code.delx.au - gnu-emacs/blob - lisp/desktop.el

   1 ;;; desktop.el --- save partial status of Emacs when killed
   2
   3 ;; Copyright (C) 1993, 1994, 1995, 1997, 2000, 2001, 2005
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Morten Welinder <terra@diku.dk>
   7 ;; Maintainter: Lars Hansen <larsh@soem.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., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, 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 (defvar desktop-file-version "206"
  87   "Version number of desktop file format.
  88 Written into the desktop file and used at desktop read to provide
  89 backward compatibility.")
  90
  91 ;; ----------------------------------------------------------------------------
  92 ;; USER OPTIONS -- settings you might want to play with.
  93 ;; ----------------------------------------------------------------------------
  94
  95 (defgroup desktop nil
  96   "Save status of Emacs when you exit."
  97   :group 'frames)
  98
  99 ;;;###autoload
 100 (define-minor-mode desktop-save-mode
 101   "Toggle desktop saving mode.
 102 With numeric ARG, turn desktop saving on if ARG is positive, off
 103 otherwise.  See variable `desktop-save' for a description of when the
 104 desktop is saved."
 105   :global t
 106   :group 'desktop)
 107
 108 ;; Maintained for backward compatibility
 109 (define-obsolete-variable-alias 'desktop-enable 'desktop-save-mode "22.1")
 110
 111 (defcustom desktop-save 'ask-if-new
 112   "*Specifies whether the desktop should be saved when it is killed.
 113 A desktop is killed when the user changes desktop or quits Emacs.
 114 Possible values are:
 115    t             -- always save.
 116    ask           -- always ask.
 117    ask-if-new    -- ask if no desktop file exists, otherwise just save.
 118    ask-if-exists -- ask if desktop file exists, otherwise don't save.
 119    if-exists     -- save if desktop file exists, otherwise don't save.
 120    nil           -- never save.
 121 The desktop is never saved when `desktop-save-mode' is nil.
 122 The variables `desktop-dirname' and `desktop-base-file-name'
 123 determine where the desktop is saved."
 124   :type '(choice
 125     (const :tag "Always save" t)
 126     (const :tag "Always ask" ask)
 127     (const :tag "Ask if desktop file is new, else do save" ask-if-new)
 128     (const :tag "Ask if desktop file exists, else don't save" ask-if-exists)
 129     (const :tag "Save if desktop file exists, else don't" if-exists)
 130     (const :tag "Never save" nil))
 131   :group 'desktop
 132   :version "22.1")
 133
 134 (defcustom desktop-base-file-name
 135   (convert-standard-filename ".emacs.desktop")
 136   "Name of file for Emacs desktop, excluding the directory part."
 137   :type 'file
 138   :group 'desktop)
 139 (define-obsolete-variable-alias 'desktop-basefilename 'desktop-base-file-name "22.1")
 140
 141 (defcustom desktop-path '("." "~")
 142   "List of directories to search for the desktop file.
 143 The base name of the file is specified in `desktop-base-file-name'."
 144   :type '(repeat directory)
 145   :group 'desktop
 146   :version "22.1")
 147
 148 (defcustom desktop-missing-file-warning nil
 149   "*If non-nil then `desktop-read' asks if a non-existent file should be recreated.
 150 Also pause for a moment to display message about errors signaled in
 151 `desktop-buffer-mode-handlers'.
 152
 153 If nil, just print error messages in the message buffer."
 154   :type 'boolean
 155   :group 'desktop
 156   :version "22.1")
 157
 158 (defcustom desktop-no-desktop-file-hook nil
 159   "Normal hook run when `desktop-read' can't find a desktop file.
 160 May be used to show a dired buffer."
 161   :type 'hook
 162   :group 'desktop
 163   :version "22.1")
 164
 165 (defcustom desktop-after-read-hook nil
 166   "Normal hook run after a successful `desktop-read'.
 167 May be used to show a buffer list."
 168   :type 'hook
 169   :group 'desktop
 170   :version "22.1")
 171
 172 (defcustom desktop-save-hook nil
 173   "Normal hook run before the desktop is saved in a desktop file.
 174 This is useful for truncating history lists, for example."
 175   :type 'hook
 176   :group 'desktop)
 177
 178 (defcustom desktop-globals-to-save
 179   '(desktop-missing-file-warning
 180     tags-file-name
 181     tags-table-list
 182     search-ring
 183     regexp-search-ring
 184     register-alist)
 185   "List of global variables saved by `desktop-save'.
 186 An element may be variable name (a symbol) or a cons cell of the form
 187 \(VAR . MAX-SIZE), which means to truncate VAR's value to at most
 188 MAX-SIZE elements (if the value is a list) before saving the value.
 189 Feature: Saving `kill-ring' implies saving `kill-ring-yank-pointer'."
 190   :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
 191   :group 'desktop)
 192
 193 (defcustom desktop-globals-to-clear
 194   '(kill-ring
 195     kill-ring-yank-pointer
 196     search-ring
 197     search-ring-yank-pointer
 198     regexp-search-ring
 199     regexp-search-ring-yank-pointer)
 200   "List of global variables that `desktop-clear' will clear.
 201 An element may be variable name (a symbol) or a cons cell of the form
 202 \(VAR . FORM).  Symbols are set to nil and for cons cells VAR is set
 203 to the value obtained by evaluating FORM."
 204   :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
 205   :group 'desktop
 206   :version "22.1")
 207
 208 (defcustom desktop-clear-preserve-buffers-regexp
 209   "^\\(\\*scratch\\*\\|\\*Messages\\*\\|\\*tramp/.+\\*\\)$"
 210   "Regexp identifying buffers that `desktop-clear' should not delete.
 211 See also `desktop-clear-preserve-buffers'."
 212   :type 'regexp
 213   :group 'desktop
 214   :version "22.1")
 215
 216 (defcustom desktop-clear-preserve-buffers nil
 217   "*List of buffer names that `desktop-clear' should not delete.
 218 See also `desktop-clear-preserve-buffers-regexp'."
 219   :type '(repeat string)
 220   :group 'desktop)
 221
 222 (defcustom desktop-locals-to-save
 223   '(desktop-locals-to-save  ; Itself!  Think it over.
 224     truncate-lines
 225     case-fold-search
 226     case-replace
 227     fill-column
 228     overwrite-mode
 229     change-log-default-name
 230     line-number-mode
 231     buffer-file-coding-system)
 232   "List of local variables to save for each buffer.
 233 The variables are saved only when they really are local."
 234   :type '(repeat symbol)
 235   :group 'desktop)
 236 (make-variable-buffer-local 'desktop-locals-to-save)
 237
 238 ;; We skip .log files because they are normally temporary.
 239 ;;         (ftp) files because they require passwords and whatnot.
 240 ;;         TAGS files to save time (tags-file-name is saved instead).
 241 (defcustom desktop-buffers-not-to-save
 242   "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
 243   "Regexp identifying buffers that are to be excluded from saving."
 244   :type 'regexp
 245   :group 'desktop)
 246
 247 ;; Skip tramp and ange-ftp files
 248 (defcustom desktop-files-not-to-save
 249   "^/[^/:]*:"
 250   "Regexp identifying files whose buffers are to be excluded from saving."
 251   :type 'regexp
 252   :group 'desktop)
 253
 254 (defcustom desktop-modes-not-to-save nil
 255   "List of major modes whose buffers should not be saved."
 256   :type '(repeat symbol)
 257   :group 'desktop)
 258
 259 (defcustom desktop-file-name-format 'absolute
 260   "*Format in which desktop file names should be saved.
 261 Possible values are:
 262    absolute -- Absolute file name.
 263    tilde    -- Relative to ~.
 264    local    -- Relative to directory of desktop file."
 265   :type '(choice (const absolute) (const tilde) (const local))
 266   :group 'desktop
 267   :version "22.1")
 268
 269 (defcustom desktop-restore-eager t
 270   "Number of buffers to restore immediately.
 271 Remaining buffers are restored lazily (when Emacs is idle).
 272 If value is t, all buffers are restored immediately."
 273   :type '(choice (const t) integer)
 274   :group 'desktop
 275   :version "22.1")
 276
 277 (defcustom desktop-lazy-verbose t
 278   "Verbose reporting of lazily created buffers."
 279   :type 'boolean
 280   :group 'desktop
 281   :version "22.1")
 282
 283 (defcustom desktop-lazy-idle-delay 5
 284   "Idle delay before starting to create buffers.
 285 See `desktop-restore-eager'."
 286   :type 'integer
 287   :group 'desktop
 288   :version "22.1")
 289
 290 ;;;###autoload
 291 (defvar desktop-save-buffer nil
 292   "When non-nil, save buffer status in desktop file.
 293 This variable becomes buffer local when set.
 294
 295 If the value is a function, it called by `desktop-save' with argument
 296 DESKTOP-DIRNAME to obtain auxiliary information to saved in the desktop
 297 file along with the state of the buffer for which it was called.
 298
 299 When file names are returned, they should be formatted using the call
 300 \"(desktop-file-name FILE-NAME DESKTOP-DIRNAME)\".
 301
 302 Later, when `desktop-read' calls a function in `desktop-buffer-mode-handlers'
 303 to restore the buffer, the auxiliary information is passed as the argument
 304 DESKTOP-BUFFER-MISC.")
 305 (make-variable-buffer-local 'desktop-save-buffer)
 306 (make-obsolete-variable 'desktop-buffer-modes-to-save
 307                         'desktop-save-buffer "22.1")
 308 (make-obsolete-variable 'desktop-buffer-misc-functions
 309                         'desktop-save-buffer "22.1")
 310
 311 (defcustom desktop-buffer-mode-handlers
 312   '((dired-mode . dired-restore-desktop-buffer)
 313     (rmail-mode . rmail-restore-desktop-buffer)
 314     (mh-folder-mode . mh-restore-desktop-buffer)
 315     (Info-mode . Info-restore-desktop-buffer))
 316   "Alist of major mode specific functions to restore a desktop buffer.
 317 Functions are called by `desktop-read'.  List elements must have the form
 318 \(MAJOR-MODE . RESTORE-BUFFER-FUNCTION).
 319
 320 Buffers with a major mode not specified here, are restored by the default
 321 handler `desktop-restore-file-buffer'.
 322
 323 Handlers are called with argument list
 324
 325    (DESKTOP-BUFFER-FILE-NAME DESKTOP-BUFFER-NAME DESKTOP-BUFFER-MISC)
 326
 327 Furthermore, they may use the following variables:
 328
 329    desktop-file-version
 330    desktop-buffer-major-mode
 331    desktop-buffer-minor-modes
 332    desktop-buffer-point
 333    desktop-buffer-mark
 334    desktop-buffer-read-only
 335    desktop-buffer-locals
 336
 337 If a handler returns a buffer, then the saved mode settings
 338 and variable values for that buffer are copied into it."
 339   :type 'alist
 340   :group 'desktop)
 341
 342 (put 'desktop-buffer-mode-handlers 'risky-local-variable t)
 343 (make-obsolete-variable 'desktop-buffer-handlers
 344                         'desktop-buffer-mode-handlers "22.1")
 345
 346 (defcustom desktop-minor-mode-table
 347   '((auto-fill-function auto-fill-mode)
 348     (vc-mode nil))
 349   "Table mapping minor mode variables to minor mode functions.
 350 Each entry has the form (NAME RESTORE-FUNCTION).
 351 NAME is the name of the buffer-local variable indicating that the minor
 352 mode is active.  RESTORE-FUNCTION is the function to activate the minor mode.
 353 called.  RESTORE-FUNCTION nil means don't try to restore the minor mode.
 354 Only minor modes for which the name of the buffer-local variable
 355 and the name of the minor mode function are different have to be added to
 356 this table."
 357   :type 'sexp
 358   :group 'desktop)
 359
 360 ;; ----------------------------------------------------------------------------
 361 (defvar desktop-dirname nil
 362   "The directory in which the desktop file should be saved.")
 363
 364 (defconst desktop-header
 365 ";; --------------------------------------------------------------------------
 366 ;; Desktop File for Emacs
 367 ;; --------------------------------------------------------------------------
 368 " "*Header to place in Desktop file.")
 369
 370 (defvar desktop-delay-hook nil
 371   "Hooks run after all buffers are loaded; intended for internal use.")
 372
 373 ;; ----------------------------------------------------------------------------
 374 (defun desktop-truncate (list n)
 375   "Truncate LIST to at most N elements destructively."
 376   (let ((here (nthcdr (1- n) list)))
 377     (if (consp here)
 378         (setcdr here nil))))
 379
 380 ;; ----------------------------------------------------------------------------
 381 (defun desktop-clear ()
 382   "Empty the Desktop.
 383 This kills all buffers except for internal ones and those matching
 384 `desktop-clear-preserve-buffers-regexp' or listed in
 385 `desktop-clear-preserve-buffers'.  Furthermore, it clears the
 386 variables listed in `desktop-globals-to-clear'."
 387   (interactive)
 388   (desktop-lazy-abort)
 389   (dolist (var desktop-globals-to-clear)
 390     (if (symbolp var)
 391       (eval `(setq-default ,var nil))
 392       (eval `(setq-default ,(car var) ,(cdr var)))))
 393   (let ((buffers (buffer-list)))
 394     (while buffers
 395       (let ((bufname (buffer-name (car buffers))))
 396          (or
 397            (null bufname)
 398            (string-match desktop-clear-preserve-buffers-regexp bufname)
 399            (member bufname desktop-clear-preserve-buffers)
 400            ;; Don't kill buffers made for internal purposes.
 401            (and (not (equal bufname "")) (eq (aref bufname 0) ?\s))
 402            (kill-buffer (car buffers))))
 403       (setq buffers (cdr buffers))))
 404   (delete-other-windows))
 405
 406 ;; ----------------------------------------------------------------------------
 407 (add-hook 'kill-emacs-hook 'desktop-kill)
 408
 409 (defun desktop-kill ()
 410   "If `desktop-save-mode' is non-nil, do what `desktop-save' says to do.
 411 If the desktop should be saved and `desktop-dirname'
 412 is nil, ask the user where to save the desktop."
 413   (when
 414     (and
 415       desktop-save-mode
 416       (let ((exists (file-exists-p (expand-file-name desktop-base-file-name desktop-dirname))))
 417         (or
 418           (eq desktop-save t)
 419           (and exists (memq desktop-save '(ask-if-new if-exists)))
 420           (and
 421             (or
 422               (memq desktop-save '(ask ask-if-new))
 423               (and exists (eq desktop-save 'ask-if-exists)))
 424             (y-or-n-p "Save desktop? ")))))
 425     (unless desktop-dirname
 426       (setq desktop-dirname
 427         (file-name-as-directory
 428           (expand-file-name
 429             (call-interactively
 430               (lambda (dir) (interactive "DDirectory for desktop file: ") dir))))))
 431     (condition-case err
 432       (desktop-save desktop-dirname)
 433       (file-error
 434         (unless (yes-or-no-p "Error while saving the desktop.  Ignore? ")
 435           (signal (car err) (cdr err)))))))
 436
 437 ;; ----------------------------------------------------------------------------
 438 (defun desktop-list* (&rest args)
 439   (if (null (cdr args))
 440       (car args)
 441     (setq args (nreverse args))
 442     (let ((value (cons (nth 1 args) (car args))))
 443       (setq args (cdr (cdr args)))
 444       (while args
 445         (setq value (cons (car args) value))
 446         (setq args (cdr args)))
 447       value)))
 448
 449 ;; ----------------------------------------------------------------------------
 450 (defun desktop-internal-v2s (value)
 451   "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
 452 TXT is a string that when read and evaluated yields value.
 453 QUOTE may be `may' (value may be quoted),
 454 `must' (values must be quoted), or nil (value may not be quoted)."
 455   (cond
 456    ((or (numberp value) (null value) (eq t value) (keywordp value))
 457     (cons 'may (prin1-to-string value)))
 458    ((stringp value)
 459     (let ((copy (copy-sequence value)))
 460       (set-text-properties 0 (length copy) nil copy)
 461       ;; Get rid of text properties because we cannot read them
 462       (cons 'may (prin1-to-string copy))))
 463    ((symbolp value)
 464     (cons 'must (prin1-to-string value)))
 465    ((vectorp value)
 466     (let* ((special nil)
 467            (pass1 (mapcar
 468                    (lambda (el)
 469                      (let ((res (desktop-internal-v2s el)))
 470                        (if (null (car res))
 471                            (setq special t))
 472                        res))
 473                    value)))
 474       (if special
 475           (cons nil (concat "(vector "
 476                             (mapconcat (lambda (el)
 477                                          (if (eq (car el) 'must)
 478                                              (concat "'" (cdr el))
 479                                            (cdr el)))
 480                                        pass1
 481                                        " ")
 482                             ")"))
 483         (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
 484    ((consp value)
 485     (let ((p value)
 486           newlist
 487           use-list*
 488           anynil)
 489       (while (consp p)
 490         (let ((q.txt (desktop-internal-v2s (car p))))
 491           (or anynil (setq anynil (null (car q.txt))))
 492           (setq newlist (cons q.txt newlist)))
 493         (setq p (cdr p)))
 494       (if p
 495           (let ((last (desktop-internal-v2s p))
 496                 (el (car newlist)))
 497             (or anynil (setq anynil (null (car last))))
 498             (or anynil
 499                 (setq newlist (cons '(must . ".") newlist)))
 500             (setq use-list* t)
 501             (setq newlist (cons last newlist))))
 502       (setq newlist (nreverse newlist))
 503       (if anynil
 504           (cons nil
 505                 (concat (if use-list* "(desktop-list* "  "(list ")
 506                         (mapconcat (lambda (el)
 507                                      (if (eq (car el) 'must)
 508                                          (concat "'" (cdr el))
 509                                        (cdr el)))
 510                                    newlist
 511                                    " ")
 512                         ")"))
 513         (cons 'must
 514               (concat "(" (mapconcat 'cdr newlist " ") ")")))))
 515    ((subrp value)
 516     (cons nil (concat "(symbol-function '"
 517                       (substring (prin1-to-string value) 7 -1)
 518                       ")")))
 519    ((markerp value)
 520     (let ((pos (prin1-to-string (marker-position value)))
 521           (buf (prin1-to-string (buffer-name (marker-buffer value)))))
 522       (cons nil (concat "(let ((mk (make-marker)))"
 523                         " (add-hook 'desktop-delay-hook"
 524                         " (list 'lambda '() (list 'set-marker mk "
 525                         pos " (get-buffer " buf ")))) mk)"))))
 526    (t                                   ; save as text
 527     (cons 'may "\"Unprintable entity\""))))
 528
 529 ;; ----------------------------------------------------------------------------
 530 (defun desktop-value-to-string (value)
 531   "Convert VALUE to a string that when read evaluates to the same value.
 532 Not all types of values are supported."
 533   (let* ((print-escape-newlines t)
 534          (float-output-format nil)
 535          (quote.txt (desktop-internal-v2s value))
 536          (quote (car quote.txt))
 537          (txt (cdr quote.txt)))
 538     (if (eq quote 'must)
 539         (concat "'" txt)
 540       txt)))
 541
 542 ;; ----------------------------------------------------------------------------
 543 (defun desktop-outvar (varspec)
 544   "Output a setq statement for variable VAR to the desktop file.
 545 The argument VARSPEC may be the variable name VAR (a symbol),
 546 or a cons cell of the form  (VAR . MAX-SIZE),
 547 which means to truncate VAR's value to at most MAX-SIZE elements
 548 \(if the value is a list) before saving the value."
 549   (let (var size)
 550     (if (consp varspec)
 551         (setq var (car varspec) size (cdr varspec))
 552       (setq var varspec))
 553     (if (boundp var)
 554         (progn
 555           (if (and (integerp size)
 556                    (> size 0)
 557                    (listp (eval var)))
 558               (desktop-truncate (eval var) size))
 559           (insert "(setq "
 560                   (symbol-name var)
 561                   " "
 562                   (desktop-value-to-string (symbol-value var))
 563                   ")\n")))))
 564
 565 ;; ----------------------------------------------------------------------------
 566 (defun desktop-save-buffer-p (filename bufname mode &rest dummy)
 567   "Return t if buffer should have its state saved in the desktop file.
 568 FILENAME is the visited file name, BUFNAME is the buffer name, and
 569 MODE is the major mode."
 570   (let ((case-fold-search nil))
 571     (and (not (string-match desktop-buffers-not-to-save bufname))
 572          (not (memq mode desktop-modes-not-to-save))
 573          (or (and filename
 574                   (not (string-match desktop-files-not-to-save filename)))
 575              (and (eq mode 'dired-mode)
 576                   (with-current-buffer bufname
 577                     (not (string-match desktop-files-not-to-save
 578                                        default-directory))))
 579              (and (null filename)
 580                   (with-current-buffer bufname desktop-save-buffer))))))
 581
 582 ;; ----------------------------------------------------------------------------
 583 (defun desktop-file-name (filename dirname)
 584   "Convert FILENAME to format specified in `desktop-file-name-format'.
 585 DIRNAME must be the directory in which the desktop file will be saved."
 586   (cond
 587     ((not filename) nil)
 588     ((eq desktop-file-name-format 'tilde)
 589      (let ((relative-name (file-relative-name (expand-file-name filename) "~")))
 590        (cond
 591          ((file-name-absolute-p relative-name) relative-name)
 592          ((string= "./" relative-name) "~/")
 593          ((string= "." relative-name) "~")
 594          (t (concat "~/" relative-name)))))
 595     ((eq desktop-file-name-format 'local) (file-relative-name filename dirname))
 596     (t (expand-file-name filename))))
 597
 598 ;; ----------------------------------------------------------------------------
 599 (defun desktop-save (dirname)
 600   "Save the desktop in a desktop file.
 601 Parameter DIRNAME specifies where to save the desktop file.
 602 See also `desktop-base-file-name'."
 603   (interactive "DDirectory to save desktop file in: ")
 604   (run-hooks 'desktop-save-hook)
 605   (setq dirname (file-name-as-directory (expand-file-name dirname)))
 606   (save-excursion
 607     (let ((filename (expand-file-name desktop-base-file-name dirname))
 608           (info
 609             (mapcar
 610               #'(lambda (b)
 611                   (set-buffer b)
 612                   (list
 613                     (desktop-file-name (buffer-file-name) dirname)
 614                     (buffer-name)
 615                     major-mode
 616                     ;; minor modes
 617                     (let (ret)
 618                       (mapc
 619                         #'(lambda (minor-mode)
 620                           (and
 621                             (boundp minor-mode)
 622                             (symbol-value minor-mode)
 623                             (let ((special (assq minor-mode desktop-minor-mode-table)))
 624                               (when (or special (functionp minor-mode))
 625                                 (setq ret
 626                                   (cons
 627                                     (if special (cadr special) minor-mode)
 628                                     ret))))))
 629                         (mapcar #'car minor-mode-alist))
 630                       ret)
 631                     (point)
 632                     (list (mark t) mark-active)
 633                     buffer-read-only
 634                     ;; Auxiliary information
 635                     (when (functionp desktop-save-buffer)
 636                       (funcall desktop-save-buffer dirname))
 637                     (let ((locals desktop-locals-to-save)
 638                           (loclist (buffer-local-variables))
 639                           (ll))
 640                       (while locals
 641                         (let ((here (assq (car locals) loclist)))
 642                           (if here
 643                             (setq ll (cons here ll))
 644                             (when (member (car locals) loclist)
 645                               (setq ll (cons (car locals) ll)))))
 646                         (setq locals (cdr locals)))
 647                       ll)))
 648               (buffer-list)))
 649           (eager desktop-restore-eager)
 650           (buf (get-buffer-create "*desktop*")))
 651       (set-buffer buf)
 652       (erase-buffer)
 653
 654       (insert
 655         ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n"
 656         desktop-header
 657         ";; Created " (current-time-string) "\n"
 658         ";; Desktop file format version " desktop-file-version "\n"
 659         ";; Emacs version " emacs-version "\n\n"
 660         ";; Global section:\n")
 661       (mapc (function desktop-outvar) desktop-globals-to-save)
 662       (if (memq 'kill-ring desktop-globals-to-save)
 663         (insert
 664           "(setq kill-ring-yank-pointer (nthcdr "
 665           (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
 666           " kill-ring))\n"))
 667
 668       (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
 669       (mapc #'(lambda (l)
 670                 (when (apply 'desktop-save-buffer-p l)
 671                   (insert "("
 672                           (if (or (not (integerp eager))
 673                                   (unless (zerop eager)
 674                                     (setq eager (1- eager))
 675                                     t))
 676                               "desktop-create-buffer"
 677                             "desktop-append-buffer-args")
 678                           " "
 679                           desktop-file-version)
 680                   (mapc #'(lambda (e)
 681                             (insert "\n  " (desktop-value-to-string e)))
 682                         l)
 683                   (insert ")\n\n")))
 684             info)
 685       (setq default-directory dirname)
 686       (when (file-exists-p filename) (delete-file filename))
 687       (let ((coding-system-for-write 'emacs-mule))
 688         (write-region (point-min) (point-max) filename nil 'nomessage))))
 689   (setq desktop-dirname dirname))
 690
 691 ;; ----------------------------------------------------------------------------
 692 (defun desktop-remove ()
 693   "Delete desktop file in `desktop-dirname'.
 694 This function also sets `desktop-dirname' to nil."
 695   (interactive)
 696   (when desktop-dirname
 697     (let ((filename (expand-file-name desktop-base-file-name desktop-dirname)))
 698       (setq desktop-dirname nil)
 699       (when (file-exists-p filename)
 700         (delete-file filename)))))
 701
 702 (defvar desktop-buffer-args-list nil
 703   "List of args for `desktop-create-buffer'.")
 704
 705 (defvar desktop-lazy-timer nil)
 706
 707 ;; ----------------------------------------------------------------------------
 708 ;;;###autoload
 709 (defun desktop-read (&optional dirname)
 710   "Read and process the desktop file in directory DIRNAME.
 711 Look for a desktop file in DIRNAME, or if DIRNAME is omitted, look in
 712 directories listed in `desktop-path'.  If a desktop file is found, it
 713 is processed and `desktop-after-read-hook' is run.  If no desktop file
 714 is found, clear the desktop and run `desktop-no-desktop-file-hook'.
 715 This function is a no-op when Emacs is running in batch mode.
 716 It returns t if a desktop file was loaded, nil otherwise."
 717   (interactive)
 718   (unless noninteractive
 719     (setq desktop-dirname
 720       (file-name-as-directory
 721         (expand-file-name
 722           (or
 723             ;; If DIRNAME is specified, use it.
 724             (and (< 0 (length dirname)) dirname)
 725             ;; Otherwise search desktop file in desktop-path.
 726             (let ((dirs desktop-path))
 727               (while
 728                 (and
 729                   dirs
 730                   (not
 731                     (file-exists-p (expand-file-name desktop-base-file-name (car dirs)))))
 732                 (setq dirs (cdr dirs)))
 733               (and dirs (car dirs)))
 734             ;; If not found and `desktop-path' is non-nil, use its first element.
 735             (and desktop-path (car desktop-path))
 736             ;; Default: Home directory.
 737             "~"))))
 738     (if (file-exists-p (expand-file-name desktop-base-file-name desktop-dirname))
 739       ;; Desktop file found, process it.
 740       (let ((desktop-first-buffer nil)
 741             (desktop-buffer-ok-count 0)
 742             (desktop-buffer-fail-count 0))
 743         (setq desktop-lazy-timer nil)
 744         ;; Evaluate desktop buffer.
 745         (load (expand-file-name desktop-base-file-name desktop-dirname) t t t)
 746         ;; `desktop-create-buffer' puts buffers at end of the buffer list.
 747         ;; We want buffers existing prior to evaluating the desktop (and not reused)
 748         ;; to be placed at the end of the buffer list, so we move them here.
 749         (mapc 'bury-buffer
 750               (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list))))))
 751         (switch-to-buffer (car (buffer-list)))
 752         (run-hooks 'desktop-delay-hook)
 753         (setq desktop-delay-hook nil)
 754         (run-hooks 'desktop-after-read-hook)
 755         (message "Desktop: %d buffer%s restored%s%s."
 756                  desktop-buffer-ok-count
 757                  (if (= 1 desktop-buffer-ok-count) "" "s")
 758                  (if (< 0 desktop-buffer-fail-count)
 759                      (format ", %d failed to restore" desktop-buffer-fail-count)
 760                    "")
 761                  (if desktop-buffer-args-list
 762                      (format ", %d to restore lazily"
 763                              (length desktop-buffer-args-list))
 764                    ""))
 765         t)
 766       ;; No desktop file found.
 767       (desktop-clear)
 768       (let ((default-directory desktop-dirname))
 769         (run-hooks 'desktop-no-desktop-file-hook))
 770       (message "No desktop file.")
 771       nil)))
 772
 773 ;; ----------------------------------------------------------------------------
 774 ;; Maintained for backward compatibility
 775 ;;;###autoload
 776 (defun desktop-load-default ()
 777   "Load the `default' start-up library manually.
 778 Also inhibit further loading of it."
 779   (if (not inhibit-default-init)        ; safety check
 780       (progn
 781         (load "default" t t)
 782         (setq inhibit-default-init t))))
 783 (make-obsolete 'desktop-load-default 'desktop-save-mode "22.1")
 784
 785 ;; ----------------------------------------------------------------------------
 786 ;;;###autoload
 787 (defun desktop-change-dir (dirname)
 788   "Change to desktop saved in DIRNAME.
 789 Kill the desktop as specified by variables `desktop-save-mode' and
 790 `desktop-save', then clear the desktop and load the desktop file in
 791 directory DIRNAME."
 792   (interactive "DChange to directory: ")
 793   (setq dirname (file-name-as-directory (expand-file-name dirname desktop-dirname)))
 794   (desktop-kill)
 795   (desktop-clear)
 796   (desktop-read dirname))
 797
 798 ;; ----------------------------------------------------------------------------
 799 ;;;###autoload
 800 (defun desktop-save-in-desktop-dir ()
 801   "Save the desktop in directory `desktop-dirname'."
 802   (interactive)
 803   (if desktop-dirname
 804     (desktop-save desktop-dirname)
 805     (call-interactively 'desktop-save))
 806   (message "Desktop saved in %s" desktop-dirname))
 807
 808 ;; ----------------------------------------------------------------------------
 809 ;;;###autoload
 810 (defun desktop-revert ()
 811   "Revert to the last loaded desktop."
 812   (interactive)
 813   (unless desktop-dirname
 814     (error "Unknown desktop directory"))
 815   (unless (file-exists-p (expand-file-name desktop-base-file-name desktop-dirname))
 816     (error "No desktop file found"))
 817   (desktop-clear)
 818   (desktop-read desktop-dirname))
 819
 820 ;; ----------------------------------------------------------------------------
 821 (defun desktop-restore-file-buffer (desktop-buffer-file-name
 822                                     desktop-buffer-name
 823                                     desktop-buffer-misc)
 824   "Restore a file buffer."
 825   (eval-when-compile ; Just to silence the byte compiler
 826     (defvar desktop-buffer-major-mode)
 827     (defvar desktop-buffer-locals))
 828   (if desktop-buffer-file-name
 829       (if (or (file-exists-p desktop-buffer-file-name)
 830               (let ((msg (format "Desktop: File \"%s\" no longer exists."
 831                                  desktop-buffer-file-name)))
 832                  (if desktop-missing-file-warning
 833                      (y-or-n-p (concat msg " Re-create? "))
 834                    (message msg)
 835                    nil)))
 836           (let* ((auto-insert nil) ; Disable auto insertion
 837                  (coding-system-for-read
 838                   (or coding-system-for-read
 839                       (cdr (assq 'buffer-file-coding-system
 840                                  desktop-buffer-locals))))
 841                  (buf (find-file-noselect desktop-buffer-file-name)))
 842             (condition-case nil
 843                 (switch-to-buffer buf)
 844               (error (pop-to-buffer buf)))
 845             (and (not (eq major-mode desktop-buffer-major-mode))
 846                  (functionp desktop-buffer-major-mode)
 847                  (funcall desktop-buffer-major-mode))
 848             buf)
 849         nil)))
 850
 851 ;; ----------------------------------------------------------------------------
 852 ;; Create a buffer, load its file, set its mode, ...;
 853 ;; called from Desktop file only.
 854
 855 (eval-when-compile ; Just to silence the byte compiler
 856    (defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read'
 857 )
 858
 859 (defun desktop-create-buffer
 860   (desktop-file-version
 861    desktop-buffer-file-name
 862    desktop-buffer-name
 863    desktop-buffer-major-mode
 864    desktop-buffer-minor-modes
 865    desktop-buffer-point
 866    desktop-buffer-mark
 867    desktop-buffer-read-only
 868    desktop-buffer-misc
 869    &optional
 870    desktop-buffer-locals)
 871   ;; Just to silence the byte compiler. Bound locally in `desktop-read'.
 872   (eval-when-compile
 873     (defvar desktop-buffer-ok-count)
 874     (defvar desktop-buffer-fail-count))
 875   ;; To make desktop files with relative file names possible, we cannot
 876   ;; allow `default-directory' to change. Therefore we save current buffer.
 877   (save-current-buffer
 878     (let ((buffer-list (buffer-list))
 879           (result
 880            (condition-case err
 881                (funcall (or (cdr (assq desktop-buffer-major-mode
 882                                        desktop-buffer-mode-handlers))
 883                             'desktop-restore-file-buffer)
 884                         desktop-buffer-file-name
 885                         desktop-buffer-name
 886                         desktop-buffer-misc)
 887              (error
 888               (message "Desktop: Can't load buffer %s: %s"
 889                        desktop-buffer-name
 890                        (error-message-string err))
 891               (when desktop-missing-file-warning (sit-for 1))
 892               nil))))
 893       (if (bufferp result)
 894           (setq desktop-buffer-ok-count (1+ desktop-buffer-ok-count))
 895         (setq desktop-buffer-fail-count (1+ desktop-buffer-fail-count))
 896         (setq result nil))
 897       ;; Restore buffer list order with new buffer at end. Don't change
 898       ;; the order for old desktop files (old desktop module behaviour).
 899       (unless (< desktop-file-version 206)
 900         (mapc 'bury-buffer buffer-list)
 901         (when result (bury-buffer result)))
 902       (when result
 903         (unless (or desktop-first-buffer (< desktop-file-version 206))
 904           (setq desktop-first-buffer result))
 905         (set-buffer result)
 906         (unless (equal (buffer-name) desktop-buffer-name)
 907           (rename-buffer desktop-buffer-name))
 908         ;; minor modes
 909         (cond ((equal '(t) desktop-buffer-minor-modes) ; backwards compatible
 910                (auto-fill-mode 1))
 911               ((equal '(nil) desktop-buffer-minor-modes) ; backwards compatible
 912                (auto-fill-mode 0))
 913               (t
 914                (mapc #'(lambda (minor-mode)
 915                          (when (functionp minor-mode) (funcall minor-mode 1)))
 916                      desktop-buffer-minor-modes)))
 917         ;; Even though point and mark are non-nil when written by `desktop-save'
 918         ;; they may be modified by handlers wanting to set point or mark themselves.
 919         (when desktop-buffer-point
 920           (goto-char
 921             (condition-case err
 922                 ;; Evaluate point. Thus point can be something like '(search-forward ...
 923                 (eval desktop-buffer-point)
 924               (error (message "%s" (error-message-string err)) 1))))
 925         (when desktop-buffer-mark
 926           (if (consp desktop-buffer-mark)
 927             (progn
 928               (set-mark (car desktop-buffer-mark))
 929               (setq mark-active (car (cdr desktop-buffer-mark))))
 930             (set-mark desktop-buffer-mark)))
 931         ;; Never override file system if the file really is read-only marked.
 932         (if desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
 933         (while desktop-buffer-locals
 934           (let ((this (car desktop-buffer-locals)))
 935             (if (consp this)
 936               ;; an entry of this form `(symbol . value)'
 937               (progn
 938                 (make-local-variable (car this))
 939                 (set (car this) (cdr this)))
 940               ;; an entry of the form `symbol'
 941               (make-local-variable this)
 942               (makunbound this)))
 943           (setq desktop-buffer-locals (cdr desktop-buffer-locals)))))))
 944
 945 ;; ----------------------------------------------------------------------------
 946 ;; Backward compatibility -- update parameters to 205 standards.
 947 (defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name
 948                        desktop-buffer-major-mode
 949                        mim pt mk ro tl fc cfs cr desktop-buffer-misc)
 950   (desktop-create-buffer 205 desktop-buffer-file-name desktop-buffer-name
 951                          desktop-buffer-major-mode (cdr mim) pt mk ro
 952                          desktop-buffer-misc
 953                          (list (cons 'truncate-lines tl)
 954                                (cons 'fill-column fc)
 955                                (cons 'case-fold-search cfs)
 956                                (cons 'case-replace cr)
 957                                (cons 'overwrite-mode (car mim)))))
 958
 959 (defun desktop-append-buffer-args (&rest args)
 960   "Append ARGS at end of `desktop-buffer-args-list'.
 961 ARGS must be an argument list for `desktop-create-buffer'."
 962   (setq desktop-buffer-args-list (nconc desktop-buffer-args-list (list args)))
 963   (unless desktop-lazy-timer
 964     (setq desktop-lazy-timer
 965           (run-with-idle-timer desktop-lazy-idle-delay t 'desktop-idle-create-buffers))))
 966
 967 (defun desktop-lazy-create-buffer ()
 968   "Pop args from `desktop-buffer-args-list', create buffer and bury it."
 969   (when desktop-buffer-args-list
 970     (let* ((remaining (length desktop-buffer-args-list))
 971            (args (pop desktop-buffer-args-list))
 972            (buffer-name (nth 2 args))
 973            (msg (format "Desktop lazily opening %s (%s remaining)..."
 974                             buffer-name remaining)))
 975       (when desktop-lazy-verbose
 976         (message msg))
 977       (let ((desktop-first-buffer nil)
 978             (desktop-buffer-ok-count 0)
 979             (desktop-buffer-fail-count 0))
 980         (apply 'desktop-create-buffer args)
 981         (run-hooks 'desktop-delay-hook)
 982         (setq desktop-delay-hook nil)
 983         (bury-buffer (get-buffer buffer-name))
 984         (when desktop-lazy-verbose
 985           (message "%s%s" msg (if (> desktop-buffer-ok-count 0) "done" "failed")))))))
 986
 987 (defun desktop-idle-create-buffers ()
 988   "Create buffers until the user does something, then stop.
 989 If there are no buffers left to create, kill the timer."
 990   (let ((repeat 1))
 991     (while (and repeat desktop-buffer-args-list)
 992       (save-window-excursion
 993         (desktop-lazy-create-buffer))
 994       (setq repeat (sit-for 0.2))
 995     (unless desktop-buffer-args-list
 996       (cancel-timer desktop-lazy-timer)
 997       (setq desktop-lazy-timer nil)
 998       (message "Lazy desktop load complete")
 999       (sit-for 3)
1000       (message "")))))
1001
1002 (defun desktop-lazy-complete ()
1003   "Run the desktop load to completion."
1004   (interactive)
1005   (let ((desktop-lazy-verbose t))
1006     (while desktop-buffer-args-list
1007       (save-window-excursion
1008         (desktop-lazy-create-buffer)))
1009     (message "Lazy desktop load complete")))
1010
1011 (defun desktop-lazy-abort ()
1012   "Abort lazy loading of the desktop."
1013   (interactive)
1014   (when desktop-lazy-timer
1015     (cancel-timer desktop-lazy-timer)
1016     (setq desktop-lazy-timer nil))
1017   (when desktop-buffer-args-list
1018     (setq desktop-buffer-args-list nil)
1019     (when (interactive-p)
1020       (message "Lazy desktop load aborted"))))
1021
1022 ;; ----------------------------------------------------------------------------
1023 ;; When `desktop-save-mode' is non-nil and "--no-desktop" is not specified on the
1024 ;; command line, we do the rest of what it takes to use desktop, but do it
1025 ;; after finishing loading the init file.
1026 ;; We cannot use `command-switch-alist' to process "--no-desktop" because these
1027 ;; functions are processed after `after-init-hook'.
1028 (add-hook
1029   'after-init-hook
1030   '(lambda ()
1031     (let ((key "--no-desktop"))
1032       (when (member key command-line-args)
1033         (setq command-line-args (delete key command-line-args))
1034         (setq desktop-save-mode nil)))
1035     (when desktop-save-mode (desktop-read))))
1036
1037 (provide 'desktop)
1038
1039 ;;; arch-tag: 221907c3-1771-4fd3-9c2e-c6f700c6ede9
1040 ;;; desktop.el ends here