X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2238127283d703f38765f9b3f6a64f799d18e9e5..2a1e24765bc3de7bf72e7117893307f6f6c441be:/lisp/emacs-lock.el?ds=sidebyside

diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index 18411f7d2e..5343d499ef 100644
--- a/lisp/emacs-lock.el
+++ b/lisp/emacs-lock.el
@@ -1,6 +1,6 @@
 ;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*-
 
-;; Copyright (C) 2011 Free Software Foundation, Inc
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
 
 ;; Author: Juanma Barranquero <lekktu@gmail.com>
 ;; Inspired by emacs-lock.el by Tom Wurgler <twurgler@goodyear.com>
@@ -81,6 +81,13 @@ for both actions (NOT RECOMMENDED)."
   :group 'emacs-lock
   :version "24.1")
 
+(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 emacs-lock-mode nil
   "If non-nil, the current buffer is locked.
 It can be one of the following values:
@@ -119,40 +126,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 +186,20 @@ 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.
-
-With \\[universal-argument], ask for the locking mode to be used.
-With other prefix ARG, turn mode on if ARG is positive, off otherwise.
+  "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.
 
-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,8 +247,6 @@ 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."
   (interactive)