X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/59361254a6ea5fcfc2f1ec344665aa719fbb936f..5155144bd4cece3bab200a0eb613ffcdef523202:/lisp/emacs-lock.el diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 18411f7d2e..28b8e35fba 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -1,10 +1,10 @@ ;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*- -;; Copyright (C) 2011 Free Software Foundation, Inc +;; Copyright (C) 2011-2016 Free Software Foundation, Inc. ;; Author: Juanma Barranquero ;; Inspired by emacs-lock.el by Tom Wurgler -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: extensions, processes ;; This file is part of GNU Emacs. @@ -27,7 +27,7 @@ ;; This package defines a minor mode Emacs Lock to mark a buffer as ;; protected against accidental killing, or exiting Emacs, or both. ;; Buffers associated with inferior modes, like shell or telnet, can -;; be treated specially, by auto-unlocking them if their interior +;; be treated specially, by auto-unlocking them if their inferior ;; processes are dead. ;;; Code: @@ -81,32 +81,35 @@ for both actions (NOT RECOMMENDED)." :group 'emacs-lock :version "24.1") -(defvar emacs-lock-mode nil +(defcustom emacs-lock-locked-buffer-functions nil + "Abnormal hook run when Emacs Lock prevents exiting Emacs, or killing a buffer. +The functions get one argument, the first locked buffer found." + :type 'hook + :group 'emacs-lock + :version "24.3") + +(defvar-local emacs-lock-mode nil "If non-nil, the current buffer is locked. It can be one of the following values: exit -- Emacs cannot exit while the buffer is locked kill -- the buffer cannot be killed, but Emacs can exit as usual all -- the buffer is locked against both actions nil -- the buffer is not locked") -(make-variable-buffer-local 'emacs-lock-mode) (put 'emacs-lock-mode 'permanent-local t) -(defvar emacs-lock--old-mode nil +(defvar-local emacs-lock--old-mode nil "Most recent locking mode set on the buffer. Internal use only.") -(make-variable-buffer-local 'emacs-lock--old-mode) (put 'emacs-lock--old-mode 'permanent-local t) -(defvar emacs-lock--try-unlocking nil +(defvar-local emacs-lock--try-unlocking nil "Non-nil if current buffer should be checked for auto-unlocking. Internal use only.") -(make-variable-buffer-local 'emacs-lock--try-unlocking) (put 'emacs-lock--try-unlocking 'permanent-local t) (defun emacs-lock-live-process-p (buffer-or-name) "Return t if BUFFER-OR-NAME is associated with a live process." - (let ((proc (get-buffer-process buffer-or-name))) - (and proc (process-live-p proc)))) + (process-live-p (get-buffer-process buffer-or-name))) (defun emacs-lock--can-auto-unlock (action) "Return t if the current buffer can auto-unlock for ACTION. @@ -119,40 +122,45 @@ See `emacs-lock-unlockable-modes'." (or (eq unlock 'all) (eq unlock action)))))) (defun emacs-lock--exit-locked-buffer () - "Return the name of the first exit-locked buffer found." + "Return the first exit-locked buffer found." (save-current-buffer (catch :found (dolist (buffer (buffer-list)) (set-buffer buffer) (unless (or (emacs-lock--can-auto-unlock 'exit) (memq emacs-lock-mode '(nil kill))) - (throw :found (buffer-name)))) + (throw :found buffer))) nil))) (defun emacs-lock--kill-emacs-hook () "Signal an error if any buffer is exit-locked. Used from `kill-emacs-hook' (which see)." - (let ((buffer-name (emacs-lock--exit-locked-buffer))) - (when buffer-name - (error "Emacs cannot exit because buffer %S is locked" buffer-name)))) + (let ((locked (emacs-lock--exit-locked-buffer))) + (when locked + (run-hook-with-args 'emacs-lock-locked-buffer-functions locked) + (error "Emacs cannot exit because buffer %S is locked" + (buffer-name locked))))) (defun emacs-lock--kill-emacs-query-functions () "Display a message if any buffer is exit-locked. Return a value appropriate for `kill-emacs-query-functions' (which see)." (let ((locked (emacs-lock--exit-locked-buffer))) - (or (not locked) - (progn - (message "Emacs cannot exit because buffer %S is locked" locked) - nil)))) + (if (not locked) + t + (run-hook-with-args 'emacs-lock-locked-buffer-functions locked) + (message "Emacs cannot exit because buffer %S is locked" + (buffer-name locked)) + nil))) (defun emacs-lock--kill-buffer-query-functions () "Display a message if the current buffer is kill-locked. Return a value appropriate for `kill-buffer-query-functions' (which see)." - (or (emacs-lock--can-auto-unlock 'kill) - (memq emacs-lock-mode '(nil exit)) - (progn - (message "Buffer %S is locked and cannot be killed" (buffer-name)) - nil))) + (if (or (emacs-lock--can-auto-unlock 'kill) + (memq emacs-lock-mode '(nil exit))) + t + (run-hook-with-args 'emacs-lock-locked-buffer-functions (current-buffer)) + (message "Buffer %S is locked and cannot be killed" (buffer-name)) + nil)) (defun emacs-lock--set-mode (mode arg) "Setter function for `emacs-lock-mode'." @@ -174,16 +182,21 @@ Return a value appropriate for `kill-buffer-query-functions' (which see)." ;; anything else (turn off) mode)))) +(define-obsolete-variable-alias 'emacs-lock-from-exiting + 'emacs-lock-mode "24.1") + ;;;###autoload (define-minor-mode emacs-lock-mode - "Toggle Emacs Lock mode in the current buffer. + "Toggle Emacs Lock mode in the current buffer. +If called with a plain prefix argument, ask for the locking mode +to be used. With any other prefix ARG, turn mode on if ARG is +positive, off otherwise. If called from Lisp, enable the mode if +ARG is omitted or nil. -With \\[universal-argument], ask for the locking mode to be used. -With other prefix ARG, turn mode on if ARG is positive, off otherwise. - -Initially, if the user does not pass an explicit locking mode, it defaults -to `emacs-lock-default-locking-mode' (which see); afterwards, the locking -mode most recently set on the buffer is used instead. +Initially, if the user does not pass an explicit locking mode, it +defaults to `emacs-lock-default-locking-mode' (which see); +afterwards, the locking mode most recently set on the buffer is +used instead. When called from Elisp code, ARG can be any locking mode: @@ -231,13 +244,11 @@ Other values are interpreted as usual." ;;; Compatibility -(define-obsolete-variable-alias 'emacs-lock-from-exiting 'emacs-lock-mode "24.1") - (defun toggle-emacs-lock () "Toggle `emacs-lock-from-exiting' for the current buffer." + (declare (obsolete emacs-lock-mode "24.1")) (interactive) (call-interactively 'emacs-lock-mode)) -(make-obsolete 'toggle-emacs-lock 'emacs-lock-mode "24.1") (provide 'emacs-lock)