1 ;;; userlock.el --- handle file access contention between multiple users
3 ;; Copyright (C) 1985, 1986, 1993 Free Software Foundation, inc.
8 ;; This file is part of SXEmacs.
10 ;; SXEmacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; SXEmacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Synched up with: FSF 19.34.
27 ;; This file is autoloaded to handle certain conditions
28 ;; detected by the file-locking code within XEmacs.
29 ;; The two entry points are `ask-user-about-lock' and
30 ;; `ask-user-about-supersession-threat'.
34 (define-error 'file-locked "File is locked" 'file-error) ; XEmacs
36 (defun ask-user-about-lock-minibuf (filename other-user)
37 (save-window-excursion
40 (message "%s is locking %s: action (s, q, p, ?)? " other-user filename)
41 (let ((tem (let ((inhibit-quit t)
42 (cursor-in-echo-area t))
43 (prog1 (downcase (read-char))
44 (setq quit-flag nil)))))
46 (ask-user-about-lock-help)
47 (setq answer (assoc tem '((?s . t)
54 (message "Please type q, s, or p; or ? for help")
56 ((eq (cdr answer) 'help)
57 (ask-user-about-lock-help)
59 ((eq (cdr answer) 'yield)
60 (signal 'file-locked (list "File is locked" filename other-user)))))))
63 (defun ask-user-about-lock-help ()
64 (with-output-to-temp-buffer "*Help*"
65 (princ "It has been detected that you want to modify a file that someone else has
66 already started modifying in EMACS.
68 You can <s>teal the file; The other user becomes the
69 intruder if (s)he ever unmodifies the file and then changes it again.
70 You can <p>roceed; you edit at your own (and the other user's) risk.
71 You can <q>uit; don't modify this file.")
73 (set-buffer standard-output)
76 (define-error 'file-supersession "File changed on disk" 'file-error) ; XEmacs
78 (defun ask-user-about-supersession-threat-minibuf (filename)
79 (save-window-excursion
82 (message "%s changed on disk; really edit the buffer? (y, n, r or C-h) "
83 (file-name-nondirectory filename))
84 (let ((tem (downcase (let ((cursor-in-echo-area t))
89 (cdr (assoc tem '((?n . yield)
96 (message "Please type y, n or r; or ? for help")
99 (ask-user-about-supersession-help)
102 (revert-buffer nil (not (buffer-modified-p)))
103 ; ask confirmation iff buffer modified
104 (signal 'file-supersession
105 (list "File reverted" filename)))
107 (signal 'file-supersession
108 (list "File changed on disk" filename))))))
110 "File on disk now will become a backup file if you save these changes.")
111 (setq buffer-backed-up nil))))
113 (defun ask-user-about-supersession-help ()
114 (with-output-to-temp-buffer "*Help*"
115 (princ "You want to modify a buffer whose disk file has changed
116 since you last read it in or saved it with this buffer.
118 If you say `y' to go ahead and modify this buffer,
119 you risk ruining the work of whoever rewrote the file.
120 If you say `r' to revert, the contents of the buffer are refreshed
121 from the file on disk.
122 If you say `n', the change you started to make will be aborted.
124 Usually, you should type `n' and then `M-x revert-buffer',
125 to get the latest version of the file, then make the change again.")
127 (set-buffer standard-output)
130 ;;; dialog-box versions [XEmacs]
132 (defun ask-user-about-lock-dbox (filename other-user)
133 (let ((echo-keystrokes 0))
136 :question (format "%s is locking %s\n
137 It has been detected that you want to modify a file that
138 someone else has already started modifying in XEmacs."
141 '(["Steal Lock\n\nThe other user will\nbecome the intruder" steal t]
142 ["Proceed\n\nEdit file at your own\n\(and the other user's) risk"
145 ["Abort\n\nDon't modify the buffer\n" yield t]))
148 (let ((event (next-command-event)))
149 (cond ((and (misc-user-event-p event)
150 (eq (event-object event) 'proceed))
151 (throw 'aual-done nil))
152 ((and (misc-user-event-p event)
153 (eq (event-object event) 'steal))
154 (throw 'aual-done t))
155 ((and (misc-user-event-p event)
156 (eq (event-object event) 'yield))
157 (signal 'file-locked (list "File is locked" filename other-user)))
158 ((and (misc-user-event-p event)
159 (eq (event-object event) 'menu-no-selection-hook))
161 ;; safety check, so we're not endlessly stuck when no
165 ((button-release-event-p event) ;; don't beep twice
169 (message "please answer the dialog box"))))))))
171 (defun ask-user-about-supersession-threat-dbox (filename)
172 (let ((echo-keystrokes 0))
176 (format "File %s has changed on disk
177 since its buffer was last read in or saved.
179 Do you really want to edit the buffer? " filename)
181 '(["Yes\n\nEdit the buffer anyway,\nignoring the disk file"
183 ["No\n\nDon't modify the buffer\n" yield t]
185 ["No\n\nDon't modify the buffer\nbut revert it" revert t]
189 (let ((event (next-command-event)))
190 (cond ((and (misc-user-event-p event) (eq (event-object event) 'proceed))
191 (throw 'auast-done nil))
192 ((and (misc-user-event-p event) (eq (event-object event) 'yield))
193 (signal 'file-supersession (list filename)))
194 ((and (misc-user-event-p event) (eq (event-object event) 'revert))
195 (or (equal filename (buffer-file-name))
197 "ask-user-about-supersession-threat called bogusly"))
198 (revert-buffer nil t)
199 (signal 'file-supersession
200 (list filename "(reverted)")))
201 ((and (misc-user-event-p event)
202 (eq (event-object event) 'menu-no-selection-hook))
204 ;; safety check, so we're not endlessly stuck when no
208 ((button-release-event-p event) ;; don't beep twice
212 (message "please answer the dialog box"))))))))
218 (defun ask-user-about-lock (filename other-user)
219 "Ask user wanting to edit FILENAME, locked by OTHER-USER, what to do.
220 This function has a choice of three things to do:
221 do (signal 'file-locked (list FILENAME OTHER-USER))
222 to refrain from editing the file
223 return t (grab the lock on the file)
224 return nil (edit the file even though it is locked).
225 You can rewrite it to use any criteria you like to choose which one to do."
227 (if (should-use-dialog-box-p)
228 (ask-user-about-lock-dbox filename other-user)
229 (ask-user-about-lock-minibuf filename other-user)))
232 (defun ask-user-about-supersession-threat (filename)
233 "Ask user who is about to modify an obsolete buffer what to do.
234 This function has two choices: it can return, in which case the modification
235 of the buffer will proceed, or it can (signal 'file-supersession (FILENAME)),
236 in which case the proposed buffer modification will not be made.
238 You can rewrite this to use any criteria you like to choose which one to do.
239 The buffer in question is current when this function is called."
241 (if (should-use-dialog-box-p)
242 (ask-user-about-supersession-threat-dbox filename)
243 (ask-user-about-supersession-threat-minibuf filename)))
245 ;;; userlock.el ends here