summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2021-04-08 19:34:57 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2021-04-08 19:34:57 -0400
commita4575655d271353a70287c497cf81efd4b8beb82 (patch)
treeaaa4e8c7156d04b95f07763afdf2e624ed07e55a
parent3492cc36f23c99344a6533a5ba4c6080b10d35a1 (diff)
downloademacs-a4575655d271353a70287c497cf81efd4b8beb82.tar.gz
* lisp/shadowfile.el: Use lexical-binding
Delete redundant `:group` args. (shadow-hashtable): Make it an actual hash-table. (shadow-shadows-of, shadow-invalidate-hashtable): Adjust accordingly. (shadow-insert-var): Strength-reduce `eval` to `symbol-value`. (shadow--save-buffers-kill-emacs): New function extracted from `shadow-save-buffers-kill-emacs`. (shadow-save-buffers-kill-emacs): Use it and use `save-buffers-kill-emacs`. (shadow-initialize, shadowfile-unload-function): Use `advice-add/remove` rather than override `save-buffers-kill-emacs` with `defalias`.
-rw-r--r--lisp/shadowfile.el87
1 files changed, 33 insertions, 54 deletions
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index b5e7d444c51..f39f17329f2 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -1,4 +1,4 @@
-;;; shadowfile.el --- automatic file copying
+;;; shadowfile.el --- automatic file copying -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
@@ -90,27 +90,23 @@
"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."
- :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe))
- :group 'shadow)
+ :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe)))
(defcustom shadow-inhibit-message nil
"If non-nil, do not display a message when a file needs copying."
- :type 'boolean
- :group 'shadow)
+ :type 'boolean)
(defcustom shadow-inhibit-overload nil
"If non-nil, shadowfile won't redefine \\[save-buffers-kill-emacs].
Normally it overloads the function `save-buffers-kill-emacs' to check for
files that have been changed and need to be copied to other systems."
- :type 'boolean
- :group 'shadow)
+ :type 'boolean)
(defcustom shadow-info-file (locate-user-emacs-file "shadows" ".shadows")
"File to keep shadow information in.
The `shadow-info-file' should be shadowed to all your accounts to
ensure consistency. Default: ~/.emacs.d/shadows"
:type 'file
- :group 'shadow
:version "26.2")
(defcustom shadow-todo-file
@@ -122,13 +118,12 @@ 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: ~/.emacs.d/shadow_todo"
:type 'file
- :group 'shadow
:version "26.2")
-;;; 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).
+;; 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).
(defvar shadow-system-name (concat "/" (system-name) ":")
"The identification for local files on this machine.")
@@ -160,7 +155,7 @@ created by `shadow-define-regexp-group'.")
(defvar shadow-files-to-copy nil) ; List of files that need to
; be copied to remote hosts.
-(defvar shadow-hashtable nil) ; for speed
+(defvar shadow-hashtable (make-hash-table :test #'equal)) ; for speed
(defvar shadow-info-buffer nil) ; buf visiting shadow-info-file
(defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file
@@ -191,11 +186,11 @@ PREFIX."
;;; Clusters and sites
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; I use the term `site' to refer to a string which may be the
-;;; cluster identification "/name:", a remote identification
-;;; "/method:user@host:", or "/system-name:" (the value of
-;;; `shadow-system-name') for the location of local files. All
-;;; user-level commands should accept either.
+;; I use the term `site' to refer to a string which may be the
+;; cluster identification "/name:", a remote identification
+;; "/method:user@host:", or "/system-name:" (the value of
+;; `shadow-system-name') for the location of local files. All
+;; user-level commands should accept either.
(cl-defstruct (shadow-cluster (:type list) :named) name primary regexp)
@@ -580,7 +575,7 @@ be shadowed), and list of SITES."
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."
- (or (symbol-value (intern-soft file shadow-hashtable))
+ (or (gethash file shadow-hashtable)
(let* ((absolute-file (shadow-expand-file-name
(or (shadow-local-file file) file)
shadow-homedir))
@@ -598,7 +593,7 @@ and to are absolute file names."
"shadow-shadows-of: %s %s %s %s %s"
file (shadow-local-file file) shadow-homedir
absolute-file canonical-file))
- (set (intern file shadow-hashtable) shadows))))
+ (puthash file shadows shadow-hashtable))))
(defun shadow-shadows-of-1 (file groups regexp)
"Return list of FILE's shadows in GROUPS.
@@ -735,7 +730,7 @@ With non-nil argument also saves the buffer."
(sit-for 1))))))
(defun shadow-invalidate-hashtable ()
- (setq shadow-hashtable (make-vector 37 0)))
+ (clrhash shadow-hashtable))
(defun shadow-insert-var (variable)
"Build a `setq' to restore VARIABLE.
@@ -744,17 +739,17 @@ will restore VARIABLE to its current setting.
VARIABLE must be the name of a variable whose value is a list."
(let ((standard-output (current-buffer)))
(insert (format "(setq %s" variable))
- (cond ((consp (eval variable))
+ (cond ((consp (symbol-value variable))
(insert "\n '(")
- (prin1 (car (eval variable)))
- (let ((rest (cdr (eval variable))))
+ (prin1 (car (symbol-value variable)))
+ (let ((rest (cdr (symbol-value variable))))
(while rest
(insert "\n ")
(prin1 (car rest))
(setq rest (cdr rest)))
(insert "))\n\n")))
(t (insert " ")
- (prin1 (eval variable))
+ (prin1 (symbol-value variable))
(insert ")\n\n")))))
(defun shadow-save-buffers-kill-emacs (&optional arg)
@@ -763,6 +758,11 @@ 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."
+ (interactive "P")
+ (shadow--save-buffers-kill-emacs arg)
+ (save-buffers-kill-emacs arg))
+
+(defun shadow--save-buffers-kill-emacs (&optional arg &rest _)
;; This function is necessary because we need to get control and save
;; the todo file /after/ saving other files, but /before/ the warning
;; message about unsaved buffers (because it can get modified by the
@@ -770,27 +770,10 @@ look for files that have been changed and need to be copied to other systems."
;; because it is not called at the correct time, and also because it is
;; called when the terminal is disconnected and we cannot ask whether
;; to copy files.
- (interactive "P")
(shadow-save-todo-file)
(save-some-buffers arg t)
(shadow-copy-files)
- (shadow-save-todo-file)
- (and (or (not (memq t (mapcar (lambda (buf) (and (buffer-file-name buf)
- (buffer-modified-p buf)))
- (buffer-list))))
- (yes-or-no-p "Modified buffers exist; exit anyway? "))
- (or (not (fboundp 'process-list))
- ;; `process-list' is not defined on MSDOS.
- (let ((processes (process-list))
- active)
- (while processes
- (and (memq (process-status (car processes)) '(run stop open listen))
- (process-query-on-exit-flag (car processes))
- (setq active t))
- (setq processes (cdr processes)))
- (or (not active)
- (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
- (kill-emacs)))
+ (shadow-save-todo-file))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hook us up
@@ -809,19 +792,15 @@ look for files that have been changed and need to be copied to other systems."
(message "Shadowfile information files not found - aborting")
(beep)
(sit-for 3))
- (when (and (not shadow-inhibit-overload)
- (not (fboundp 'shadow-orig-save-buffers-kill-emacs)))
- (defalias 'shadow-orig-save-buffers-kill-emacs
- (symbol-function 'save-buffers-kill-emacs))
- (defalias 'save-buffers-kill-emacs 'shadow-save-buffers-kill-emacs))
- (add-hook 'write-file-functions 'shadow-add-to-todo)
- (define-key ctl-x-4-map "s" 'shadow-copy-files)))
+ (unless shadow-inhibit-overload
+ (advice-add 'save-buffers-kill-emacs :before
+ #'shadow--save-buffers-kill-emacs))
+ (add-hook 'write-file-functions #'shadow-add-to-todo)
+ (define-key ctl-x-4-map "s" #'shadow-copy-files)))
(defun shadowfile-unload-function ()
- (substitute-key-definition 'shadow-copy-files nil ctl-x-4-map)
- (when (fboundp 'shadow-orig-save-buffers-kill-emacs)
- (fset 'save-buffers-kill-emacs
- (symbol-function 'shadow-orig-save-buffers-kill-emacs)))
+ (substitute-key-definition #'shadow-copy-files nil ctl-x-4-map)
+ (advice-remove 'save-buffers-kill-emacs #'shadow--save-buffers-kill-emacs)
;; continue standard unloading
nil)