]> code.delx.au - gnu-emacs/blobdiff - lisp/userlock.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / userlock.el
index 329d46c2124907b9c0f484ad5cf3279c95cd0e7d..a0c55fd1e13433ca7c9e8070cac20cc91e75fbd0 100644 (file)
@@ -1,17 +1,19 @@
 ;;; userlock.el --- handle file access contention between multiple users
 
-;; Copyright (C) 1985, 1986, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 2001-2016 Free Software Foundation, Inc.
 
-;; Maintainer: FSF
+;; Author: Richard King
+;; (according to authors.el)
+;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: internal
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +21,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 
 ;;; Code:
 
-(put 'file-locked 'error-conditions '(file-locked file-error error))
-(put 'file-locked 'error-message "File is locked")
+(define-error 'file-locked "File is locked" 'file-error)
 
 ;;;###autoload
 (defun ask-user-about-lock (file opponent)
   "Ask user what to do when he wants to edit FILE but it is locked by OPPONENT.
 This function has a choice of three things to do:
-  do (signal 'file-locked (list FILE OPPONENT))
+  do (signal \\='file-locked (list FILE OPPONENT))
     to refrain from editing the file
   return t (grab the lock on the file)
   return nil (edit the file even though it is locked).
@@ -93,55 +92,43 @@ You can <s>teal the file; the other user becomes the
   intruder if (s)he ever unmodifies the file and then changes it again.
 You can <p>roceed; you edit at your own (and the other user's) risk.
 You can <q>uit; don't modify this file.")
-    (save-excursion
-      (set-buffer standard-output)
+    (with-current-buffer standard-output
       (help-mode))))
 
-(put
- 'file-supersession 'error-conditions '(file-supersession file-error error))
+(define-error 'file-supersession nil 'file-error)
 
 ;;;###autoload
 (defun ask-user-about-supersession-threat (fn)
   "Ask a user who is about to modify an obsolete buffer what to do.
 This function has two choices: it can return, in which case the modification
-of the buffer will proceed, or it can (signal 'file-supersession (file)),
+of the buffer will proceed, or it can (signal \\='file-supersession (file)),
 in which case the proposed buffer modification will not be made.
 
 You can rewrite this to use any criterion you like to choose which one to do.
 The buffer in question is current when this function is called."
   (discard-input)
   (save-window-excursion
-    (let (answer)
+    (let ((prompt
+          (format "%s changed on disk; \
+really edit the buffer? (y, n, r or C-h) "
+                  (file-name-nondirectory fn)))
+         (choices '(?y ?n ?r ?? ?\C-h))
+         answer)
       (while (null answer)
-       (message "%s changed on disk; really edit the buffer? (y, n, r or C-h) "
-                (file-name-nondirectory fn))
-       (let ((tem (downcase (let ((cursor-in-echo-area t))
-                              (read-char-exclusive)))))
-         (setq answer
-               (if (= tem help-char)
-                   'help
-                 (cdr (assoc tem '((?n . yield)
-                                   (?\C-g . yield)
-                                   (?y . proceed)
-                                   (?r . revert)
-                                   (?? . help))))))
-         (cond ((null answer)
-                (beep)
-                (message "Please type y, n or r; or ? for help")
-                (sit-for 3))
-               ((eq answer 'help)
-                (ask-user-about-supersession-help)
-                (setq answer nil))
-               ((eq answer 'revert)
-                (revert-buffer nil (not (buffer-modified-p)))
-                                       ; ask confirmation iff buffer modified
-                (signal 'file-supersession
-                        (list "File reverted" fn)))
-               ((eq answer 'yield)
-                (signal 'file-supersession
-                        (list "File changed on disk" fn))))))
+       (setq answer (read-char-choice prompt choices))
+       (cond ((memq answer '(?? ?\C-h))
+              (ask-user-about-supersession-help)
+              (setq answer nil))
+             ((eq answer ?r)
+              ;; Ask for confirmation if buffer modified
+              (revert-buffer nil (not (buffer-modified-p)))
+              (signal 'file-supersession
+                      (list "File reverted" fn)))
+             ((eq answer ?n)
+              (signal 'file-supersession
+                      (list "File changed on disk" fn)))))
       (message
-        "File on disk now will become a backup file if you save these changes.")
+       "File on disk now will become a backup file if you save these changes.")
       (setq buffer-backed-up nil))))
 
 (defun ask-user-about-supersession-help ()
@@ -155,11 +142,9 @@ If you say `r' to revert, the contents of the buffer are refreshed
 from the file on disk.
 If you say `n', the change you started to make will be aborted.
 
-Usually, you should type `n' and then `M-x revert-buffer',
+Usually, you should type `n' and then `\\[revert-buffer]',
 to get the latest version of the file, then make the change again.")
-    (save-excursion
-      (set-buffer standard-output)
+    (with-current-buffer standard-output
       (help-mode))))
 
-;;; arch-tag: a61c5b60-e1c8-44fd-894a-c617f4dfc639
 ;;; userlock.el ends here