In display-buffer-record-window record selected window if necessary.
[emacs.git] / lisp / emacs-lock.el
blob919cbcb0c50ddd39ee3c27b016e555a470ef53af
1 ;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*-
3 ;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
5 ;; Author: Juanma Barranquero <lekktu@gmail.com>
6 ;; Inspired by emacs-lock.el by Tom Wurgler <twurgler@goodyear.com>
7 ;; Maintainer: emacs-devel@gnu.org
8 ;; Keywords: extensions, processes
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
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.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Commentary:
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 inferior
31 ;; processes are dead.
33 ;;; Code:
35 (defgroup emacs-lock nil
36 "Emacs-Lock mode."
37 :version "24.1"
38 :group 'convenience)
40 (defcustom emacs-lock-default-locking-mode 'all
41 "Default locking mode of Emacs-Locked buffers.
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.
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")
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")
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
89 :version "24.3")
91 (defvar-local emacs-lock-mode nil
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")
98 (put 'emacs-lock-mode 'permanent-local t)
100 (defvar-local emacs-lock--old-mode nil
101 "Most recent locking mode set on the buffer.
102 Internal use only.")
103 (put 'emacs-lock--old-mode 'permanent-local t)
105 (defvar-local emacs-lock--try-unlocking nil
106 "Non-nil if current buffer should be checked for auto-unlocking.
107 Internal use only.")
108 (put 'emacs-lock--try-unlocking 'permanent-local t)
110 (defun emacs-lock-live-process-p (buffer-or-name)
111 "Return t if BUFFER-OR-NAME is associated with a live process."
112 (process-live-p (get-buffer-process buffer-or-name)))
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))))))
124 (defun emacs-lock--exit-locked-buffer ()
125 "Return the first exit-locked buffer found."
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)))
132 (throw :found buffer)))
133 nil)))
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)."
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)))))
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)))
148 (if (not locked)
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)))
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)."
158 (if (or (emacs-lock--can-auto-unlock 'kill)
159 (memq emacs-lock-mode '(nil exit)))
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))
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))
182 ;; anything else (turn off)
183 mode))))
185 (define-obsolete-variable-alias 'emacs-lock-from-exiting
186 'emacs-lock-mode "24.1")
188 ;;;###autoload
189 (define-minor-mode emacs-lock-mode
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.
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.
201 When called from Elisp code, ARG can be any locking mode:
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
207 Other values are interpreted as usual."
208 :init-value nil
209 :lighter (""
210 (emacs-lock--try-unlocking " locked:" " Locked:")
211 (:eval (symbol-name emacs-lock-mode)))
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
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))))
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))
232 (defun emacs-lock-unload-function ()
233 "Unload the Emacs Lock library."
234 (catch :continue
235 (dolist (buffer (buffer-list))
236 (set-buffer buffer)
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))
245 ;;; Compatibility
247 (defun toggle-emacs-lock ()
248 "Toggle `emacs-lock-from-exiting' for the current buffer."
249 (declare (obsolete emacs-lock-mode "24.1"))
250 (interactive)
251 (call-interactively 'emacs-lock-mode))
253 (provide 'emacs-lock)
255 ;;; emacs-lock.el ends here