mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-27 07:37:33 +00:00
Code Issues Releases Activity

* lisp/emacs-lock.el (emacs-lock-locked-buffer-functions): New hook.

Browse Source 
(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.

Fixes: debbugs:11017
This commit is contained in:
Juanma Barranquero 2012-04-14 05:11:18 +02:00
parent ab036cd7bd
commit d5e6342ed5
2 changed files with 33 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lisp/ChangeLog
View File

@ -1,3 +1,10 @@
2012-04-14 Juanma Barranquero <lekktu@gmail.com>
* 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 <monnier@iro.umontreal.ca>
* progmodes/which-func.el (which-func-modes): Change default.

40
lisp/emacs-lock.el
View File

@ -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.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 @@ 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'."