home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / gnu / emacs / sources / 807 < prev    next >
Encoding:
Text File  |  1992-11-18  |  13.5 KB  |  352 lines
  1. Path: sparky!uunet!charon.amdahl.com!pacbell.com!sgiblab!zaphod.mps.ohio-state.edu!ub!galileo.cc.rochester.edu!rochester!boris
  2. From: boris@cs.rochester.edu (Boris Goldowsky)
  3. Newsgroups: gnu.emacs.sources
  4. Subject: Re: Automatic file carbon-copying
  5. Summary: yet another...
  6. Message-ID: <1992Nov18.214842.16875@cs.rochester.edu>
  7. Date: 18 Nov 92 21:48:42 GMT
  8. References: <KEVIN.92Nov18163701@calamityjane.edscom.demon.co.uk>
  9. Reply-To: boris@slate.cs.rochester.edu
  10. Organization: University of Rochester
  11. Lines: 339
  12.  
  13. Several versions of file-copying packages have been posted recently, but I
  14. will post this one anyway... I haven't seen anything quite like it yet.
  15.  
  16. This is for people with accounts on several hosts, who want to keep
  17. identical copies of some files on more than one host.  It does this in a
  18. failrly general way.  The files are not required to have the same name on
  19. all hosts, but if they do you can specify groups of files with a
  20. regular expression.  You do not need .rhosts files, since it uses ange-ftp
  21. to do the transfers.
  22.  
  23. Bugs, suggestions (especially if you have good ideas for the user
  24. interface), or questions to me...  (code follows .sig)
  25. --
  26. Boris Goldowsky                        The only way you'll end up in a corner
  27.                                         Is by walking in too straight of a li
  28. boris@prodigal.psych.rochester.edu        --Claudia Schmidt                 n
  29. 57 Glasgow Street, Rochester, NY 14608                                      e
  30.  
  31. ----------------------------------------------------------------------
  32. ;;;; shadow-files.el: For keeping identical copies of files on multiple hosts
  33. ;;;  By Boris Goldowsky, 11/92.  Bugs to <boris@prodigal.psych.rochester.edu>.
  34.  
  35. ;;; USE: put (require 'shadow-files) in your .emacs; add clusters and file
  36. ;;; groups with shadow-define-cluster, shadow-define-group, and
  37. ;;; shadow-define-regexp-group (see the documentation for these functions for
  38. ;;; information on how and when to use them).  After doing this once,
  39. ;;; everything should be automatic.
  40. ;;;     If you need to remove or edit a cluster or file group, you can edit the
  41. ;;; .shadows buffer, then type M-x shadow-read to load in the new information
  42. ;;; (if you do not do this, your changes could be overwritten!).
  43.  
  44. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45. ;;; DEPENDENCIES:
  46. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47. ;;;  All of the packages mentioned below are available from archive sites like
  48. ;;;  archive.cis.ohio-state.edu. 
  49.  
  50. ;;; ANGE-FTP.  This file could be modified (with some loss of generality and
  51. ;;; cleanliness of the user interface) to use only the standard ftp library by
  52. ;;; replacing the call to write-region with:
  53. ;;;  (ftp-write-file (shadow-primary (shadow-site s)) (shadow-file s))
  54.  
  55. (require 'ange-ftp)
  56.  
  57. ;;; ADD-HOOK.  Several implementations of this are available.  I'd
  58. ;;; use ange-ftp-add-hook, but that is capable of messing up write-file-hooks.
  59.  
  60. (require 'add-hook)
  61.  
  62. ;;; CL, the common lisp library in the standard emacs distribution.
  63.  
  64. (require 'cl)
  65.  
  66. ;;; SYMLINK-FIX.  Symbolic links can cause nasty surprises, so I recommend
  67. ;;; loading this package.  However, it is not actually necessary, so comment
  68. ;;; out the next two lines if you want, and proceeed at your own risk.
  69.  
  70. (setq symlink-overload-expand-file-name t)
  71. (require 'symlink-fix)
  72.  
  73. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74. ;;; Variables
  75. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  76.  
  77. (defvar shadow-info-file "~/.shadows"
  78.   "*File to keep shadow information in.  
  79. If this is nil, the information will not be read from or saved to a file.")
  80.  
  81. (defvar shadow-noquery nil
  82.   "*If t, always copy shadow files without asking.")
  83.  
  84. (defvar kill-emacs-hooks nil
  85.   ;; Note, this is the one symbol defined in this file which does not begin
  86.   ;; with shadow- .  However, if it is already defined, we don't clobber it.
  87.   "*Functions to run before exiting emacs.
  88. This is a replacement for kill-emacs-hook, which only allowed one hook
  89. function.")
  90.  
  91. (defvar shadow-homedir (expand-file-name (getenv "HOME"))
  92.   ;; Call to expand-file-name is in case we are using symlink-fix
  93.   "The directory that shadow file specs are assumed to be relative to 
  94. \(on this machine), if not specified as absolute pathnames.")
  95.  
  96. (defvar shadow-clusters nil
  97.   "List of host clusters.")
  98.  
  99. (defvar shadow-literal-groups nil
  100.   "List of files that are shared between hosts.
  101. This list contains shadow structures with literal filenames, created by
  102. shadow-define-group.")
  103.  
  104. (defvar shadow-regexp-groups nil
  105.   "List of file types that are shared between hosts.
  106. This list contains shadow structures with regexps matching filenames, 
  107. created by shadow-define-regexp-group.")
  108.  
  109. (defvar shadow-marked-files nil
  110.   "List of files that need to be copied to remote hosts.")
  111.  
  112. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  113.  
  114. (defstruct shadow-cluster
  115.   "Structure for holding information about host clusters.
  116. The shadow-clusters variable associates the names of clusters to these
  117. structures."
  118.   primary
  119.   regexp)
  120.  
  121. (defstruct shadow
  122.   "Structure for holding information about shadows of files.
  123. The site can be a cluster \(symbol) or a hostname \(string).  The file can be
  124. either a literal filename, or a regexp.  The buffer may is only filled in once
  125. something is in the shadow-marked-files list."
  126.   site
  127.   file
  128.   buffer
  129.   )
  130.  
  131. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  132. ;;; User-level Commands
  133. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  134.  
  135. (defun shadow-define-cluster (name primary regexp)
  136.   "Define a new `cluster.'
  137. This is a group of hosts that share files, so that copying to or from
  138. one of them is sufficient to update the file on all of them.  Clusters are
  139. defined by a NAME, the name of a PRIMARY host \(the one we copy files to), and
  140. a REGEXP that matches the hostname of all the sites in the cluster."
  141.   (interactive (let* ((name (read-no-blanks-input "Cluster name: " ""))
  142.               (primary (read-no-blanks-input "Primary host: " name))
  143.               (regexp (read-string "Regexp matching all host names: "
  144.                        (regexp-quote primary))))
  145.          (list (intern name) primary regexp)))
  146.   (let ((c (cons name (make-shadow-cluster :primary primary
  147.                        :regexp regexp))))
  148.     (when (not (member c shadow-clusters))
  149.       (push c shadow-clusters)
  150.       (shadow-write))))
  151.  
  152. (defun shadow-define-group (&rest shadows)
  153.   "Set things up so that one file is shared between hosts.
  154. Prompts for hostnames and the file's name on each host.  When any of these is
  155. edited, the new file will be copied to each of the other locations.  Filenames
  156. may be either absolute or relative to the home directory; sites can be specific
  157. hostnames or names of clusters \(see shadow-define-cluster).
  158.   Noninteractively, each arg is a dotted pair of a site and a filename."
  159.   (interactive (let (args site file)
  160.          (while (setq site (shadow-read-site))
  161.            (setq args (cons (cons site (read-string "Filename: "
  162.                                 (cdar args)))
  163.                     args)))
  164.          args))
  165.   (push (mapcar (function (lambda (pair) 
  166.                 (make-shadow :site (car pair)
  167.                      :file (cdr pair))))
  168.         shadows)
  169.     shadow-literal-groups)
  170.   (shadow-write))
  171.  
  172. (defun shadow-define-regexp-group (regexp sites)
  173.   "Set things up so that a group of files are shared between hosts.
  174. Files matching REGEXP are shared between the list of SITES;
  175. the filenames must be identical on all hosts \(if they aren't, use
  176. shadow-define-group instead of this function).  Each site can be either a
  177. hostname or the name of a cluster \(see shadow-define-cluster)."
  178.   (interactive (let ((regexp (read-string "Filename regexp: " 
  179.                       (regexp-quote 
  180.                        (file-name-nondirectory
  181.                         (buffer-file-name)))))
  182.              site sites)
  183.          (while (setq site (shadow-read-site))
  184.            (push site sites))
  185.          (list regexp sites)))
  186.   (push (mapcar (function (lambda (site)
  187.                 (make-shadow :site site
  188.                      :file regexp)))
  189.         sites)
  190.     shadow-regexp-groups)
  191.   (shadow-write))
  192.  
  193. (defun shadow-write-marked-files ()
  194.   "FTP all files in shadow-marked-files list to their shadows.
  195. This is invoked from kill-emacs-hook, so you do not need to call it
  196. explicitly."
  197.   (interactive)
  198.   (let (notdone)
  199.     (dolist (s shadow-marked-files)
  200.       (if (or shadow-noquery 
  201.           (y-or-n-p (format "Write shadow file %s:%s?" 
  202.                 (shadow-site s)
  203.                 (shadow-file s)))) 
  204.       (let ((buffer (condition-case i
  205.                 (set-buffer (shadow-buffer s))
  206.               (error (if (y-or-n-p 
  207.  (format "Buffer killed -- ftp %s anyway?" (shadow-file s)))
  208.                      (find-file-noselect (shadow-file s)))))))
  209.         (when buffer
  210.           (save-restriction
  211.         (widen)
  212.         (condition-case i 
  213.             (write-region (point-min) (point-max) ; see note 1 above
  214.                   (concat "/" (shadow-primary (shadow-site s))
  215.                       ":" (shadow-file s)))
  216.           (error (setq notdone (cons s notdone)))))))
  217.     (setq notdone (cons s notdone))))
  218.     (setq shadow-marked-files notdone)))
  219.  
  220. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  221. ;;; Internal functions
  222. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  223.  
  224. (defun shadow-of (buffer)
  225.   "If BUFFER's file has shadows, return the list of shadow structures."
  226.   (let* ((site (system-name))
  227.      (file-abs (buffer-file-name buffer))
  228.      (file-rel (if (string-match (concat "^" (regexp-quote shadow-homedir))
  229.                      file-abs)
  230.                (substring file-abs (1+ (match-end 0)))))
  231.      (found nil))
  232.     (dolist (group shadow-literal-groups)
  233.       (if (some (function 
  234.          (lambda (s)
  235.            (let ((f (shadow-file s)))
  236.              (and (string-equal file-abs 
  237.                     (expand-file-name f shadow-homedir))
  238.               (shadow-site-match (shadow-site s) site)))))
  239.         group)
  240.       (setq found (append found 
  241.                   (shadow-what-to-copy site nil buffer group)))))
  242.     (dolist (group shadow-regexp-groups)
  243.       (if (and (or (string-match (shadow-file (car group)) file-abs)
  244.            (if file-rel
  245.                (string-match (shadow-file (car group)) file-rel)))
  246.            (some (function
  247.               (lambda (s)
  248.             (shadow-site-match (shadow-site s) site)))
  249.              group))
  250.       (setq found (append found
  251.                   (shadow-what-to-copy site (or file-rel file-abs)
  252.                            buffer group)))))
  253.     found))
  254.  
  255. (defun shadow-what-to-copy (site file buffer group)
  256.   "Return list of shadow structures indicating the copy operations that need to
  257.   be performed in order to reflect a modification made at SITE to FILE/BUFFER
  258.   which has the given GROUP of shadow files.  If file argument is nil, trust
  259.   the filenames in the structures in group.  You probably don't want to use
  260.   this unless you are the shadow-of function \(which I doubt :-)."
  261.   (let (found)
  262.     (dolist (s group)
  263.       (if (not (shadow-site-match (shadow-site s) site))
  264.       (push (make-shadow :site (shadow-primary (shadow-site s))
  265.                  :file (or file (shadow-file s))
  266.                  :buffer buffer)
  267.         found)))
  268.     found))
  269.  
  270. (defun shadow-mark-file-for-write ()
  271.   "Add the current file to the list of shadow-marked-files,
  272. if it is on the shadow-file-list."
  273.   (let ((shadows (shadow-of (current-buffer))))
  274.     (dolist (s shadows)
  275.       (when (not (member-general s shadow-marked-files (function equal)))
  276.     (push s shadow-marked-files)
  277.     (message "Use %s to copy this file to %s."
  278.          (substitute-command-keys "\\[shadow-write-marked-files]")
  279.          (shadow-primary (shadow-site s)))
  280.     (sit-for 1))))
  281.    nil); Return nil for write-file-hooks
  282.  
  283. (defun shadow-read-site ()
  284.   "Read a site or cluster name from the minibuffer."
  285.   (let ((ans (read-no-blanks-input "Site or cluster [RET when done]: " "")))
  286.     (cond ((equal "" ans) nil)
  287.       ((assoc (intern ans) shadow-clusters) (intern ans))
  288.       (t ans))))
  289.  
  290. (defun shadow-site-match (site1 site2)
  291.   "See if SITE1 matches SITE2.  
  292. Each may be a string or a cluster; if they are clusters,
  293. regexp of site1 will be matched against the primary of site2."
  294.   (setq site2 (shadow-primary site2))
  295.   (if (symbolp site1)
  296.       (string-match (shadow-cluster-regexp (cdr (assoc site1 shadow-clusters)))
  297.             site2)
  298.     (string-equal site1 site2)))
  299.  
  300. (defun shadow-primary (host)
  301.   (if (symbolp host)
  302.       (shadow-cluster-primary (cdr (assoc host shadow-clusters)))
  303.     host))
  304.  
  305. (defun shadow-read ()
  306.   (interactive)
  307.   (when shadow-info-file
  308.     (save-excursion
  309.       (set-buffer (find-file-noselect shadow-info-file))
  310.       (eval-current-buffer nil))))
  311.  
  312. (defun shadow-write ()
  313.   (when shadow-info-file
  314.     (save-excursion
  315.       (set-buffer (find-file-noselect shadow-info-file))
  316.       (delete-region (point-min) (point-max))
  317.       (insert (format "(setq shadow-clusters '%s)\n\n" 
  318.               shadow-clusters)
  319.           (format "(setq shadow-literal-groups '%s)\n\n" 
  320.               shadow-literal-groups)
  321.           (format "(setq shadow-regexp-groups '%s)\n\n" 
  322.               shadow-regexp-groups)))))
  323.  
  324. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  325. ;;; Hook us up
  326. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  327.  
  328. (defun shadow-kill-emacs-hook ()
  329.   "Make there be more than one kill-emacs-hook,
  330. so we can hook ourselves up without messing up any other packages."
  331.   (run-hooks 'kill-emacs-hooks))
  332.  
  333. (when (not (and (boundp 'kill-emacs-hook)
  334.         (eq kill-emacs-hook 'shadow-kill-emacs-hook)))
  335.   (setq kill-emacs-hooks (if (boundp 'kill-emacs-hook) kill-emacs-hook nil))
  336.   (setq kill-emacs-hook 'shadow-kill-emacs-hook)
  337.   (add-hook 'kill-emacs-hooks 'shadow-write-marked-files))
  338.  
  339. (add-hook 'write-file-hooks 'shadow-mark-file-for-write)
  340.  
  341. (define-key ctl-x-4-map "s" 'shadow-write-marked-files)
  342.  
  343. (shadow-read)
  344.  
  345. (provide 'shadow-files)
  346.  
  347. -- 
  348. Boris Goldowsky                        The only way you'll end up in a corner
  349.                                         Is by walking in too straight of a li
  350. boris@prodigal.psych.rochester.edu        --Claudia Schmidt                 n
  351. 57 Glasgow Street, Rochester, NY 14608                                      e
  352.