desktop.el 12.5 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>
Richard M. Stallman's avatar
Richard M. Stallman committed
6 7 8
;; Version: 2.03
;; 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 36 37 38 39
;; 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
;;		- truncate-lines
;;		- case-fold-search
;;		- case-replace
;;		- fill-column
Richard M. Stallman's avatar
Richard M. Stallman committed
40

41 42 43 44 45 46 47
;; 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)
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
48

49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
;; 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
;; left them.
;;
;; 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.
;;
;; 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.
;; ---------------------------------------------------------------------------
;; 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
70 71 72

;;; Code:

73 74 75
;; USER OPTIONS -- settings you might want to play with.
;; ----------------------------------------------------------------------------
(defconst desktop-basefilename
Richard M. Stallman's avatar
Richard M. Stallman committed
76 77 78 79 80
  (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.")

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

85
(defvar desktop-globals-to-save
Richard M. Stallman's avatar
Richard M. Stallman committed
86
  (list 'desktop-missing-file-warning
87 88 89 90 91
	;; Feature: saving kill-ring implies saving kill-ring-yank-pointer
	;; 'kill-ring			
	'tags-file-name
	'tags-table-list
	;; 'desktop-globals-to-save	; Itself!
Richard M. Stallman's avatar
Richard M. Stallman committed
92
	)
Richard M. Stallman's avatar
Richard M. Stallman committed
93 94
  "List of global variables to save when killing Emacs.")

95 96 97
;; 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
98
(defvar desktop-buffers-not-to-save
99
 "\\(\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
Richard M. Stallman's avatar
Richard M. Stallman committed
100 101 102
 "Regexp identifying buffers that are to be excluded from saving.")

(defvar desktop-buffer-handlers
103
  '(desktop-buffer-dired
Richard M. Stallman's avatar
Richard M. Stallman committed
104 105 106
    desktop-buffer-rmail
    desktop-buffer-info
    desktop-buffer-file)
107 108 109 110
  "*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
111
If the function returns t then the buffer is considered created.")
112 113
;; ----------------------------------------------------------------------------
(defvar desktop-dirname nil
Richard M. Stallman's avatar
Richard M. Stallman committed
114 115 116
  "The directory in which the current desktop file resides.")

(defconst desktop-header
117 118 119
";; --------------------------------------------------------------------------
;; Desktop File for Emacs
;; --------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
120
" "*Header to place in Desktop file.")
121 122
;; ----------------------------------------------------------------------------
(defconst postv18
Richard M. Stallman's avatar
Richard M. Stallman committed
123
  (string-lessp "19" emacs-version)
124
  "t if Emacs version 19 or later.")
Richard M. Stallman's avatar
Richard M. Stallman committed
125 126 127 128 129

(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
130 131
  (mapcar (function kill-buffer) (buffer-list))
  (delete-other-windows))
132 133 134
;; ----------------------------------------------------------------------------
;; This is a bit dirty for version 18 because that version of Emacs was not
;; toilet-trained considering hooks.
Richard M. Stallman's avatar
Richard M. Stallman committed
135 136 137 138
(if (not (boundp 'desktop-kill))
    (if postv18
	(add-hook 'kill-emacs-hook 'desktop-kill)
      (setq old-kill-emacs kill-emacs-hook)
139 140 141 142 143 144 145 146
      (setq kill-emacs-hook
	    (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
147
(defun desktop-kill ()
148
  (if desktop-dirname
Richard M. Stallman's avatar
Richard M. Stallman committed
149 150
      (progn
	(desktop-save desktop-dirname))))
151
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
152
(defun desktop-outvar (var)
Richard M. Stallman's avatar
Richard M. Stallman committed
153
  "Output a setq statement for VAR to the desktop file."
Richard M. Stallman's avatar
Richard M. Stallman committed
154 155 156
  (if (boundp var)
      (let ((print-escape-newlines t)
	    (val (symbol-value var)))
Richard M. Stallman's avatar
Richard M. Stallman committed
157
	(insert "(setq ")
Richard M. Stallman's avatar
Richard M. Stallman committed
158 159 160 161 162 163 164 165
	(prin1 var (current-buffer))
	;; 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))))
	    (insert " '")
	  (insert " "))
	(prin1 val (current-buffer))
Richard M. Stallman's avatar
Richard M. Stallman committed
166
	(insert ")\n"))))
167
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
168
(defun desktop-save-buffer-p (filename bufname mode)
Richard M. Stallman's avatar
Richard M. Stallman committed
169
  "Return t if the desktop should record a particular buffer for next startup.
170
FILENAME is the visited file name, BUFNAME is the buffer name, and
Richard M. Stallman's avatar
Richard M. Stallman committed
171 172 173 174 175
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)))))
176
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
177 178 179 180
(defun desktop-save (dirname)
  "Save the Desktop file.  Parameter DIRNAME specifies where to save desktop."
  (interactive "DDirectory to save desktop file in: ")
  (save-excursion
181
    (let ((filename (expand-file-name
Richard M. Stallman's avatar
Richard M. Stallman committed
182
		     (concat dirname desktop-basefilename)))
183 184
	  (info (nreverse
		 (mapcar
Richard M. Stallman's avatar
Richard M. Stallman committed
185 186
		  (function (lambda (b)
			      (set-buffer b)
187
			      (list
Richard M. Stallman's avatar
Richard M. Stallman committed
188 189 190 191
			       (buffer-file-name)
			       (buffer-name)
			       (list 'quote major-mode)
			       (list 'quote
192 193
				     (list overwrite-mode
					   (not (null
Richard M. Stallman's avatar
Richard M. Stallman committed
194 195 196 197 198
						 (if postv18
						     auto-fill-function
						   auto-fill-hook)))))
			       (point)
			       (if postv18
Richard M. Stallman's avatar
Richard M. Stallman committed
199
				   (list 'quote (list (mark t) mark-active))
Richard M. Stallman's avatar
Richard M. Stallman committed
200 201 202 203 204 205
				 (mark))
			       buffer-read-only
			       truncate-lines
			       fill-column
			       case-fold-search
			       case-replace
206
			       (list
Richard M. Stallman's avatar
Richard M. Stallman committed
207 208 209 210 211
				'quote
				(cond ((equal major-mode 'Info-mode)
				       (list Info-current-file
					     Info-current-node))
				      ((equal major-mode 'dired-mode)
212 213 214 215 216 217
				       (if postv18
					   (nreverse
					    (mapcar
					     (function car)
					     dired-subdir-alist))
					 (list default-directory)))
Richard M. Stallman's avatar
Richard M. Stallman committed
218 219 220 221 222 223 224
				      ))
			       )))
		  (buffer-list))))
	  (buf (get-buffer-create "*desktop*")))
      (set-buffer buf)
      (erase-buffer)

225 226 227 228
      (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
229 230
      (mapcar (function desktop-outvar) desktop-globals-to-save)
      (if (memq 'kill-ring desktop-globals-to-save)
231 232
	  (insert "(setq kill-ring-yank-pointer (nthcdr "
		  (int-to-string
Richard M. Stallman's avatar
Richard M. Stallman committed
233 234 235
		   (- (length kill-ring) (length kill-ring-yank-pointer)))
		  " kill-ring))\n"))

236
      (insert "\n;; Buffer section:\n")
Richard M. Stallman's avatar
Richard M. Stallman committed
237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
      (let ((print-escape-newlines t))
	(mapcar
	 (function (lambda (l)
		     (if (desktop-save-buffer-p
			  (car l)
			  (nth 1 l)
			  (nth 1 (nth 2 l)))
			 (progn
			   (insert "(desktop-buffer")
			   (mapcar
			    (function (lambda (e)
					(insert "\n  ")
					(prin1 e (current-buffer))))
			    l)
			   (insert ")\n\n")))))
	 info))
Richard M. Stallman's avatar
Richard M. Stallman committed
253 254 255 256
      (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))
257
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
258 259 260 261 262 263 264
(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))))
265
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
266 267 268 269 270 271 272 273 274 275 276 277 278 279
(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))))
280
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
281
(defun desktop-load-default ()
282 283 284 285
  "Load the `default' start-up library manually.  Also inhibit further loading
of it.  Call this from your `.emacs' file to provide correct modes for 
autoloaded files."
  (if (not inhibit-default-init)	; safety check
Richard M. Stallman's avatar
Richard M. Stallman committed
286 287 288
      (progn
	(load "default" t t)
	(setq inhibit-default-init t))))
289 290 291 292
;; ----------------------------------------------------------------------------
;; Note: the following functions use the dynamic variable binding in Lisp.
;;       The byte compiler may therefore complain of undeclared variables.
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
293 294 295 296 297 298
(defun desktop-buffer-info () "Load an info file."
  (if (equal 'Info-mode mam)
      (progn
	(require 'info)
	(Info-find-node (nth 0 misc) (nth 1 misc))
	t)))
299
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
300 301
(defun desktop-buffer-rmail () "Load an RMAIL file."
  (if (eq 'rmail-mode mam)
Richard M. Stallman's avatar
Richard M. Stallman committed
302
      (progn (rmail-input fn) t)))
303
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
304
(defun desktop-buffer-dired () "Load a directory using dired."
Richard M. Stallman's avatar
Richard M. Stallman committed
305
  (if (eq 'dired-mode mam)
306 307 308 309 310
      (progn
	(dired (car misc))
	(mapcar (function dired-maybe-insert-subdir) (cdr misc))
	t)))
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
311 312 313 314
(defun desktop-buffer-file () "Load a file."
  (if fn
      (if (or (file-exists-p fn)
	      (and desktop-missing-file-warning
315 316
		   (y-or-n-p (format
			      "File \"%s\" no longer exists. Re-create? "
Richard M. Stallman's avatar
Richard M. Stallman committed
317 318 319
			      fn))))
	  (progn (find-file fn) t)
	'ignored)))
320 321
;; ----------------------------------------------------------------------------
;; Create a buffer, load its file, set is mode, ...;  called from Desktop file
Richard M. Stallman's avatar
Richard M. Stallman committed
322 323 324 325 326 327 328 329 330
;; only.
(defun desktop-buffer (fn bn mam mim pt mk ro tl fc cfs cr misc)
  (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
331
    (if (eq result t)
Richard M. Stallman's avatar
Richard M. Stallman committed
332 333 334 335 336 337 338 339 340 341
	(progn
	  (if (not (equal (buffer-name) bn))
	      (rename-buffer bn))
	  (if (nth 0 mim)
	      (overwrite-mode 1)
	    (overwrite-mode 0))
	  (if (nth 1 mim)
	      (auto-fill-mode 1)
	    (overwrite-mode 0))
	  (goto-char pt)
342 343 344 345 346 347 348
	  (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))
Richard M. Stallman's avatar
Richard M. Stallman committed
349 350 351 352 353
	  (setq truncate-lines tl)
	  (setq fill-column fc)
	  (setq case-fold-search cfs)
	  (setq case-replace cr)
	  ))))
354
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
355
(provide 'desktop)
Richard M. Stallman's avatar
Richard M. Stallman committed
356 357

;; desktop.el ends here.