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
 157 (defcustom desktop-path '("." "~")
 158   "List of directories to search for the desktop file.
 159 The base name of the file is specified in `desktop-base-file-name'."
 160   :type '(repeat directory)
 161   :group 'desktop)
 162
 163 (defcustom desktop-missing-file-warning nil
 164   "*If non-nil then desktop warns when a file no longer exists.
 165 Otherwise it simply ignores that file."
 166   :type 'boolean
 167   :group 'desktop)
 168
 169 (defcustom desktop-no-desktop-file-hook nil
 170   "Normal hook run after fail of `desktop-read' due to missing desktop file.
 171 May e.g. be used to show a dired buffer."
 172   :type 'hook
 173   :group 'desktop)
 174
 175 (defcustom desktop-after-read-hook nil
 176   "Normal hook run after a sucessful `desktop-read'.
 177 May e.g. be used to show a buffer list."
 178   :type 'hook
 179   :group 'desktop)
 180
 181 (defcustom desktop-save-hook nil
 182   "Hook run before desktop saves the state of Emacs.
 183 This is useful for truncating history lists, for example."
 184   :type 'hook
 185   :group 'desktop)
 186
 187 (defcustom desktop-globals-to-save '(
 188   desktop-missing-file-warning
 189   tags-file-name
 190   tags-table-list
 191   search-ring
 192   regexp-search-ring
 193   register-alist)
 194   "List of global variables to save when killing Emacs.
 195 An element may be variable name (a symbol)
 196 or a cons cell of the form  (VAR . MAX-SIZE),
 197 which means to truncate VAR's value to at most MAX-SIZE elements
 198 \(if the value is a list) before saving the value.
 199 Feature: Saving `kill-ring' implies saving `kill-ring-yank-pointer'."
 200   :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
 201   :group 'desktop)
 202
 203 (defcustom desktop-globals-to-clear '(
 204   kill-ring
 205   kill-ring-yank-pointer
 206   search-ring
 207   search-ring-yank-pointer
 208   regexp-search-ring
 209   regexp-search-ring-yank-pointer)
 210   "List of global variables set to clear by `desktop-clear'.
 211 An element may be variable name (a symbol) or a cons cell of the form
 212 \(VAR . FORM). Symbols are set to nil and for cons cells VAR is set
 213 to the value obtained by evaluateing FORM."
 214   :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
 215   :group 'desktop)
 216
 217 (defcustom desktop-clear-preserve-buffers-regexp
 218   "^\\*tramp/.+\\*$"
 219   "Regexp identifying buffers that `desktop-clear' should not delete."
 220   :type 'regexp
 221   :group 'desktop)
 222
 223 ;; Maintained for backward compatibility
 224 (defcustom desktop-clear-preserve-buffers
 225   '("*scratch*" "*Messages*")
 226   "*List of buffer names that `desktop-clear' should not delete."
 227   :type '(repeat string)
 228   :group 'desktop)
 229
 230 (defvar desktop-locals-to-save '(
 231   desktop-locals-to-save  ; Itself!  Think it over.
 232   truncate-lines
 233   case-fold-search
 234   case-replace
 235   fill-column
 236   overwrite-mode
 237   change-log-default-name
 238   line-number-mode)
 239   "List of local variables to save for each buffer.
 240 The variables are saved only when they really are local.")
 241 (make-variable-buffer-local 'desktop-locals-to-save)
 242
 243 ;; We skip .log files because they are normally temporary.
 244 ;;         (ftp) files because they require passwords and whatnot.
 245 ;;         TAGS files to save time (tags-file-name is saved instead).
 246 (defcustom desktop-buffers-not-to-save
 247   "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
 248   "Regexp identifying buffers that are to be excluded from saving."
 249   :type 'regexp
 250   :group 'desktop)
 251
 252 ;; Skip ange-ftp files
 253 (defcustom desktop-files-not-to-save
 254   "^/[^/:]*:"
 255   "Regexp identifying files whose buffers are to be excluded from saving."
 256   :type 'regexp
 257   :group 'desktop)
 258
 259 (defcustom desktop-buffer-modes-to-save
 260   '(Info-mode rmail-mode)
 261   "If a buffer is of one of these major modes, save the buffer name.
 262 It is up to the functions in `desktop-buffer-handlers' to decide
 263 whether the buffer should be recreated or not, and how."
 264   :type '(repeat symbol)
 265   :group 'desktop)
 266
 267 (defcustom desktop-modes-not-to-save nil
 268   "List of major modes whose buffers should not be saved."
 269   :type '(repeat symbol)
 270   :group 'desktop)
 271
 272 (defcustom desktop-file-name-format 'absolute
 273   "*Format in which desktop file names should be saved.
 274 Possible values are:
 275    absolute -- Absolute file name.
 276    tilde    -- Relative to ~.
 277    local    -- Relative to directory of desktop file."
 278   :type '(choice (const absolute) (const tilde) (const local))
 279   :group 'desktop)
 280
 281 (defcustom desktop-buffer-misc-functions
 282   '(desktop-buffer-info-misc-data
 283     desktop-buffer-dired-misc-data)
 284   "*Functions used to determine auxiliary information for a buffer.
 285 These functions are called in order, with no arguments.  If a function
 286 returns non-nil, its value is saved along with the desktop buffer for
 287 which it was called; no further functions will be called.
 288
 289 File names should formatted using the call
 290 \"(desktop-file-name FILE-NAME dirname)\".
 291
 292 Later, when desktop.el restores the buffers it has saved, each of the
 293 `desktop-buffer-handlers' functions will have access to a buffer local
 294 variable, named `desktop-buffer-misc', whose value is what the
 295 \"misc\" function returned previously."
 296   :type '(repeat function)
 297   :group 'desktop)
 298
 299 (defcustom desktop-buffer-handlers
 300   '(desktop-buffer-dired
 301     desktop-buffer-rmail
 302     desktop-buffer-mh
 303     desktop-buffer-info
 304     desktop-buffer-file)
 305   "*List of functions to call in order to create a buffer.
 306 The functions are called without explicit parameters but can use the
 307 following variables:
 308
 309    desktop-file-version
 310    desktop-buffer-file-name
 311    desktop-buffer-name
 312    desktop-buffer-major-mode
 313    desktop-buffer-minor-modes
 314    desktop-buffer-point
 315    desktop-buffer-mark
 316    desktop-buffer-read-only
 317    desktop-buffer-misc
 318    desktop-buffer-locals
 319
 320 If one function returns non-nil, no further functions are called.
 321 If the function returns a buffer, then the saved mode settings
 322 and variable values for that buffer are copied into it."
 323   :type '(repeat function)
 324   :group 'desktop)
 325
 326 (put 'desktop-buffer-handlers 'risky-local-variable t)
 327
 328 (defcustom desktop-minor-mode-table
 329   '((auto-fill-function auto-fill-mode)
 330     (vc-mode nil))
 331   "Table mapping minor mode variables to minor mode functions.
 332 Each entry has the form (NAME RESTORE-FUNCTION).
 333 NAME is the name of the buffer-local variable indicating that the minor
 334 mode is active.  RESTORE-FUNCTION is the function to activate the minor mode.
 335 called.  RESTORE-FUNCTION nil means don't try to restore the minor mode.
 336 Only minor modes for which the name of the buffer-local variable
 337 and the name of the minor mode function are different have to added to
 338 this table."
 339   :type 'sexp
 340   :group 'desktop)
 341
 342 ;; ----------------------------------------------------------------------------
 343 (defvar desktop-dirname nil
 344   "The directory in which the current desktop file resides.")
 345
 346 (defconst desktop-header
 347 ";; --------------------------------------------------------------------------
 348 ;; Desktop File for Emacs
 349 ;; --------------------------------------------------------------------------
 350 " "*Header to place in Desktop file.")
 351
 352 (defvar desktop-delay-hook nil
 353   "Hooks run after all buffers are loaded; intended for internal use.")
 354
 355 ;; ----------------------------------------------------------------------------
 356 (defun desktop-truncate (l n)
 357   "Truncate LIST to at most N elements destructively."
 358   (let ((here (nthcdr (1- n) l)))
 359     (if (consp here)
 360         (setcdr here nil))))
 361
 362 ;; ----------------------------------------------------------------------------
 363 (defun desktop-clear ()
 364   "Empty the Desktop.
 365 This kills all buffers except for internal ones and those listed
 366 in `desktop-clear-preserve-buffers'.  Furthermore, it clears the
 367 variables listed in `desktop-globals-to-clear'."
 368   (interactive)
 369   (dolist (var desktop-globals-to-clear)
 370     (if (symbolp var)
 371       (eval `(setq-default ,var nil))
 372       (eval `(setq-default ,(car var) ,(cdr var)))))
 373   (let ((buffers (buffer-list)))
 374     (while buffers
 375       (let ((bufname (buffer-name (car buffers))))
 376          (or
 377            (null bufname)
 378            (string-match desktop-clear-preserve-buffers-regexp bufname)
 379            (member bufname desktop-clear-preserve-buffers)
 380            ;; Don't kill buffers made for internal purposes.
 381            (and (not (equal bufname "")) (eq (aref bufname 0) ?\ ))
 382            (kill-buffer (car buffers))))
 383       (setq buffers (cdr buffers))))
 384   (delete-other-windows))
 385
 386 ;; ----------------------------------------------------------------------------
 387 (add-hook 'kill-emacs-hook 'desktop-kill)
 388
 389 (defun desktop-kill ()
 390   "If `desktop-enable' is non-nil, do what `desktop-save' says to do.
 391 If the desktop should be saved and `desktop-dirname'
 392 is nil, ask the user where to save the desktop."
 393   (when
 394     (and
 395       desktop-enable
 396       (let ((exists (file-exists-p (concat desktop-dirname desktop-base-file-name))))
 397         (or
 398           (eq desktop-save 't)
 399           (and exists (memq desktop-save '(ask-if-new if-exists)))
 400           (and
 401             (or
 402               (memq desktop-save '(ask ask-if-new))
 403               (and exists (eq desktop-save 'ask-if-exists)))
 404             (y-or-n-p "Save desktop? ")))))
 405     (unless desktop-dirname
 406       (setq desktop-dirname
 407         (expand-file-name
 408           (call-interactively
 409             (lambda (dir) (interactive "DDirectory for desktop file: ") dir)))))
 410     (condition-case err
 411       (desktop-save desktop-dirname)
 412       (file-error
 413         (unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
 414           (signal (car err) (cdr err)))))))
 415
 416 ;; ----------------------------------------------------------------------------
 417 (defun desktop-list* (&rest args)
 418   (if (null (cdr args))
 419       (car args)
 420     (setq args (nreverse args))
 421     (let ((value (cons (nth 1 args) (car args))))
 422       (setq args (cdr (cdr args)))
 423       (while args
 424         (setq value (cons (car args) value))
 425         (setq args (cdr args)))
 426       value)))
 427
 428 ;; ----------------------------------------------------------------------------
 429 (defun desktop-internal-v2s (val)
 430   "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
 431 TXT is a string that when read and evaluated yields value.
 432 QUOTE may be `may' (value may be quoted),
 433 `must' (values must be quoted), or nil (value may not be quoted)."
 434   (cond
 435    ((or (numberp val) (null val) (eq t val))
 436     (cons 'may (prin1-to-string val)))
 437    ((stringp val)
 438     (let ((copy (copy-sequence val)))
 439       (set-text-properties 0 (length copy) nil copy)
 440       ;; Get rid of text properties because we cannot read them
 441       (cons 'may (prin1-to-string copy))))
 442    ((symbolp val)
 443     (cons 'must (prin1-to-string val)))
 444    ((vectorp val)
 445     (let* ((special nil)
 446            (pass1 (mapcar
 447                    (lambda (el)
 448                      (let ((res (desktop-internal-v2s el)))
 449                        (if (null (car res))
 450                            (setq special t))
 451                        res))
 452                    val)))
 453       (if special
 454           (cons nil (concat "(vector "
 455                             (mapconcat (lambda (el)
 456                                          (if (eq (car el) 'must)
 457                                              (concat "'" (cdr el))
 458                                            (cdr el)))
 459                                        pass1
 460                                        " ")
 461                             ")"))
 462         (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
 463    ((consp val)
 464     (let ((p val)
 465           newlist
 466           use-list*
 467           anynil)
 468       (while (consp p)
 469         (let ((q.txt (desktop-internal-v2s (car p))))
 470           (or anynil (setq anynil (null (car q.txt))))
 471           (setq newlist (cons q.txt newlist)))
 472         (setq p (cdr p)))
 473       (if p
 474           (let ((last (desktop-internal-v2s p))
 475                 (el (car newlist)))
 476             (or anynil (setq anynil (null (car last))))
 477             (or anynil
 478                 (setq newlist (cons '(must . ".") newlist)))
 479             (setq use-list* t)
 480             (setq newlist (cons last newlist))))
 481       (setq newlist (nreverse newlist))
 482       (if anynil
 483           (cons nil
 484                 (concat (if use-list* "(desktop-list* "  "(list ")
 485                         (mapconcat (lambda (el)
 486                                      (if (eq (car el) 'must)
 487                                          (concat "'" (cdr el))
 488                                        (cdr el)))
 489                                    newlist
 490                                    " ")
 491                         ")"))
 492         (cons 'must
 493               (concat "(" (mapconcat 'cdr newlist " ") ")")))))
 494    ((subrp val)
 495     (cons nil (concat "(symbol-function '"
 496                       (substring (prin1-to-string val) 7 -1)
 497                       ")")))
 498    ((markerp val)
 499     (let ((pos (prin1-to-string (marker-position val)))
 500           (buf (prin1-to-string (buffer-name (marker-buffer val)))))
 501       (cons nil (concat "(let ((mk (make-marker)))"
 502                         " (add-hook 'desktop-delay-hook"
 503                         " (list 'lambda '() (list 'set-marker mk "
 504                         pos " (get-buffer " buf ")))) mk)"))))
 505    (t                                   ; save as text
 506     (cons 'may "\"Unprintable entity\""))))
 507
 508 ;; ----------------------------------------------------------------------------
 509 (defun desktop-value-to-string (val)
 510   "Convert VALUE to a string that when read evaluates to the same value.
 511 Not all types of values are supported."
 512   (let* ((print-escape-newlines t)
 513          (float-output-format nil)
 514          (quote.txt (desktop-internal-v2s val))
 515          (quote (car quote.txt))
 516          (txt (cdr quote.txt)))
 517     (if (eq quote 'must)
 518         (concat "'" txt)
 519       txt)))
 520
 521 ;; ----------------------------------------------------------------------------
 522 (defun desktop-outvar (varspec)
 523   "Output a setq statement for variable VAR to the desktop file.
 524 The argument VARSPEC may be the variable name VAR (a symbol),
 525 or a cons cell of the form  (VAR . MAX-SIZE),
 526 which means to truncate VAR's value to at most MAX-SIZE elements
 527 \(if the value is a list) before saving the value."
 528   (let (var size)
 529     (if (consp varspec)
 530         (setq var (car varspec) size (cdr varspec))
 531       (setq var varspec))
 532     (if (boundp var)
 533         (progn
 534           (if (and (integerp size)
 535                    (> size 0)
 536                    (listp (eval var)))
 537               (desktop-truncate (eval var) size))
 538           (insert "(setq "
 539                   (symbol-name var)
 540                   " "
 541                   (desktop-value-to-string (symbol-value var))
 542                   ")\n")))))
 543
 544 ;; ----------------------------------------------------------------------------
 545 (defun desktop-save-buffer-p (filename bufname mode &rest dummy)
 546   "Return t if the desktop should record a particular buffer for next startup.
 547 FILENAME is the visited file name, BUFNAME is the buffer name, and
 548 MODE is the major mode."
 549   (let ((case-fold-search nil))
 550     (and (not (string-match desktop-buffers-not-to-save bufname))
 551          (not (memq mode desktop-modes-not-to-save))
 552          (or (and filename
 553                   (not (string-match desktop-files-not-to-save filename)))
 554              (and (eq mode 'dired-mode)
 555                   (save-excursion
 556                     (set-buffer (get-buffer bufname))
 557                     (not (string-match desktop-files-not-to-save
 558                                        default-directory))))
 559              (and (null filename)
 560                   (memq mode desktop-buffer-modes-to-save))))))
 561
 562 ;; ----------------------------------------------------------------------------
 563 (defun desktop-file-name (filename dirname)
 564   "Convert FILENAME to format specified in `desktop-file-name-format'.
 565 DIRNAME must be the directory in which the desktop file will be saved."
 566   (cond
 567     ((not filename) nil)
 568     ((eq desktop-file-name-format 'tilde)
 569      (let ((relative-name (file-relative-name (expand-file-name filename) "~")))
 570        (cond
 571          ((file-name-absolute-p relative-name) relative-name)
 572          ((string= "./" relative-name) "~/")
 573          ((string= "." relative-name) "~")
 574          (t (concat "~/" relative-name)))))
 575     ((eq desktop-file-name-format 'local) (file-relative-name filename dirname))
 576     (t (expand-file-name filename))))
 577
 578 ;; ----------------------------------------------------------------------------
 579 (defun desktop-save (dirname)
 580   "Save the Desktop file. Parameter DIRNAME specifies where to save desktop."
 581   (interactive "DDirectory to save desktop file in: ")
 582   (run-hooks 'desktop-save-hook)
 583   (save-excursion
 584     (let ((filename (expand-file-name desktop-base-file-name dirname))
 585       (info
 586         (mapcar
 587           (function
 588             (lambda (b)
 589               (set-buffer b)
 590               (list
 591                 (desktop-file-name (buffer-file-name) dirname)
 592                 (buffer-name)
 593                 major-mode
 594                 ;; minor modes
 595                 (let (ret)
 596                   (mapcar
 597                     #'(lambda (mim)
 598                       (and
 599                         (boundp mim)
 600                         (symbol-value mim)
 601                         (setq
 602                           ret
 603                           (cons
 604                             (let (
 605                               (special (assq mim desktop-minor-mode-table))
 606                             )
 607                               (if special (cadr special) mim))
 608                             ret))))
 609                     (mapcar #'car minor-mode-alist))
 610                   ret)
 611                 (point)
 612                 (list (mark t) mark-active)
 613                 buffer-read-only
 614                 (run-hook-with-args-until-success 'desktop-buffer-misc-functions)
 615                 (let (
 616                   (locals desktop-locals-to-save)
 617                   (loclist (buffer-local-variables))
 618                   (ll)
 619                 )
 620                   (while locals
 621                     (let ((here (assq (car locals) loclist)))
 622                       (if here
 623                         (setq ll (cons here ll))
 624                         (when (member (car locals) loclist)
 625                           (setq ll (cons (car locals) ll)))))
 626                     (setq locals (cdr locals)))
 627                   ll))))
 628           (buffer-list)))
 629       (buf (get-buffer-create "*desktop*")))
 630       (set-buffer buf)
 631       (erase-buffer)
 632
 633       (insert
 634         ";; -*- coding: emacs-mule; -*-\n"
 635         desktop-header
 636         ";; Created " (current-time-string) "\n"
 637         ";; Desktop file format version " desktop-file-version "\n"
 638         ";; Emacs version " emacs-version "\n\n"
 639         ";; Global section:\n")
 640       (mapcar (function desktop-outvar) desktop-globals-to-save)
 641       (if (memq 'kill-ring desktop-globals-to-save)
 642         (insert
 643           "(setq kill-ring-yank-pointer (nthcdr "
 644           (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
 645           " kill-ring))\n"))
 646
 647       (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
 648       (mapcar
 649         (function
 650           (lambda (l)
 651             (if (apply 'desktop-save-buffer-p l)
 652               (progn
 653                 (insert "(desktop-create-buffer " desktop-file-version)
 654                 (mapcar
 655                   (function
 656                     (lambda (e)
 657                       (insert "\n  " (desktop-value-to-string e))))
 658                   l)
 659                 (insert ")\n\n")))))
 660         info)
 661       (setq default-directory dirname)
 662       (when (file-exists-p filename) (delete-file filename))
 663       (let ((coding-system-for-write 'emacs-mule))
 664         (write-region (point-min) (point-max) filename nil 'nomessage))))
 665   (setq desktop-dirname dirname))
 666
 667 ;; ----------------------------------------------------------------------------
 668 (defun desktop-remove ()
 669   "Delete the Desktop file and inactivate the desktop system."
 670   (interactive)
 671   (if desktop-dirname
 672       (let ((filename (concat desktop-dirname desktop-base-file-name)))
 673         (setq desktop-dirname nil)
 674         (if (file-exists-p filename)
 675             (delete-file filename)))))
 676
 677 ;; ----------------------------------------------------------------------------
 678 ;;;###autoload
 679 (defun desktop-read ()
 680   "Read the Desktop file and the files it specifies.
 681 This is a no-op when Emacs is running in batch mode.
 682 Look for the desktop file according to the variables `desktop-base-file-name'
 683 and `desktop-path'.  If no desktop file is found, clear the desktop.
 684 Returns t if it has read a desktop file, nil otherwise."
 685   (interactive)
 686   (unless noninteractive
 687     (let ((dirs desktop-path))
 688       (while
 689         (and
 690           dirs
 691           (not
 692             (file-exists-p (expand-file-name desktop-base-file-name (car dirs)))))
 693         (setq dirs (cdr dirs)))
 694       (setq desktop-dirname (and dirs (expand-file-name (car dirs))))
 695       (if desktop-dirname
 696         (let ((desktop-first-buffer nil))
 697           ;; `desktop-create-buffer' sets `desktop-first-buffer' to the first
 698           ;; buffer in the desktop file (the last for desktop files written
 699           ;; by desktop version prior to 206).
 700           (load (expand-file-name desktop-base-file-name desktop-dirname) t t t)
 701           (when desktop-first-buffer (switch-to-buffer desktop-first-buffer))
 702           (run-hooks 'desktop-delay-hook)
 703           (setq desktop-delay-hook nil)
 704           (run-hooks 'desktop-after-read-hook)
 705           (message "Desktop loaded.")
 706           t)
 707         (desktop-clear)
 708         (run-hooks 'desktop-no-desktop-file-hook)
 709         (message "No desktop file.")
 710         nil))))
 711
 712 ;; ----------------------------------------------------------------------------
 713 ;;;###autoload
 714 (defun desktop-load-default ()
 715   "Load the `default' start-up library manually.
 716 Also inhibit further loading of it.  Call this from your `.emacs' file
 717 to provide correct modes for autoloaded files."
 718   (if (not inhibit-default-init)        ; safety check
 719       (progn
 720         (load "default" t t)
 721         (setq inhibit-default-init t))))
 722
 723 ;; ----------------------------------------------------------------------------
 724 ;;;###autoload
 725 (defun desktop-change-dir (dir)
 726   "Save and clear the desktop, then load the desktop from directory DIR.
 727 However, if `desktop-enable' was nil at call, don't save the old desktop.
 728 This function always sets `desktop-enable' to t."
 729   (interactive "DNew directory: ")
 730   (desktop-kill)
 731   (desktop-clear)
 732   (cd dir)
 733   (setq desktop-enable t)
 734   (let ((desktop-path '(".")))
 735     (desktop-read)
 736     ;; Set `desktop-dirname' even in no desktop file was found
 737     (setq desktop-dirname (expand-file-name dir))))
 738
 739 ;; ----------------------------------------------------------------------------
 740 ;;;###autoload
 741 (defun desktop-save-in-load-dir ()
 742   "Save desktop in directory from which it was loaded."
 743   (interactive)
 744   (if desktop-dirname
 745     (desktop-save desktop-dirname)
 746     (call-interactively 'desktop-save))
 747   (message "Desktop saved in %s" desktop-dirname))
 748
 749 ;; ----------------------------------------------------------------------------
 750 ;;;###autoload
 751 (defun desktop-revert ()
 752   "Revert to the last loaded desktop."
 753   (interactive)
 754   (unless desktop-dirname (error "No desktop has been loaded"))
 755   (setq desktop-enable nil)
 756   (desktop-change-dir desktop-dirname))
 757
 758 ;; ----------------------------------------------------------------------------
 759 ;; Note: the following functions use the dynamic variable binding in Lisp.
 760 ;;
 761
 762 (eval-when-compile ; Just to silence the byte compiler
 763   (defvar desktop-file-version)
 764   (defvar desktop-buffer-file-name)
 765   (defvar desktop-buffer-name)
 766   (defvar desktop-buffer-major-mode)
 767   (defvar desktop-buffer-minor-modes)
 768   (defvar desktop-buffer-point)
 769   (defvar desktop-buffer-mark)
 770   (defvar desktop-buffer-read-only)
 771   (defvar desktop-buffer-misc)
 772   (defvar desktop-buffer-locals)
 773 )
 774
 775 (defun desktop-buffer-info-misc-data ()
 776   (if (eq major-mode 'Info-mode)
 777       (list Info-current-file
 778             Info-current-node)))
 779
 780 ;; ----------------------------------------------------------------------------
 781 (defun desktop-buffer-dired-misc-data ()
 782   (when (eq major-mode 'dired-mode)
 783     (eval-when-compile (defvar dirname))
 784     (cons
 785       ;; dired directory in portable form
 786       (file-name-as-directory (desktop-file-name dired-directory dirname))
 787       (cdr (nreverse (mapcar (function car) dired-subdir-alist))))))
 788
 789 ;; ----------------------------------------------------------------------------
 790 (defun desktop-buffer-info () "Load an info file."
 791   (if (eq 'Info-mode desktop-buffer-major-mode)
 792       (progn
 793         (let ((first (nth 0 desktop-buffer-misc))
 794               (second (nth 1 desktop-buffer-misc)))
 795         (when (and first second)
 796           (require 'info)
 797           (Info-find-node first second)
 798           (current-buffer))))))
 799
 800 ;; ----------------------------------------------------------------------------
 801 (eval-when-compile (defvar rmail-buffer)) ; Just to silence the byte compiler.
 802 (defun desktop-buffer-rmail () "Load an RMAIL file."
 803   (if (eq 'rmail-mode desktop-buffer-major-mode)
 804       (condition-case error
 805           (progn (rmail-input desktop-buffer-file-name)
 806                          (if (eq major-mode 'rmail-mode)
 807                              (current-buffer)
 808                            rmail-buffer))
 809         (file-locked
 810          (kill-buffer (current-buffer))
 811          'ignored))))
 812
 813 ;; ----------------------------------------------------------------------------
 814 (defun desktop-buffer-mh () "Load a folder in the mh system."
 815   (if (eq 'mh-folder-mode desktop-buffer-major-mode)
 816       (progn
 817         (eval-and-compile (require 'mh-e))
 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 () "Load a file."
 836   (if desktop-buffer-file-name
 837       (if (or (file-exists-p desktop-buffer-file-name)
 838               (and desktop-missing-file-warning
 839                    (y-or-n-p (format
 840                               "File \"%s\" no longer exists. Re-create? "
 841                               desktop-buffer-file-name))))
 842           (let ((buf (find-file-noselect desktop-buffer-file-name)))
 843             (condition-case nil
 844                 (switch-to-buffer buf)
 845               (error (pop-to-buffer buf)))
 846             buf)
 847         'ignored)))
 848
 849 ;; ----------------------------------------------------------------------------
 850 ;; Create a buffer, load its file, set is mode, ...;  called from Desktop file
 851 ;; only.
 852
 853 (eval-when-compile ; Just to silence the byte compiler
 854    (defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read'
 855 )
 856
 857 (defun desktop-create-buffer (
 858   desktop-file-version
 859   desktop-buffer-file-name
 860   desktop-buffer-name
 861   desktop-buffer-major-mode
 862   desktop-buffer-minor-modes
 863   desktop-buffer-point
 864   desktop-buffer-mark
 865   desktop-buffer-read-only
 866   desktop-buffer-misc
 867   &optional
 868   desktop-buffer-locals)
 869   ;; To make desktop files with relative file names possible, we cannot
 870   ;; allow `default-directory' to change. Therefore we save current buffer.
 871   (save-current-buffer
 872     (let (
 873       (buffer-list (buffer-list))
 874       (hlist desktop-buffer-handlers)
 875       (result)
 876       (handler)
 877     )
 878       ;; Call desktop-buffer-handlers to create buffer.
 879       (while (and (not result) hlist)
 880         (setq handler (car hlist))
 881         (setq result (funcall handler))
 882         (setq hlist (cdr hlist)))
 883       (unless (bufferp result) (setq result nil))
 884       (unless (< desktop-file-version 206)
 885         (when result (setq buffer-list (cons result buffer-list)))
 886         (mapcar 'bury-buffer buffer-list))
 887       (when result
 888         (if (< desktop-file-version 206)
 889           (setq desktop-first-buffer result)
 890           (bury-buffer result))
 891         (unless desktop-first-buffer (setq desktop-first-buffer result))
 892         (set-buffer result)
 893         (unless (equal (buffer-name) desktop-buffer-name)
 894           (rename-buffer desktop-buffer-name))
 895         ;; minor modes
 896         (cond (
 897           ;; backwards compatible
 898           (equal '(t) desktop-buffer-minor-modes)
 899           (auto-fill-mode 1))(
 900           (equal '(nil) desktop-buffer-minor-modes)
 901           (auto-fill-mode 0))(
 902           t
 903           (mapcar
 904             #'(lambda (minor-mode)
 905               (when (functionp minor-mode) (funcall minor-mode 1)))
 906             desktop-buffer-minor-modes)))
 907         ;; Even though point and mark are non-nil when written by `desktop-save'
 908         ;; they may be modified by mandlers wanting to set point or mark themselves.
 909         (when desktop-buffer-point (goto-char desktop-buffer-point))
 910         (when desktop-buffer-mark
 911           (if (consp desktop-buffer-mark)
 912             (progn
 913               (set-mark (car desktop-buffer-mark))
 914               (setq mark-active (car (cdr desktop-buffer-mark))))
 915             (set-mark desktop-buffer-mark)))
 916         ;; Never override file system if the file really is read-only marked.
 917         (if desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
 918         (while desktop-buffer-locals
 919           (let ((this (car desktop-buffer-locals)))
 920             (if (consp this)
 921               ;; an entry of this form `(symbol . value)'
 922               (progn
 923                 (make-local-variable (car this))
 924                 (set (car this) (cdr this)))
 925               ;; an entry of the form `symbol'
 926               (make-local-variable this)
 927               (makunbound this)))
 928           (setq desktop-buffer-locals (cdr desktop-buffer-locals)))))))
 929
 930 ;; ----------------------------------------------------------------------------
 931 ;; Backward compatibility -- update parameters to 205 standards.
 932 (defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name
 933                        desktop-buffer-major-mode
 934                        mim pt mk ro tl fc cfs cr desktop-buffer-misc)
 935   (desktop-create-buffer 205 desktop-buffer-file-name desktop-buffer-name
 936                          desktop-buffer-major-mode (cdr mim) pt mk ro
 937                          desktop-buffer-misc
 938                          (list (cons 'truncate-lines tl)
 939                                (cons 'fill-column fc)
 940                                (cons 'case-fold-search cfs)
 941                                (cons 'case-replace cr)
 942                                (cons 'overwrite-mode (car mim)))))
 943
 944 ;; ----------------------------------------------------------------------------
 945 ;; When `desktop-enable' is non-nil and "--no-desktop" is not specified on the
 946 ;; command line, we do the rest of what it takes to use desktop, but do it
 947 ;; after finishing loading the init file.
 948 ;; We cannot use `command-switch-alist' to process "--no-desktop" because these
 949 ;; functions are processed after `after-init-hook'.
 950 (add-hook
 951   'after-init-hook
 952   '(lambda ()
 953     (let ((key "--no-desktop"))
 954       (if (member key command-line-args)
 955         (delete key command-line-args)
 956         (when desktop-enable
 957           (desktop-load-default)
 958           (desktop-read))))))
 959
 960 (provide 'desktop)
 961
 962 ;;; desktop.el ends here