desktop.el 15.7 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1 2 3 4 5
;;; desktop.el --- save partial status of Emacs when killed

;; Copyright (C) 1993 Free Software Foundation, Inc.

;; Author: Morten Welinder <terra@diku.dk>
6
;; Version: 2.05
Richard M. Stallman's avatar
Richard M. Stallman committed
7 8
;; Keywords: customization
;; Favourite-brand-of-beer: None, I hate beer.
Richard M. Stallman's avatar
Richard M. Stallman committed
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

28 29 30 31 32 33 34 35
;; Save the Desktop, i.e.,
;;	- some global variables
;; 	- the list of buffers with associated files.  For each buffer also
;;		- the major mode
;;		- the default directory
;;		- the point
;;		- the mark & mark-active
;;		- buffer-read-only
36
;;		- some local variables
Richard M. Stallman's avatar
Richard M. Stallman committed
37

38 39 40 41 42 43 44
;; To use this, first put these three lines in the bottom of your .emacs
;; file (the later the better):
;;
;;	(load "desktop")
;;	(desktop-load-default)
;;	(desktop-read)
;;
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
;; Between the second and the third line you may wish to add something that
;; updates the variables `desktop-globals-to-save' and/or 
;; `desktop-locals-to-save'.  If for instance you want to save the local
;; variable `foobar' for every buffer in which it is local, you could add
;; the line
;;
;;	(setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save))
;;
;; To avoid saving excessive amounts of data you may also with to add 
;; something like the following
;;
;;	(add-hook 'kill-emacs-hook
;;		  '(lambda () 
;;		     (desktop-truncate search-ring 3)
;;		     (desktop-truncate regexp-search-ring 3)))
;;
;; which will make sure that no more than three search items are saved.  You
;; must place this line *after* the (load "desktop") line.
Richard M. Stallman's avatar
Richard M. Stallman committed
63

64 65 66 67 68
;; Start Emacs in the root directory of your "project". The desktop saver
;; is inactive by default.  You activate it by M-x desktop-save RET.  When
;; you exit the next time the above data will be saved.  This ensures that
;; all the files you were editing will be reloaded the next time you start
;; Emacs from the same directory and that points will be set where you
69 70 71 72 73 74 75 76
;; left them.  If you save a desktop file in your home directory it will
;; act as a default desktop when you start Emacs from a directory that 
;; doesn't have its own.  I never do this, but you may want to.

;; By the way: don't use desktop.el to customize Emacs -- the file .emacs
;; in your home directory is used for that.  Saving global default values
;; for buffers is an example of misuse.

77 78 79
;; PLEASE NOTE: The kill ring can be saved as specified by the variable
;; `desktop-globals-to-save' (by default it isn't).  This may result in saving
;; things you did not mean to keep.  Use M-x desktop-clear RET.
80 81 82 83 84

;; Thanks to  hetrick@phys.uva.nl (Jim Hetrick)     for useful ideas.
;;            avk@rtsg.mot.com (Andrew V. Klein)    for a dired tip.
;;            chris@tecc.co.uk (Chris Boucher)      for a mark tip.
;;            f89-kam@nada.kth.se (Klas Mellbourn)  for a mh-e tip.
85 86 87 88 89 90 91
;; ---------------------------------------------------------------------------
;; TODO:
;;
;; Save window configuration.
;; Recognize more minor modes.
;; Save mark rings.
;; Start-up with buffer-menu???
Richard M. Stallman's avatar
Richard M. Stallman committed
92 93 94

;;; Code:

95 96 97 98 99 100 101 102 103
;; Make the compilation more silent
(eval-when-compile
  ;; We use functions from these modules
  (mapcar 'require '(info mh-e dired))
  ;; We handle auto-fill-hook in a way that is ok.
  (put 'auto-fill-hook 'byte-obsolete-variable nil)
  ;; Some things are different in version 18.
  (setq postv18 (string-lessp "19" emacs-version)))
