[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Experimental features
|
From: |
Juanma Barranquero |
|
Subject: |
Re: Experimental features |
|
Date: |
Sat, 23 Jun 2007 15:37:18 +0200 |
On 6/23/07, Richard Stallman <address@hidden> wrote:
I don't mind adding some new features to minor releases.
We've already added some for Emacs 22.2.
They should be totally modular, though, so that we
know they are safe.
BTW, if the release of 22.2 isn't imminent, I'd like to offer Davis
Herring's desktop locking feature for inclusion in 22.2 (it's already
in the trunk).
It's a small change (it seems bigger because a big bunch of code was
factored out to a function, and also I changed a few one-armed `if's
to `when's) and pretty safe.
Juanma
2007-06-20 Juanma Barranquero <address@hidden>
* desktop.el (desktop-read): Run `desktop-not-loaded-hook' in the
directory where the desktop file was found, as the docstring says.
(desktop-kill): Use `read-directory-name'.
2007-06-12 Juanma Barranquero <address@hidden>
* desktop.el (desktop-load-locked-desktop): New option.
(desktop-read): Use it.
(desktop-truncate, desktop-outvar, desktop-restore-file-buffer):
Use `when'.
2007-06-12 Davis Herring <address@hidden>
* desktop.el (desktop-save-mode-off): New function.
(desktop-base-lock-name, desktop-not-loaded-hook): New variables.
(desktop-full-lock-name, desktop-file-modtime, desktop-owner)
(desktop-claim-lock, desktop-release-lock): New functions.
(desktop-kill): Tell `desktop-save' that this is the last save.
Release the lock afterwards.
(desktop-buffer-info): New function.
(desktop-save): Use it. Run `desktop-save-hook' where the doc
says to. Detect conflicts, and manage the lock.
(desktop-read): Detect conflicts. Manage the lock.
Index: lisp/desktop.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/desktop.el,v
retrieving revision 1.108.2.1
diff -c -b -r1.108.2.1 desktop.el
*** lisp/desktop.el 9 Jun 2007 00:10:38 -0000 1.108.2.1
--- lisp/desktop.el 23 Jun 2007 13:29:16 -0000
***************
*** 162,167 ****
--- 162,171 ----
(define-obsolete-variable-alias 'desktop-enable
'desktop-save-mode "22.1")
+ (defun desktop-save-mode-off ()
+ "Disable `desktop-save-mode'. Provided for use in hooks."
+ (desktop-save-mode 0))
+
(defcustom desktop-save 'ask-if-new
"*Specifies whether the desktop should be saved when it is killed.
A desktop is killed when the user changes desktop or quits Emacs.
***************
*** 186,191 ****
--- 190,211 ----
:group 'desktop
:version "22.1")
+ (defcustom desktop-load-locked-desktop 'ask
+ "Specifies whether the desktop should be loaded if locked.
+ Possible values are:
+ t -- load anyway.
+ nil -- don't load.
+ ask -- ask the user.
+ If the value is nil, or `ask' and the user chooses not to load the desktop,
+ the normal hook `desktop-not-loaded-hook' is run."
+ :type
+ '(choice
+ (const :tag "Load anyway" t)
+ (const :tag "Don't load" nil)
+ (const :tag "Ask the user" ask))
+ :group 'desktop
+ :version "22.2")
+
(defcustom desktop-base-file-name
(convert-standard-filename ".emacs.desktop")
"Name of file for Emacs desktop, excluding the directory part."
***************
*** 194,199 ****
--- 214,226 ----
(define-obsolete-variable-alias 'desktop-basefilename
'desktop-base-file-name "22.1")
+ (defcustom desktop-base-lock-name
+ (convert-standard-filename ".emacs.desktop.lock")
+ "Name of lock file for Emacs desktop, excluding the directory part."
+ :type 'file
+ :group 'desktop
+ :version "22.2")
+
(defcustom desktop-path '("." "~")
"List of directories to search for the desktop file.
The base name of the file is specified in `desktop-base-file-name'."
***************
*** 219,224 ****
--- 246,260 ----
:group 'desktop
:version "22.1")
+ (defcustom desktop-not-loaded-hook nil
+ "Normal hook run when the user declines to re-use a desktop file.
+ Run in the directory in which the desktop file was found.
+ May be used to deal with accidental multiple Emacs jobs."
+ :type 'hook
+ :group 'desktop
+ :options '(desktop-save-mode-off save-buffers-kill-emacs)
+ :version "22.2")
+
(defcustom desktop-after-read-hook nil
"Normal hook run after a successful `desktop-read'.
May be used to show a buffer list."
***************
*** 486,491 ****
--- 522,532 ----
DIRNAME omitted or nil means use `desktop-dirname'."
(expand-file-name desktop-base-file-name (or dirname desktop-dirname)))
+ (defun desktop-full-lock-name (&optional dirname)
+ "Return the full name of the desktop lock file in DIRNAME.
+ DIRNAME omitted or nil means use `desktop-dirname'."
+ (expand-file-name desktop-base-lock-name (or dirname desktop-dirname)))
+
(defconst desktop-header
";; --------------------------------------------------------------------------
;; Desktop File for Emacs
***************
*** 496,505 ****
"Hooks run after all buffers are loaded; intended for internal use.")
;; ----------------------------------------------------------------------------
(defun desktop-truncate (list n)
"Truncate LIST to at most N elements destructively."
(let ((here (nthcdr (1- n) list)))
! (if (consp here)
(setcdr here nil))))
;; ----------------------------------------------------------------------------
--- 537,579 ----
"Hooks run after all buffers are loaded; intended for internal use.")
;; ----------------------------------------------------------------------------
+ ;; Desktop file conflict detection
+ (defvar desktop-file-modtime nil
+ "When the desktop file was last modified to the knowledge of this Emacs.
+ Used to detect desktop file conflicts.")
+
+ (defun desktop-owner (&optional dirname)
+ "Return the PID of the Emacs process that owns the desktop file in DIRNAME.
+ Return nil if no desktop file found or no Emacs process is using it.
+ DIRNAME omitted or nil means use `desktop-dirname'."
+ (let (owner)
+ (and (file-exists-p (desktop-full-lock-name dirname))
+ (condition-case nil
+ (with-temp-buffer
+ (insert-file-contents-literally (desktop-full-lock-name dirname))
+ (goto-char (point-min))
+ (setq owner (read (current-buffer)))
+ (integerp owner))
+ (error nil))
+ owner)))
+
+ (defun desktop-claim-lock (&optional dirname)
+ "Record this Emacs process as the owner of the desktop file in DIRNAME.
+ DIRNAME omitted or nil means use `desktop-dirname'."
+ (write-region (number-to-string (emacs-pid)) nil
+ (desktop-full-lock-name dirname)))
+
+ (defun desktop-release-lock (&optional dirname)
+ "Remove the lock file for the desktop in DIRNAME.
+ DIRNAME omitted or nil means use `desktop-dirname'."
+ (let ((file (desktop-full-lock-name dirname)))
+ (when (file-exists-p file) (delete-file file))))
+
+ ;;
----------------------------------------------------------------------------
(defun desktop-truncate (list n)
"Truncate LIST to at most N elements destructively."
(let ((here (nthcdr (1- n) list)))
! (when (consp here)
(setcdr here nil))))
;; ----------------------------------------------------------------------------
***************
*** 552,565 ****
(setq desktop-dirname
(file-name-as-directory
(expand-file-name
! (call-interactively
! (lambda (dir)
! (interactive "DDirectory for desktop file: ") dir))))))
(condition-case err
! (desktop-save desktop-dirname)
(file-error
(unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
! (signal (car err) (cdr err)))))))
;; ----------------------------------------------------------------------------
(defun desktop-list* (&rest args)
--- 626,639 ----
(setq desktop-dirname
(file-name-as-directory
(expand-file-name
! (read-directory-name "Directory for desktop file: " nil nil t)))))
(condition-case err
! (desktop-save desktop-dirname t)
(file-error
(unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
! (signal (car err) (cdr err))))))
! ;; If we own it, we don't anymore.
! (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock)))
;; ----------------------------------------------------------------------------
(defun desktop-list* (&rest args)
***************
*** 574,579 ****
--- 648,693 ----
value)))
;; ----------------------------------------------------------------------------
+ (defun desktop-buffer-info (buffer)
+ (set-buffer buffer)
+ (list
+ ;; basic information
+ (desktop-file-name (buffer-file-name) dirname)
+ (buffer-name)
+ major-mode
+ ;; minor modes
+ (let (ret)
+ (mapc
+ #'(lambda (minor-mode)
+ (and (boundp minor-mode)
+ (symbol-value minor-mode)
+ (let* ((special (assq minor-mode desktop-minor-mode-table))
+ (value (cond (special (cadr special))
+ ((functionp minor-mode) minor-mode))))
+ (when value (add-to-list 'ret value)))))
+ (mapcar #'car minor-mode-alist))
+ ret)
+ ;; point and mark, and read-only status
+ (point)
+ (list (mark t) mark-active)
+ buffer-read-only
+ ;; auxiliary information
+ (when (functionp desktop-save-buffer)
+ (funcall desktop-save-buffer dirname))
+ ;; local variables
+ (let ((locals desktop-locals-to-save)
+ (loclist (buffer-local-variables))
+ (ll))
+ (while locals
+ (let ((here (assq (car locals) loclist)))
+ (if here
+ (setq ll (cons here ll))
+ (when (member (car locals) loclist)
+ (setq ll (cons (car locals) ll)))))
+ (setq locals (cdr locals)))
+ ll)))
+
+ ;;
----------------------------------------------------------------------------
(defun desktop-internal-v2s (value)
"Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
TXT is a string that when read and evaluated yields value.
***************
*** 676,684 ****
(if (consp varspec)
(setq var (car varspec) size (cdr varspec))
(setq var varspec))
! (if (boundp var)
! (progn
! (if (and (integerp size)
(> size 0)
(listp (eval var)))
(desktop-truncate (eval var) size))
--- 790,797 ----
(if (consp varspec)
(setq var (car varspec) size (cdr varspec))
(setq var varspec))
! (when (boundp var)
! (when (and (integerp size)
(> size 0)
(listp (eval var)))
(desktop-truncate (eval var) size))
***************
*** 686,692 ****
(symbol-name var)
" "
(desktop-value-to-string (symbol-value var))
! ")\n")))))
;; ----------------------------------------------------------------------------
(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
--- 799,805 ----
(symbol-name var)
" "
(desktop-value-to-string (symbol-value var))
! ")\n"))))
;; ----------------------------------------------------------------------------
(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
***************
*** 724,802 ****
;; ----------------------------------------------------------------------------
;;;###autoload
! (defun desktop-save (dirname)
"Save the desktop in a desktop file.
Parameter DIRNAME specifies where to save the desktop file.
See also `desktop-base-file-name'."
(interactive "DDirectory to save desktop file in: ")
! (run-hooks 'desktop-save-hook)
! (setq dirname (file-name-as-directory (expand-file-name dirname)))
(save-excursion
! (let ((filename (desktop-full-file-name dirname))
! (info
! (mapcar
! #'(lambda (b)
! (set-buffer b)
! (list
! (desktop-file-name (buffer-file-name) dirname)
! (buffer-name)
! major-mode
! ;; minor modes
! (let (ret)
! (mapc
! #'(lambda (minor-mode)
! (and
! (boundp minor-mode)
! (symbol-value minor-mode)
! (let* ((special (assq minor-mode
desktop-minor-mode-table))
! (value (cond (special (cadr special))
! ((functionp
minor-mode) minor-mode))))
! (when value (add-to-list 'ret value)))))
! (mapcar #'car minor-mode-alist))
! ret)
! (point)
! (list (mark t) mark-active)
! buffer-read-only
! ;; Auxiliary information
! (when (functionp desktop-save-buffer)
! (funcall desktop-save-buffer dirname))
! (let ((locals desktop-locals-to-save)
! (loclist (buffer-local-variables))
! (ll))
! (while locals
! (let ((here (assq (car locals) loclist)))
! (if here
! (setq ll (cons here ll))
! (when (member (car locals) loclist)
! (setq ll (cons (car locals) ll)))))
! (setq locals (cdr locals)))
! ll)))
! (buffer-list)))
! (eager desktop-restore-eager))
(with-temp-buffer
(insert
";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n"
desktop-header
";; Created " (current-time-string) "\n"
";; Desktop file format version " desktop-file-version "\n"
! ";; Emacs version " emacs-version "\n\n"
! ";; Global section:\n")
! (dolist (varspec desktop-globals-to-save)
! (desktop-outvar varspec))
! (if (memq 'kill-ring desktop-globals-to-save)
(insert
"(setq kill-ring-yank-pointer (nthcdr "
(int-to-string (- (length kill-ring) (length
kill-ring-yank-pointer)))
" kill-ring))\n"))
(insert "\n;; Buffer section -- buffers listed in same order
as in buffer list:\n")
! (dolist (l info)
(when (apply 'desktop-save-buffer-p l)
(insert "("
(if (or (not (integerp eager))
! (unless (zerop eager)
! (setq eager (1- eager))
! t))
"desktop-create-buffer"
"desktop-append-buffer-args")
" "
--- 837,893 ----
;; ----------------------------------------------------------------------------
;;;###autoload
! (defun desktop-save (dirname &optional release)
"Save the desktop in a desktop file.
Parameter DIRNAME specifies where to save the desktop file.
+ Optional parameter RELEASE says whether we're done with this desktop.
See also `desktop-base-file-name'."
(interactive "DDirectory to save desktop file in: ")
! (setq desktop-dirname (file-name-as-directory (expand-file-name dirname)))
(save-excursion
! (let ((eager desktop-restore-eager)
! (new-modtime (nth 5 (file-attributes (desktop-full-file-name)))))
! (when
! (or (not new-modtime) ; nothing to overwrite
! (equal desktop-file-modtime new-modtime)
! (yes-or-no-p (if desktop-file-modtime
! (if (> (float-time new-modtime) (float-time
desktop-file-modtime))
! "Desktop file is more recent than the one loaded.
Save anyway? "
! "Desktop file isn't the one loaded. Overwrite it?
")
! "Current desktop was not loaded from a file.
Overwrite this
desktop file? "))
! (unless release (error "Desktop file conflict")))
!
! ;; If we're done with it, release the lock.
! ;; Otherwise, claim it if it's unclaimed or if we created it.
! (if release
! (desktop-release-lock)
! (unless (and new-modtime (desktop-owner)) (desktop-claim-lock)))
!
(with-temp-buffer
(insert
";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n"
desktop-header
";; Created " (current-time-string) "\n"
";; Desktop file format version " desktop-file-version "\n"
! ";; Emacs version " emacs-version "\n")
! (save-excursion (run-hooks 'desktop-save-hook))
! (goto-char (point-max))
! (insert "\n;; Global section:\n")
! (mapc (function desktop-outvar) desktop-globals-to-save)
! (when (memq 'kill-ring desktop-globals-to-save)
(insert
"(setq kill-ring-yank-pointer (nthcdr "
(int-to-string (- (length kill-ring) (length
kill-ring-yank-pointer)))
" kill-ring))\n"))
(insert "\n;; Buffer section -- buffers listed in same order as
in buffer list:\n")
! (dolist (l (mapcar 'desktop-buffer-info (buffer-list)))
(when (apply 'desktop-save-buffer-p l)
(insert "("
(if (or (not (integerp eager))
! (if (zerop eager)
! nil
! (setq eager (1- eager))))
"desktop-create-buffer"
"desktop-append-buffer-args")
" "
***************
*** 804,813 ****
(dolist (e l)
(insert "\n " (desktop-value-to-string e)))
(insert ")\n\n")))
(setq default-directory dirname)
(let ((coding-system-for-write 'emacs-mule))
! (write-region (point-min) (point-max) filename nil 'nomessage)))))
! (setq desktop-dirname dirname))
;; ----------------------------------------------------------------------------
;;;###autoload
--- 895,906 ----
(dolist (e l)
(insert "\n " (desktop-value-to-string e)))
(insert ")\n\n")))
+
(setq default-directory dirname)
(let ((coding-system-for-write 'emacs-mule))
! (write-region (point-min) (point-max) (desktop-full-file-name)
nil 'nomessage))
! ;; We remember when it was modified (which is presumably just now).
! (setq desktop-file-modtime (nth 5 (file-attributes
(desktop-full-file-name)))))))))
;; ----------------------------------------------------------------------------
;;;###autoload
***************
*** 856,873 ****
;; Default: Home directory.
"~"))))
(if (file-exists-p (desktop-full-file-name))
! ;; Desktop file found, process it.
(let ((desktop-first-buffer nil)
(desktop-buffer-ok-count 0)
(desktop-buffer-fail-count 0)
;; Avoid desktop saving during evaluation of desktop buffer.
(desktop-save nil))
(desktop-lazy-abort)
! ;; Evaluate desktop buffer.
(load (desktop-full-file-name) t t t)
;; `desktop-create-buffer' puts buffers at end of the buffer list.
! ;; We want buffers existing prior to evaluating the desktop
(and not reused)
! ;; to be placed at the end of the buffer list, so we move them here.
(mapc 'bury-buffer
(nreverse (cdr (memq desktop-first-buffer (nreverse
(buffer-list))))))
(switch-to-buffer (car (buffer-list)))
--- 949,987 ----
;; Default: Home directory.
"~"))))
(if (file-exists-p (desktop-full-file-name))
! ;; Desktop file found, but is it already in use?
(let ((desktop-first-buffer nil)
(desktop-buffer-ok-count 0)
(desktop-buffer-fail-count 0)
+ (owner (desktop-owner))
;; Avoid desktop saving during evaluation of desktop buffer.
(desktop-save nil))
+ (if (and owner
+ (memq desktop-load-locked-desktop '(nil ask))
+ (or (null desktop-load-locked-desktop)
+ (not (y-or-n-p (format "Warning: desktop file appears to
be
in use by PID %s.\n\
+ Using it may cause conflicts. Use it anyway? " owner)))))
+ (progn
+ (let ((default-directory desktop-dirname))
+ (run-hooks 'desktop-not-loaded-hook))
+ (setq desktop-dirname nil)
+ (message "Desktop file in use; not loaded."))
(desktop-lazy-abort)
! ;; Evaluate desktop buffer and remember when it was modified.
(load (desktop-full-file-name) t t t)
+ (setq desktop-file-modtime (nth 5 (file-attributes
(desktop-full-file-name))))
+ ;; If it wasn't already, mark it as in-use, to bother other
+ ;; desktop instances.
+ (unless owner
+ (condition-case nil
+ (desktop-claim-lock)
+ (file-error (message "Couldn't record use of desktop file")
+ (sit-for 1))))
+
;; `desktop-create-buffer' puts buffers at end of the buffer list.
! ;; We want buffers existing prior to evaluating the desktop (and
! ;; not reused) to be placed at the end of the buffer list, so we
! ;; move them here.
(mapc 'bury-buffer
(nreverse (cdr (memq desktop-first-buffer (nreverse
(buffer-list))))))
(switch-to-buffer (car (buffer-list)))
***************
*** 884,890 ****
(format ", %d to restore lazily"
(length desktop-buffer-args-list))
""))
! t)
;; No desktop file found.
(desktop-clear)
(let ((default-directory desktop-dirname))
--- 998,1004 ----
(format ", %d to restore lazily"
(length desktop-buffer-args-list))
""))
! t))
;; No desktop file found.
(desktop-clear)
(let ((default-directory desktop-dirname))
***************
*** 946,952 ****
desktop-buffer-name
desktop-buffer-misc)
"Restore a file buffer."
! (if desktop-buffer-file-name
(if (or (file-exists-p desktop-buffer-file-name)
(let ((msg (format "Desktop: File \"%s\" no longer exists."
desktop-buffer-file-name)))
--- 1060,1066 ----
desktop-buffer-name
desktop-buffer-misc)
"Restore a file buffer."
! (when desktop-buffer-file-name
(if (or (file-exists-p desktop-buffer-file-name)
(let ((msg (format "Desktop: File \"%s\" no longer exists."
desktop-buffer-file-name)))
***************
*** 1067,1073 ****
(setq mark-active (car (cdr desktop-buffer-mark))))
(set-mark desktop-buffer-mark)))
;; Never override file system if the file really is read-only marked.
! (if desktop-buffer-read-only (setq buffer-read-only
desktop-buffer-read-only))
(while desktop-buffer-locals
(let ((this (car desktop-buffer-locals)))
(if (consp this)
--- 1181,1187 ----
(setq mark-active (car (cdr desktop-buffer-mark))))
(set-mark desktop-buffer-mark)))
;; Never override file system if the file really is read-only marked.
! (when desktop-buffer-read-only (setq buffer-read-only
desktop-buffer-read-only))
(while desktop-buffer-locals
(let ((this (car desktop-buffer-locals)))
(if (consp this)
- Re: Experimental features, (continued)
Re: Experimental features, dhruva, 2007/06/22
Re: Experimental features, Andreas Röhler, 2007/06/23
Re: Experimental features, Richard Stallman, 2007/06/23
- Re: Experimental features,
Juanma Barranquero <=
Re: Experimental features, Stefan Monnier, 2007/06/23
- Re: Experimental features, Richard Stallman, 2007/06/24
- Re: Experimental features, Stefan Monnier, 2007/06/24
- Re: Experimental features, Richard Stallman, 2007/06/24
- Re: Experimental features, Stefan Monnier, 2007/06/28
- Re: Experimental features, Richard Stallman, 2007/06/29