emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: desktop and tilde-expand-file-name


From: Lars Hansen
Subject: Re: desktop and tilde-expand-file-name
Date: Wed, 19 Feb 2003 10:22:01 +0100
User-agent: Mozilla/5.0 (Windows; U; Win 9x 4.90; en-US; rv:1.2.1) Gecko/20021130

Kim F. Storm wrote:

You could start by posting a "diff -c" between CVS head and your files
to emacs-devel for comments and to let Richard judge whether he wants
to install the changes or not.

A diff between desktop.el (and files.el) on CVS head and my version is in included below.

I have discussed these changes with Richard some weeks ago, and I have made the changes
he sugested. He also asked me to look at a feature requested in
address@hidden: desktop.el asks about local variables when loading a desktop]. This feature is NOT included yet. I want to use more time to think it over, because I want to avoid unnecessarily complicated code and a lot of variables. The feature is a bit tricky.

 Remember to include ChangeLog entries
for your changes, and also something for the NEWS file.
Here is a description of my changes. I will (if my changes are included) write something for
the manual as well.

Module desktop.el
-----------------
1.  Customizable variable `desktop-save' introduced.
When the user changes desktop or quits emacs, should the desktop be saved?
      t          -- Allways save.
      ask        -- Ask.
      ask-if-new -- Ask if no desktop file exists, otherwise just save.
      nil        -- Never.
   The desktop is never saved when `desktop-enable' is nil.
2.  Customizable variable `desktop-path' introduced.
List of directories in which to lookup the desktop file. Replaces hard coded list.
3.  Customizable hook `desktop-no-desktop-file-hook' introduced.
It is run when no desktop file is found. May e.g. be used to show a dired buffer.
4.  Customizable hook `desktop-after-read-hook' introduced.
It is run after a desktop is read. May e.g. be used to show a buffer list.
5.  Customizable variable `desktop-globals-to-clear' introduced.
   Relpaces hard code.
6. Customizable variable `desktop-clear-preserve-buffers-regexp' introduced.
   It defaults to a pattern matching tramp buffers.
The old customizable variable `desktop-clear-preserve-buffers' (a list) is
   maintained for backwards compatibility.
7.  Customizable variable `desktop-file-name-format' introduced.
   Format in which desktop file names should be saved.
   Possible values are:
      absolute -- Absolute file name.
      tilde    -- Relative to ~.
      local    -- Relative to directory of desktop file.
This variable applies to functions `desktop-save' and `desktop-buffer-dired-misc-data'. 8. Customizable variables `desktop-buffer-major-mode', `desktop-buffer-file-name',
   `desktop-buffer-name' and variable `desktop-buffer-misc' removed.
Symbols in desktop buffer handlers are bound to parameters in `desktop-create-buffer'
   (and `desktop-buffer'), not to the global variables!
The remaining parameters in `desktop-create-buffer' have been renamed to more descriptive names, and it has been documented that desktop buffer handlers can access
   these variables. The list of vatiables now is:
      desktop-version
      desktop-buffer-file-name
      desktop-buffer-name
      desktop-buffer-major-mode
      desktop-buffer-minor-modes
      desktop-buffer-point
      desktop-buffer-mark
      desktop-buffer-read-only
      desktop-buffer-misc
      desktop-buffer-locals
9.  Command line option --no-desktop introduced.
   When this is specified, no desktop file is loaded.
10. Previously the desktop module wrote buffers in the desktop file in the reverse order of the buffer list. Morover restoring buffers in the same order depended on handlers to not change the order of the buffer list and to put newly created buffers at the top of the list. The new module writes buffers in the desktop file in the same order as the buffer list, and the dependence of handlers just described is removed. The change is backwards compatible in the sense that old desktop files are handled in the
   same way as the were with the old module.
11. New function `desktop-change-dir'.
Saves and clears the desktop, changes to directory DIR and loads the desktop there
   indepentently of the value of `desktop-path'.
If `desktop-enable' was nil at call, the desktop is not saved, but `desktop-enable' is
   subsequently set to t.
12. New function `desktop-save-in-load-dir'.
   Save desktop in directory from witch it was loaded.
13. New function `desktop-revert'. Revert to the last loaded desktop.