;; ----------------------------------------------------------------------------
104 105 106
;; USER OPTIONS -- settings you might want to play with.
;; ----------------------------------------------------------------------------
(defconst desktop-basefilename
Richard M. Stallman's avatar
Richard M. Stallman committed
107 108 109 110 111
  (if (equal system-type 'ms-dos)
      "emacs.dsk" ; Ms-Dos does not support multiple dots in file name
    ".emacs.desktop")
  "File for Emacs desktop.  A directory name will be prepended to this name.")

112
(defvar desktop-missing-file-warning t
Richard M. Stallman's avatar
Richard M. Stallman committed
113 114 115
  "*If non-nil then issue warning if a file no longer exists.
Otherwise simply ignore the file.")

116
(defvar desktop-globals-to-save
Richard M. Stallman's avatar
Richard M. Stallman committed
117
  (list 'desktop-missing-file-warning
118
	;; Feature: saving kill-ring implies saving kill-ring-yank-pointer
119
	;; 'kill-ring
120 121
	'tags-file-name
	'tags-table-list
122 123
	'search-ring
	'regexp-search-ring
124
	;; 'desktop-globals-to-save	; Itself!
Richard M. Stallman's avatar
Richard M. Stallman committed
125
	)
Richard M. Stallman's avatar
Richard M. Stallman committed
126 127
  "List of global variables to save when killing Emacs.")

128 129 130 131 132 133 134 135 136 137 138 139
(defvar desktop-locals-to-save
  (list 'desktop-locals-to-save		; Itself!  Think it over.
        'truncate-lines
	'case-fold-search
	'case-replace
	'fill-column
	'overwrite-mode
	'change-log-default-name
	)
  "List of local variables to save for each buffer.  The variables are saved
only when they really are local.")

140 141 142
;; We skip .log files because they are normally temporary.
;;         (ftp) files because they require passwords and whatsnot.
;;         TAGS files to save time (tags-file-name is saved instead).
Richard M. Stallman's avatar
Richard M. Stallman committed
143
(defvar desktop-buffers-not-to-save
144
 "\\(\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
Richard M. Stallman's avatar
Richard M. Stallman committed
145 146 147
 "Regexp identifying buffers that are to be excluded from saving.")

(defvar desktop-buffer-handlers
148
  '(desktop-buffer-dired
Richard M. Stallman's avatar
Richard M. Stallman committed
149
    desktop-buffer-rmail
150
    desktop-buffer-mh
Richard M. Stallman's avatar
Richard M. Stallman committed
151 152
    desktop-buffer-info
    desktop-buffer-file)
153 154 155 156
  "*List of functions to call in order to create a buffer.  The functions are
called without explicit parameters but may access the the major mode as `mam',
the file name as `fn', the buffer name as `bn', the default directory as
`dd'.  If some function returns non-nil no further functions are called.
Richard M. Stallman's avatar
Richard M. Stallman committed
157
If the function returns t then the buffer is considered created.")
158 159 160

(defvar desktop-create-buffer-form "(desktop-create-buffer 205"
  "Opening of form for creation of new buffers.")
161 162
;; ----------------------------------------------------------------------------
(defvar desktop-dirname nil
Richard M. Stallman's avatar
Richard M. Stallman committed
163 164 165
  "The directory in which the current desktop file resides.")

(defconst desktop-header
166 167 168
";; --------------------------------------------------------------------------
;; Desktop File for Emacs
;; --------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
169
" "*Header to place in Desktop file.")
170
;; ----------------------------------------------------------------------------
171 172 173 174 175 176
(defun desktop-truncate (l n)
  "Truncate LIST to at most N elements destructively."
  (let ((here (nthcdr (1- n) l)))
    (if (consp here)
	(setcdr here nil))))		  
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
177 178 179 180
(defun desktop-clear () "Empty the Desktop."
  (interactive)
  (setq kill-ring nil)
  (setq kill-ring-yank-pointer nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
181 182
  (mapcar (function kill-buffer) (buffer-list))
  (delete-other-windows))
183 184 185
;; ----------------------------------------------------------------------------
;; This is a bit dirty for version 18 because that version of Emacs was not
;; toilet-trained considering hooks.
186 187 188 189 190 191 192
(defvar old-kill-emacs)

(if (eval-when-compile postv18)
    (add-hook 'kill-emacs-hook 'desktop-kill)
  (if (not (boundp 'desktop-kill))
      (setq old-kill-emacs kill-emacs-hook
	    kill-emacs-hook
193 194 195 196 197 198 199
	    (function (lambda ()
			(progn (desktop-kill)
			       (if (or (null old-kill-emacs)
				       (symbolp old-kill-emacs))
				   (run-hooks old-kill-emacs)
				 (funcall old-kill-emacs))))))))
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
200
(defun desktop-kill ()
201
  (if desktop-dirname
Richard M. Stallman's avatar
Richard M. Stallman committed
202 203
      (progn
	(desktop-save desktop-dirname))))
204
;; ----------------------------------------------------------------------------
205 206 207 208 209 210 211 212 213 214 215
(defun desktop-value-to-string (val)
  (let ((print-escape-newlines t))
    (concat
     ;; symbols are needed for cons cells and for symbols except
     ;; `t' and `nil'.
     (if (or (consp val)
	     (and (symbolp val) val (not (eq t val))))
	 "'"
       "")
     (prin1-to-string val))))
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
216
(defun desktop-outvar (var)
Richard M. Stallman's avatar
Richard M. Stallman committed
217
  "Output a setq statement for VAR to the desktop file."
Richard M. Stallman's avatar
Richard M. Stallman committed
218
  (if (boundp var)
219 220 221 222 223
      (insert "(setq "
	      (symbol-name var)
	      " "
	      (desktop-value-to-string (symbol-value var))
	      ")\n")))
