| 1 | ;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*- |
| 2 | |
| 3 | ;; Copyright (C) 2011-2014 Free Software Foundation, Inc. |
| 4 | |
| 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 |
| 9 | |
| 10 | ;; This file is part of GNU Emacs. |
| 11 | |
| 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. |
| 16 | |
| 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. |
| 21 | |
| 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/>. |
| 24 | |
| 25 | ;;; Commentary: |
| 26 | |
| 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. |
| 32 | |
| 33 | ;;; Code: |
| 34 | |
| 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 | (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") |
| 90 | |
| 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) |
| 99 | |
| 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) |
| 104 | |
| 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) |
| 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 | (process-live-p (get-buffer-process buffer-or-name))) |
| 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 () |
| 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))) |
| 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)." |
| 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))))) |
| 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))) |
| 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))) |
| 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)." |
| 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)) |
| 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 | |
| 185 | (define-obsolete-variable-alias 'emacs-lock-from-exiting |
| 186 | 'emacs-lock-mode "24.1") |
| 187 | |
| 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. |
| 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. |
| 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:") |
| 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)))) |
| 223 | |
| 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 |
| 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)) |
| 244 | |
| 245 | ;;; Compatibility |
| 246 | |
| 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)) |
| 252 | |
| 253 | (provide 'emacs-lock) |
| 254 | |
| 255 | ;;; emacs-lock.el ends here |