;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*-
-;; Copyright (C) 2011 Free Software Foundation, Inc
+;; Copyright (C) 2011-2015 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.
;; 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:
: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.
(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'."
;; 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:
:init-value nil
:lighter (""
(emacs-lock--try-unlocking " locked:" " Locked:")
- (:eval (symbol-name emacs-lock-model)))
+ (:eval (symbol-name emacs-lock-mode)))
:group 'emacs-lock
:variable (emacs-lock-mode .
(lambda (mode)
(when emacs-lock-mode
(setq emacs-lock--old-mode emacs-lock-mode)
(setq emacs-lock--try-unlocking
- (or (and (eq emacs-lock-unlockable-modes t)
- (emacs-lock-live-process-p (current-buffer)))
- (assq major-mode emacs-lock-unlockable-modes)))))
+ (and (if (eq emacs-lock-unlockable-modes t)
+ (emacs-lock-live-process-p (current-buffer))
+ (assq major-mode emacs-lock-unlockable-modes))
+ t))))
(unless noninteractive
(add-hook 'kill-buffer-query-functions 'emacs-lock--kill-buffer-query-functions)
;;; 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)