userlock.el 7.2 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; userlock.el --- handle file access contention between multiple users

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1985-1986, 2001-2019 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
4

5 6
;; Author: Richard King
;; (according to authors.el)
7
;; Maintainer: emacs-devel@gnu.org
Eric S. Raymond's avatar
Eric S. Raymond committed
8
;; Keywords: internal
9
;; Package: emacs
Eric S. Raymond's avatar
Eric S. Raymond committed
10

Joseph Arceneaux's avatar
Joseph Arceneaux committed
11 12
;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
Joseph Arceneaux's avatar
Joseph Arceneaux committed
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
17 18 19 20 21 22 23

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
25

Eric S. Raymond's avatar
Eric S. Raymond committed
26
;;; Commentary:
Joseph Arceneaux's avatar
Joseph Arceneaux committed
27

Eric S. Raymond's avatar
Eric S. Raymond committed
28
;; This file is autoloaded to handle certain conditions
Joseph Arceneaux's avatar
Joseph Arceneaux committed
29 30 31 32
;; detected by the file-locking code within Emacs.
;; The two entry points are `ask-user-about-lock' and
;; `ask-user-about-supersession-threat'.

Eric S. Raymond's avatar
Eric S. Raymond committed
33
;;; Code:
Joseph Arceneaux's avatar
Joseph Arceneaux committed
34

