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