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