35 36
(eval-when-compile (require 'cl-lib))

37 38 39
;;;###autoload
(put 'create-lockfiles 'safe-local-variable 'booleanp)

40
(define-error 'file-locked "File is locked" 'file-error)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
41

Jim Blandy's avatar
Jim Blandy committed
42
;;;###autoload
43 44
(defun ask-user-about-lock (file opponent)
  "Ask user what to do when he wants to edit FILE but it is locked by OPPONENT.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
45
This function has a choice of three things to do:
46
  do (signal \\='file-locked (list FILE OPPONENT))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
47 48 49
    to refrain from editing the file
  return t (grab the lock on the file)
  return nil (edit the file even though it is locked).
50 51
You can redefine this function to choose among those three alternatives
in any way you like."
Joseph Arceneaux's avatar
Joseph Arceneaux committed
52 53
  (discard-input)
  (save-window-excursion
54 55 56 57 58 59 60 61 62 63 64 65
    (let (answer short-opponent short-file)
      (setq short-file
	    (if (> (length file) 22)
		(concat "..." (substring file (- (length file) 22)))
	      file))
      (setq short-opponent
	    (if (> (length opponent) 25)
		(save-match-data
		  (string-match " (pid [0-9]+)" opponent)
		  (concat (substring opponent 0 13) "..."
			  (match-string 0 opponent)))
	      opponent))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
66
      (while (null answer)
67 68
	(message "%s locked by %s: (s, q, p, ?)? "
		 short-file short-opponent)
69
	(if noninteractive (error "Cannot resolve lock conflict in batch mode"))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
	(let ((tem (let ((inhibit-quit t)
			 (cursor-in-echo-area t))
		     (prog1 (downcase (read-char))
		            (setq quit-flag nil)))))
	  (if (= tem help-char)
	      (ask-user-about-lock-help)
	    (setq answer (assoc tem '((?s . t)
				      (?q . yield)
				      (?\C-g . yield)
				      (?p . nil)
				      (?? . help))))
	    (cond ((null answer)
		   (beep)
		   (message "Please type q, s, or p; or ? for help")
		   (sit-for 3))
		  ((eq (cdr answer) 'help)
		   (ask-user-about-lock-help)
		   (setq answer nil))
		  ((eq (cdr answer) 'yield)
89
		   (signal 'file-locked (list file opponent)))))))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
90 91 92 93 94
      (cdr answer))))

(defun ask-user-about-lock-help ()
  (with-output-to-temp-buffer "*Help*"
    (princ "It has been detected that you want to modify a file that someone else has
95
already started modifying in Emacs.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
96

97
You can <s>teal the file; the other user becomes the
Joseph Arceneaux's avatar
Joseph Arceneaux committed
98 99
  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.
100
You can <q>uit; don't modify this file.")
101
    (with-current-buffer standard-output
102
      (help-mode))))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
103

104
(define-error 'file-supersession nil 'file-error)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
105

106
(defun userlock--check-content-unchanged (filename)
107
  (with-demoted-errors "Unchanged content check: %S"
108
    ;; Even tho we receive `filename', we know that `filename' refers to the current
109
    ;; buffer's file.
110
    (cl-assert (equal filename (expand-file-name buffer-file-truename)))
111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
    ;; Note: rather than read the file and compare to the buffer, we could save
    ;; the buffer and compare to the file, but for encrypted data this
    ;; wouldn't work well (and would risk exposing the data).
    (save-restriction
      (widen)
      (let ((buf (current-buffer))
            (cs buffer-file-coding-system)
            (start (point-min))
            (end (point-max)))
        ;; FIXME: To avoid a slow `insert-file-contents' on large or
        ;; remote files, it'd be good to include file size in the
        ;; "visited-modtime" check.
        (when (with-temp-buffer
                (let ((coding-system-for-read cs)
                      (non-essential t))
126
                  (insert-file-contents filename))
127 128 129 130 131 132 133 134 135
                (when (= (buffer-size) (- end start)) ;Minor optimization.
                  (= 0 (let ((case-fold-search nil))
                         (compare-buffer-substrings
                          buf start end
                          (current-buffer) (point-min) (point-max))))))
          (set-visited-file-modtime)
          'unchanged)))))

;;;###autoload
136
(defun userlock--ask-user-about-supersession-threat (filename)
137
  ;; Called from filelock.c.
138 139
  (unless (userlock--check-content-unchanged filename)
    (ask-user-about-supersession-threat filename)))
140

Jim Blandy's avatar
Jim Blandy committed
141
;;;###autoload
142
(defun ask-user-about-supersession-threat (filename)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
143 144
  "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
145
of the buffer will proceed, or it can (signal \\='file-supersession (file)),
Joseph Arceneaux's avatar
Joseph Arceneaux committed
146 147 148 149 150 151
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
152 153 154
    (let ((prompt
	   (format "%s changed on disk; \
really edit the buffer? (y, n, r or C-h) "
155
		   (file-name-nondirectory filename)))
156 157
	  (choices '(?y ?n ?r ?? ?\C-h))
	  answer)
158 159 160
      (when noninteractive
	(message "%s" prompt)
	(error "Cannot resolve conflict in batch mode"))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
161
      (while (null answer)
162
	(setq answer (read-char-from-minibuffer prompt choices))
163 164 165 166 167 168 169
	(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
170
		       (list "File reverted" filename)))
171 172
	      ((eq answer ?n)
	       (signal 'file-supersession
173
		       (list "File changed on disk" filename)))))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
174
      (message
175
       "File on disk now will become a backup file if you save these changes.")
Joseph Arceneaux's avatar
Joseph Arceneaux committed
176 177 178 179
      (setq buffer-backed-up nil))))

(defun ask-user-about-supersession-help ()
  (with-output-to-temp-buffer "*Help*"
180 181 182
    (princ
     (substitute-command-keys
      "You want to modify a buffer whose disk file has changed
Joseph Arceneaux's avatar
Joseph Arceneaux committed
183 184 185 186
since you last read it in or saved it with this buffer.

If you say `y' to go ahead and modify this buffer,
you risk ruining the work of whoever rewrote the file.
187 188
If you say `r' to revert, the contents of the buffer are refreshed
from the file on disk.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
189 190
If you say `n', the change you started to make will be aborted.

191
Usually, you should type `n' and then `\\[revert-buffer]',
192
to get the latest version of the file, then make the change again."))
193
    (with-current-buffer standard-output
194
      (help-mode))))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
195

Eric S. Raymond's avatar
Eric S. Raymond committed
196
;;; userlock.el ends here