lisp/desktop.el

   1 ;;; desktop.el --- save partial status of Emacs when killed
   2
   3 ;; Copyright (C) 1993, 1994, 1995, 1997, 2000, 2001
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Morten Welinder <terra@diku.dk>
   7 ;; Keywords: convenience
   8 ;; Favourite-brand-of-beer: None, I hate beer.
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; Save the Desktop, i.e.,
  30 ;;      - some global variables
  31 ;;      - the list of buffers with associated files.  For each buffer also
  32 ;;              - the major mode
  33 ;;              - the default directory
  34 ;;              - the point
  35 ;;              - the mark & mark-active
  36 ;;              - buffer-read-only
  37 ;;              - some local variables
  38
  39 ;; To use this, first put these two lines in the bottom of your .emacs
  40 ;; file (the later the better):
  41 ;;
  42 ;;      (desktop-load-default)
  43 ;;      (desktop-read)
  44 ;;
  45 ;; Between these two lines you may wish to add something that updates the
  46 ;; variables `desktop-globals-to-save' and/or `desktop-locals-to-save'.  If
  47 ;; for instance you want to save the local variable `foobar' for every buffer
  48 ;; in which it is local, you could add the line
  49 ;;
  50 ;;      (setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save))
  51 ;;
  52 ;; To avoid saving excessive amounts of data you may also wish to add
  53 ;; something like the following
  54 ;;
  55 ;;      (add-hook 'kill-emacs-hook
  56 ;;                '(lambda ()
  57 ;;                   (desktop-truncate search-ring 3)
  58 ;;                   (desktop-truncate regexp-search-ring 3)))
  59 ;;
  60 ;; which will make sure that no more than three search items are saved.  You
  61 ;; must place this line *after* the `(desktop-load-default)' line.  See also
  62 ;; the variable `desktop-save-hook'.
  63
  64 ;; Start Emacs in the root directory of your "project". The desktop saver
  65 ;; is inactive by default.  You activate it by M-x desktop-save RET.  When
  66 ;; you exit the next time the above data will be saved.  This ensures that
  67 ;; all the files you were editing will be reloaded the next time you start
  68 ;; Emacs from the same directory and that points will be set where you
  69 ;; left them.  If you save a desktop file in your home directory it will
  70 ;; act as a default desktop when you start Emacs from a directory that
  71 ;; doesn't have its own.  I never do this, but you may want to.
  72
  73 ;; Some words on minor modes: Most minor modes are controlled by
  74 ;; buffer-local variables, which have a standard save / restore
  75 ;; mechanism.  To handle all minor modes, we take the following
  76 ;; approach: (1) check whether the variable name from
  77 ;; `minor-mode-alist' is also a function; and (2) use translation
  78 ;; table `desktop-minor-mode-table' in the case where the two names
  79 ;; are not the same.
  80
  81 ;; By the way: don't use desktop.el to customize Emacs -- the file .emacs
  82 ;; in your home directory is used for that.  Saving global default values
  83 ;; for buffers is an example of misuse.
  84
  85 ;; PLEASE NOTE: The kill ring can be saved as specified by the variable
  86 ;; `desktop-globals-to-save' (by default it isn't).  This may result in saving
  87 ;; things you did not mean to keep.  Use M-x desktop-clear RET.
  88
  89 ;; Thanks to  hetrick@phys.uva.nl (Jim Hetrick)      for useful ideas.
  90 ;;            avk@rtsg.mot.com (Andrew V. Klein)     for a dired tip.
  91 ;;            chris@tecc.co.uk (Chris Boucher)       for a mark tip.
  92 ;;            f89-kam@nada.kth.se (Klas Mellbourn)   for a mh-e tip.
  93 ;;            kifer@sbkifer.cs.sunysb.edu (M. Kifer) for a bug hunt.
  94 ;;            treese@lcs.mit.edu (Win Treese)        for ange-ftp tips.
  95 ;;            pot@cnuce.cnr.it (Francesco Potorti`)  for misc. tips.
  96 ;; ---------------------------------------------------------------------------
  97 ;; TODO:
  98 ;;
  99 ;; Save window configuration.
 100 ;; Recognize more minor modes.
 101 ;; Save mark rings.
 102
 103 ;;; Code:
 104
 105 ;; Make the compilation more silent
 106 (eval-when-compile
 107   ;; We use functions from these modules
 108   ;; We can't (require 'mh-e) since that wants to load something.
 109   (mapcar 'require '(info dired reporter)))
 110
 111 (defvar desktop-file-version "206"
 112   "Verion number of desktop file format.
 113 Written into the desktop file and used at desktop read to provide
 114 backward compatibility.")
 115
 116 ;; ----------------------------------------------------------------------------
 117 ;; USER OPTIONS -- settings you might want to play with.
 118 ;; ----------------------------------------------------------------------------
 119
 120 (defgroup desktop nil
 121   "Save status of Emacs when you exit."
 122   :group 'frames)
 123
 124 (defcustom desktop-enable nil
 125   "*Non-nil enable Desktop to save the state of Emacs when you exit."
 126   :group 'desktop
 127   :type 'boolean
 128   :require 'desktop
 129   :initialize 'custom-initialize-default
 130   :version "20.3")
 131
 132 (defcustom desktop-save 'ask-if-new
 133   "*When the user changes desktop or quits emacs, should the desktop be saved?
 134 \(in the current desktop directory)
 135    t             -- always save.
 136    ask           -- always ask.
 137    ask-if-new    -- ask if no desktop file exists, otherwise just save.
 138    ask-if-exists -- ask if desktop file exists, otherwise don't save.
 139    if-exists     -- save if desktop file exists, otherwise don't save.
 140    nil           -- never save.
 141 The desktop is never saved when `desktop-enable' is nil."
 142   :type '(choice
 143     (const :tag "Always save" t)
 144     (const :tag "Always ask" ask)
 145     (const :tag "Ask if desktop file is new, else do save" ask-if-new)
 146     (const :tag "Ask if desktop file exists, else don't save" ask-if-exists)
 147     (const :tag "Save if desktop file exists, else don't" if-exists)
 148     (const :tag "Never save" nil))
 149   :group 'desktop)
 150
 151 (defcustom desktop-base-file-name
 152   (convert-standard-filename ".emacs.desktop")
 153   "File for Emacs desktop, not including the directory name."
 154   :type 'file
 155   :group 'desktop)
 156 (defvaralias 'desktop-basefilename 'desktop-base-file-name)
 157
 158 (defcustom desktop-path '("." "~")
 159   "List of directories to search for the desktop file.
 160 The base name of the file is specified in `desktop-base-file-name'."
 161   :type '(repeat directory)
 162   :group 'desktop)
 163
 164 (defcustom desktop-missing-file-warning nil
 165   "*If non-nil then desktop warns when a file no longer exists.
 166 Otherwise it simply ignores that file."
 167   :type 'boolean
 168   :group 'desktop)
 169
 170 (defcustom desktop-no-desktop-file-hook nil
 171   "Normal hook run after fail of `desktop-read' due to missing desktop file.
 172 May e.g. be used to show a dired buffer."
 173   :type 'hook
 174   :group 'desktop)
 175
 176 (defcustom desktop-after-read-hook nil
 177   "Normal hook run after a sucessful `desktop-read'.
 178 May e.g. be used to show a buffer list."
 179   :type 'hook
 180   :group 'desktop)
 181
 182 (defcustom desktop-save-hook nil
 183   "Hook run before desktop saves the state of Emacs.
 184 This is useful for truncating history lists, for example."
 185   :type 'hook
 186   :group 'desktop)
 187
 188 (defcustom desktop-globals-to-save '(
 189   desktop-missing-file-warning
 190   tags-file-name
 191   tags-table-list
 192   search-ring
 193   regexp-search-ring
 194   register-alist)
 195   "List of global variables to save when killing Emacs.
 196 An element may be variable name (a symbol)
 197 or a cons cell of the form  (VAR . MAX-SIZE),
 198 which means to truncate VAR's value to at most MAX-SIZE elements
 199 \(if the value is a list) before saving the value.
 200 Feature: Saving `kill-ring' implies saving `kill-ring-yank-pointer'."
 201   :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
 202   :group 'desktop)
 203
 204 (defcustom desktop-globals-to-clear '(
 205   kill-ring
 206   kill-ring-yank-pointer
 207   search-ring
 208   search-ring-yank-pointer
 209   regexp-search-ring
 210   regexp-search-ring-yank-pointer)
 211   "List of global variables set to clear by `desktop-clear'.
 212 An element may be variable name (a symbol) or a cons cell of the form
 213 \(VAR . FORM). Symbols are set to nil and for cons cells VAR is set
 214 to the value obtained by evaluateing FORM."
 215   :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
 216   :group 'desktop)
 217
 218 (defcustom desktop-clear-preserve-buffers-regexp
 219   "^\\*tramp/.+\\*$"
 220   "Regexp identifying buffers that `desktop-clear' should not delete."
 221   :type 'regexp
 222   :group 'desktop)
 223
 224 ;; Maintained for backward compatibility
 225 (defcustom desktop-clear-preserve-buffers
 226   '("*scratch*" "*Messages*")
 227   "*List of buffer names that `desktop-clear' should not delete."
 228   :type '(repeat string)
 229   :group 'desktop)
 230
 231 (defvar desktop-locals-to-save '(
 232   desktop-locals-to-save  ; Itself!  Think it over.
 233   truncate-lines
 234   case-fold-search
 235   case-replace
 236   fill-column
 237   overwrite-mode
 238   change-log-default-name
 239   line-number-mode)
 240   "List of local variables to save for each buffer.
 241 The variables are saved only when they really are local.")
 242 (make-variable-buffer-local 'desktop-locals-to-save)
 243
 244 ;; We skip .log files because they are normally temporary.
 245 ;;         (ftp) files because they require passwords and whatnot.
 246 ;;         TAGS files to save time (tags-file-name is saved instead).
 247 (defcustom desktop-buffers-not-to-save
 248   "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
 249   "Regexp identifying buffers that are to be excluded from saving."
 250   :type 'regexp
 251   :group 'desktop)
 252
 253 ;; Skip ange-ftp files
 254 (defcustom desktop-files-not-to-save
 255   "^/[^/:]*:"
 256   "Regexp identifying files whose buffers are to be excluded from saving."
 257   :type 'regexp
 258   :group 'desktop)
 259
 260 (defcustom desktop-buffer-modes-to-save
 261   '(Info-mode rmail-mode)
 262   "If a buffer is of one of these major modes, save the buffer name.
 263 It is up to the functions in `desktop-buffer-handlers' to decide
 264 whether the buffer should be recreated or not, and how."
 265   :type '(repeat symbol)
 266   :group 'desktop)
 267
 268 (defcustom desktop-modes-not-to-save nil
 269   "List of major modes whose buffers should not be saved."
 270   :type '(repeat symbol)
 271   :group 'desktop)
 272
 273 (defcustom desktop-file-name-format 'absolute
 274   "*Format in which desktop file names should be saved.
 275 Possible values are:
 276    absolute -- Absolute file name.
 277    tilde    -- Relative to ~.
 278    local    -- Relative to directory of desktop file."
 279   :type '(choice (const absolute) (const tilde) (const local))
 280   :group 'desktop)
 281
 282 (defcustom desktop-buffer-misc-functions
 283   '(desktop-buffer-info-misc-data
 284     desktop-buffer-dired-misc-data)
 285   "*Functions used to determine auxiliary information for a buffer.
 286 These functions are called in order, with no arguments.  If a function
 287 returns non-nil, its value is saved along with the desktop buffer for
 288 which it was called; no further functions will be called.
 289
 290 File names should formatted using the call
 291 \"(desktop-file-name FILE-NAME dirname)\".
 292
 293 Later, when desktop.el restores the buffers it has saved, each of the
 294 `desktop-buffer-handlers' functions will have access to a buffer local
 295 variable, named `desktop-buffer-misc', whose value is what the
 296 \"misc\" function returned previously."
 297   :type '(repeat function)
 298   :group 'desktop)
 299
 300 (defcustom desktop-buffer-handlers
 301   '(desktop-buffer-dired
 302     desktop-buffer-rmail
 303     desktop-buffer-mh
 304     desktop-buffer-info
 305     desktop-buffer-file)
 306   "*List of functions to call in order to create a buffer.
 307 The functions are called without explicit parameters but can use the
 308 following variables:
 309
 310    desktop-file-version
 311    desktop-buffer-file-name
 312    desktop-buffer-name
 313    desktop-buffer-major-mode
 314    desktop-buffer-minor-modes
 315    desktop-buffer-point
 316    desktop-buffer-mark
 317    desktop-buffer-read-only
 318    desktop-buffer-misc
 319    desktop-buffer-locals
 320
 321 If one function returns non-nil, no further functions are called.
 322 If the function returns a buffer, then the saved mode settings
 323 and variable values for that buffer are copied into it."
 324   :type '(repeat function)
 325   :group 'desktop)
 326
 327 (put 'desktop-buffer-handlers 'risky-local-variable t)
 328
 329 (defcustom desktop-minor-mode-table
 330   '((auto-fill-function auto-fill-mode)
 331     (vc-mode nil))
 332   "Table mapping minor mode variables to minor mode functions.
 333 Each entry has the form (NAME RESTORE-FUNCTION).
 334 NAME is the name of the buffer-local variable indicating that the minor
 335 mode is active.  RESTORE-FUNCTION is the function to activate the minor mode.
 336 called.  RESTORE-FUNCTION nil means don't try to restore the minor mode.
 337 Only minor modes for which the name of the buffer-local variable
 338 and the name of the minor mode function are different have to added to
 339 this table."
 340   :type 'sexp
 341   :group 'desktop)
 342
 343 ;; ----------------------------------------------------------------------------
 344 (defvar desktop-dirname nil
 345   "The directory in which the current desktop file resides.")
 346
 347 (defconst desktop-header
 348 ";; --------------------------------------------------------------------------
 349 ;; Desktop File for Emacs
 350 ;; --------------------------------------------------------------------------
 351 " "*Header to place in Desktop file.")
 352
 353 (defvar desktop-delay-hook nil
 354   "Hooks run after all buffers are loaded; intended for internal use.")
 355
 356 ;; ----------------------------------------------------------------------------
 357 (defun desktop-truncate (l n)
 358   "Truncate LIST to at most N elements destructively."
 359   (let ((here (nthcdr (1- n) l)))
 360     (if (consp here)
 361         (setcdr here nil))))
 362
 363 ;; ----------------------------------------------------------------------------
 364 (defun desktop-clear ()
 365   "Empty the Desktop.
 366 This kills all buffers except for internal ones and those listed
 367 in `desktop-clear-preserve-buffers'.  Furthermore, it clears the
 368 variables listed in `desktop-globals-to-clear'."
 369   (interactive)
 370   (dolist (var desktop-globals-to-clear)
 371     (if (symbolp var)
 372       (eval `(setq-default ,var nil))
 373       (eval `(setq-default ,(car var) ,(cdr var)))))
 374   (let ((buffers (buffer-list)))
 375     (while buffers
 376       (let ((bufname (buffer-name (car buffers))))
 377          (or
 378            (null bufname)
 379            (string-match desktop-clear-preserve-buffers-regexp bufname)
 380            (member bufname desktop-clear-preserve-buffers)
 381            ;; Don't kill buffers made for internal purposes.
 382            (and (not (equal bufname "")) (eq (aref bufname 0) ?\ ))
 383            (kill-buffer (car buffers))))
 384       (setq buffers (cdr buffers))))
 385   (delete-other-windows))
 386
 387 ;; ----------------------------------------------------------------------------
 388 (add-hook 'kill-emacs-hook 'desktop-kill)
 389
 390 (defun desktop-kill ()
 391   "If `desktop-enable' is non-nil, do what `desktop-save' says to do.
 392 If the desktop should be saved and `desktop-dirname'
 393 is nil, ask the user where to save the desktop."
 394   (when
 395     (and
 396       desktop-enable
 397       (let ((exists (file-exists-p (concat desktop-dirname desktop-base-file-name))))
 398         (or
 399           (eq desktop-save 't)
 400           (and exists (memq desktop-save '(ask-if-new if-exists)))
 401           (and
 402             (or
 403               (memq desktop-save '(ask ask-if-new))
 404               (and exists (eq desktop-save 'ask-if-exists)))
 405             (y-or-n-p "Save desktop? ")))))
 406     (unless desktop-dirname
 407       (setq desktop-dirname
 408         (expand-file-name
 409           (call-interactively
 410             (lambda (dir) (interactive "DDirectory for desktop file: ") dir)))))
 411     (condition-case err
 412       (desktop-save desktop-dirname)
 413       (file-error
 414         (unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
 415           (signal (car err) (cdr err)))))))
 416
 417 ;; ----------------------------------------------------------------------------
 418 (defun desktop-list* (&rest args)
 419   (if (null (cdr args))
 420       (car args)
 421     (setq args (nreverse args))
 422     (let ((value (cons (nth 1 args) (car args))))
 423       (setq args (cdr (cdr args)))
 424       (while args
 425         (setq value (cons (car args) value))
 426         (setq args (cdr args)))
 427       value)))
 428
 429 ;; ----------------------------------------------------------------------------
 430 (defun desktop-internal-v2s (val)
 431   "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
 432 TXT is a string that when read and evaluated yields value.
 433 QUOTE may be `may' (value may be quoted),
 434 `must' (values must be quoted), or nil (value may not be quoted)."
 435   (cond
 436    ((or (numberp val) (null val) (eq t val))
 437     (cons 'may (prin1-to-string val)))
 438    ((stringp val)
 439     (let ((copy (copy-sequence val)))
 440       (set-text-properties 0 (length copy) nil copy)
 441       ;; Get rid of text properties because we cannot read them
 442       (cons 'may (prin1-to-string copy))))
 443    ((symbolp val)
 444     (cons 'must (prin1-to-string val)))
 445    ((vectorp val)
 446     (let* ((special nil)
 447            (pass1 (mapcar
 448                    (lambda (el)
 449                      (let ((res (desktop-internal-v2s el)))
 450                        (if (null (car res))
 451                            (setq special t))
 452                        res))
 453                    val)))
 454       (if special
 455           (cons nil (concat "(vector "
 456                             (mapconcat (lambda (el)
 457                                          (if (eq (car el) 'must)
 458                                              (concat "'" (cdr el))
 459                                            (cdr el)))
 460                                        pass1
 461                                        " ")
 462                             ")"))
 463         (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
 464    ((consp val)
 465     (let ((p val)
 466           newlist
 467           use-list*
 468           anynil)
 469       (while (consp p)
 470         (let ((q.txt (desktop-internal-v2s (car p))))
 471           (or anynil (setq anynil (null (car q.txt))))
 472           (setq newlist (cons q.txt newlist)))
 473         (setq p (cdr p)))
 474       (if p
 475           (let ((last (desktop-internal-v2s p))
 476                 (el (car newlist)))
 477             (or anynil (setq anynil (null (car last))))
 478             (or anynil
 479                 (setq newlist (cons '(must . ".") newlist)))
 480             (setq use-list* t)
 481             (setq newlist (cons last newlist))))
 482       (setq newlist (nreverse newlist))
 483       (if anynil
 484           (cons nil
 485                 (concat (if use-list* "(desktop-list* "  "(list ")
 486                         (mapconcat (lambda (el)
 487                                      (if (eq (car el) 'must)
 488                                          (concat "'" (cdr el))
 489                                        (cdr el)))
 490                                    newlist
 491                                    " ")
 492                         ")"))
 493         (cons 'must
 494               (concat "(" (mapconcat 'cdr newlist " ") ")")))))
 495    ((subrp val)
 496     (cons nil (concat "(symbol-function '"
 497                       (substring (prin1-to-string val) 7 -1)
 498                       ")")))
 499    ((markerp val)
 500     (let ((pos (prin1-to-string (marker-position val)))
 501           (buf (prin1-to-string (buffer-name (marker-buffer val)))))
 502       (cons nil (concat "(let ((mk (make-marker)))"
 503                         " (add-hook 'desktop-delay-hook"
 504                         " (list 'lambda '() (list 'set-marker mk "
 505                         pos " (get-buffer " buf ")))) mk)"))))
 506    (t                                   ; save as text
 507     (cons 'may "\"Unprintable entity\""))))
 508
 509 ;; ----------------------------------------------------------------------------
 510 (defun desktop-value-to-string (val)
 511   "Convert VALUE to a string that when read evaluates to the same value.
 512 Not all types of values are supported."
 513   (let* ((print-escape-newlines t)
 514          (float-output-format nil)
 515          (quote.txt (desktop-internal-v2s val))
 516          (quote (car quote.txt))
 517          (txt (cdr quote.txt)))
 518     (if (eq quote 'must)
 519         (concat "'" txt)
 520       txt)))
 521
 522 ;; ----------------------------------------------------------------------------
 523 (defun desktop-outvar (varspec)
 524   "Output a setq statement for variable VAR to the desktop file.
 525 The argument VARSPEC may be the variable name VAR (a symbol),
 526 or a cons cell of the form  (VAR . MAX-SIZE),
 527 which means to truncate VAR's value to at most MAX-SIZE elements
 528 \(if the value is a list) before saving the value."
 529   (let (var size)
 530     (if (consp varspec)
 531         (setq var (car varspec) size (cdr varspec))
 532       (setq var varspec))
 533     (if (boundp var)
 534         (progn
 535           (if (and (integerp size)
 536                    (> size 0)
 537                    (listp (eval var)))
 538               (desktop-truncate (eval var) size))
 539           (insert "(setq "
 540                   (symbol-name var)
 541                   " "
 542                   (desktop-value-to-string (symbol-value var))
 543                   ")\n")))))
 544
 545 ;; ----------------------------------------------------------------------------
 546 (defun desktop-save-buffer-p (filename bufname mode &rest dummy)
 547   "Return t if the desktop should record a particular buffer for next startup.
 548 FILENAME is the visited file name, BUFNAME is the buffer name, and
 549 MODE is the major mode."
 550   (let ((case-fold-search nil))
 551     (and (not (string-match desktop-buffers-not-to-save bufname))
 552          (not (memq mode desktop-modes-not-to-save))
 553          (or (and filename
 554                   (not (string-match desktop-files-not-to-save filename)))
 555              (and (eq mode 'dired-mode)
 556                   (save-excursion
 557                     (set-buffer (get-buffer bufname))
 558                     (not (string-match desktop-files-not-to-save
 559                                        default-directory))))
 560              (and (null filename)
 561                   (memq mode desktop-buffer-modes-to-save))))))
 562
 563 ;; ----------------------------------------------------------------------------
 564 (defun desktop-file-name (filename dirname)
 565   "Convert FILENAME to format specified in `desktop-file-name-format'.
 566 DIRNAME must be the directory in which the desktop file will be saved."
 567   (cond
 568     ((not filename) nil)
 569     ((eq desktop-file-name-format 'tilde)
 570      (let ((relative-name (file-relative-name (expand-file-name filename) "~")))
 571        (cond
 572          ((file-name-absolute-p relative-name) relative-name)
 573          ((string= "./" relative-name) "~/")
 574          ((string= "." relative-name) "~")
 575          (t (concat "~/" relative-name)))))
 576     ((eq desktop-file-name-format 'local) (file-relative-name filename dirname))
 577     (t (expand-file-name filename))))
 578
 579 ;; ----------------------------------------------------------------------------
 580 (defun desktop-save (dirname)
 581   "Save the Desktop file. Parameter DIRNAME specifies where to save desktop."
 582   (interactive "DDirectory to save desktop file in: ")
 583   (run-hooks 'desktop-save-hook)
 584   (save-excursion
 585     (let ((filename (expand-file-name desktop-base-file-name dirname))
 586       (info
 587         (mapcar
 588           (function
 589             (lambda (b)
 590               (set-buffer b)
 591               (list
 592                 (desktop-file-name (buffer-file-name) dirname)
 593                 (buffer-name)
 594                 major-mode
 595                 ;; minor modes
 596                 (let (ret)
 597                   (mapcar
 598                     #'(lambda (mim)
 599                       (and
 600                         (boundp mim)
 601                         (symbol-value mim)
 602                         (setq
 603                           ret
 604                           (cons
 605                             (let (
 606                               (special (assq mim desktop-minor-mode-table))
 607                             )
 608                               (if special (cadr special) mim))
 609                             ret))))
 610                     (mapcar #'car minor-mode-alist))
 611                   ret)
 612                 (point)
 613                 (list (mark t) mark-active)
 614                 buffer-read-only
 615                 (run-hook-with-args-until-success 'desktop-buffer-misc-functions)
 616                 (let (
 617                   (locals desktop-locals-to-save)
 618                   (loclist (buffer-local-variables))
 619                   (ll)
 620                 )
 621                   (while locals
 622                     (let ((here (assq (car locals) loclist)))
 623                       (if here
 624                         (setq ll (cons here ll))
 625                         (when (member (car locals) loclist)
 626                           (setq ll (cons (car locals) ll)))))
 627                     (setq locals (cdr locals)))
 628                   ll))))
 629           (buffer-list)))
 630       (buf (get-buffer-create "*desktop*")))
 631       (set-buffer buf)
 632       (erase-buffer)
 633
 634       (insert
 635         ";; -*- coding: emacs-mule; -*-\n"
 636         desktop-header
 637         ";; Created " (current-time-string) "\n"
 638         ";; Desktop file format version " desktop-file-version "\n"
 639         ";; Emacs version " emacs-version "\n\n"
 640         ";; Global section:\n")
 641       (mapcar (function desktop-outvar) desktop-globals-to-save)
 642       (if (memq 'kill-ring desktop-globals-to-save)
 643         (insert
 644           "(setq kill-ring-yank-pointer (nthcdr "
 645           (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
 646           " kill-ring))\n"))
 647
 648       (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
 649       (mapcar
 650         (function
 651           (lambda (l)
 652             (if (apply 'desktop-save-buffer-p l)
 653               (progn
 654                 (insert "(desktop-create-buffer " desktop-file-version)
 655                 (mapcar
 656                   (function
 657                     (lambda (e)
 658                       (insert "\n  " (desktop-value-to-string e))))
 659                   l)
 660                 (insert ")\n\n")))))
 661         info)
 662       (setq default-directory dirname)
 663       (when (file-exists-p filename) (delete-file filename))
 664       (let ((coding-system-for-write 'emacs-mule))
 665         (write-region (point-min) (point-max) filename nil 'nomessage))))
 666   (setq desktop-dirname dirname))
 667
 668 ;; ----------------------------------------------------------------------------
 669 (defun desktop-remove ()
 670   "Delete the Desktop file and inactivate the desktop system."
 671   (interactive)
 672   (if desktop-dirname
 673       (let ((filename (concat desktop-dirname desktop-base-file-name)))
 674         (setq desktop-dirname nil)
 675         (if (file-exists-p filename)
 676             (delete-file filename)))))
 677
 678 ;; ----------------------------------------------------------------------------
 679 ;;;###autoload
 680 (defun desktop-read ()
 681   "Read the Desktop file and the files it specifies.
 682 This is a no-op when Emacs is running in batch mode.
 683 Look for the desktop file according to the variables `desktop-base-file-name'
 684 and `desktop-path'.  If no desktop file is found, clear the desktop.
 685 Returns t if it has read a desktop file, nil otherwise."
 686   (interactive)
 687   (unless noninteractive
 688     (let ((dirs desktop-path))
 689       (while
 690         (and
 691           dirs
 692           (not
 693             (file-exists-p (expand-file-name desktop-base-file-name (car dirs)))))
 694         (setq dirs (cdr dirs)))
 695       (setq desktop-dirname (and dirs (expand-file-name (car dirs))))
 696       (if desktop-dirname
 697         (let ((desktop-first-buffer nil))
 698           ;; `desktop-create-buffer' sets `desktop-first-buffer' to the first
 699           ;; buffer in the desktop file (the last for desktop files written
 700           ;; by desktop version prior to 206).
 701           (load (expand-file-name desktop-base-file-name desktop-dirname) t t t)
 702           (when desktop-first-buffer (switch-to-buffer desktop-first-buffer))
 703           (run-hooks 'desktop-delay-hook)
 704           (setq desktop-delay-hook nil)
 705           (run-hooks 'desktop-after-read-hook)
 706           (message "Desktop loaded.")
 707           t)
 708         (desktop-clear)
 709         (run-hooks 'desktop-no-desktop-file-hook)
 710         (message "No desktop file.")
 711         nil))))
 712
 713 ;; ----------------------------------------------------------------------------
 714 ;;;###autoload
 715 (defun desktop-load-default ()
 716   "Load the `default' start-up library manually.
 717 Also inhibit further loading of it.  Call this from your `.emacs' file
 718 to provide correct modes for autoloaded files."
 719   (if (not inhibit-default-init)        ; safety check
 720       (progn
 721         (load "default" t t)
 722         (setq inhibit-default-init t))))
 723
 724 ;; ----------------------------------------------------------------------------
 725 ;;;###autoload
 726 (defun desktop-change-dir (dir)
 727   "Save and clear the desktop, then load the desktop from directory DIR.
 728 However, if `desktop-enable' was nil at call, don't save the old desktop.
 729 This function always sets `desktop-enable' to t."
 730   (interactive "DNew directory: ")
 731   (desktop-kill)
 732   (desktop-clear)
 733   (cd dir)
 734   (setq desktop-enable t)
 735   (let ((desktop-path '(".")))
 736     (desktop-read)
 737     ;; Set `desktop-dirname' even in no desktop file was found
 738     (setq desktop-dirname (expand-file-name dir))))
 739
 740 ;; ----------------------------------------------------------------------------
 741 ;;;###autoload
 742 (defun desktop-save-in-load-dir ()
 743   "Save desktop in directory from which it was loaded."
 744   (interactive)
 745   (if desktop-dirname
 746     (desktop-save desktop-dirname)
 747     (call-interactively 'desktop-save))
 748   (message "Desktop saved in %s" desktop-dirname))
 749
 750 ;; ----------------------------------------------------------------------------
 751 ;;;###autoload
 752 (defun desktop-revert ()
 753   "Revert to the last loaded desktop."
 754   (interactive)
 755   (unless desktop-dirname (error "No desktop has been loaded"))
 756   (setq desktop-enable nil)
 757   (desktop-change-dir desktop-dirname))
 758
 759 ;; ----------------------------------------------------------------------------
 760 ;; Note: the following functions use the dynamic variable binding in Lisp.
 761 ;;
 762
 763 (eval-when-compile ; Just to silence the byte compiler
 764   (defvar desktop-file-version)
 765   (defvar desktop-buffer-file-name)
 766   (defvar desktop-buffer-name)
 767   (defvar desktop-buffer-major-mode)
 768   (defvar desktop-buffer-minor-modes)
 769   (defvar desktop-buffer-point)
 770   (defvar desktop-buffer-mark)
 771   (defvar desktop-buffer-read-only)
 772   (defvar desktop-buffer-misc)
 773   (defvar desktop-buffer-locals)
 774 )
 775
 776 (defun desktop-buffer-info-misc-data ()
 777   (if (eq major-mode 'Info-mode)
 778       (list Info-current-file
 779             Info-current-node)))
 780
 781 ;; ----------------------------------------------------------------------------
 782 (defun desktop-buffer-dired-misc-data ()
 783   (when (eq major-mode 'dired-mode)
 784     (eval-when-compile (defvar dirname))
 785     (cons
 786       ;; dired directory in portable form
 787       (file-name-as-directory (desktop-file-name dired-directory dirname))
 788       (cdr (nreverse (mapcar (function car) dired-subdir-alist))))))
 789
 790 ;; ----------------------------------------------------------------------------
 791 (defun desktop-buffer-info () "Load an info file."
 792   (if (eq 'Info-mode desktop-buffer-major-mode)
 793       (progn
 794         (let ((first (nth 0 desktop-buffer-misc))
 795               (second (nth 1 desktop-buffer-misc)))
 796         (when (and first second)
 797           (require 'info)
 798           (Info-find-node first second)
 799           (current-buffer))))))
 800
 801 ;; ----------------------------------------------------------------------------
 802 (eval-when-compile (defvar rmail-buffer)) ; Just to silence the byte compiler.
 803 (defun desktop-buffer-rmail () "Load an RMAIL file."
 804   (if (eq 'rmail-mode desktop-buffer-major-mode)
 805       (condition-case error
 806           (progn (rmail-input desktop-buffer-file-name)
 807                          (if (eq major-mode 'rmail-mode)
 808                              (current-buffer)
 809                            rmail-buffer))
 810         (file-locked
 811          (kill-buffer (current-buffer))
 812          'ignored))))
 813
 814 ;; ----------------------------------------------------------------------------
 815 (defun desktop-buffer-mh () "Load a folder in the mh system."
 816   (if (eq 'mh-folder-mode desktop-buffer-major-mode)
 817       (progn
 818         (mh-find-path)
 819         (mh-visit-folder desktop-buffer-name)
 820         (current-buffer))))
 821
 822 ;; ----------------------------------------------------------------------------
 823 (defun desktop-buffer-dired () "Load a directory using dired."
 824   (if (eq 'dired-mode desktop-buffer-major-mode)
 825       (if (file-directory-p (file-name-directory (car desktop-buffer-misc)))
 826           (progn
 827             (dired (car desktop-buffer-misc))
 828             (mapcar 'dired-maybe-insert-subdir (cdr desktop-buffer-misc))
 829             (current-buffer))
 830         (message "Directory %s no longer exists." (car desktop-buffer-misc))
 831         (sit-for 1)
 832         'ignored)))
 833
 834 ;; ----------------------------------------------------------------------------
 835 (defun desktop-buffer-file ()
 836   "Load a file."
 837   (if desktop-buffer-file-name
 838       (if (or (file-exists-p desktop-buffer-file-name)
 839               (and desktop-missing-file-warning
 840                    (y-or-n-p (format
 841                               "File \"%s\" no longer exists. Re-create? "
 842                               desktop-buffer-file-name))))
 843           (let ((buf (find-file-noselect desktop-buffer-file-name)))
 844             (condition-case nil
 845                 (switch-to-buffer buf)
 846               (error (pop-to-buffer buf)))
 847             (and (not (eq major-mode desktop-buffer-major-mode))
 848                  (functionp desktop-buffer-major-mode)
 849                  (funcall desktop-buffer-major-mode))
 850             buf)
 851         'ignored)))
 852
 853 ;; ----------------------------------------------------------------------------
 854 ;; Create a buffer, load its file, set is mode, ...;  called from Desktop file
 855 ;; only.
 856
 857 (eval-when-compile ; Just to silence the byte compiler
 858    (defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read'
 859 )
 860
 861 (defun desktop-create-buffer (
 862   desktop-file-version
 863   desktop-buffer-file-name
 864   desktop-buffer-name
 865   desktop-buffer-major-mode
 866   desktop-buffer-minor-modes
 867   desktop-buffer-point
 868   desktop-buffer-mark
 869   desktop-buffer-read-only
 870   desktop-buffer-misc
 871   &optional
 872   desktop-buffer-locals)
 873   ;; To make desktop files with relative file names possible, we cannot
 874   ;; allow `default-directory' to change. Therefore we save current buffer.
 875   (save-current-buffer
 876     (let (
 877       (buffer-list (buffer-list))
 878       (hlist desktop-buffer-handlers)
 879       (result)
 880       (handler)
 881     )
 882       ;; Call desktop-buffer-handlers to create buffer.
 883       (while (and (not result) hlist)
 884         (setq handler (car hlist))
 885         (setq result (funcall handler))
 886         (setq hlist (cdr hlist)))
 887       (unless (bufferp result) (setq result nil))
 888       (unless (< desktop-file-version 206)
 889         (when result (setq buffer-list (cons result buffer-list)))
 890         (mapcar 'bury-buffer buffer-list))
 891       (when result
 892         (if (< desktop-file-version 206)
 893           (setq desktop-first-buffer result)
 894           (bury-buffer result))
 895         (unless desktop-first-buffer (setq desktop-first-buffer result))
 896         (set-buffer result)
 897         (unless (equal (buffer-name) desktop-buffer-name)
 898           (rename-buffer desktop-buffer-name))
 899         ;; minor modes
 900         (cond (
 901           ;; backwards compatible
 902           (equal '(t) desktop-buffer-minor-modes)
 903           (auto-fill-mode 1))(
 904           (equal '(nil) desktop-buffer-minor-modes)
 905           (auto-fill-mode 0))(
 906           t
 907           (mapcar
 908             #'(lambda (minor-mode)
 909               (when (functionp minor-mode) (funcall minor-mode 1)))
 910             desktop-buffer-minor-modes)))
 911         ;; Even though point and mark are non-nil when written by `desktop-save'
 912         ;; they may be modified by mandlers wanting to set point or mark themselves.
 913         (when desktop-buffer-point (goto-char desktop-buffer-point))
 914         (when desktop-buffer-mark
 915           (if (consp desktop-buffer-mark)
 916             (progn
 917               (set-mark (car desktop-buffer-mark))
 918               (setq mark-active (car (cdr desktop-buffer-mark))))
 919             (set-mark desktop-buffer-mark)))
 920         ;; Never override file system if the file really is read-only marked.
 921         (if desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
 922         (while desktop-buffer-locals
 923           (let ((this (car desktop-buffer-locals)))
 924             (if (consp this)
 925               ;; an entry of this form `(symbol . value)'
 926               (progn
 927                 (make-local-variable (car this))
 928                 (set (car this) (cdr this)))
 929               ;; an entry of the form `symbol'
 930               (make-local-variable this)
 931               (makunbound this)))
 932           (setq desktop-buffer-locals (cdr desktop-buffer-locals)))))))
 933
 934 ;; ----------------------------------------------------------------------------
 935 ;; Backward compatibility -- update parameters to 205 standards.
 936 (defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name
 937                        desktop-buffer-major-mode
 938                        mim pt mk ro tl fc cfs cr desktop-buffer-misc)
 939   (desktop-create-buffer 205 desktop-buffer-file-name desktop-buffer-name
 940                          desktop-buffer-major-mode (cdr mim) pt mk ro
 941                          desktop-buffer-misc
 942                          (list (cons 'truncate-lines tl)
 943                                (cons 'fill-column fc)
 944                                (cons 'case-fold-search cfs)
 945                                (cons 'case-replace cr)
 946                                (cons 'overwrite-mode (car mim)))))
 947
 948 ;; ----------------------------------------------------------------------------
 949 ;; When `desktop-enable' is non-nil and "--no-desktop" is not specified on the
 950 ;; command line, we do the rest of what it takes to use desktop, but do it
 951 ;; after finishing loading the init file.
 952 ;; We cannot use `command-switch-alist' to process "--no-desktop" because these
 953 ;; functions are processed after `after-init-hook'.
 954 (add-hook
 955   'after-init-hook
 956   '(lambda ()
 957     (let ((key "--no-desktop"))
 958       (if (member key command-line-args)
 959         (delete key command-line-args)
 960         (when desktop-enable
 961           (desktop-load-default)
 962           (desktop-read))))))
 963
 964 (provide 'desktop)
 965
 966 ;;; desktop.el ends here