Commit | Line | Data |
---|---|---|
53bbe3ad | 1 | ;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*- |
b578f267 | 2 | |
ba318903 | 3 | ;; Copyright (C) 2011-2014 Free Software Foundation, Inc. |
b578f267 | 4 | |
53bbe3ad JB |
5 | ;; Author: Juanma Barranquero <lekktu@gmail.com> |
6 | ;; Inspired by emacs-lock.el by Tom Wurgler <twurgler@goodyear.com> | |
7 | ;; Maintainer: FSF | |
1a2b7f51 | 8 | ;; Keywords: extensions, processes |
b578f267 EN |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
eb3fa2cf | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
c9e2fc17 | 13 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
b578f267 EN |
16 | |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
c9e2fc17 RS |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
b578f267 | 21 | |
c9e2fc17 | 22 | ;; You should have received a copy of the GNU General Public License |
eb3fa2cf | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
c9e2fc17 RS |
24 | |
25 | ;;; Commentary: | |
b578f267 | 26 | |
53bbe3ad JB |
27 | ;; This package defines a minor mode Emacs Lock to mark a buffer as |
28 | ;; protected against accidental killing, or exiting Emacs, or both. | |
29 | ;; Buffers associated with inferior modes, like shell or telnet, can | |
388573ee | 30 | ;; be treated specially, by auto-unlocking them if their inferior |
53bbe3ad | 31 | ;; processes are dead. |
c9e2fc17 | 32 | |
b578f267 EN |
33 | ;;; Code: |
34 | ||
53bbe3ad JB |
35 | (defgroup emacs-lock nil |
36 | "Emacs-Lock mode." | |
37 | :version "24.1" | |
38 | :group 'convenience) | |
39 | ||
40 | (defcustom emacs-lock-default-locking-mode 'all | |
41 | "Default locking mode of Emacs-Locked buffers. | |
42 | ||
43 | Its value is used as the default for `emacs-lock-mode' (which | |
44 | see) the first time that Emacs Lock mode is turned on in a buffer | |
45 | without passing an explicit locking mode. | |
46 | ||
47 | Possible values are: | |
48 | exit -- Emacs cannot exit while the buffer is locked | |
49 | kill -- the buffer cannot be killed, but Emacs can exit as usual | |
50 | all -- the buffer is locked against both actions | |
51 | nil -- the buffer is not locked" | |
52 | :type '(choice | |
53 | (const :tag "Do not allow Emacs to exit" exit) | |
54 | (const :tag "Do not allow killing the buffer" kill) | |
55 | (const :tag "Do not allow killing the buffer or exiting Emacs" all) | |
56 | (const :tag "Do not lock the buffer" nil)) | |
57 | :group 'emacs-lock | |
58 | :version "24.1") | |
59 | ||
60 | ;; Note: as auto-unlocking can lead to data loss, it would be better | |
61 | ;; to default to nil; but the value below is for compatibility with | |
62 | ;; the old emacs-lock.el. | |
63 | (defcustom emacs-lock-unlockable-modes '((shell-mode . all) | |
64 | (telnet-mode . all)) | |
65 | "Alist of auto-unlockable modes. | |
66 | Each element is a pair (MAJOR-MODE . ACTION), where ACTION is | |
67 | one of `kill', `exit' or `all'. Buffers with matching major | |
68 | modes are auto-unlocked for the specific action if their | |
69 | inferior processes are not alive. If this variable is t, all | |
70 | buffers associated to inferior processes are auto-unlockable | |
71 | for both actions (NOT RECOMMENDED)." | |
72 | :type '(choice | |
73 | (const :tag "All buffers with inferior processes" t) | |
74 | (repeat :tag "Selected modes" | |
75 | (cons :tag "Set auto-unlock for" | |
76 | (symbol :tag "Major mode") | |
77 | (radio | |
78 | (const :tag "Allow exiting" exit) | |
79 | (const :tag "Allow killing" kill) | |
80 | (const :tag "Allow both" all))))) | |
81 | :group 'emacs-lock | |
82 | :version "24.1") | |
83 | ||
d5e6342e JB |
84 | (defcustom emacs-lock-locked-buffer-functions nil |
85 | "Abnormal hook run when Emacs Lock prevents exiting Emacs, or killing a buffer. | |
86 | The functions get one argument, the first locked buffer found." | |
87 | :type 'hook | |
88 | :group 'emacs-lock | |
2a1e2476 | 89 | :version "24.3") |
d5e6342e | 90 | |
388573ee | 91 | (defvar-local emacs-lock-mode nil |
53bbe3ad JB |
92 | "If non-nil, the current buffer is locked. |
93 | It can be one of the following values: | |
94 | exit -- Emacs cannot exit while the buffer is locked | |
95 | kill -- the buffer cannot be killed, but Emacs can exit as usual | |
96 | all -- the buffer is locked against both actions | |
97 | nil -- the buffer is not locked") | |
53bbe3ad JB |
98 | (put 'emacs-lock-mode 'permanent-local t) |
99 | ||
388573ee | 100 | (defvar-local emacs-lock--old-mode nil |
53bbe3ad JB |
101 | "Most recent locking mode set on the buffer. |
102 | Internal use only.") | |
53bbe3ad JB |
103 | (put 'emacs-lock--old-mode 'permanent-local t) |
104 | ||
388573ee | 105 | (defvar-local emacs-lock--try-unlocking nil |
53bbe3ad JB |
106 | "Non-nil if current buffer should be checked for auto-unlocking. |
107 | Internal use only.") | |
53bbe3ad JB |
108 | (put 'emacs-lock--try-unlocking 'permanent-local t) |
109 | ||
110 | (defun emacs-lock-live-process-p (buffer-or-name) | |
111 | "Return t if BUFFER-OR-NAME is associated with a live process." | |
0518b057 | 112 | (process-live-p (get-buffer-process buffer-or-name))) |
53bbe3ad JB |
113 | |
114 | (defun emacs-lock--can-auto-unlock (action) | |
115 | "Return t if the current buffer can auto-unlock for ACTION. | |
116 | ACTION must be one of `kill' or `exit'. | |
117 | See `emacs-lock-unlockable-modes'." | |
118 | (and emacs-lock--try-unlocking | |
119 | (not (emacs-lock-live-process-p (current-buffer))) | |
120 | (or (eq emacs-lock-unlockable-modes t) | |
121 | (let ((unlock (cdr (assq major-mode emacs-lock-unlockable-modes)))) | |
122 | (or (eq unlock 'all) (eq unlock action)))))) | |
123 | ||
124 | (defun emacs-lock--exit-locked-buffer () | |
d5e6342e | 125 | "Return the first exit-locked buffer found." |
53bbe3ad JB |
126 | (save-current-buffer |
127 | (catch :found | |
128 | (dolist (buffer (buffer-list)) | |
129 | (set-buffer buffer) | |
130 | (unless (or (emacs-lock--can-auto-unlock 'exit) | |
131 | (memq emacs-lock-mode '(nil kill))) | |
d5e6342e | 132 | (throw :found buffer))) |
53bbe3ad JB |
133 | nil))) |
134 | ||
135 | (defun emacs-lock--kill-emacs-hook () | |
136 | "Signal an error if any buffer is exit-locked. | |
137 | Used from `kill-emacs-hook' (which see)." | |
d5e6342e JB |
138 | (let ((locked (emacs-lock--exit-locked-buffer))) |
139 | (when locked | |
140 | (run-hook-with-args 'emacs-lock-locked-buffer-functions locked) | |
141 | (error "Emacs cannot exit because buffer %S is locked" | |
142 | (buffer-name locked))))) | |
53bbe3ad JB |
143 | |
144 | (defun emacs-lock--kill-emacs-query-functions () | |
145 | "Display a message if any buffer is exit-locked. | |
146 | Return a value appropriate for `kill-emacs-query-functions' (which see)." | |
147 | (let ((locked (emacs-lock--exit-locked-buffer))) | |
d5e6342e JB |
148 | (if (not locked) |
149 | t | |
150 | (run-hook-with-args 'emacs-lock-locked-buffer-functions locked) | |
151 | (message "Emacs cannot exit because buffer %S is locked" | |
152 | (buffer-name locked)) | |
153 | nil))) | |
53bbe3ad JB |
154 | |
155 | (defun emacs-lock--kill-buffer-query-functions () | |
156 | "Display a message if the current buffer is kill-locked. | |
157 | Return a value appropriate for `kill-buffer-query-functions' (which see)." | |
d5e6342e JB |
158 | (if (or (emacs-lock--can-auto-unlock 'kill) |
159 | (memq emacs-lock-mode '(nil exit))) | |
160 | t | |
161 | (run-hook-with-args 'emacs-lock-locked-buffer-functions (current-buffer)) | |
162 | (message "Buffer %S is locked and cannot be killed" (buffer-name)) | |
163 | nil)) | |
53bbe3ad JB |
164 | |
165 | (defun emacs-lock--set-mode (mode arg) | |
166 | "Setter function for `emacs-lock-mode'." | |
167 | (setq emacs-lock-mode | |
168 | (cond ((memq arg '(all exit kill)) | |
169 | ;; explicit locking mode arg, use it | |
170 | arg) | |
171 | ((and (eq arg current-prefix-arg) (consp current-prefix-arg)) | |
172 | ;; called with C-u M-x emacs-lock-mode, so ask the user | |
173 | (intern (completing-read "Locking mode: " | |
174 | '("all" "exit" "kill") | |
175 | nil t nil nil | |
176 | (symbol-name | |
177 | emacs-lock-default-locking-mode)))) | |
178 | ((eq mode t) | |
179 | ;; turn on, so use previous setting, or customized default | |
180 | (or emacs-lock--old-mode emacs-lock-default-locking-mode)) | |
181 | (t | |
182 | ;; anything else (turn off) | |
183 | mode)))) | |
184 | ||
e5bd0a28 SM |
185 | (define-obsolete-variable-alias 'emacs-lock-from-exiting |
186 | 'emacs-lock-mode "24.1") | |
388573ee | 187 | |
53bbe3ad JB |
188 | ;;;###autoload |
189 | (define-minor-mode emacs-lock-mode | |
06e21633 CY |
190 | "Toggle Emacs Lock mode in the current buffer. |
191 | If called with a plain prefix argument, ask for the locking mode | |
192 | to be used. With any other prefix ARG, turn mode on if ARG is | |
193 | positive, off otherwise. If called from Lisp, enable the mode if | |
194 | ARG is omitted or nil. | |
195 | ||
196 | Initially, if the user does not pass an explicit locking mode, it | |
197 | defaults to `emacs-lock-default-locking-mode' (which see); | |
198 | afterwards, the locking mode most recently set on the buffer is | |
199 | used instead. | |
53bbe3ad JB |
200 | |
201 | When called from Elisp code, ARG can be any locking mode: | |
202 | ||
203 | exit -- Emacs cannot exit while the buffer is locked | |
204 | kill -- the buffer cannot be killed, but Emacs can exit as usual | |
205 | all -- the buffer is locked against both actions | |
206 | ||
207 | Other values are interpreted as usual." | |
208 | :init-value nil | |
209 | :lighter ("" | |
210 | (emacs-lock--try-unlocking " locked:" " Locked:") | |
b27640fe | 211 | (:eval (symbol-name emacs-lock-mode))) |
53bbe3ad JB |
212 | :group 'emacs-lock |
213 | :variable (emacs-lock-mode . | |
214 | (lambda (mode) | |
215 | (emacs-lock--set-mode mode arg))) | |
216 | (when emacs-lock-mode | |
217 | (setq emacs-lock--old-mode emacs-lock-mode) | |
218 | (setq emacs-lock--try-unlocking | |
b27640fe JB |
219 | (and (if (eq emacs-lock-unlockable-modes t) |
220 | (emacs-lock-live-process-p (current-buffer)) | |
221 | (assq major-mode emacs-lock-unlockable-modes)) | |
222 | t)))) | |
c9e2fc17 | 223 | |
53bbe3ad JB |
224 | (unless noninteractive |
225 | (add-hook 'kill-buffer-query-functions 'emacs-lock--kill-buffer-query-functions) | |
226 | ;; We set a hook in both kill-emacs-hook and kill-emacs-query-functions because | |
227 | ;; we really want to use k-e-q-f to stop as soon as possible, but don't want to | |
228 | ;; be caught by surprise if someone calls `kill-emacs' instead. | |
229 | (add-hook 'kill-emacs-hook 'emacs-lock--kill-emacs-hook) | |
230 | (add-hook 'kill-emacs-query-functions 'emacs-lock--kill-emacs-query-functions)) | |
231 | ||
232 | (defun emacs-lock-unload-function () | |
233 | "Unload the Emacs Lock library." | |
234 | (catch :continue | |
c4667a1a JB |
235 | (dolist (buffer (buffer-list)) |
236 | (set-buffer buffer) | |
53bbe3ad JB |
237 | (when emacs-lock-mode |
238 | (if (y-or-n-p (format "Buffer %S is locked, unlock it? " (buffer-name))) | |
239 | (emacs-lock-mode -1) | |
240 | (message "Unloading of feature `emacs-lock' aborted.") | |
241 | (throw :continue t)))) | |
242 | ;; continue standard unloading | |
243 | nil)) | |
c9e2fc17 | 244 | |
53bbe3ad | 245 | ;;; Compatibility |
0333a1cc | 246 | |
53bbe3ad JB |
247 | (defun toggle-emacs-lock () |
248 | "Toggle `emacs-lock-from-exiting' for the current buffer." | |
59f7af81 | 249 | (declare (obsolete emacs-lock-mode "24.1")) |
53bbe3ad JB |
250 | (interactive) |
251 | (call-interactively 'emacs-lock-mode)) | |
a1479eac JB |
252 | |
253 | (provide 'emacs-lock) | |
254 | ||
255 | ;;; emacs-lock.el ends here |