From 53bbe3ad4c130bfc8c2e3d3262f8739ce8f7d553 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Tue, 5 Jul 2011 13:38:44 +0200 Subject: [PATCH] lisp/emacs-lock.el: New file. Old one moved to lisp/obsolete/. --- etc/ChangeLog | 4 + etc/NEWS | 7 + lisp/ChangeLog | 5 + lisp/emacs-lock.el | 281 ++++++++++++++++++++++++-------- lisp/obsolete/old-emacs-lock.el | 102 ++++++++++++ 5 files changed, 328 insertions(+), 71 deletions(-) create mode 100644 lisp/obsolete/old-emacs-lock.el diff --git a/etc/ChangeLog b/etc/ChangeLog index 0ab5f860d62..4f4e8762328 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2011-07-05 Juanma Barranquero + + * NEWS: Document new emacs-lock.el and renaming of old one. + 2011-07-05 Manoj Srivastava * themes/manoj-dark-theme.el (manoj-dark): New file. diff --git a/etc/NEWS b/etc/NEWS index d123073bd79..5da6e06d0d0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -857,6 +857,13 @@ soap-inspect.el is an interactive inspector for SOAP WSDL structures. ** xmodmap-generic-mode for xmodmap files. +** New emacs-lock.el package. +(The pre-existing one has been renamed to old-emacs-lock.el and moved +to obsolete/.) Now, Emacs Lock is a proper minor mode +`emacs-lock-mode'. Protection against exiting Emacs and killing the +buffer can be set separately. The mechanism for auto turning off +protection for buffers with inferior processes has been generalized. + * Incompatible Lisp Changes in Emacs 24.1 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a8b65d6915b..701cec11c2e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-07-05 Juanma Barranquero + + * obsolete/old-emacs-lock.el: Rename from emacs-lock.el. + * emacs-lock.el: New file. + 2011-07-05 Julien Danjou * textmodes/rst.el (rst-define-level-faces): Use `facep' rather diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 1553aeae0d5..9e0a93b4731 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -1,9 +1,10 @@ -;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked +;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*- -;; Copyright (C) 1994, 1997, 2001-2011 Free Software Foundation, Inc +;; Copyright (C) 2011 Free Software Foundation, Inc -;; Author: Tom Wurgler -;; Created: 12/8/94 +;; Author: Juanma Barranquero +;; Inspired by emacs-lock.el by Tom Wurgler +;; Maintainer: FSF ;; Keywords: extensions, processes ;; This file is part of GNU Emacs. @@ -23,79 +24,217 @@ ;;; Commentary: -;; This code sets a buffer-local variable to t if toggle-emacs-lock is run, -;; then if the user attempts to exit Emacs, the locked buffer name will be -;; displayed and the exit aborted. This is just a way of protecting -;; yourself from yourself. For example, if you have a shell running a big -;; program and exiting Emacs would abort that program, you may want to lock -;; that buffer, then if you forget about it after a while, you won't -;; accidentally exit Emacs. To unlock the buffer, just goto the buffer and -;; run toggle-emacs-lock again. +;; 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 +;; processes are dead. ;;; Code: -(defvar emacs-lock-from-exiting nil - "Whether Emacs is locked to prevent exiting. See `check-emacs-lock'.") -(make-variable-buffer-local 'emacs-lock-from-exiting) - -(defvar emacs-lock-buffer-locked nil - "Whether a shell or telnet buffer was locked when its process was killed.") -(make-variable-buffer-local 'emacs-lock-buffer-locked) -(put 'emacs-lock-buffer-locked 'permanent-local t) +(defgroup emacs-lock nil + "Emacs-Lock mode." + :version "24.1" + :group 'convenience) + +(defcustom emacs-lock-default-locking-mode 'all + "Default locking mode of Emacs-Locked buffers. + +Its value is used as the default for `emacs-lock-mode' (which +see) the first time that Emacs Lock mode is turned on in a buffer +without passing an explicit locking mode. + +Possible values are: + 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" + :type '(choice + (const :tag "Do not allow Emacs to exit" exit) + (const :tag "Do not allow killing the buffer" kill) + (const :tag "Do not allow killing the buffer or exiting Emacs" all) + (const :tag "Do not lock the buffer" nil)) + :group 'emacs-lock + :version "24.1") + +;; Note: as auto-unlocking can lead to data loss, it would be better +;; to default to nil; but the value below is for compatibility with +;; the old emacs-lock.el. +(defcustom emacs-lock-unlockable-modes '((shell-mode . all) + (telnet-mode . all)) + "Alist of auto-unlockable modes. +Each element is a pair (MAJOR-MODE . ACTION), where ACTION is +one of `kill', `exit' or `all'. Buffers with matching major +modes are auto-unlocked for the specific action if their +inferior processes are not alive. If this variable is t, all +buffers associated to inferior processes are auto-unlockable +for both actions (NOT RECOMMENDED)." + :type '(choice + (const :tag "All buffers with inferior processes" t) + (repeat :tag "Selected modes" + (cons :tag "Set auto-unlock for" + (symbol :tag "Major mode") + (radio + (const :tag "Allow exiting" exit) + (const :tag "Allow killing" kill) + (const :tag "Allow both" all))))) + :group 'emacs-lock + :version "24.1") + +(defvar 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 + "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 + "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)))) + +(defun emacs-lock--can-auto-unlock (action) + "Return t if the current buffer can auto-unlock for ACTION. +ACTION must be one of `kill' or `exit'. +See `emacs-lock-unlockable-modes'." + (and emacs-lock--try-unlocking + (not (emacs-lock-live-process-p (current-buffer))) + (or (eq emacs-lock-unlockable-modes t) + (let ((unlock (cdr (assq major-mode 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." + (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)))) + 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)))) + +(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)))) + +(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))) + +(defun emacs-lock--set-mode (mode arg) + "Setter function for `emacs-lock-mode'." + (setq emacs-lock-mode + (cond ((memq arg '(all exit kill)) + ;; explicit locking mode arg, use it + arg) + ((and (eq arg current-prefix-arg) (consp current-prefix-arg)) + ;; called with C-u M-x emacs-lock-mode, so ask the user + (intern (completing-read "Locking mode: " + '("all" "exit" "kill") + nil t nil nil + (symbol-name + emacs-lock-default-locking-mode)))) + ((eq mode t) + ;; turn on, so use previous setting, or customized default + (or emacs-lock--old-mode emacs-lock-default-locking-mode)) + (t + ;; anything else (turn off) + mode)))) + +;;;###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. + +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: + + 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 + +Other values are interpreted as usual." + :init-value nil + :lighter ("" + (emacs-lock--try-unlocking " locked:" " Locked:") + (:eval (symbol-name emacs-lock-model))) + :group 'emacs-lock + :variable (emacs-lock-mode . + (lambda (mode) + (emacs-lock--set-mode mode arg))) + (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))))) -(defun check-emacs-lock () - "Check if variable `emacs-lock-from-exiting' is t for any buffer. -If any locked buffer is found, signal error and display the buffer's name." - (save-excursion +(unless noninteractive + (add-hook 'kill-buffer-query-functions 'emacs-lock--kill-buffer-query-functions) + ;; We set a hook in both kill-emacs-hook and kill-emacs-query-functions because + ;; we really want to use k-e-q-f to stop as soon as possible, but don't want to + ;; be caught by surprise if someone calls `kill-emacs' instead. + (add-hook 'kill-emacs-hook 'emacs-lock--kill-emacs-hook) + (add-hook 'kill-emacs-query-functions 'emacs-lock--kill-emacs-query-functions)) + +(defun emacs-lock-unload-function () + "Unload the Emacs Lock library." + (catch :continue (dolist (buffer (buffer-list)) (set-buffer buffer) - (when emacs-lock-from-exiting - (error "Emacs is locked from exit due to buffer: %s" (buffer-name)))))) + (when emacs-lock-mode + (if (y-or-n-p (format "Buffer %S is locked, unlock it? " (buffer-name))) + (emacs-lock-mode -1) + (message "Unloading of feature `emacs-lock' aborted.") + (throw :continue t)))) + ;; continue standard unloading + nil)) -(defun toggle-emacs-lock () - "Toggle `emacs-lock-from-exiting' for the current buffer. -See `check-emacs-lock'." - (interactive) - (setq emacs-lock-from-exiting (not emacs-lock-from-exiting)) - (if emacs-lock-from-exiting - (message "Buffer is now locked") - (message "Buffer is now unlocked"))) - -(defun emacs-lock-check-buffer-lock () - "Check if variable `emacs-lock-from-exiting' is t for a buffer. -If the buffer is locked, signal error and display its name." - (when emacs-lock-from-exiting - (error "Buffer `%s' is locked, can't delete it" (buffer-name)))) - -; These next defuns make it so if you exit a shell that is locked, the lock -; is shut off for that shell so you can exit Emacs. Same for telnet. -; Also, if a shell or a telnet buffer was locked and the process killed, -; turn the lock back on again if the process is restarted. - -(defun emacs-lock-shell-sentinel () - (set-process-sentinel - (get-buffer-process (buffer-name)) (function emacs-lock-clear-sentinel))) - -(defun emacs-lock-clear-sentinel (_proc _str) - (if emacs-lock-from-exiting - (progn - (setq emacs-lock-from-exiting nil) - (setq emacs-lock-buffer-locked t) - (message "Buffer is now unlocked")) - (setq emacs-lock-buffer-locked nil))) +;;; Compatibility -(defun emacs-lock-was-buffer-locked () - (if emacs-lock-buffer-locked - (setq emacs-lock-from-exiting t))) +(define-obsolete-variable-alias 'emacs-lock-from-exiting 'emacs-lock-mode "24.1") -(unless noninteractive - (add-hook 'kill-emacs-hook 'check-emacs-lock)) -(add-hook 'kill-buffer-hook 'emacs-lock-check-buffer-lock) -(add-hook 'shell-mode-hook 'emacs-lock-was-buffer-locked) -(add-hook 'shell-mode-hook 'emacs-lock-shell-sentinel) -(add-hook 'telnet-mode-hook 'emacs-lock-was-buffer-locked) -(add-hook 'telnet-mode-hook 'emacs-lock-shell-sentinel) - -(provide 'emacs-lock) - -;;; emacs-lock.el ends here +(defun toggle-emacs-lock () + "Toggle `emacs-lock-from-exiting' for the current buffer." + (interactive) + (call-interactively 'emacs-lock-mode)) +(make-obsolete 'toggle-emacs-lock 'emacs-lock-mode "24.1") +k diff --git a/lisp/obsolete/old-emacs-lock.el b/lisp/obsolete/old-emacs-lock.el new file mode 100644 index 00000000000..b45003fcecc --- /dev/null +++ b/lisp/obsolete/old-emacs-lock.el @@ -0,0 +1,102 @@ +;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked + +;; Copyright (C) 1994, 1997, 2001-2011 Free Software Foundation, Inc + +;; Author: Tom Wurgler +;; Created: 12/8/94 +;; Keywords: extensions, processes +;; Obsolete-since: 24.1 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This code sets a buffer-local variable to t if toggle-emacs-lock is run, +;; then if the user attempts to exit Emacs, the locked buffer name will be +;; displayed and the exit aborted. This is just a way of protecting +;; yourself from yourself. For example, if you have a shell running a big +;; program and exiting Emacs would abort that program, you may want to lock +;; that buffer, then if you forget about it after a while, you won't +;; accidentally exit Emacs. To unlock the buffer, just goto the buffer and +;; run toggle-emacs-lock again. + +;;; Code: + +(defvar emacs-lock-from-exiting nil + "Whether Emacs is locked to prevent exiting. See `check-emacs-lock'.") +(make-variable-buffer-local 'emacs-lock-from-exiting) + +(defvar emacs-lock-buffer-locked nil + "Whether a shell or telnet buffer was locked when its process was killed.") +(make-variable-buffer-local 'emacs-lock-buffer-locked) +(put 'emacs-lock-buffer-locked 'permanent-local t) + +(defun check-emacs-lock () + "Check if variable `emacs-lock-from-exiting' is t for any buffer. +If any locked buffer is found, signal error and display the buffer's name." + (save-excursion + (dolist (buffer (buffer-list)) + (set-buffer buffer) + (when emacs-lock-from-exiting + (error "Emacs is locked from exit due to buffer: %s" (buffer-name)))))) + +(defun toggle-emacs-lock () + "Toggle `emacs-lock-from-exiting' for the current buffer. +See `check-emacs-lock'." + (interactive) + (setq emacs-lock-from-exiting (not emacs-lock-from-exiting)) + (if emacs-lock-from-exiting + (message "Buffer is now locked") + (message "Buffer is now unlocked"))) + +(defun emacs-lock-check-buffer-lock () + "Check if variable `emacs-lock-from-exiting' is t for a buffer. +If the buffer is locked, signal error and display its name." + (when emacs-lock-from-exiting + (error "Buffer `%s' is locked, can't delete it" (buffer-name)))) + +; These next defuns make it so if you exit a shell that is locked, the lock +; is shut off for that shell so you can exit Emacs. Same for telnet. +; Also, if a shell or a telnet buffer was locked and the process killed, +; turn the lock back on again if the process is restarted. + +(defun emacs-lock-shell-sentinel () + (set-process-sentinel + (get-buffer-process (buffer-name)) (function emacs-lock-clear-sentinel))) + +(defun emacs-lock-clear-sentinel (_proc _str) + (if emacs-lock-from-exiting + (progn + (setq emacs-lock-from-exiting nil) + (setq emacs-lock-buffer-locked t) + (message "Buffer is now unlocked")) + (setq emacs-lock-buffer-locked nil))) + +(defun emacs-lock-was-buffer-locked () + (if emacs-lock-buffer-locked + (setq emacs-lock-from-exiting t))) + +(unless noninteractive + (add-hook 'kill-emacs-hook 'check-emacs-lock)) +(add-hook 'kill-buffer-hook 'emacs-lock-check-buffer-lock) +(add-hook 'shell-mode-hook 'emacs-lock-was-buffer-locked) +(add-hook 'shell-mode-hook 'emacs-lock-shell-sentinel) +(add-hook 'telnet-mode-hook 'emacs-lock-was-buffer-locked) +(add-hook 'telnet-mode-hook 'emacs-lock-shell-sentinel) + +(provide 'emacs-lock) + +;;; emacs-lock.el ends here -- 2.39.2