declare smobs in alloc.c

[bpt/emacs.git] / lisp / emacs-lock.el

diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index 743b828..0432fc2 100644 (file)
--- 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-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
 
 ;; Author: Juanma Barranquero <lekktu@gmail.com>
 ;; Inspired by emacs-lock.el by Tom Wurgler <twurgler@goodyear.com>
-;; 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,6 +182,9 @@ 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.
@@ -233,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)