224
;; ----------------------------------------------------------------------------
225
(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
Richard M. Stallman's avatar
Richard M. Stallman committed
226
  "Return t if the desktop should record a particular buffer for next startup.
227
FILENAME is the visited file name, BUFNAME is the buffer name, and
Richard M. Stallman's avatar
Richard M. Stallman committed
228 229 230 231 232
MODE is the major mode."
  (or (and filename
	   (not (string-match desktop-buffers-not-to-save bufname)))
      (and (null filename)
	   (memq mode '(Info-mode dired-mode rmail-mode)))))
233
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
234 235 236 237
(defun desktop-save (dirname)
  "Save the Desktop file.  Parameter DIRNAME specifies where to save desktop."
  (interactive "DDirectory to save desktop file in: ")
  (save-excursion
238
    (let ((filename (expand-file-name
Richard M. Stallman's avatar
Richard M. Stallman committed
239
		     (concat dirname desktop-basefilename)))
240 241
	  (info (nreverse
		 (mapcar
Richard M. Stallman's avatar
Richard M. Stallman committed
242 243
		  (function (lambda (b)
			      (set-buffer b)
244
			      (list
Richard M. Stallman's avatar
Richard M. Stallman committed
245 246
			       (buffer-file-name)
			       (buffer-name)
247 248 249 250 251 252
			       major-mode
			       (list	; list explaining minor modes
				     (not (null
					   (if (eval-when-compile postv18)
					       auto-fill-function
					     auto-fill-hook))))
Richard M. Stallman's avatar
Richard M. Stallman committed
253
			       (point)
254 255
			       (if (eval-when-compile postv18)
				   (list (mark t) mark-active)
Richard M. Stallman's avatar
Richard M. Stallman committed
256 257
				 (mark))
			       buffer-read-only
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279
			       (cond ((eq major-mode 'Info-mode)
				      (list Info-current-file
					    Info-current-node))
				     ((eq major-mode 'dired-mode)
				      (if (eval-when-compile postv18)
					  (nreverse
					   (mapcar
					    (function car)
					    dired-subdir-alist))
					(list default-directory)))
				     )
			       (let ((locals desktop-locals-to-save)
				     (loclist (buffer-local-variables))
				     (ll))
				 (while locals
				   (let ((here (assq (car locals) loclist)))
				     (if here
					 (setq ll (cons here ll))
				       (if (member (car locals) loclist)
					   (setq ll (cons (car locals) ll)))))
				   (setq locals (cdr locals)))
				 ll)
Richard M. Stallman's avatar
Richard M. Stallman committed
280 281 282 283 284 285
			       )))
		  (buffer-list))))
	  (buf (get-buffer-create "*desktop*")))
      (set-buffer buf)
      (erase-buffer)

286 287 288 289
      (insert desktop-header
	      ";; Created " (current-time-string) "\n"
	      ";; Emacs version " emacs-version "\n\n"
	      ";; Global section:\n")
Richard M. Stallman's avatar
Richard M. Stallman committed
290 291
      (mapcar (function desktop-outvar) desktop-globals-to-save)
      (if (memq 'kill-ring desktop-globals-to-save)
292 293
	  (insert "(setq kill-ring-yank-pointer (nthcdr "
		  (int-to-string
Richard M. Stallman's avatar
Richard M. Stallman committed
294 295 296
		   (- (length kill-ring) (length kill-ring-yank-pointer)))
		  " kill-ring))\n"))

297
      (insert "\n;; Buffer section:\n")
Richard M. Stallman's avatar
Richard M. Stallman committed
298 299 300
      (let ((print-escape-newlines t))
	(mapcar
	 (function (lambda (l)
301
		     (if (apply 'desktop-save-buffer-p l)
Richard M. Stallman's avatar
Richard M. Stallman committed
302
			 (progn
303
			   (insert desktop-create-buffer-form)
Richard M. Stallman's avatar
Richard M. Stallman committed
304 305
			   (mapcar
			    (function (lambda (e)
306 307
					(insert "\n  "
						(desktop-value-to-string e))))
Richard M. Stallman's avatar
Richard M. Stallman committed
308 309 310
			    l)
			   (insert ")\n\n")))))
	 info))
Richard M. Stallman's avatar
Richard M. Stallman committed
311 312 313 314
      (setq default-directory dirname)
      (if (file-exists-p filename) (delete-file filename))
      (write-region (point-min) (point-max) filename nil 'nomessage)))
  (setq desktop-dirname dirname))
315
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
316 317 318 319 320 321 322
(defun desktop-remove ()
  "Delete the Desktop file and inactivate the desktop system."
  (interactive)
  (if desktop-dirname
      (let ((filename (concat desktop-dirname desktop-basefilename)))
	(if (file-exists-p filename) (delete-file filename))
	(setq desktop-dirname nil))))
323
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
324 325 326 327 328 329 330 331 332 333 334 335 336 337
(defun desktop-read ()
  "Read the Desktop file and the files it specifies."
  (interactive)
  (let ((filename))
    (if (file-exists-p (concat "./" desktop-basefilename))
	(setq desktop-dirname (expand-file-name "./"))
      (if (file-exists-p (concat "~/" desktop-basefilename))
	  (setq desktop-dirname (expand-file-name "~/"))
	(setq desktop-dirname nil)))
    (if desktop-dirname
	(progn
	  (load (concat desktop-dirname desktop-basefilename) t t t)
	  (message "Desktop loaded."))
      (desktop-clear))))
338
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
339
(defun desktop-load-default ()
340
  "Load the `default' start-up library manually.  Also inhibit further loading
341
of it.  Call this from your `.emacs' file to provide correct modes for
342 343
autoloaded files."
  (if (not inhibit-default-init)	; safety check
Richard M. Stallman's avatar
Richard M. Stallman committed
344 345 346
      (progn
	(load "default" t t)
	(setq inhibit-default-init t))))
347 348 349
;; ----------------------------------------------------------------------------
;; Note: the following functions use the dynamic variable binding in Lisp.
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
350
(defun desktop-buffer-info () "Load an info file."
351
  (if (eq 'Info-mode mam)
Richard M. Stallman's avatar
Richard M. Stallman committed
352 353 354 355
      (progn
	(require 'info)
	(Info-find-node (nth 0 misc) (nth 1 misc))
	t)))
356
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
357 358
(defun desktop-buffer-rmail () "Load an RMAIL file."
  (if (eq 'rmail-mode mam)
Richard M. Stallman's avatar
Richard M. Stallman committed
359
      (progn (rmail-input fn) t)))
360
;; ----------------------------------------------------------------------------
361 362 363 364 365 366 367 368
(defun desktop-buffer-mh () "Load a folder in the mh system."
  (if (eq 'mh-folder-mode mam)
      (progn
	(require 'mh-e)
	(mh-find-path)
	(mh-visit-folder bn)
	t)))
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
369
(defun desktop-buffer-dired () "Load a directory using dired."
Richard M. Stallman's avatar
Richard M. Stallman committed
370
  (if (eq 'dired-mode mam)
371 372 373 374 375
      (progn
	(dired (car misc))
	(mapcar (function dired-maybe-insert-subdir) (cdr misc))
	t)))
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
376 377 378 379
(defun desktop-buffer-file () "Load a file."
  (if fn
      (if (or (file-exists-p fn)
	      (and desktop-missing-file-warning
380 381
		   (y-or-n-p (format
			      "File \"%s\" no longer exists. Re-create? "
Richard M. Stallman's avatar
Richard M. Stallman committed
382 383 384
			      fn))))
	  (progn (find-file fn) t)
	'ignored)))
385 386
;; ----------------------------------------------------------------------------
;; Create a buffer, load its file, set is mode, ...;  called from Desktop file
Richard M. Stallman's avatar
Richard M. Stallman committed
387
;; only.
388
(defun desktop-create-buffer (ver fn bn mam mim pt mk ro misc &optional locals)
Richard M. Stallman's avatar
Richard M. Stallman committed
389 390 391 392 393 394 395
  (let ((hlist desktop-buffer-handlers)
	(result)
	(handler))
    (while (and (not result) hlist)
      (setq handler (car hlist))
      (setq result (funcall handler))
      (setq hlist (cdr hlist)))
Richard M. Stallman's avatar
Richard M. Stallman committed
396
    (if (eq result t)
Richard M. Stallman's avatar
Richard M. Stallman committed
397 398 399
	(progn
	  (if (not (equal (buffer-name) bn))
	      (rename-buffer bn))
400
	  (auto-fill-mode (if (nth 0 mim) 1 0))
Richard M. Stallman's avatar
Richard M. Stallman committed
401
	  (goto-char pt)
402 403 404 405 406 407 408
	  (if (consp mk)
	      (progn
		(set-mark (car mk))
		(setq mark-active (car (cdr mk))))
	    (set-mark mk))
	  ;; Never override file system if the file really is read-only marked.
	  (if ro (setq buffer-read-only ro))
409 410 411 412 413 414 415 416 417 418 419
	  (while locals
	    (let ((this (car locals)))
	      (if (consp this)
		  ;; an entry of this form `(symbol . value)'
		  (progn
		    (make-local-variable (car this))
		    (set (car this) (cdr this)))
		;; an entry of the form `symbol'
		(make-local-variable this)
		(makunbound this)))
	    (setq locals (cdr locals)))
Richard M. Stallman's avatar
Richard M. Stallman committed
420
	  ))))
421 422 423 424 425 426 427 428 429

;; Backward compatibility -- update parameters to 205 standards.
(defun desktop-buffer (fn bn mam mim pt mk ro tl fc cfs cr misc)
  (desktop-create-buffer 205 fn bn mam (cdr mim) pt mk ro misc
			 (list (cons 'truncate-lines tl)
			       (cons 'fill-column fc)
			       (cons 'case-fold-search cfs)
			       (cons 'case-replace cr)
			       (cons 'overwrite-mode (car mim)))))
430
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
431
(provide 'desktop)
Richard M. Stallman's avatar
Richard M. Stallman committed
432 433

;; desktop.el ends here.