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