|
|
1.1 root 1: ;; Copyright (C) 1985, 1986 Free Software Foundation, inc.
2:
3: ;; This file is part of GNU Emacs.
4:
5: ;; GNU Emacs is distributed in the hope that it will be useful,
6: ;; but WITHOUT ANY WARRANTY. No author or distributor
7: ;; accepts responsibility to anyone for the consequences of using it
8: ;; or for whether it serves any particular purpose or works at all,
9: ;; unless he says so in writing. Refer to the GNU Emacs General Public
10: ;; License for full details.
11:
12: ;; Everyone is granted permission to copy, modify and redistribute
13: ;; GNU Emacs, but only under the conditions described in the
14: ;; GNU Emacs General Public License. A copy of this license is
15: ;; supposed to have been given to you along with GNU Emacs so you
16: ;; can know your rights and responsibilities. It should be in a
17: ;; file named COPYING. Among other things, the copyright notice
18: ;; and this notice must be preserved on all copies.
19:
20:
21: ;; This file is autloaded to handle certain conditions
22: ;; detected by the file-locking code within Emacs.
23: ;; The two entry points are `ask-user-about-lock' and
24: ;; `ask-user-about-supersession-threat'.
25:
26:
27: (put 'file-locked 'error-conditions '(file-locked file-error error))
28:
29: (defun ask-user-about-lock (fn opponent)
30: "Ask user what to do when he wants to edit FILE but it is locked by USER.
31: This function has a choice of three things to do:
32: do (signal 'buffer-file-locked (list FILE USER))
33: to refrain from editing the file
34: return t (grab the lock on the file)
35: return nil (edit the file even though it is locked).
36: You can rewrite it to use any criterion you like to choose which one to do."
37: (discard-input)
38: (save-window-excursion
39: (let (answer)
40: (while (null answer)
41: (message "%s is locking %s: action (s, q, p, ?)? " opponent fn)
42: (let ((tem (let ((inhibit-quit t)
43: (cursor-in-echo-area t))
44: (prog1 (downcase (read-char))
45: (setq quit-flag nil)))))
46: (if (= tem help-char)
47: (ask-user-about-lock-help)
48: (setq answer (assoc tem '((?s . t)
49: (?q . yield)
50: (?\C-g . yield)
51: (?p . nil)
52: (?? . help))))
53: (cond ((null answer)
54: (beep)
55: (message "Please type q, s, or p; or ? for help")
56: (sit-for 3))
57: ((eq (cdr answer) 'help)
58: (ask-user-about-lock-help)
59: (setq answer nil))
60: ((eq (cdr answer) 'yield)
61: (signal 'file-locked (list "File is locked" fn opponent)))))))
62: (cdr answer))))
63:
64: (defun ask-user-about-lock-help ()
65: (with-output-to-temp-buffer "*Help*"
66: (princ "It has been detected that you want to modify a file that someone else has
67: already started modifying in EMACS.
68:
69: You can <s>teal the file; The other user becomes the
70: intruder if (s)he ever unmodifies the file and then changes it again.
71: You can <p>roceed; you edit at your own (and the other user's) risk.
72: You can <q>uit; don't modify this file.")))
73:
74: (put
75: 'file-supersession 'error-conditions '(file-supersession file-error error))
76:
77: (defun ask-user-about-supersession-threat (fn)
78: "Ask a user who is about to modify an obsolete buffer what to do.
79: This function has two choices: it can return, in which case the modification
80: of the buffer will proceed, or it can (signal 'file-supersession (file)),
81: in which case the proposed buffer modification will not be made.
82: You can rewrite this to use any criterion you like to choose which one to do."
83: (discard-input)
84: (save-window-excursion
85: (let (answer)
86: (while (null answer)
87: (message "File has changed on disk; really want to edit the buffer? (y, n or C-h) ")
88: (let ((tem (downcase (let ((cursor-in-echo-area t))
89: (read-char)))))
90: (setq answer
91: (if (= tem help-char)
92: 'help
93: (cdr (assoc tem '((?n . yield)
94: (?\C-g . yield)
95: (?y . proceed)
96: (?? . help))))))
97: (cond ((null answer)
98: (beep)
99: (message "Please type y or n; or ? for help")
100: (sit-for 3))
101: ((eq answer 'help)
102: (ask-user-about-supersession-help)
103: (setq answer nil))
104: ((eq answer 'yield)
105: (signal 'file-supersession
106: (list "File changed on disk" fn))))))
107: (message
108: "File on disk now will become a backup file if you save these changes.")
109: (setq buffer-backed-up nil))))
110:
111: (defun ask-user-about-supersession-help ()
112: (with-output-to-temp-buffer "*Help*"
113: (princ "You want to modify a buffer whose disk file has changed
114: since you last read it in or saved it with this buffer.
115:
116: If you say `y' to go ahead and modify this buffer,
117: you risk ruining the work of whoever rewrote the file.
118: If you say `n', the change you started to make will be aborted.
119:
120: You might consider answering `n', running `M-x revert-buffer' to
121: bring the text in Emacs into accord with what is on disk, and then
122: making the change again.")))
123:
124:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.