;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat May 7 01:33:20 1994 ;;; from file /home/fsf/rms/e19/lisp/shadowfile.el ;;; emacs version 19.22.91.5. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/home/fsf/rms/e19/lisp/shadowfile.el' was compiled for Emacs 19")) (byte-code "!!" [provide shadowfile require ange-ftp t find-file-visit-truename] 2) (defvar shadow-noquery nil "\ *If t, always copy shadow files without asking. If nil (the default), always ask. If not nil and not t, ask only if there is no buffer currently visiting the file.") (defvar shadow-inhibit-message nil "\ *If nonnil, do not display a message when a file needs copying.") (defvar shadow-inhibit-overload nil "\ If nonnil, shadowfile won't redefine C-x C-c. Normally it overloads the function `save-buffers-kill-emacs' to check for files have been changed and need to be copied to other systems.") (defvar shadow-info-file nil "\ File to keep shadow information in. The shadow-info-file should be shadowed to all your accounts to ensure consistency. Default: ~/.shadows") (defvar shadow-todo-file nil "\ File to store the list of uncopied shadows in. This means that if a remote system is down, or for any reason you cannot or decide not to copy your shadow files at the end of one emacs session, it will remember and ask you again in your next emacs session. This file must NOT be shadowed to any other system, it is host-specific. Default: ~/.shadow_todo") (defvar shadow-system-name (system-name) "\ The complete hostname of this machine.") (defvar shadow-homedir nil "\ Your home directory on this machine.") (defvar shadow-clusters nil "\ List of host clusters (see shadow-define-cluster).") (defvar shadow-literal-groups nil "\ List of files that are shared between hosts. This list contains shadow structures with literal filenames, created by shadow-define-group.") (defvar shadow-regexp-groups nil "\ List of file types that are shared between hosts. This list contains shadow structures with regexps matching filenames, created by shadow-define-regexp-group.") (byte-code "!!!! ‡" [boundp shadow-files-to-copy nil shadow-hashtable shadow-info-buffer shadow-todo-buffer] 2) (defalias 'shadow-when '(macro . #[(condition &rest body) "\nD\fBBB" [if not condition nil body] 4 "\ (shadow-when CONDITION . BODY) => evaluate BODY if CONDITION is true."])) (defalias 'shadow-union #[(a b) " @ A \"A@ B\"" [a b shadow-union] 4 "\ Add members of list A to list B if they are not equal to items already in B."]) (defalias 'shadow-find #[(func list) " @!A@" [list func] 3 "\ If FUNC applied to some element of LIST is nonnil, return the first such element."]) (defalias 'shadow-remove-if #[(func list) " @! A\"@ A\"B" [list func shadow-remove-if] 4 "\ Remove elements satisfying FUNC from LIST. Nondestructive; actually returns a copy of the list with the elements removed."]) (defalias 'shadow-join #[(strings sep) "A@@A\f\"Q" [strings "" " " shadow-join sep] 5 "\ Concatenate elements of the list of STRINGS with SEP between each."]) (defalias 'shadow-regexp-superquote #[(string) "\n!Q" ["^" regexp-quote string "$"] 3 "\ Like regexp-quote, but includes the ^ and $ to make sure regexp matches nothing but STRING."]) (defalias 'shadow-suffix #[(prefix string) "G G\n Y O O*" [prefix string ls lp 0 nil] 4 "\ If PREFIX begins STRING, return the rest. Return value is nonnil if PREFIX and STRING are string= up to the length of PREFIX."]) (defalias 'shadow-make-cluster #[(name primary regexp) " \nE" [name primary regexp] 3 "\ Creates a shadow cluster called NAME, using the PRIMARY hostname, REGEXP matching all hosts in the cluster. The variable shadow-clusters associates the names of clusters to these structures. This function is for program use: to create clusters interactively, use shadow-define-cluster instead."]) (defalias 'shadow-cluster-name '(macro . #[(cluster) " E" [elt cluster 0] 3 "\ Return the name of the CLUSTER."])) (defalias 'shadow-cluster-primary '(macro . #[(cluster) " E" [elt cluster 1] 3 "\ Return the primary hostname of a CLUSTER."])) (defalias 'shadow-cluster-regexp '(macro . #[(cluster) " E" [elt cluster 2] 3 "\ Return the regexp matching hosts in a CLUSTER."])) (defalias 'shadow-set-cluster #[(name primary regexp) "\n\" # B)" [shadow-remove-if #[(x) " @" [name x] 2] shadow-clusters rest shadow-make-cluster name primary regexp] 4 "\ Put cluster NAME on the list of clusters, replacing old definition if any. PRIMARY and REGEXP are the information defining the cluster. For interactive use, call shadow-define-cluster instead."]) (defalias 'shadow-get-cluster '(macro . #[(name) " E" [assoc name shadow-clusters] 3 "\ Return cluster named NAME, or nil."])) (defalias 'shadow-site-primary #[(site) " \n\" Ĝ )" [assoc site shadow-clusters c 1] 4 "\ If SITE is a cluster, return primary host, otherwise return SITE."]) (defalias 'shadow-site-cluster #[(site) " \n\" \n\"" [assoc site shadow-clusters shadow-find #[(x) " œ \"" [string-match x 2 site] 3]] 3 "\ Given a SITE (hostname or cluster name), return the cluster that it is in, or nil."]) (defalias 'shadow-read-site #[nil "\n\"Ě? )" [completing-read "Host or cluster name [RET when done]: " shadow-clusters ans ""] 4 "\ Read a cluster name or hostname from the minibuffer."]) (defalias 'shadow-site-match #[(site1 site2) " # \" !\f\fȜ\"\"*" [site1 site2 assoc shadow-clusters cluster1 shadow-site-primary primary2 string-match 2] 3 "\ Nonnil iff SITE1 is or includes SITE2. Each may be a host or cluster name; if they are clusters, regexp of site1 will be matched against the primary of site2."]) (defalias 'shadow-get-user #[(site) "\n!!" [ange-ftp-get-user shadow-site-primary site] 3 "\ Returns the default username for a site."]) (defalias 'shadow-parse-fullpath #[(fullpath) "<!" [fullpath ange-ftp-ftp-name] 2 "\ Parse PATH into (site user path) list, or leave it alone if it already is one. Returns nil if the argument is not a full ange-ftp pathname."]) (defalias 'shadow-parse-path #[(path) " ! \n E" [shadow-parse-fullpath path shadow-system-name user-login-name] 3 "\ Parse any PATH into (site user path) list. Argument can be a simple path, full ange-ftp path, or already a hup list."]) (defalias 'shadow-make-fullpath #[(host user path) "  P " ["/" user "@" host ":" path] 5 "\ Make an ange-ftp style fullpath out of HOST, USER (optional), and PATH. This is probably not as general as it ought to be."]) (put (quote shadow-make-fullpath) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'shadow-replace-path-component #[(fullpath newpath) " !@\nA@   P\f," [shadow-parse-fullpath fullpath hup newpath path user host "/" "@" ":"] 6 "\ Return FULLPATH with the pathname component changed to NEWPATH."]) (defalias 'shadow-local-file #[(file) " !\f $\n@\f\"#\nA@ #\n8$)" [shadow-parse-fullpath file hup shadow-site-match shadow-system-name user-login-name 2 nil] 4 "\ If FILENAME is at this site, remove /user@host part. If refers to a different system or a different user on this system, return nil."]) (defalias 'shadow-expand-cluster-in-file-name #[(file) " ! 6\f!6\f@!\fA@\f8 \n . P\n+*" [shadow-parse-path file nil cluster hup shadow-local-file shadow-site-primary 2 path user host "/" "@" ":"] 6 "\ If hostname part of FILE is a cluster, expand it into the cluster's primary hostname. Will return the pathname bare if it is a local file."]) (defalias 'shadow-expand-file-name #[(file &optional default) "\n \"!" [file-truename expand-file-name file default] 4 "\ Expand file name and get file's true name."]) (defalias 'shadow-contract-file-name #[(file) " !\n!\f4\n@\nA@\n \f ( P\f\n+!!8!\n8\"\n@!P՜R\n@\nA@aPd\n8\n \f t P\f\n." [shadow-parse-path file hup shadow-local-file shadow-homedir file-name-as-directory 2 shadow-parse-fullpath expand-file-name "~" path user host "/" "@" ":" homedir shadow-suffix suffix shadow-site-cluster cluster 0 "~/"] 10 "\ Simplify FILENAME by replacing (when possible) home directory with ~, and hostname with cluster name that includes it. Filename should be absolute and true."]) (defalias 'shadow-same-site #[(pattern file) " ! ! @\f@\" A@? A@\fA@*" [shadow-parse-fullpath pattern shadow-parse-path file file-sup pattern-sup shadow-site-match] 3 "\ True if the site of PATTERN and of FILE are on the same site. If usernames are supplied, they must also match exactly. PATTERN and FILE may be lists of host, user, path, or ange-ftp pathnames. FILE may also be just a local filename."]) (defalias 'shadow-file-match #[(pattern file &optional regexp) " !\f!\n \"&\n8 8\"&\n8 8*" [shadow-parse-fullpath pattern pattern-sup shadow-parse-path file file-sup shadow-same-site regexp string-match 2] 4 "\ Returns t if PATTERN matches FILE. If REGEXP is supplied and nonnil, the pathname part of the pattern is a regular expression, otherwise it must match exactly. The sites and usernames must match---see shadow-same-site. The pattern must be in full ange-ftp format, but the file can be any valid filename. This function does not do any filename expansion or contraction, you must do that yourself first."]) (defalias 'shadow-define-cluster #[(name) " \n\"  Ɯ \" % ̜)!\" \">!! ) #+" [assoc name shadow-clusters old read-string "Primary host: " 1 primary nil try-regexp string-match "Regexp matching all host names: " 2 shadow-regexp-superquote message "Regexp doesn't include the primary host!" sit-for regexp shadow-set-cluster] 5 "\ Edit (or create) the definition of a cluster. This is a group of hosts that share directories, so that copying to or from one of them is sufficient to update the file on all of them. Clusters are defined by a name, the network address of a primary host (the one we copy files to), and a regular expression that matches the hostnames of all the sites in the cluster." (list (completing-read "Cluster name: " shadow-clusters nil nil))]) (defalias 'shadow-define-literal-group #[nil " !! 8 ]!\"! \"И<!> NP + B  B- " [shadow-parse-fullpath shadow-contract-file-name buffer-file-name hup 2 path nil user site group shadow-read-site read-string format "Username [default %s]: " shadow-get-user "Filename: " "" host "/" "@" ":" shadow-literal-groups shadow-write-info-file] 5 "\ Declare a single file to be shared between sites. It may have different filenames on each site. When this file is edited, the new version will be copied to each of the other locations. Sites can be specific hostnames, or names of clusters (see shadow-define-cluster)." nil]) (defalias 'shadow-define-regexp-group #[nil "  !!8!\"lj \n \n?\n B \n\"\n!\"B  #B ," [read-string "Filename regexp: " buffer-file-name shadow-regexp-superquote 2 shadow-parse-path shadow-contract-file-name nil usernames sites site regexp shadow-read-site format "Username for %s: " shadow-get-user shadow-make-group shadow-regexp-groups shadow-write-info-file] 7 "\ Make each of a group of files be shared between hosts. Prompts for regular expression; files matching this are shared between a list of sites, which are also prompted for. The filenames must be identical on all hosts (if they aren't, use shadow-define-group instead of this function). Each site can be either a hostname or the name of a cluster (see shadow-define-cluster)." nil]) (defalias 'shadow-shadows #[nil " !\"\"GUɂ!)" [shadow-join mapcar cdr shadow-shadows-of buffer-file-name " " msg message 0 "No shadows."] 5 "\ Interactive function to display shadows of a buffer." nil]) (defalias 'shadow-copy-files #[(&optional arg) "\ft\f!$!)" [shadow-files-to-copy message "No files need to be shadowed." map-y-or-n-p #[(pair) " \fA\"" [arg shadow-noquery format "Copy shadow file %s? " pair] 3] shadow-copy-file ("shadow" "shadows" "copy") shadow-write-todo-file t] 5 "\ Copy all pending shadow files. With prefix argument, copy all pending files without query. Pending copies are stored in variable shadow-files-to-copy, and in shadow-todo-file if necessary. This function is invoked by shadow-save-buffers-kill-emacs, so it is not usually necessary to call it manually." "P"]) (defalias 'shadow-cancel #[nil " $ G\"! " [map-y-or-n-p #[(pair) "\n@\nA#" [format "Cancel copying %s to %s? " pair] 4] #[(pair) " !" [shadow-remove-from-todo pair] 2] shadow-files-to-copy ("shadow" "shadows" "cancel copy") message format "There are %d shadows to be updated." shadow-write-todo-file] 5 "\ Cancel the instruction to copy some files. Prompts for which copy operations to cancel. You will not be asked to copy them again, unless you make more changes to the files. To cancel a shadow permanently, remove the group from shadow-literal-groups or shadow-regexp-groups." nil]) (defalias 'shadow-make-group #[(regexp sites usernames) "\"@ @\n\f\fP +\nA A#B" [sites usernames regexp path user host "/" "@" ":" shadow-make-group] 5 "\ Makes a description of a file group--- actually a list of regexp ange-ftp file names---from REGEXP (name of file to be shadowed), list of SITES, and corresponding list of USERNAMES for each site."]) (defalias 'shadow-copy-file #[(s) " @!!!9 @!$ @\"! !ɂ9\n=5 @\"!9 @! A!??Tq~ӏ)*" [get-file-buffer abbreviate-file-name shadow-expand-file-name s file-readable-p y-or-n-p format "Cannot find file %s--cancel copy request?" shadow-remove-from-todo nil shadow-noquery t "No buffer for %s -- update shadow anyway?" find-file-noselect buffer shadow-expand-cluster-in-file-name to i (byte-code "ed # !" [write-region to shadow-remove-from-todo s] 4) ((error (byte-code " A\"!" [message format "Shadow %s not updated!" s] 4)))] 4 "\ Copy one shadow file."]) (defalias 'shadow-shadows-of #[(file) " \n\"J7 ! \"! ##\"\" \n\"L+" [intern-soft file shadow-hashtable shadow-expand-file-name shadow-local-file shadow-homedir absolute-file shadow-contract-file-name canonical-file mapcar #[(shadow) " B" [absolute-file shadow] 2] append shadow-shadows-of-1 shadow-literal-groups nil shadow-regexp-groups t shadows intern] 8 "\ Returns copy operations needed to update FILE. Filename should have clusters expanded, but otherwise can have any format. Return value is a list of dotted pairs like (from . to), where from and to are absolute file names."]) (defalias 'shadow-shadows-of-1 #[(file groups regexp) "6@\" @ł,+ !8\n \"),  A#\")" [groups shadow-remove-if #[(x) " \n #" [shadow-file-match x file regexp] 4] nonmatching append nil regexp 2 shadow-parse-fullpath file realpath mapcar #[(x) " \n\"" [shadow-replace-path-component x realpath] 3] shadow-shadows-of-1] 6 "\ Return list of FILE's shadows in GROUPS, which are considered as regular expressions if third arg REGEXP is true."]) (defalias 'shadow-add-to-todo #[nil "p!!!# \" !!! )͇" [shadow-shadows-of shadow-expand-file-name buffer-file-name shadows shadow-union shadow-files-to-copy shadow-inhibit-message message substitute-command-keys "Use \\[shadow-copy-files] to update shadows." sit-for 1 shadow-write-todo-file nil] 5 "\ If current buffer has shadows, add them to the list of files needing to be copied."]) (defalias 'shadow-remove-from-todo #[(pair) "\n\"" [shadow-remove-if #[(s) " =" [s pair] 2] shadow-files-to-copy] 3 "\ Remove PAIR from shadow-files-to-copy. PAIR must be (eq to) one of the elements of that list."]) (defalias 'shadow-read-files #[nil "!!\n!; !;!! !ɇ\nN\n! q K \n\"K !@\"! { !q w \"w !@\"!! )և" [fboundp file-locked-p shadow-info-file shadow-todo-file message "Shadowfile is running in another emacs; can't have two." beep sit-for 3 nil find-file-noselect shadow-info-buffer buffer-modified-p file-newer-than-file-p make-auto-save-file-name erase-buffer "Data recovered from %s." insert-file-contents 1 eval-current-buffer shadow-todo-buffer shadow-invalidate-hashtable t] 4 "\ Visits and loads shadow-info-file and shadow-todo-file, thus restoring shadowfile's state from your last emacs session. Returns t unless files were locked; then returns nil." nil]) (defalias 'shadow-write-info-file #[nil " #\n !\nqed|!!!)" [shadow-invalidate-hashtable shadow-info-file shadow-info-buffer find-file-noselect shadow-insert-var shadow-clusters shadow-literal-groups shadow-regexp-groups] 2 "\ Write out information to shadow-info-file. Also clears shadow-hashtable, since when there are new shadows defined, the old hashtable info is invalid."]) (defalias 'shadow-write-todo-file #[(&optional save) " \n!qed|!  )" [shadow-todo-buffer find-file-noselect shadow-todo-file shadow-insert-var shadow-files-to-copy save shadow-save-todo-file] 2 "\ Write out information to shadow-todo-file. With nonnil argument also saves the buffer."]) (byte-code "\"\"" [defalias shadow-save-todo-file #[nil "!qď)" [shadow-todo-buffer buffer-modified-p nil (basic-save-buffer) ((error (byte-code "!!" [message "WARNING: Can't save shadow todo file; it is locked!" sit-for 1] 2)))] 3] shadow-invalidate-hashtable #[nil "\"" [make-vector 37 0 shadow-hashtable] 3]] 3) (defalias 'shadow-insert-var #[(variable) "p \"c !:;c !@! !A5c@!A#c)Fc !!c)" [standard-output format "(setq %s" variable eval "\n '(" prin1 rest "\n " "))\n\n" " " ")\n\n"] 4 "\ Prettily insert a setq command for VARIABLE. which, when later evaluated, will restore it to its current setting. SYMBOL must be the name of a variable whose value is a list."]) (defalias 'shadow-save-buffers-kill-emacs #[(&optional arg) " \n\" \">!i!g  Z@!>Q@!@\")Q A/ ?c!*i " [shadow-save-todo-file save-some-buffers arg t shadow-copy-files mapcar #[(buf) " ! !" [buffer-file-name buf buffer-modified-p] 2] buffer-list yes-or-no-p "Modified buffers exist; exit anyway? " fboundp process-list nil active processes process-status (run stop open) process-kill-without-query val "Active processes exist; kill them and exit anyway? " kill-emacs] 5 "\ Offer to save each buffer and copy shadows, then kill this Emacs process. With prefix arg, silently save all file-visiting buffers, then kill. Extended by shadowfile to automatically save `shadow-todo-file' and look for files that have been changed and need to be copied to other systems." "P"]) (byte-code "\" \" " [defalias shadow-initialize #[nil "\n!!\f!! ,! !A!AKMKM\"#" [shadow-homedir file-name-as-directory shadow-expand-file-name "~" shadow-info-file "~/.shadows" shadow-todo-file "~/.shadow_todo" shadow-read-files message "Shadowfile information files not found - aborting" beep sit-for 3 shadow-inhibit-overload fboundp shadow-orig-save-buffers-kill-emacs save-buffers-kill-emacs shadow-save-buffers-kill-emacs add-hook write-file-hooks shadow-add-to-todo define-key ctl-x-4-map "s" shadow-copy-files] 4] noninteractive add-hook after-init-hook] 3)