Commit | Line | Data |
---|---|---|
53bbe3ad | 1 | ;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*- |
b578f267 | 2 | |
ab422c4d | 3 | ;; Copyright (C) 2011-2013 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." | |
112 | (let ((proc (get-buffer-process buffer-or-name))) | |
113 | (and proc (process-live-p proc)))) | |
114 | ||
115 | (defun emacs-lock--can-auto-unlock (action) | |
116 | "Return t if the current buffer can auto-unlock for ACTION. | |
117 | ACTION must be one of `kill' or `exit'. | |
118 | See `emacs-lock-unlockable-modes'." | |
119 | (and emacs-lock--try-unlocking | |
120 | (not (emacs-lock-live-process-p (current-buffer))) | |
121 | (or (eq emacs-lock-unlockable-modes t) | |
122 | (let ((unlock (cdr (assq major-mode emacs-lock-unlockable-modes)))) | |
123 | (or (eq unlock 'all) (eq unlock action)))))) | |
124 | ||
125 | (defun emacs-lock--exit-locked-buffer () | |
d5e6342e | 126 | "Return the first exit-locked buffer found." |
53bbe3ad JB |
127 | (save-current-buffer |
128 | (catch :found | |
129 | (dolist (buffer (buffer-list)) | |
130 | (set-buffer buffer) | |
131 | (unless (or (emacs-lock--can-auto-unlock 'exit) | |
132 | (memq emacs-lock-mode '(nil kill))) | |
d5e6342e | 133 | (throw :found buffer))) |
53bbe3ad JB |
134 | nil))) |
135 | ||
136 | (defun emacs-lock--kill-emacs-hook () | |
137 | "Signal an error if any buffer is exit-locked. | |
138 | Used from `kill-emacs-hook' (which see)." | |
d5e6342e JB |
139 | (let ((locked (emacs-lock--exit-locked-buffer))) |
140 | (when locked | |
141 | (run-hook-with-args 'emacs-lock-locked-buffer-functions locked) | |
142 | (error "Emacs cannot exit because buffer %S is locked" | |
143 | (buffer-name locked))))) | |
53bbe3ad JB |
144 | |
145 | (defun emacs-lock--kill-emacs-query-functions () | |
146 | "Display a message if any buffer is exit-locked. | |
147 | Return a value appropriate for `kill-emacs-query-functions' (which see)." | |
148 | (let ((locked (emacs-lock--exit-locked-buffer))) | |
d5e6342e JB |
149 | (if (not locked) |
150 | t | |
151 | (run-hook-with-args 'emacs-lock-locked-buffer-functions locked) | |
152 | (message "Emacs cannot exit because buffer %S is locked" | |
153 | (buffer-name locked)) | |
154 | nil))) | |
53bbe3ad JB |
155 | |
156 | (defun emacs-lock--kill-buffer-query-functions () | |
157 | "Display a message if the current buffer is kill-locked. | |
158 | Return a value appropriate for `kill-buffer-query-functions' (which see)." | |
d5e6342e JB |
159 | (if (or (emacs-lock--can-auto-unlock 'kill) |
160 | (memq emacs-lock-mode '(nil exit))) | |
161 | t | |
162 | (run-hook-with-args 'emacs-lock-locked-buffer-functions (current-buffer)) | |
163 | (message "Buffer %S is locked and cannot be killed" (buffer-name)) | |
164 | nil)) | |
53bbe3ad JB |
165 | |
166 | (defun emacs-lock--set-mode (mode arg) | |
167 | "Setter function for `emacs-lock-mode'." | |
168 | (setq emacs-lock-mode | |
169 | (cond ((memq arg '(all exit kill)) | |
170 | ;; explicit locking mode arg, use it | |
171 | arg) | |
172 | ((and (eq arg current-prefix-arg) (consp current-prefix-arg)) | |
173 | ;; called with C-u M-x emacs-lock-mode, so ask the user | |
174 | (intern (completing-read "Locking mode: " | |
175 | '("all" "exit" "kill") | |
176 | nil t nil nil | |
177 | (symbol-name | |
178 | emacs-lock-default-locking-mode)))) | |
179 | ((eq mode t) | |
180 | ;; turn on, so use previous setting, or customized default | |
181 | (or emacs-lock--old-mode emacs-lock-default-locking-mode)) | |
182 | (t | |
183 | ;; anything else (turn off) | |
184 | mode)))) | |
185 | ||
e5bd0a28 SM |
186 | (define-obsolete-variable-alias 'emacs-lock-from-exiting |
187 | 'emacs-lock-mode "24.1") | |
388573ee | 188 | |
53bbe3ad JB |
189 | ;;;###autoload |
190 | (define-minor-mode emacs-lock-mode | |
06e21633 CY |
191 | "Toggle Emacs Lock mode in the current buffer. |
192 | If called with a plain prefix argument, ask for the locking mode | |
193 | to be used. With any other prefix ARG, turn mode on if ARG is | |
194 | positive, off otherwise. If called from Lisp, enable the mode if | |
195 | ARG is omitted or nil. | |
196 | ||
197 | Initially, if the user does not pass an explicit locking mode, it | |
198 | defaults to `emacs-lock-default-locking-mode' (which see); | |
199 | afterwards, the locking mode most recently set on the buffer is | |
200 | used instead. | |
53bbe3ad JB |
201 | |
202 | When called from Elisp code, ARG can be any locking mode: | |
203 | ||
204 | exit -- Emacs cannot exit while the buffer is locked | |
205 | kill -- the buffer cannot be killed, but Emacs can exit as usual | |
206 | all -- the buffer is locked against both actions | |
207 | ||
208 | Other values are interpreted as usual." | |
209 | :init-value nil | |
210 | :lighter ("" | |
211 | (emacs-lock--try-unlocking " locked:" " Locked:") | |
b27640fe | 212 | (:eval (symbol-name emacs-lock-mode))) |
53bbe3ad JB |
213 | :group 'emacs-lock |
214 | :variable (emacs-lock-mode . | |
215 | (lambda (mode) | |
216 | (emacs-lock--set-mode mode arg))) | |
217 | (when emacs-lock-mode | |
218 | (setq emacs-lock--old-mode emacs-lock-mode) | |
219 | (setq emacs-lock--try-unlocking | |
b27640fe JB |
220 | (and (if (eq emacs-lock-unlockable-modes t) |
221 | (emacs-lock-live-process-p (current-buffer)) | |
222 | (assq major-mode emacs-lock-unlockable-modes)) | |
223 | t)))) | |
c9e2fc17 | 224 | |
53bbe3ad JB |
225 | (unless noninteractive |
226 | (add-hook 'kill-buffer-query-functions 'emacs-lock--kill-buffer-query-functions) | |
227 | ;; We set a hook in both kill-emacs-hook and kill-emacs-query-functions because | |
228 | ;; we really want to use k-e-q-f to stop as soon as possible, but don't want to | |
229 | ;; be caught by surprise if someone calls `kill-emacs' instead. | |
230 | (add-hook 'kill-emacs-hook 'emacs-lock--kill-emacs-hook) | |
231 | (add-hook 'kill-emacs-query-functions 'emacs-lock--kill-emacs-query-functions)) | |
232 | ||
233 | (defun emacs-lock-unload-function () | |
234 | "Unload the Emacs Lock library." | |
235 | (catch :continue | |
c4667a1a JB |
236 | (dolist (buffer (buffer-list)) |
237 | (set-buffer buffer) | |
53bbe3ad JB |
238 | (when emacs-lock-mode |
239 | (if (y-or-n-p (format "Buffer %S is locked, unlock it? " (buffer-name))) | |
240 | (emacs-lock-mode -1) | |
241 | (message "Unloading of feature `emacs-lock' aborted.") | |
242 | (throw :continue t)))) | |
243 | ;; continue standard unloading | |
244 | nil)) | |
c9e2fc17 | 245 | |
53bbe3ad | 246 | ;;; Compatibility |
0333a1cc | 247 | |
53bbe3ad JB |
248 | (defun toggle-emacs-lock () |
249 | "Toggle `emacs-lock-from-exiting' for the current buffer." | |
59f7af81 | 250 | (declare (obsolete emacs-lock-mode "24.1")) |
53bbe3ad JB |
251 | (interactive) |
252 | (call-interactively 'emacs-lock-mode)) | |
a1479eac JB |
253 | |
254 | (provide 'emacs-lock) | |
255 | ||
256 | ;;; emacs-lock.el ends here |