lisp/desktop.el

   1 ;;; desktop.el --- save partial status of Emacs when killed
   2
   3 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
   4
   5 ;; Author: Morten Welinder <terra@diku.dk>
   6 ;; Version: 2.07
   7 ;; Keywords: customization
   8 ;; Favourite-brand-of-beer: None, I hate beer.
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Save the Desktop, i.e.,
  29 ;;      - some global variables
  30 ;;      - the list of buffers with associated files.  For each buffer also
  31 ;;              - the major mode
  32 ;;              - the default directory
  33 ;;              - the point
  34 ;;              - the mark & mark-active
  35 ;;              - buffer-read-only
  36 ;;              - some local variables
  37
  38 ;; To use this, first put these three lines in the bottom of your .emacs
  39 ;; file (the later the better):
  40 ;;
  41 ;;      (load "desktop")
  42 ;;      (desktop-load-default)
  43 ;;      (desktop-read)
  44 ;;
  45 ;; Between the second and the third line you may wish to add something that
  46 ;; updates the variables `desktop-globals-to-save' and/or
  47 ;; `desktop-locals-to-save'.  If for instance you want to save the local
  48 ;; variable `foobar' for every buffer in which it is local, you could add
  49 ;; the line
  50 ;;
  51 ;;      (setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save))
  52 ;;
  53 ;; To avoid saving excessive amounts of data you may also with to add
  54 ;; something like the following
  55 ;;
  56 ;;      (add-hook 'kill-emacs-hook
  57 ;;                '(lambda ()
  58 ;;                   (desktop-truncate search-ring 3)
  59 ;;                   (desktop-truncate regexp-search-ring 3)))
  60 ;;
  61 ;; which will make sure that no more than three search items are saved.  You
  62 ;; must place this line *after* the (load "desktop") line.
  63
  64 ;; Start Emacs in the root directory of your "project". The desktop saver
  65 ;; is inactive by default.  You activate it by M-x desktop-save RET.  When
  66 ;; you exit the next time the above data will be saved.  This ensures that
  67 ;; all the files you were editing will be reloaded the next time you start
  68 ;; Emacs from the same directory and that points will be set where you
  69 ;; left them.  If you save a desktop file in your home directory it will
  70 ;; act as a default desktop when you start Emacs from a directory that
  71 ;; doesn't have its own.  I never do this, but you may want to.
  72
  73 ;; By the way: don't use desktop.el to customize Emacs -- the file .emacs
  74 ;; in your home directory is used for that.  Saving global default values
  75 ;; for buffers is an example of misuse.
  76
  77 ;; PLEASE NOTE: The kill ring can be saved as specified by the variable
  78 ;; `desktop-globals-to-save' (by default it isn't).  This may result in saving
  79 ;; things you did not mean to keep.  Use M-x desktop-clear RET.
  80
  81 ;; Thanks to  hetrick@phys.uva.nl (Jim Hetrick)     for useful ideas.
  82 ;;            avk@rtsg.mot.com (Andrew V. Klein)    for a dired tip.
  83 ;;            chris@tecc.co.uk (Chris Boucher)      for a mark tip.
  84 ;;            f89-kam@nada.kth.se (Klas Mellbourn)  for a mh-e tip.
  85 ;; ---------------------------------------------------------------------------
  86 ;; TODO:
  87 ;;
  88 ;; Save window configuration.
  89 ;; Recognize more minor modes.
  90 ;; Save mark rings.
  91 ;; Start-up with buffer-menu???
  92
  93 ;;; Code:
  94
  95 ;; Make the compilation more silent
  96 (eval-when-compile
  97   ;; We use functions from these modules
  98   (mapcar 'require '(info mh-e dired reporter)))
  99 ;; ----------------------------------------------------------------------------
 100 ;; USER OPTIONS -- settings you might want to play with.
 101 ;; ----------------------------------------------------------------------------
 102 (defconst desktop-basefilename
 103   (if (eq system-type 'ms-dos)
 104       "emacs.dsk" ; Ms-Dos does not support multiple dots in file name
 105     ".emacs.desktop")
 106   "File for Emacs desktop.  A directory name will be prepended to this name.")
 107
 108 (defvar desktop-missing-file-warning t
 109   "*If non-nil then issue warning if a file no longer exists.
 110 Otherwise simply ignore the file.")
 111
 112 (defvar desktop-globals-to-save
 113   (list 'desktop-missing-file-warning
 114         ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer
 115         ;; 'kill-ring
 116         'tags-file-name
 117         'tags-table-list
 118         'search-ring
 119         'regexp-search-ring
 120         'register-alist
 121         ;; 'desktop-globals-to-save     ; Itself!
 122         )
 123   "List of global variables to save when killing Emacs.")
 124
 125 (defvar desktop-locals-to-save
 126   (list 'desktop-locals-to-save         ; Itself!  Think it over.
 127         'truncate-lines
 128         'case-fold-search
 129         'case-replace
 130         'fill-column
 131         'overwrite-mode
 132         'change-log-default-name
 133         )
 134   "List of local variables to save for each buffer.  The variables are saved
 135 only when they really are local.")
 136 (make-variable-buffer-local 'desktop-locals-to-save)
 137
 138 ;; We skip .log files because they are normally temporary.
 139 ;;         (ftp) files because they require passwords and whatsnot.
 140 ;;         TAGS files to save time (tags-file-name is saved instead).
 141 (defvar desktop-buffers-not-to-save
 142  "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
 143  "Regexp identifying buffers that are to be excluded from saving.")
 144
 145 (defvar desktop-buffer-handlers
 146   '(desktop-buffer-dired
 147     desktop-buffer-rmail
 148     desktop-buffer-mh
 149     desktop-buffer-info
 150     desktop-buffer-file)
 151   "*List of functions to call in order to create a buffer.  The functions are
 152 called without explicit parameters but may access the the major mode as `mam',
 153 the file name as `fn', the buffer name as `bn', the default directory as
 154 `dd'.  If some function returns non-nil no further functions are called.
 155 If the function returns t then the buffer is considered created.")
 156
 157 (defvar desktop-create-buffer-form "(desktop-create-buffer 205"
 158   "Opening of form for creation of new buffers.")
 159 ;; ----------------------------------------------------------------------------
 160 (defvar desktop-dirname nil
 161   "The directory in which the current desktop file resides.")
 162
 163 (defconst desktop-header
 164 ";; --------------------------------------------------------------------------
 165 ;; Desktop File for Emacs
 166 ;; --------------------------------------------------------------------------
 167 " "*Header to place in Desktop file.")
 168
 169 (defvar desktop-delay-hook nil
 170   "Hooks run after all buffers are loaded; intended for internal use.")
 171 ;; ----------------------------------------------------------------------------
 172 (defun desktop-truncate (l n)
 173   "Truncate LIST to at most N elements destructively."
 174   (let ((here (nthcdr (1- n) l)))
 175     (if (consp here)
 176         (setcdr here nil))))
 177 ;; ----------------------------------------------------------------------------
 178 (defun desktop-clear () "Empty the Desktop."
 179   (interactive)
 180   (setq kill-ring nil)
 181   (setq kill-ring-yank-pointer nil)
 182   (mapcar (function kill-buffer) (buffer-list))
 183   (delete-other-windows))
 184 ;; ----------------------------------------------------------------------------
 185 (add-hook 'kill-emacs-hook 'desktop-kill)
 186
 187 (defun desktop-kill ()
 188   (if desktop-dirname
 189       (progn
 190         (desktop-save desktop-dirname))))
 191 ;; ----------------------------------------------------------------------------
 192 (defun desktop-internal-v2s (val)
 193   "Convert VALUE to a pair (quote . txt) where txt is a string that when read
 194 and evaluated yields value.  quote may be 'may (value may be quoted),
 195 'must (values must be quoted), or nil (value may not be quoted)."
 196   (cond
 197    ((or (numberp val) (stringp val) (null val) (eq t val))
 198     (cons 'may (prin1-to-string val)))
 199    ((symbolp val)
 200     (cons 'must (prin1-to-string val)))
 201    ((vectorp val)
 202     (let* ((special nil)
 203            (pass1 (mapcar
 204                    (lambda (el)
 205                      (let ((res (desktop-internal-v2s el)))
 206                        (if (null (car res))
 207                            (setq special t))
 208                        res))
 209                    val)))
 210       (if special
 211           (cons nil (concat "(vector "
 212                             (mapconcat (lambda (el)
 213                                          (if (eq (car el) 'must)
 214                                              (concat "'" (cdr el))
 215                                            (cdr el)))
 216                                        pass1
 217                                        " ")
 218                             ")"))
 219         (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
 220    ((consp val)
 221     (let ((car-q.txt (desktop-internal-v2s (car val)))
 222           (cdr-q.txt (desktop-internal-v2s (cdr val))))
 223       (cond
 224        ((or (null (car car-q.txt)) (null (car cdr-q.txt)))
 225         (cons nil (concat "(cons "
 226                           (if (eq (car car-q.txt) 'must) "'")
 227                           (cdr car-q.txt) " "
 228                           (if (eq (car cdr-q.txt) 'must) "'")
 229                           (cdr cdr-q.txt) ")")))
 230        ((consp (cdr val))
 231         (cons 'must (concat "(" (cdr car-q.txt)
 232                             " " (substring (cdr cdr-q.txt) 1 -1) ")")))
 233        ((null (cdr val))
 234         (cons 'must (concat "(" (cdr car-q.txt) ")")))
 235        (t
 236         (cons 'must (concat "(" (cdr car-q.txt) " . " (cdr cdr-q.txt) ")"))))))
 237    ((subrp val)
 238     (cons nil (concat "(symbol-function '"
 239                       (substring (prin1-to-string val) 7 -1)
 240                       ")")))
 241    ((markerp val)
 242     (let ((pos (prin1-to-string (marker-position val)))
 243           (buf (prin1-to-string (buffer-name (marker-buffer val)))))
 244       (cons nil (concat "(let ((mk (make-marker)))"
 245                         " (add-hook 'desktop-delay-hook"
 246                         " (list 'lambda '() (list 'set-marker mk "
 247                         pos " (get-buffer " buf ")))) mk)"))))
 248    (t                                   ; save as text
 249     (prin1-to-string (prin1-to-string val)))))
 250
 251 (defun desktop-value-to-string (val)
 252   "Convert VALUE to a string that when read evaluates to the same value.  Not
 253 all types of values are supported."
 254   (let* ((print-escape-newlines t)
 255          (float-output-format nil)
 256          (quote.txt (desktop-internal-v2s val))
 257          (quote (car quote.txt))
 258          (txt (cdr quote.txt)))
 259     (if (eq quote 'must)
 260         (concat "'" txt)
 261       txt)))
 262 ;; ----------------------------------------------------------------------------
 263 (defun desktop-outvar (var)
 264   "Output a setq statement for VAR to the desktop file."
 265   (if (boundp var)
 266       (insert "(setq "
 267               (symbol-name var)
 268               " "
 269               (desktop-value-to-string (symbol-value var))
 270               ")\n")))
 271 ;; ----------------------------------------------------------------------------
 272 (defun desktop-save-buffer-p (filename bufname mode &rest dummy)
 273   "Return t if the desktop should record a particular buffer for next startup.
 274 FILENAME is the visited file name, BUFNAME is the buffer name, and
 275 MODE is the major mode."
 276   (or (and filename
 277            (not (string-match desktop-buffers-not-to-save bufname)))
 278       (and (null filename)
 279            (memq mode '(Info-mode dired-mode rmail-mode)))))
 280 ;; ----------------------------------------------------------------------------
 281 (defun desktop-save (dirname)
 282   "Save the Desktop file.  Parameter DIRNAME specifies where to save desktop."
 283   (interactive "DDirectory to save desktop file in: ")
 284   (save-excursion
 285     (let ((filename (expand-file-name
 286                      (concat dirname desktop-basefilename)))
 287           (info (nreverse
 288                  (mapcar
 289                   (function (lambda (b)
 290                               (set-buffer b)
 291                               (list
 292                                (buffer-file-name)
 293                                (buffer-name)
 294                                major-mode
 295                                (list    ; list explaining minor modes
 296                                      (not (null auto-fill-function)))
 297                                (point)
 298                                (list (mark t) mark-active)
 299                                buffer-read-only
 300                                (cond ((eq major-mode 'Info-mode)
 301                                       (list Info-current-file
 302                                             Info-current-node))
 303                                      ((eq major-mode 'dired-mode)
 304                                       (nreverse
 305                                        (mapcar
 306                                         (function car)
 307                                         dired-subdir-alist)))
 308                                      )
 309                                (let ((locals desktop-locals-to-save)
 310                                      (loclist (buffer-local-variables))
 311                                      (ll))
 312                                  (while locals
 313                                    (let ((here (assq (car locals) loclist)))
 314                                      (if here
 315                                          (setq ll (cons here ll))
 316                                        (if (member (car locals) loclist)
 317                                            (setq ll (cons (car locals) ll)))))
 318                                    (setq locals (cdr locals)))
 319                                  ll)
 320                                )))
 321                   (buffer-list))))
 322           (buf (get-buffer-create "*desktop*")))
 323       (set-buffer buf)
 324       (erase-buffer)
 325
 326       (insert desktop-header
 327               ";; Created " (current-time-string) "\n"
 328                   ";; Emacs version " emacs-version "\n\n"
 329                       ";; Global section:\n")
 330       (mapcar (function desktop-outvar) desktop-globals-to-save)
 331       (if (memq 'kill-ring desktop-globals-to-save)
 332           (insert "(setq kill-ring-yank-pointer (nthcdr "
 333                   (int-to-string
 334                    (- (length kill-ring) (length kill-ring-yank-pointer)))
 335                   " kill-ring))\n"))
 336
 337       (insert "\n;; Buffer section:\n")
 338       (mapcar
 339        (function (lambda (l)
 340                    (if (apply 'desktop-save-buffer-p l)
 341                        (progn
 342                          (insert desktop-create-buffer-form)
 343                          (mapcar
 344                           (function (lambda (e)
 345                                       (insert "\n  "
 346                                               (desktop-value-to-string e))))
 347                           l)
 348                          (insert ")\n\n")))))
 349        info)
 350       (setq default-directory dirname)
 351       (if (file-exists-p filename) (delete-file filename))
 352       (write-region (point-min) (point-max) filename nil 'nomessage)))
 353   (setq desktop-dirname dirname))
 354 ;; ----------------------------------------------------------------------------
 355 (defun desktop-remove ()
 356   "Delete the Desktop file and inactivate the desktop system."
 357   (interactive)
 358   (if desktop-dirname
 359       (let ((filename (concat desktop-dirname desktop-basefilename)))
 360         (if (file-exists-p filename) (delete-file filename))
 361         (setq desktop-dirname nil))))
 362 ;; ----------------------------------------------------------------------------
 363 (defun desktop-read ()
 364   "Read the Desktop file and the files it specifies."
 365   (interactive)
 366   (let ((filename))
 367     (if (file-exists-p (concat "./" desktop-basefilename))
 368         (setq desktop-dirname (expand-file-name "./"))
 369       (if (file-exists-p (concat "~/" desktop-basefilename))
 370           (setq desktop-dirname (expand-file-name "~/"))
 371         (setq desktop-dirname nil)))
 372     (if desktop-dirname
 373         (progn
 374           (load (concat desktop-dirname desktop-basefilename) t t t)
 375           (run-hooks 'desktop-delay-hook)
 376           (message "Desktop loaded."))
 377       (desktop-clear))))
 378 ;; ----------------------------------------------------------------------------
 379 (defun desktop-load-default ()
 380   "Load the `default' start-up library manually.  Also inhibit further loading
 381 of it.  Call this from your `.emacs' file to provide correct modes for
 382 autoloaded files."
 383   (if (not inhibit-default-init)        ; safety check
 384       (progn
 385         (load "default" t t)
 386         (setq inhibit-default-init t))))
 387 ;; ----------------------------------------------------------------------------
 388 ;; Note: the following functions use the dynamic variable binding in Lisp.
 389 ;;
 390 (defun desktop-buffer-info () "Load an info file."
 391   (if (eq 'Info-mode mam)
 392       (progn
 393         (require 'info)
 394         (Info-find-node (nth 0 misc) (nth 1 misc))
 395         t)))
 396 ;; ----------------------------------------------------------------------------
 397 (defun desktop-buffer-rmail () "Load an RMAIL file."
 398   (if (eq 'rmail-mode mam)
 399       (progn (rmail-input fn) t)))
 400 ;; ----------------------------------------------------------------------------
 401 (defun desktop-buffer-mh () "Load a folder in the mh system."
 402   (if (eq 'mh-folder-mode mam)
 403       (progn
 404         (require 'mh-e)
 405         (mh-find-path)
 406         (mh-visit-folder bn)
 407         t)))
 408 ;; ----------------------------------------------------------------------------
 409 (defun desktop-buffer-dired () "Load a directory using dired."
 410   (if (eq 'dired-mode mam)
 411       (progn
 412         (dired (car misc))
 413         (mapcar (function dired-maybe-insert-subdir) (cdr misc))
 414         t)))
 415 ;; ----------------------------------------------------------------------------
 416 (defun desktop-buffer-file () "Load a file."
 417   (if fn
 418       (if (or (file-exists-p fn)
 419               (and desktop-missing-file-warning
 420                    (y-or-n-p (format
 421                               "File \"%s\" no longer exists. Re-create? "
 422                               fn))))
 423           (progn (find-file fn) t)
 424         'ignored)))
 425 ;; ----------------------------------------------------------------------------
 426 ;; Create a buffer, load its file, set is mode, ...;  called from Desktop file
 427 ;; only.
 428 (defun desktop-create-buffer (ver fn bn mam mim pt mk ro misc &optional locals)
 429   (let ((hlist desktop-buffer-handlers)
 430         (result)
 431         (handler))
 432     (while (and (not result) hlist)
 433       (setq handler (car hlist))
 434       (setq result (funcall handler))
 435       (setq hlist (cdr hlist)))
 436     (if (eq result t)
 437         (progn
 438           (if (not (equal (buffer-name) bn))
 439               (rename-buffer bn))
 440           (auto-fill-mode (if (nth 0 mim) 1 0))
 441           (goto-char pt)
 442           (if (consp mk)
 443               (progn
 444                 (set-mark (car mk))
 445                 (setq mark-active (car (cdr mk))))
 446             (set-mark mk))
 447           ;; Never override file system if the file really is read-only marked.
 448           (if ro (setq buffer-read-only ro))
 449           (while locals
 450             (let ((this (car locals)))
 451               (if (consp this)
 452                   ;; an entry of this form `(symbol . value)'
 453                   (progn
 454                     (make-local-variable (car this))
 455                     (set (car this) (cdr this)))
 456                 ;; an entry of the form `symbol'
 457                 (make-local-variable this)
 458                 (makunbound this)))
 459             (setq locals (cdr locals)))
 460           ))))
 461
 462 ;; Backward compatibility -- update parameters to 205 standards.
 463 (defun desktop-buffer (fn bn mam mim pt mk ro tl fc cfs cr misc)
 464   (desktop-create-buffer 205 fn bn mam (cdr mim) pt mk ro misc
 465                          (list (cons 'truncate-lines tl)
 466                                (cons 'fill-column fc)
 467                                (cons 'case-fold-search cfs)
 468                                (cons 'case-replace cr)
 469                                (cons 'overwrite-mode (car mim)))))
 470 ;; ----------------------------------------------------------------------------
 471 (provide 'desktop)
 472
 473 ;; desktop.el ends here.