[Emacs-diffs] /srv/bzr/emacs/emacs-24 r107901: * lisp/emacs-lock.el (emacs-lock-locked-buffer-functions): New hook.

[Juanma Barranquero]

------------------------------------------------------------
revno: 107901
fixes bug: http://debbugs.gnu.org/11017
committer: Juanma Barranquero <address@hidden>
branch nick: trunk
timestamp: Sat 2012-04-14 05:11:18 +0200
message:
  * lisp/emacs-lock.el (emacs-lock-locked-buffer-functions): New hook.
    (emacs-lock--exit-locked-buffer): Return the locked buffer.  Doc fix.
    (emacs-lock--kill-emacs-hook, emacs-lock--kill-emacs-query-functions)
    (emacs-lock--kill-buffer-query-functions): Run new hook.
modified:
  lisp/ChangeLog
  lisp/emacs-lock.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-04-14 02:31:50 +0000
+++ b/lisp/ChangeLog    2012-04-14 03:11:18 +0000
@@ -1,3 +1,10 @@
+2012-04-14  Juanma Barranquero  <address@hidden>
+
+       * emacs-lock.el (emacs-lock-locked-buffer-functions): New hook.
+       (emacs-lock--exit-locked-buffer): Return the locked buffer.  Doc fix.
+       (emacs-lock--kill-emacs-hook, emacs-lock--kill-emacs-query-functions)
+       (emacs-lock--kill-buffer-query-functions): Run new hook.  (Bug#11017)
+
 2012-04-14  Stefan Monnier  <address@hidden>
 
        * progmodes/which-func.el (which-func-modes): Change default.

=== modified file 'lisp/emacs-lock.el'
--- a/lisp/emacs-lock.el        2012-01-11 07:48:55 +0000
+++ b/lisp/emacs-lock.el        2012-04-14 03:11:18 +0000
@@ -81,6 +81,13 @@
   :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.2")
+
 (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 @@
              (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'."