Module files.el
---------------
New function `tilde-expand-file-name' added.

If Richard likes the changes, he will tell you what's needed.  You
will probably have to sign papers unless the changes are very small.
Ok.

Once the papers are in order, you may be given write access to the CVS
repository and install the changes yourself, or you may (re-)post the
changes and have one of the emacs developers install them for you.

I would like to get write access. I don't think this is the last time I will contribute, I have a
few things in mind if time permits.

Diffs (old file first):
-------------------------------------------

diff -c cvs/emacs/lisp/desktop.el emacs/emacs-cvs/desktop.el
*** cvs/emacs/lisp/desktop.el    Wed Feb 19 09:14:08 2003
--- emacs/emacs-cvs/desktop.el    Mon Feb 17 21:45:08 2003
***************
*** 99,105 ****
 ;; Save window configuration.
 ;; Recognize more minor modes.
 ;; Save mark rings.
- ;; Start-up with buffer-menu???

 ;;; Code:

--- 99,104 ----
***************
*** 108,113 ****
--- 107,116 ----
   ;; We use functions from these modules
   ;; We can't (require 'mh-e) since that wants to load something.
   (mapcar 'require '(info dired reporter)))
+
+ (defvar desktop-version "206"
+   "Verion of desktop module.")
+
;; ----------------------------------------------------------------------------
 ;; USER OPTIONS -- settings you might want to play with.
;; ----------------------------------------------------------------------------
***************
*** 116,122 ****
   "Save status of Emacs when you exit."
   :group 'frames)

! (defcustom desktop-enable nil
   "*Non-nil enable Desktop to save the state of Emacs when you exit."
   :group 'desktop
   :type 'boolean
--- 119,126 ----
   "Save status of Emacs when you exit."
   :group 'frames)

! (defcustom desktop-enable
!   nil
   "*Non-nil enable Desktop to save the state of Emacs when you exit."
   :group 'desktop
   :type 'boolean
***************
*** 124,168 ****
   :initialize 'custom-initialize-default
   :version "20.3")

 (defcustom desktop-basefilename
   (convert-standard-filename ".emacs.desktop")
   "File for Emacs desktop, not including the directory name."
   :type 'file
   :group 'desktop)

! (defcustom desktop-missing-file-warning nil
   "*If non-nil then desktop warns when a file no longer exists.
 Otherwise it simply ignores that file."
   :type 'boolean
   :group 'desktop)

! (defvar desktop-globals-to-save
!   (list 'desktop-missing-file-warning
!     ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer
!     ;; 'kill-ring
!     'tags-file-name
!     'tags-table-list
!     'search-ring
!     'regexp-search-ring
!     'register-alist
!     ;; 'desktop-globals-to-save    ; Itself!
!     )
   "List of global variables to save when killing Emacs.
 An element may be variable name (a symbol)
 or a cons cell of the form  (VAR . MAX-SIZE),
 which means to truncate VAR's value to at most MAX-SIZE elements
! \(if the value is a list) before saving the value.")

! (defvar desktop-locals-to-save
!   (list 'desktop-locals-to-save        ; Itself!  Think it over.
!         'truncate-lines
!     'case-fold-search
!     'case-replace
!     'fill-column
!     'overwrite-mode
!     'change-log-default-name
!     'line-number-mode
!     )
   "List of local variables to save for each buffer.
 The variables are saved only when they really are local.")
 (make-variable-buffer-local 'desktop-locals-to-save)
--- 128,237 ----
   :initialize 'custom-initialize-default
   :version "20.3")

+ (defcustom desktop-save
+   'ask-if-new
+ "*When the user changes desktop or quits emacs, should the desktop be saved?
+    t          -- Allways save.
+    ask        -- Ask.
+    ask-if-new -- Ask if no desktop file exists, otherwise just save.
+    nil        -- Never.
+ The desktop is never saved when `desktop-enable' is nil"
+   :type '(choice (const t) (const ask) (const ask-if-new) (const nil))
+   :group 'desktop)
+
 (defcustom desktop-basefilename
   (convert-standard-filename ".emacs.desktop")
   "File for Emacs desktop, not including the directory name."
   :type 'file
   :group 'desktop)

! (defcustom desktop-path
!   '("." "~")
!   "List of directories in which to lookup the desktop file.
! The base name of the file is specified in `desktop-basefilename'."
!   :type '(repeat directory)
!   :group 'desktop)
!
! (defcustom desktop-missing-file-warning
!   nil
   "*If non-nil then desktop warns when a file no longer exists.
 Otherwise it simply ignores that file."
   :type 'boolean
   :group 'desktop)

! (defcustom desktop-no-desktop-file-hook
!   nil
! "Normal hook run after fail of `desktop-read' due to missing desktop file.
! May e.g. be used to show a dired buffer."
!   :type 'hook
!   :group 'desktop)
!
! (defcustom desktop-after-read-hook
!   nil
!   "Normal hook run after a sucessful `desktop-read'.
! May e.g. be used to show a buffer list."
!   :type 'hook
!   :group 'desktop)
!
! (defcustom desktop-save-hook
!   nil
!   "Hook run before desktop saves the state of Emacs.
! This is useful for truncating history lists, for example."
!   :type 'hook
!   :group 'desktop)
!
! (defcustom desktop-globals-to-save '(
!   desktop-missing-file-warning
!   tags-file-name
!   tags-table-list
!   search-ring
!   regexp-search-ring
!   register-alist)
   "List of global variables to save when killing Emacs.
 An element may be variable name (a symbol)
 or a cons cell of the form  (VAR . MAX-SIZE),
 which means to truncate VAR's value to at most MAX-SIZE elements
! \(if the value is a list) before saving the value.
! Feature: Saving `kill-ring' implies saving `kill-ring-yank-pointer'."
!   :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
!   :group 'desktop)
!
! (defcustom desktop-globals-to-clear '(
!   kill-ring
!   kill-ring-yank-pointer
!   search-ring
!   search-ring-yank-pointer
!   regexp-search-ring
!   regexp-search-ring-yank-pointer)
!   "List of global variables set to clear by `desktop-clear'.
! An element may be variable name (a symbol) or a cons cell of the form
! \(VAR . FORM). Symbols are set to nil and for cons cells VAR is set
! to the value obtained by evaluateing FORM."
!   :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
!   :group 'desktop)
!
! (defcustom desktop-clear-preserve-buffers-regexp
!   "^\\*tramp/.+\\*$"
!   "Regexp identifying buffers that `desktop-clear' should not delete."
!   :type 'regexp
!   :group 'desktop)

! ;; Maintained for backward compatibility
! (defcustom desktop-clear-preserve-buffers
!   '("*scratch*" "*Messages*")
!   "*List of buffer names that `desktop-clear' should not delete."
!   :type '(repeat string)
!   :group 'desktop)
!
! (defvar desktop-locals-to-save '(
!   desktop-locals-to-save  ; Itself!  Think it over.
!   truncate-lines
!   case-fold-search
!   case-replace
!   fill-column
!   overwrite-mode
!   change-log-default-name
!   line-number-mode)
   "List of local variables to save for each buffer.
 The variables are saved only when they really are local.")
 (make-variable-buffer-local 'desktop-locals-to-save)
***************
*** 171,180 ****
 ;;         (ftp) files because they require passwords and whatnot.
 ;;         TAGS files to save time (tags-file-name is saved instead).
 (defcustom desktop-buffers-not-to-save
!  "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
!  "Regexp identifying buffers that are to be excluded from saving."
!  :type 'regexp
!  :group 'desktop)

 ;; Skip ange-ftp files
 (defcustom desktop-files-not-to-save
--- 240,249 ----
 ;;         (ftp) files because they require passwords and whatnot.
 ;;         TAGS files to save time (tags-file-name is saved instead).
 (defcustom desktop-buffers-not-to-save
!   "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
!   "Regexp identifying buffers that are to be excluded from saving."
!   :type 'regexp
!   :group 'desktop)

 ;; Skip ange-ftp files
 (defcustom desktop-files-not-to-save
***************
*** 191,220 ****
   :type '(repeat symbol)
   :group 'desktop)

! (defcustom desktop-modes-not-to-save nil
   "List of major modes whose buffers should not be saved."
   :type '(repeat symbol)
   :group 'desktop)

! (defcustom desktop-buffer-major-mode nil
!   "When desktop creates a buffer, this holds the desired Major mode."
!   :type 'symbol
!   :group 'desktop)
!
! (defcustom desktop-buffer-file-name nil
!   "When desktop creates a buffer, this holds the file name to visit."
!   :type '(choice file (const nil))
   :group 'desktop)

- (defcustom desktop-buffer-name nil
-   "When desktop creates a buffer, this holds the desired buffer name."
-   :type '(choice string (const nil))
-   :group 'desktop)
-
- (defvar desktop-buffer-misc nil
-   "When desktop creates a buffer, this holds a list of misc info.
- It is used by the `desktop-buffer-handlers' functions.")
-
 (defcustom desktop-buffer-misc-functions
   '(desktop-buffer-info-misc-data
     desktop-buffer-dired-misc-data)
--- 260,281 ----
   :type '(repeat symbol)
   :group 'desktop)

! (defcustom desktop-modes-not-to-save
!   nil
   "List of major modes whose buffers should not be saved."
   :type '(repeat symbol)
   :group 'desktop)

! (defcustom desktop-file-name-format
!   'absolute
!   "*Format in which desktop file names should be saved.
! Possible values are:
!    absolute -- Absolute file name.
!    tilde    -- Relative to ~.
!    local    -- Relative to directory of desktop file."
!   :type '(choice (const absolute) (const tilde) (const local))
   :group 'desktop)

 (defcustom desktop-buffer-misc-functions
   '(desktop-buffer-info-misc-data
     desktop-buffer-dired-misc-data)
***************
*** 238,245 ****
     desktop-buffer-file)
   "*List of functions to call in order to create a buffer.
 The functions are called without explicit parameters but can use the
! variables `desktop-buffer-major-mode', `desktop-buffer-file-name',
! `desktop-buffer-name'.
 If one function returns non-nil, no further functions are called.
 If the function returns a buffer, then the saved mode settings
 and variable values for that buffer are copied into it."
--- 299,317 ----
     desktop-buffer-file)
   "*List of functions to call in order to create a buffer.
 The functions are called without explicit parameters but can use the
! following variables:
!
!    desktop-version
!    desktop-buffer-file-name
!    desktop-buffer-name
!    desktop-buffer-major-mode
!    desktop-buffer-minor-modes
!    desktop-buffer-point
!    desktop-buffer-mark
!    desktop-buffer-read-only
!    desktop-buffer-misc
!    desktop-buffer-locals
!
 If one function returns non-nil, no further functions are called.
 If the function returns a buffer, then the saved mode settings
 and variable values for that buffer are copied into it."
***************
*** 248,262 ****

 (put 'desktop-buffer-handlers 'risky-local-variable t)

- (defvar desktop-create-buffer-form "(desktop-create-buffer 205"
-   "Opening of form for creation of new buffers.")
-
- (defcustom desktop-save-hook nil
-   "Hook run before desktop saves the state of Emacs.
- This is useful for truncating history lists, for example."
-   :type 'hook
-   :group 'desktop)
-
 (defcustom desktop-minor-mode-table
   '((auto-fill-function auto-fill-mode)
     (vc-mode nil))
--- 320,325 ----
***************
*** 281,287 ****
;; --------------------------------------------------------------------------
 " "*Header to place in Desktop file.")

! (defvar desktop-delay-hook nil
   "Hooks run after all buffers are loaded; intended for internal use.")

;; ----------------------------------------------------------------------------
--- 344,351 ----
;; --------------------------------------------------------------------------
 " "*Header to place in Desktop file.")

! (defvar desktop-delay-hook
!   nil
   "Hooks run after all buffers are loaded; intended for internal use.")

;; ----------------------------------------------------------------------------
***************
*** 290,334 ****
   (let ((here (nthcdr (1- n) l)))
     (if (consp here)
     (setcdr here nil))))
- ;; ----------------------------------------------------------------------------
- (defcustom desktop-clear-preserve-buffers
-   '("*scratch*" "*Messages*")
-   "*Buffer names that `desktop-clear' should not delete."
-   :type '(repeat string)
-   :group 'desktop)

 (defun desktop-clear ()
   "Empty the Desktop.
! This kills all buffers except for internal ones
! and those listed in `desktop-clear-preserve-buffers'."
   (interactive)
!   (setq kill-ring nil
!     kill-ring-yank-pointer nil
!     search-ring nil
!     search-ring-yank-pointer nil
!     regexp-search-ring nil
!     regexp-search-ring-yank-pointer nil)
   (let ((buffers (buffer-list)))
     (while buffers
! (or (member (buffer-name (car buffers)) desktop-clear-preserve-buffers)
!       (null (buffer-name (car buffers)))
!       ;; Don't kill buffers made for internal purposes.
!       (and (not (equal (buffer-name (car buffers)) ""))
!            (eq (aref (buffer-name (car buffers)) 0) ?\ ))
!       (kill-buffer (car buffers)))
       (setq buffers (cdr buffers))))
   (delete-other-windows))
;; ----------------------------------------------------------------------------
 (add-hook 'kill-emacs-hook 'desktop-kill)

 (defun desktop-kill ()
!   (if desktop-dirname
!       (condition-case err
!       (desktop-save desktop-dirname)
!     (file-error
!      (if (yes-or-no-p "Error while saving the desktop.  Quit anyway? ")
!          nil
!        (signal (car err) (cdr err)))))))
;; ----------------------------------------------------------------------------
 (defun desktop-list* (&rest args)
   (if (null (cdr args))
--- 354,413 ----
   (let ((here (nthcdr (1- n) l)))
     (if (consp here)
     (setcdr here nil))))

+ ;; ----------------------------------------------------------------------------
 (defun desktop-clear ()
   "Empty the Desktop.
! This kills all buffers except for internal ones and those listed
! in `desktop-clear-preserve-buffers'. Furthermore, variables listed
! in `desktop-globals-to-clear' are cleared."
   (interactive)
!   (dolist (var desktop-globals-to-clear)
!     (if (symbolp var)
!       (eval `(setq-default ,var nil))
!       (eval `(setq-default ,(car var) ,(cdr var)))))
   (let ((buffers (buffer-list)))
     (while buffers
!       (let ((bufname (buffer-name (car buffers))))
!          (or
!            (null bufname)
!            (string-match desktop-clear-preserve-buffers-regexp bufname)
!            (member bufname desktop-clear-preserve-buffers)
!            ;; Don't kill buffers made for internal purposes.
!            (and (not (equal bufname "")) (eq (aref bufname 0) ?\ ))
!            (kill-buffer (car buffers))))
       (setq buffers (cdr buffers))))
   (delete-other-windows))
+
;; ----------------------------------------------------------------------------
 (add-hook 'kill-emacs-hook 'desktop-kill)

 (defun desktop-kill ()
! "If `desktop-enable' is non-nil, the desktop is saved if specified by the ! value of `desktop-save'. If the desktop should be saved and `desktop-dirname'
! is nil, the user is asked where to saved the desktop."
!   (when
!     (and
!       desktop-enable
!       (or
!         (eq desktop-save 't)
!         (and
!           (eq desktop-save 'ask-if-new)
!           (file-exists-p (concat desktop-dirname desktop-basefilename)))
!         (and
!           (or (eq desktop-save 'ask) (eq desktop-save 'ask-if-new))
!           (y-or-n-p "Save desktop? "))))
!     (unless desktop-dirname
!       (setq desktop-dirname
!         (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)
   (if (null (cdr args))
***************
*** 341,346 ****
--- 420,426 ----
     (setq args (cdr args)))
       value)))

+ ;; ----------------------------------------------------------------------------
 (defun desktop-internal-v2s (val)
   "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
 TXT is a string that when read and evaluated yields value.
***************
*** 420,425 ****
--- 500,506 ----
    (t                    ; save as text
     (cons 'may "\"Unprintable entity\""))))

+ ;; ----------------------------------------------------------------------------
 (defun desktop-value-to-string (val)
   "Convert VALUE to a string that when read evaluates to the same value.
 Not all types of values are supported."
***************
*** 431,436 ****
--- 512,518 ----
     (if (eq quote 'must)
     (concat "'" txt)
       txt)))
+
;; ----------------------------------------------------------------------------
 (defun desktop-outvar (varspec)
   "Output a setq statement for variable VAR to the desktop file.
***************
*** 453,458 ****
--- 535,541 ----
           " "
           (desktop-value-to-string (symbol-value var))
           ")\n")))))
+
;; ----------------------------------------------------------------------------
 (defun desktop-save-buffer-p (filename bufname mode &rest dummy)
"Return t if the desktop should record a particular buffer for next startup.
***************
*** 470,566 ****
                        default-directory))))
          (and (null filename)
           (memq mode desktop-buffer-modes-to-save))))))
;; ----------------------------------------------------------------------------
! (defcustom desktop-relative-file-names nil
!   "*Store relative file names in the desktop file."
!   :type 'boolean
!   :group 'desktop)

 (defun desktop-save (dirname)
! "Save the Desktop file. Parameter DIRNAME specifies where to save desktop."
   (interactive "DDirectory to save desktop file in: ")
   (run-hooks 'desktop-save-hook)
   (save-excursion
     (let ((filename (expand-file-name desktop-basefilename dirname))
!       (info (nreverse
!          (mapcar
!           (function
!            (lambda (b)
!                     (set-buffer b)
!                     (list
!                      (let ((bn (buffer-file-name)))
!                        (if bn
!                            (if desktop-relative-file-names
!                                (file-relative-name bn dirname)
!                              bn)))
!                      (buffer-name)
!                      major-mode
!                      ;; minor modes
!                      (let (ret)
!                        (mapcar
!                         #'(lambda (mim)
!                             (and (boundp mim)
!                                  (symbol-value mim)
!                                  (setq ret
! (cons (let ((special (assq mim desktop-minor-mode-table)))
!                                                (if special
!                                                    (cadr special)
!                                                  mim))
!                                              ret))))
!                         (mapcar #'car minor-mode-alist))
!                        ret)
!                      (point)
!                      (list (mark t) mark-active)
!                      buffer-read-only
!                      (run-hook-with-args-until-success
!                       'desktop-buffer-misc-functions)
!                      (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))
!                              (if (member (car locals) loclist)
!                                  (setq ll (cons (car locals) ll)))))
!                          (setq locals (cdr locals)))
!                        ll)
!                      )))
!           (buffer-list))))
!       (buf (get-buffer-create "*desktop*")))
       (set-buffer buf)
       (erase-buffer)

!       (insert ";; -*- coding: emacs-mule; -*-\n"
!           desktop-header
!           ";; Created " (current-time-string) "\n"
!           ";; Emacs version " emacs-version "\n\n"
!           ";; Global section:\n")
       (mapcar (function desktop-outvar) desktop-globals-to-save)
       (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:\n")
       (mapcar
!        (function (lambda (l)
!          (if (apply 'desktop-save-buffer-p l)
!              (progn
!                (insert desktop-create-buffer-form)
!                (mapcar
!                 (function (lambda (e)
!                   (insert "\n  "
!                           (desktop-value-to-string e))))
!                 l)
!                (insert ")\n\n")))))
!        info)
       (setq default-directory dirname)
!       (if (file-exists-p filename) (delete-file filename))
       (let ((coding-system-for-write 'emacs-mule))
!     (write-region (point-min) (point-max) filename nil 'nomessage))))
   (setq desktop-dirname dirname))
;; ----------------------------------------------------------------------------
 (defun desktop-remove ()
   "Delete the Desktop file and inactivate the desktop system."
--- 553,658 ----
                        default-directory))))
          (and (null filename)
           (memq mode desktop-buffer-modes-to-save))))))
+
;; ----------------------------------------------------------------------------
! (defun desktop-file-name (filename dirname)
!   "Convert FILENAME to format specified in `desktop-file-name-format'.
! DIRNAME must be the directory in which the desktop file will be saved."
!   (cond
!     ((not filename) nil)
! ((eq desktop-file-name-format 'tilde) (tilde-expand-file-name filename)) ! ((eq desktop-file-name-format 'local) (file-relative-name filename dirname))
!     (t (expand-file-name filename))))

+ ;; ----------------------------------------------------------------------------
 (defun desktop-save (dirname)
! "Save the Desktop file. Parameter DIRNAME specifies where to save desktop."
   (interactive "DDirectory to save desktop file in: ")
   (run-hooks 'desktop-save-hook)
   (save-excursion
     (let ((filename (expand-file-name desktop-basefilename dirname))
!       (info
!         (mapcar
!           (function
!             (lambda (b)
!               (set-buffer b)
!               (list
!                 (desktop-file-name (buffer-file-name) dirname)
!                 (buffer-name)
!                 major-mode
!                 ;; minor modes
!                 (let (ret)
!                   (mapcar
!                     #'(lambda (mim)
!                       (and
!                         (boundp mim)
!                         (symbol-value mim)
!                         (setq
!                           ret
!                           (cons
!                             (let (
! (special (assq mim desktop-minor-mode-table))
!                             )
!                               (if special (cadr special) mim))
!                             ret))))
!                     (mapcar #'car minor-mode-alist))
!                   ret)
!                 (point)
!                 (list (mark t) mark-active)
!                 buffer-read-only
! (run-hook-with-args-until-success 'desktop-buffer-misc-functions)
!                 (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)))
!       (buf (get-buffer-create "*desktop*")))
       (set-buffer buf)
       (erase-buffer)

!       (insert
!         ";; -*- coding: emacs-mule; -*-\n"
!         desktop-header
!         ";; Created " (current-time-string) "\n"
!         ";; Desktop module version " desktop-version "\n"
!         ";; Emacs version " emacs-version "\n\n"
!         ";; Global section:\n")
       (mapcar (function desktop-outvar) desktop-globals-to-save)
       (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")
       (mapcar
!         (function
!           (lambda (l)
!             (if (apply 'desktop-save-buffer-p l)
!               (progn
!                 (insert "(desktop-create-buffer " desktop-version)
!                 (mapcar
!                   (function
!                     (lambda (e)
!                       (insert "\n  " (desktop-value-to-string e))))
!                   l)
!                 (insert ")\n\n")))))
!         info)
       (setq default-directory dirname)
!       (when (file-exists-p filename) (delete-file filename))
       (let ((coding-system-for-write 'emacs-mule))
!         (write-region (point-min) (point-max) filename nil 'nomessage))))
   (setq desktop-dirname dirname))
+
;; ----------------------------------------------------------------------------
 (defun desktop-remove ()
   "Delete the Desktop file and inactivate the desktop system."
***************
*** 570,606 ****
     (setq desktop-dirname nil)
     (if (file-exists-p filename)
         (delete-file filename)))))
;; ----------------------------------------------------------------------------
 ;;;###autoload
 (defun desktop-read ()
   "Read the Desktop file and the files it specifies.
! This is a no-op when Emacs is running in batch mode."
   (interactive)
!   (if noninteractive
!       nil
!     (let ((dirs '("./" "~/")))
!       (while (and dirs
!           (not (file-exists-p (expand-file-name
!                        desktop-basefilename
!                        (car dirs)))))
!     (setq dirs (cdr dirs)))
       (setq desktop-dirname (and dirs (expand-file-name (car dirs))))
       (if desktop-dirname
!       (let ((desktop-last-buffer nil))
!         ;; `load-with-code-conversion' calls `eval-buffer' which
!         ;; contains a `save-excursion', so we end up with the same
!         ;; buffer before and after the load.  This is a problem
!         ;; when the desktop is read initially when Emacs starts up
!         ;; because, if we still are in *scratch* after running
!         ;; `after-init-hook', the splash screen will be displayed.
!         (load (expand-file-name desktop-basefilename desktop-dirname)
!           t t t)
!         (when desktop-last-buffer
!           (switch-to-buffer desktop-last-buffer))
!         (run-hooks 'desktop-delay-hook)
!         (setq desktop-delay-hook nil)
!         (message "Desktop loaded."))
!     (desktop-clear)))))
;; ----------------------------------------------------------------------------
 ;;;###autoload
 (defun desktop-load-default ()
--- 662,703 ----
     (setq desktop-dirname nil)
     (if (file-exists-p filename)
         (delete-file filename)))))
+
;; ----------------------------------------------------------------------------
 ;;;###autoload
 (defun desktop-read ()
   "Read the Desktop file and the files it specifies.
! This is a no-op when Emacs is running in batch mode.
! The desktop file is looked up according to the variables `desktop-basefilename'
! and `desktop-path'. If no desktop file is found, the desktop is cleared.
! Returns t if a desktop file is read, nil otherwise."
   (interactive)
!   (unless noninteractive
!     (let ((dirs desktop-path))
!       (while
!         (and
!           dirs
!           (not
! (file-exists-p (expand-file-name desktop-basefilename (car dirs)))))
!         (setq dirs (cdr dirs)))
       (setq desktop-dirname (and dirs (expand-file-name (car dirs))))
       (if desktop-dirname
!         (let ((desktop-first-buffer nil))
! ;; `desktop-create-buffer' sets `desktop-first-buffer' to the first ! ;; buffer in the desktop file (the last for desktop files written
!           ;; by desktop version prior to 206).
! (load (expand-file-name desktop-basefilename desktop-dirname) t t t) ! (when desktop-first-buffer (switch-to-buffer desktop-first-buffer))
!           (run-hooks 'desktop-delay-hook)
!           (setq desktop-delay-hook nil)
!           (run-hooks 'desktop-after-read-hook)
!           (message "Desktop loaded.")
!           t)
!         (desktop-clear)
!         (run-hooks 'desktop-no-desktop-file-hook)
!         (message "No desktop file.")
!         nil))))
!
;; ----------------------------------------------------------------------------
 ;;;###autoload
 (defun desktop-load-default ()
***************
*** 611,634 ****
       (progn
     (load "default" t t)
     (setq inhibit-default-init t))))
;; ----------------------------------------------------------------------------
 ;; Note: the following functions use the dynamic variable binding in Lisp.
 ;;
 (defun desktop-buffer-info-misc-data ()
   (if (eq major-mode 'Info-mode)
       (list Info-current-file
             Info-current-node)))

 (defun desktop-buffer-dired-misc-data ()
!   (if (eq major-mode 'dired-mode)
!       (cons
!        (expand-file-name dired-directory)
!        (cdr
!         (nreverse
!          (mapcar
!           (function car)
!           dired-subdir-alist))))))

 (defun desktop-buffer-info () "Load an info file."
   (if (eq 'Info-mode desktop-buffer-major-mode)
       (progn
--- 708,781 ----
       (progn
     (load "default" t t)
     (setq inhibit-default-init t))))
+
+ ;; ----------------------------------------------------------------------------
+ ;;;###autoload
+ (defun desktop-change-dir (dir)
+ "Saves and clears the desktop, changes to directory DIR and loads the desktop
+ there indepentently of the value of `desktop-path'.
+ If `desktop-enable' was nil at call, the desktop is not saved, but
+ `desktop-enable' is subsequently set to t."
+   (interactive "DNew directory: ")
+   (desktop-kill)
+   (desktop-clear)
+   (cd dir)
+   (setq desktop-enable t)
+   (let ((desktop-path '(".")))
+     (desktop-read)
+     ;; Set `desktop-dirname' even in no desktop file was found
+     (setq desktop-dirname (expand-file-name dir))))
+
+ ;; ----------------------------------------------------------------------------
+ ;;;###autoload
+ (defun desktop-save-in-load-dir ()
+   "Save desktop in directory from witch it was loaded."
+   (interactive)
+   (if desktop-dirname
+     (desktop-save desktop-dirname)
+     (call-interactively 'desktop-save))
+   (message "Desktop saved in %s" desktop-dirname))
+
+ ;; ----------------------------------------------------------------------------
+ ;;;###autoload
+ (defun desktop-revert ()
+   "Revert to the last loaded desktop."
+   (interactive)
+   (unless desktop-dirname (error "No desktop has been loaded"))
+   (setq desktop-enable nil)
+   (desktop-change-dir desktop-dirname))
+
;; ----------------------------------------------------------------------------
 ;; Note: the following functions use the dynamic variable binding in Lisp.
 ;;
+
+ (eval-when-compile ; Just to silence the byte compiler
+   (defvar desktop-version)
+   (defvar desktop-buffer-file-name)
+   (defvar desktop-buffer-name)
+   (defvar desktop-buffer-major-mode)
+   (defvar desktop-buffer-minor-modes)
+   (defvar desktop-buffer-point)
+   (defvar desktop-buffer-mark)
+   (defvar desktop-buffer-read-only)
+   (defvar desktop-buffer-misc)
+   (defvar desktop-buffer-locals)
+ )
+
 (defun desktop-buffer-info-misc-data ()
   (if (eq major-mode 'Info-mode)
       (list Info-current-file
             Info-current-node)))

+ ;; ----------------------------------------------------------------------------
 (defun desktop-buffer-dired-misc-data ()
!   (when (eq major-mode 'dired-mode)
!     (cons
!       ;; dired directory in portable form
!       (file-name-as-directory (tilde-expand-file-name dired-directory))
!       (cdr (nreverse (mapcar (function car) dired-subdir-alist))))))

+ ;; ----------------------------------------------------------------------------
 (defun desktop-buffer-info () "Load an info file."
   (if (eq 'Info-mode desktop-buffer-major-mode)
       (progn
***************
*** 638,644 ****
--- 785,793 ----
       (require 'info)
       (Info-find-node first second)
       (current-buffer))))))
+
;; ---------------------------------------------------------------------------- + (eval-when-compile (defvar rmail-buffer)) ; Just to silence the byte compiler.
 (defun desktop-buffer-rmail () "Load an RMAIL file."
   (if (eq 'rmail-mode desktop-buffer-major-mode)
       (condition-case error
***************
*** 649,662 ****
     (file-locked
      (kill-buffer (current-buffer))
      'ignored))))
;; ----------------------------------------------------------------------------
 (defun desktop-buffer-mh () "Load a folder in the mh system."
   (if (eq 'mh-folder-mode desktop-buffer-major-mode)
       (progn
!     (require 'mh-e)
     (mh-find-path)
         (mh-visit-folder desktop-buffer-name)
     (current-buffer))))
;; ----------------------------------------------------------------------------
 (defun desktop-buffer-dired () "Load a directory using dired."
   (if (eq 'dired-mode desktop-buffer-major-mode)
--- 798,813 ----
     (file-locked
      (kill-buffer (current-buffer))
      'ignored))))
+
;; ----------------------------------------------------------------------------
 (defun desktop-buffer-mh () "Load a folder in the mh system."
   (if (eq 'mh-folder-mode desktop-buffer-major-mode)
       (progn
!         (eval-and-compile (require 'mh-e))
     (mh-find-path)
         (mh-visit-folder desktop-buffer-name)
     (current-buffer))))
+
;; ----------------------------------------------------------------------------
 (defun desktop-buffer-dired () "Load a directory using dired."
   (if (eq 'dired-mode desktop-buffer-major-mode)
***************
*** 668,673 ****
--- 819,825 ----
     (message "Directory %s no longer exists." (car desktop-buffer-misc))
     (sit-for 1)
     'ignored)))
+
;; ----------------------------------------------------------------------------
 (defun desktop-buffer-file () "Load a file."
   (if desktop-buffer-file-name
***************
*** 682,737 ****
           (error (pop-to-buffer buf)))
         buf)
     'ignored)))
;; ---------------------------------------------------------------------------- ;; Create a buffer, load its file, set is mode, ...; called from Desktop file
 ;; only.

! (defvar desktop-last-buffer nil
!   "Last buffer read.  Dynamically bound in `desktop-read'.")
!
! (defun desktop-create-buffer (ver desktop-buffer-file-name desktop-buffer-name
!                   desktop-buffer-major-mode
!                   mim pt mk ro desktop-buffer-misc
!                   &optional locals)
!   (let ((hlist desktop-buffer-handlers)
!     (result)
!     (handler))
!     (while (and (not result) hlist)
!       (setq handler (car hlist))
!       (setq result (funcall handler))
!       (setq hlist (cdr hlist)))
!     (when (bufferp result)
!       (setq desktop-last-buffer result)
!       (set-buffer result)
!       (if (not (equal (buffer-name) desktop-buffer-name))
!       (rename-buffer desktop-buffer-name))
!       ;; minor modes
! (cond ((equal '(t) mim) (auto-fill-mode 1)) ; backwards compatible
!         ((equal '(nil) mim) (auto-fill-mode 0))
!         (t (mapcar #'(lambda (minor-mode)
!                (when (functionp minor-mode)
!                  (funcall minor-mode 1)))
!                mim)))
!       (goto-char pt)
!       (if (consp mk)
!       (progn
!         (set-mark (car mk))
!         (setq mark-active (car (cdr mk))))
!     (set-mark mk))
! ;; Never override file system if the file really is read-only marked.
!       (if ro (setq buffer-read-only ro))
!       (while locals
!     (let ((this (car locals)))
!       (if (consp this)
!           ;; an entry of this form `(symbol . value)'
!           (progn
!         (make-local-variable (car this))
!         (set (car this) (cdr this)))
!         ;; an entry of the form `symbol'
!         (make-local-variable this)
!         (makunbound this)))
!     (setq locals (cdr locals))))))

 ;; Backward compatibility -- update parameters to 205 standards.
 (defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name
                desktop-buffer-major-mode
--- 834,922 ----
           (error (pop-to-buffer buf)))
         buf)
     'ignored)))
+
;; ---------------------------------------------------------------------------- ;; Create a buffer, load its file, set is mode, ...; called from Desktop file
 ;; only.

! (eval-when-compile ; Just to silence the byte compiler
!    (defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read'
! )
!
! (defun desktop-create-buffer (
!   desktop-version
!   desktop-buffer-file-name
!   desktop-buffer-name
!   desktop-buffer-major-mode
!   desktop-buffer-minor-modes
!   desktop-buffer-point
!   desktop-buffer-mark
!   desktop-buffer-read-only
!   desktop-buffer-misc
!   &optional
!   desktop-buffer-locals)
!   ;; To make desktop files with relative file names possible, we cannot
! ;; allow `default-directory' to change. Therefore we save current buffer.
!   (save-current-buffer
!     (let (
!       (buffer-list (buffer-list))
!       (hlist desktop-buffer-handlers)
!       (result)
!       (handler)
!     )
!       ;; Call desktop-buffer-handlers to create buffer.
!       (while (and (not result) hlist)
!         (setq handler (car hlist))
!         (setq result (funcall handler))
!         (setq hlist (cdr hlist)))
!       (unless (bufferp result) (setq result nil))
!       (unless (< desktop-version 206)
!         (when result (setq buffer-list (cons result buffer-list)))
!         (mapcar 'bury-buffer buffer-list))
!       (when result
!         (if (< desktop-version 206)
!           (setq desktop-first-buffer result)
!           (bury-buffer result))
!         (unless desktop-first-buffer (setq desktop-first-buffer result))
!         (set-buffer result)
!         (unless (equal (buffer-name) desktop-buffer-name)
!           (rename-buffer desktop-buffer-name))
!         ;; minor modes
!         (cond (
!           ;; backwards compatible
!           (equal '(t) desktop-buffer-minor-modes)
!           (auto-fill-mode 1))(
!           (equal '(nil) desktop-buffer-minor-modes)
!           (auto-fill-mode 0))(
!           t
!           (mapcar
!             #'(lambda (minor-mode)
!               (when (functionp minor-mode) (funcall minor-mode 1)))
!             desktop-buffer-minor-modes)))
! ;; Even though point and mark are non-nil when written by `desktop-save' ! ;; they may be modified by mandlers wanting to set point or mark themselves.
!         (when desktop-buffer-point (goto-char desktop-buffer-point))
!         (when desktop-buffer-mark
!           (if (consp desktop-buffer-mark)
!             (progn
!               (set-mark (car desktop-buffer-mark))
!               (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)
!               ;; an entry of this form `(symbol . value)'
!               (progn
!                 (make-local-variable (car this))
!                 (set (car this) (cdr this)))
!               ;; an entry of the form `symbol'
!               (make-local-variable this)
!               (makunbound this)))
!           (setq desktop-buffer-locals (cdr desktop-buffer-locals)))))))

+ ;; ----------------------------------------------------------------------------
 ;; Backward compatibility -- update parameters to 205 standards.
 (defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name
                desktop-buffer-major-mode
***************
*** 744,759 ****
                    (cons 'case-fold-search cfs)
                    (cons 'case-replace cr)
                    (cons 'overwrite-mode (car mim)))))
;; ----------------------------------------------------------------------------
!
! ;; If the user set desktop-enable to t with Custom,
! ;; do the rest of what it takes to use desktop,
! ;; but do it after finishing loading the init file.
! (add-hook 'after-init-hook
!       '(lambda ()
!          (when desktop-enable
!            (desktop-load-default)
!            (desktop-read))))

 (provide 'desktop)

--- 929,950 ----
                    (cons 'case-fold-search cfs)
                    (cons 'case-replace cr)
                    (cons 'overwrite-mode (car mim)))))
+ ;; ---------------------------------------------------------------------------- ! ;; When `desktop-enable' is non-nil and "--no-desktop" is not specified on the
! ;; command line, we do the rest of what it takes to use desktop, but do it
! ;; after finishing loading the init file.
! ;; We cannot use `command-switch-alist' to process "--no-desktop" because these
! ;; functions are processed after `after-init-hook'.
! (add-hook
!   'after-init-hook
!   '(lambda ()
!     (let ((key "--no-desktop"))
!       (if (member key command-line-args)
!         (delete key command-line-args)
!         (when desktop-enable
!           (desktop-load-default)
!           (desktop-read))))))

 (provide 'desktop)


D:\>diff -c cvs/emacs/lisp/files.el emacs/emacs-cvs/files.el
diff -c cvs/emacs/lisp/files.el emacs/emacs-cvs/files.el
*** cvs/emacs/lisp/files.el    Wed Feb 19 09:14:18 2003
--- emacs/emacs-cvs/files.el    Wed Feb 19 09:29:46 2003
***************
*** 2767,2772 ****
--- 2767,2786 ----
           (concat (file-name-as-directory ancestor) rest)))
         ;; We matched FNAME's directory equivalent.
         ancestor))))))
+
+ (defun tilde-expand-file-name (file-name &optional default-dir)
+ ;; Don't use parameter name `default-directory' here! Then `expand-file-name' will + ;; see the parameter instead of the buffer-local variable of the same name. + "Works like `expand-file-name' except that path of the file name returned
+ is relative to \"~\" rather than root when possible.
+ \(It can be impossible on MSDOS and Windows when the FILE-NAME and \"~\"
+ are on different drives.)"
+ (let ((relative-name (file-relative-name (expand-file-name file-name default-dir) "~")))
+     (cond
+       ((file-name-absolute-p relative-name) relative-name)
+       ((string= "./" relative-name) "~/")
+       ((string= "." relative-name) "~")
+       (t (concat "~/" relative-name)))))
 
 (defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below.






reply via email to

[Prev in Thread] Current Thread [Next in Thread]