;;; shadowfile.el --- automatic file copying
-;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: comm files
;; documentation for these functions for information on how and when to use
;; them). After doing this once, everything should be automatic.
-;; The lists of clusters and shadows are saved in a file called .shadows,
-;; so that they can be remembered from one Emacs session to another, even
-;; (as much as possible) if the Emacs session terminates abnormally. The
-;; files needing to be copied are stored in .shadow_todo; if a file cannot
-;; be copied for any reason, it will stay on the list to be tried again
-;; next time. The .shadows file should itself have shadows on all your
-;; accounts so that the information in it is consistent everywhere, but
-;; .shadow_todo is local information and should have no shadows.
+;; The lists of clusters and shadows are saved in a ~/.emacs.d/shadows
+;; (`shadow-info-file') file, so that they can be remembered from one
+;; Emacs session to another, even (as much as possible) if the Emacs
+;; session terminates abnormally. The files needing to be copied are
+;; stored in `shadow-todo-file'; if a file cannot be copied for any
+;; reason, it will stay on the list to be tried again next time. The
+;; `shadow-info-file' file should itself have shadows on all your accounts
+;; so that the information in it is consistent everywhere, but
+;; `shadow-todo-file' is local information and should have no shadows.
;; If you do not want to copy a particular file, you can answer "no" and
;; be asked again next time you hit C-x 4 s or exit Emacs. If you do not
;; want to be asked again, use shadow-cancel, and you will not be asked
;; until you change the file and save it again. If you do not want to
-;; shadow that file ever again, you can edit it out of the .shadows
-;; buffer. Anytime you edit the .shadows buffer, you must type M-x
+;; shadow that file ever again, you can edit it out of the shadows
+;; buffer. Anytime you edit the shadows buffer, you must type M-x
;; shadow-read-files to load in the new information, or your changes will
;; be overwritten!
;;; Code:
+(require 'cl-lib)
(require 'ange-ftp)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defcustom 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
+If nil (the default), always ask. If not nil and not t, ask only if there
is no buffer currently visiting the file."
:type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe))
:group 'shadow)
:type 'boolean
:group 'shadow)
+;; FIXME in a sense, this changed in 24.4 (addition of locate-user-emacs-file),
+;; but due to the weird way this variable is initialized to nil, it didn't
+;; literally change. Same for shadow-todo-file.
(defcustom 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"
+ensure consistency. Default: ~/.emacs.d/shadows"
:type '(choice (const nil) file)
:group 'shadow)
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"
+Default: ~/.emacs.d/shadow_todo"
:type '(choice (const nil) file)
:group 'shadow)
;;; The following two variables should in most cases initialize themselves
;;; correctly. They are provided as variables in case the defaults are wrong
-;;; on your machine \(and for efficiency).
+;;; on your machine (and for efficiency).
(defvar shadow-system-name (system-name)
"The complete hostname of this machine.")
;;;
(defvar shadow-clusters nil
- "List of host clusters \(see `shadow-define-cluster').")
+ "List of host clusters (see `shadow-define-cluster').")
(defvar shadow-literal-groups nil
"List of files that are shared between hosts.
(setq list (cdr list)))
(car list))
-(defun shadow-remove-if (func list)
- "Remove elements satisfying FUNC from LIST.
-Nondestructive; actually returns a copy of the list with the elements removed."
- (if list
- (if (funcall func (car list))
- (shadow-remove-if func (cdr list))
- (cons (car list) (shadow-remove-if func (cdr list))))
- nil))
-
(defun shadow-regexp-superquote (string)
"Like `regexp-quote', but includes the ^ and $.
This makes sure regexp matches nothing but STRING."
Replace old definition, if any. PRIMARY and REGEXP are the
information defining the cluster. For interactive use, call
`shadow-define-cluster' instead."
- (let ((rest (shadow-remove-if
- (function (lambda (x) (equal name (car x))))
- shadow-clusters)))
+ (let ((rest (cl-remove-if (lambda (x) (equal name (car x)))
+ shadow-clusters)))
(setq shadow-clusters
(cons (shadow-make-cluster name primary regexp)
rest))))
;;; SITES
(defun shadow-site-cluster (site)
- "Given a SITE \(hostname or cluster name), return cluster it is in, or nil."
+ "Given a SITE (hostname or cluster name), return cluster it is in, or nil."
(or (assoc site shadow-clusters)
(shadow-find
(function (lambda (x)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun shadow-parse-fullname (fullname)
- "Parse FULLNAME into \(site user path) list.
+ "Parse FULLNAME into (site user path) list.
Leave it alone if it already is one. Return nil if the argument is
not a full ange-ftp pathname."
(if (listp fullname)
(ange-ftp-ftp-name fullname)))
(defun shadow-parse-name (name)
- "Parse any NAME into \(site user name) list.
+ "Parse any NAME into (site user name) list.
Argument can be a simple name, full ange-ftp name, or already a hup list."
(or (shadow-parse-fullname name)
(list shadow-system-name
(defun shadow-expand-cluster-in-file-name (file)
"If hostname part of FILE is a cluster, expand it to cluster's primary hostname.
Will return the name bare if it is a local file."
- (let ((hup (shadow-parse-name file))
- cluster)
+ (let ((hup (shadow-parse-name file)))
(cond ((null hup) file)
((shadow-local-file hup))
((shadow-make-fullname (shadow-site-primary (nth 0 hup))
;;;###autoload
(defun shadow-define-cluster (name)
- "Edit \(or create) the definition of a cluster NAME.
+ "Edit (or create) the definition of a cluster NAME.
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
+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."
(interactive (list (completing-read "Cluster name: " shadow-clusters () ())))
"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')."
+specific hostnames, or names of clusters (see `shadow-define-cluster')."
(interactive)
(let* ((hup (shadow-parse-fullname
(shadow-contract-file-name (buffer-file-name))))
"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-literal-group' instead of this
-function). Each site can be either a hostname or the name of a cluster \(see
+hosts (if they aren't, use `shadow-define-literal-group' instead of this
+function). Each site can be either a hostname or the name of a cluster (see
`shadow-define-cluster')."
(interactive)
(let ((regexp (read-string
(defun shadow-make-group (regexp sites usernames)
"Make a description of a file group---
-actually a list of regexp ange-ftp file names---from REGEXP \(name of file to
+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."
(if sites
(to (shadow-expand-cluster-in-file-name (cdr s))))
(when buffer
(set-buffer buffer)
- (condition-case i
+ (condition-case nil
(progn
(write-region nil nil to)
(shadow-remove-from-todo s))
(defun shadow-shadows-of (file)
"Return 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
+Return value is a list of dotted pairs like (from . to), where from
and to are absolute file names."
(or (symbol-value (intern-soft file shadow-hashtable))
(let* ((absolute-file (shadow-expand-file-name
Consider them as regular expressions if third arg REGEXP is true."
(if groups
(let ((nonmatching
- (shadow-remove-if
- (function (lambda (x) (shadow-file-match x file regexp)))
- (car groups))))
+ (cl-remove-if (lambda (x) (shadow-file-match x file regexp))
+ (car groups))))
(append (cond ((equal nonmatching (car groups)) nil)
(regexp
(let ((realname (nth 2 (shadow-parse-fullname file))))
"Remove PAIR from `shadow-files-to-copy'.
PAIR must be `eq' to one of the elements of that list."
(setq shadow-files-to-copy
- (shadow-remove-if (function (lambda (s) (eq s pair)))
- shadow-files-to-copy)))
+ (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy)))
(defun shadow-read-files ()
"Visit and load `shadow-info-file' and `shadow-todo-file'.
(beep)
(sit-for 3)
nil)
- (save-excursion
+ (save-current-buffer
(when shadow-info-file
(set-buffer (setq shadow-info-buffer
(find-file-noselect shadow-info-file)))
defined, the old hashtable info is invalid."
(shadow-invalidate-hashtable)
(if shadow-info-file
- (save-excursion
+ (save-current-buffer
(if (not shadow-info-buffer)
(setq shadow-info-buffer (find-file-noselect shadow-info-file)))
(set-buffer shadow-info-buffer)
(file-name-as-directory (shadow-expand-file-name "~"))))
(if (null shadow-info-file)
(setq shadow-info-file
- (shadow-expand-file-name (convert-standard-filename "~/.shadows"))))
+ ;; FIXME: Move defaults to their defcustom.
+ (shadow-expand-file-name
+ (locate-user-emacs-file "shadows" ".shadows"))))
(if (null shadow-todo-file)
(setq shadow-todo-file
(shadow-expand-file-name
- (convert-standard-filename "~/.shadow_todo"))))
+ (locate-user-emacs-file "shadow_todo" ".shadow_todo"))))
(if (not (shadow-read-files))
(progn
(message "Shadowfile information files not found - aborting")
HCoop / bpt / emacs.git / blobdiff