[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r104963: lisp/emacs-lock.el: New file
From: |
Juanma Barranquero |
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r104963: lisp/emacs-lock.el: New file. Old one moved to lisp/obsolete/. |
Date: |
Tue, 05 Jul 2011 13:38:44 +0200 |
User-agent: |
Bazaar (2.3.1) |
------------------------------------------------------------
revno: 104963
committer: Juanma Barranquero <address@hidden>
branch nick: trunk
timestamp: Tue 2011-07-05 13:38:44 +0200
message:
lisp/emacs-lock.el: New file. Old one moved to lisp/obsolete/.
added:
lisp/emacs-lock.el
renamed:
lisp/emacs-lock.el => lisp/obsolete/old-emacs-lock.el
modified:
etc/ChangeLog
etc/NEWS
lisp/ChangeLog
lisp/obsolete/old-emacs-lock.el
=== modified file 'etc/ChangeLog'
--- a/etc/ChangeLog 2011-07-05 03:02:06 +0000
+++ b/etc/ChangeLog 2011-07-05 11:38:44 +0000
@@ -1,3 +1,7 @@
+2011-07-05 Juanma Barranquero <address@hidden>
+
+ * NEWS: Document new emacs-lock.el and renaming of old one.
+
2011-07-05 Manoj Srivastava <address@hidden>
* themes/manoj-dark-theme.el (manoj-dark): New file.
=== modified file 'etc/NEWS'
--- a/etc/NEWS 2011-07-04 22:11:40 +0000
+++ b/etc/NEWS 2011-07-05 11:38:44 +0000
@@ -857,6 +857,13 @@
** 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
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2011-07-05 10:02:48 +0000
+++ b/lisp/ChangeLog 2011-07-05 11:38:44 +0000
@@ -1,3 +1,8 @@
+2011-07-05 Juanma Barranquero <address@hidden>
+
+ * obsolete/old-emacs-lock.el: Rename from emacs-lock.el.
+ * emacs-lock.el: New file.
+
2011-07-05 Julien Danjou <address@hidden>
* textmodes/rst.el (rst-define-level-faces): Use `facep' rather
=== added file 'lisp/emacs-lock.el'
--- a/lisp/emacs-lock.el 1970-01-01 00:00:00 +0000
+++ b/lisp/emacs-lock.el 2011-07-05 11:38:44 +0000
@@ -0,0 +1,240 @@
+;;; emacs-lock.el --- protect buffers against killing or exiting -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2011 Free Software Foundation, Inc
+
+;; Author: Juanma Barranquero <address@hidden>
+;; Inspired by emacs-lock.el by Tom Wurgler <address@hidden>
+;; Maintainer: FSF
+;; Keywords: extensions, processes
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; 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:
+
+(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)))))
+
+(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-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))
+
+;;; 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."
+ (interactive)
+ (call-interactively 'emacs-lock-mode))
+(make-obsolete 'toggle-emacs-lock 'emacs-lock-mode "24.1")
+k
=== renamed file 'lisp/emacs-lock.el' => 'lisp/obsolete/old-emacs-lock.el'
--- a/lisp/emacs-lock.el 2011-04-19 13:44:55 +0000
+++ b/lisp/obsolete/old-emacs-lock.el 2011-07-05 11:38:44 +0000
@@ -5,6 +5,7 @@
;; Author: Tom Wurgler <address@hidden>
;; Created: 12/8/94
;; Keywords: extensions, processes
+;; Obsolete-since: 24.1
;; This file is part of GNU Emacs.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r104963: lisp/emacs-lock.el: New file. Old one moved to lisp/obsolete/.,
Juanma Barranquero <=