Mercurial > emacs
comparison lisp/desktop.el @ 5314:e65e125e5334
Add keywords.
(desktop-outvar): clean-up output using fewer quotes and \n for newlines.
(desktop-save): print buffer information using \n for newlines.
(desktop-save-buffer-p): doc fix.
(desktop-save): bug in mark-activity saving.
(desktop-buffer-rmail): doc fix.
(desktop-buffer-rmail, desktop-buffer-dired, desktop-buffer):
Use `eq' instead of `equal'.
(desktop-clear): end up with one window.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 23 Dec 1993 04:59:47 +0000 |
parents | a61307ac474e |
children | 9fcfca1caec7 |
comparison
equal
deleted
inserted
replaced
5313:3189e46001fd | 5314:e65e125e5334 |
---|---|
1 ;;; desktop.el --- save partial status of Emacs when killed | 1 ;;; desktop.el --- save partial status of Emacs when killed |
2 | 2 |
3 ;; Copyright (C) 1993 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1993 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Morten Welinder <terra@diku.dk> | 5 ;; Author: Morten Welinder <terra@diku.dk> |
6 ;; Version: 2.02 | 6 ;; Version: 2.03 |
7 ;; Keywords: customization | |
8 ;; Favourite-brand-of-beer: None, I hate beer. | |
7 | 9 |
8 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
9 | 11 |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
11 ;; it under the terms of the GNU General Public License as published by | 13 ;; it under the terms of the GNU General Public License as published by |
85 ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer | 87 ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer |
86 ;; 'kill-ring | 88 ;; 'kill-ring |
87 'tags-file-name | 89 'tags-file-name |
88 'tags-table-list | 90 'tags-table-list |
89 ;; 'desktop-globals-to-save ; Itself! | 91 ;; 'desktop-globals-to-save ; Itself! |
90 ) | 92 ) |
91 "List of global variables to save when killing Emacs.") | 93 "List of global variables to save when killing Emacs.") |
92 | 94 |
93 ;; We skip .log files because they are normally temporary. | 95 ;; We skip .log files because they are normally temporary. |
94 ;; (ftp) files because they require passwords and whatsnot. | 96 ;; (ftp) files because they require passwords and whatsnot. |
95 ;; TAGS files to save time (tags-file-name is saved instead). | 97 ;; TAGS files to save time (tags-file-name is saved instead). |
123 | 125 |
124 (defun desktop-clear () "Empty the Desktop." | 126 (defun desktop-clear () "Empty the Desktop." |
125 (interactive) | 127 (interactive) |
126 (setq kill-ring nil) | 128 (setq kill-ring nil) |
127 (setq kill-ring-yank-pointer nil) | 129 (setq kill-ring-yank-pointer nil) |
128 (mapcar (function kill-buffer) (buffer-list))) | 130 (mapcar (function kill-buffer) (buffer-list)) |
131 (delete-other-windows)) | |
129 ;; ---------------------------------------------------------------------------- | 132 ;; ---------------------------------------------------------------------------- |
130 ;; This is a bit dirty for version 18 because that version of Emacs was not | 133 ;; This is a bit dirty for version 18 because that version of Emacs was not |
131 ;; toilet-trained considering hooks. | 134 ;; toilet-trained considering hooks. |
132 (if (not (boundp 'desktop-kill)) | 135 (if (not (boundp 'desktop-kill)) |
133 (if postv18 | 136 (if postv18 |
144 (defun desktop-kill () | 147 (defun desktop-kill () |
145 (if desktop-dirname | 148 (if desktop-dirname |
146 (progn | 149 (progn |
147 (desktop-save desktop-dirname)))) | 150 (desktop-save desktop-dirname)))) |
148 ;; ---------------------------------------------------------------------------- | 151 ;; ---------------------------------------------------------------------------- |
149 (defun desktop-outvar (VAR) | 152 (defun desktop-outvar (var) |
150 "Output a setq statement for VAR to the desktop file." | 153 "Output a setq statement for VAR to the desktop file." |
151 (if (boundp VAR) | 154 (if (boundp var) |
152 (progn | 155 (let ((print-escape-newlines t) |
156 (val (symbol-value var))) | |
153 (insert "(setq ") | 157 (insert "(setq ") |
154 (prin1 VAR (current-buffer)) | 158 (prin1 var (current-buffer)) |
155 (insert " '") | 159 ;; symbols are needed for cons cells and for symbols except |
156 (prin1 (symbol-value VAR) (current-buffer)) | 160 ;; `t' and `nil'. |
161 (if (or (consp val) | |
162 (and (symbolp val) val (not (eq t val)))) | |
163 (insert " '") | |
164 (insert " ")) | |
165 (prin1 val (current-buffer)) | |
157 (insert ")\n")))) | 166 (insert ")\n")))) |
158 ;; ---------------------------------------------------------------------------- | 167 ;; ---------------------------------------------------------------------------- |
159 (defun desktop-save-buffer-p (filename bufname mode) | 168 (defun desktop-save-buffer-p (filename bufname mode) |
160 "Return t if should record a particular buffer for next startup. | 169 "Return t if the desktop should record a particular buffer for next startup. |
161 FILENAME is the visited file name, BUFNAME is the buffer name, and | 170 FILENAME is the visited file name, BUFNAME is the buffer name, and |
162 MODE is the major mode." | 171 MODE is the major mode." |
163 | |
164 (or (and filename | 172 (or (and filename |
165 (not (string-match desktop-buffers-not-to-save bufname))) | 173 (not (string-match desktop-buffers-not-to-save bufname))) |
166 (and (null filename) | 174 (and (null filename) |
167 (memq mode '(Info-mode dired-mode rmail-mode))))) | 175 (memq mode '(Info-mode dired-mode rmail-mode))))) |
168 ;; ---------------------------------------------------------------------------- | 176 ;; ---------------------------------------------------------------------------- |
186 (if postv18 | 194 (if postv18 |
187 auto-fill-function | 195 auto-fill-function |
188 auto-fill-hook))))) | 196 auto-fill-hook))))) |
189 (point) | 197 (point) |
190 (if postv18 | 198 (if postv18 |
191 (list 'quote (mark t) mark-active) | 199 (list 'quote (list (mark t) mark-active)) |
192 (mark)) | 200 (mark)) |
193 buffer-read-only | 201 buffer-read-only |
194 truncate-lines | 202 truncate-lines |
195 fill-column | 203 fill-column |
196 case-fold-search | 204 case-fold-search |
224 (int-to-string | 232 (int-to-string |
225 (- (length kill-ring) (length kill-ring-yank-pointer))) | 233 (- (length kill-ring) (length kill-ring-yank-pointer))) |
226 " kill-ring))\n")) | 234 " kill-ring))\n")) |
227 | 235 |
228 (insert "\n;; Buffer section:\n") | 236 (insert "\n;; Buffer section:\n") |
229 (mapcar | 237 (let ((print-escape-newlines t)) |
230 (function (lambda (l) | 238 (mapcar |
231 (if (desktop-save-buffer-p | 239 (function (lambda (l) |
232 (car l) | 240 (if (desktop-save-buffer-p |
233 (nth 1 l) | 241 (car l) |
234 (nth 1 (nth 2 l))) | 242 (nth 1 l) |
235 (progn | 243 (nth 1 (nth 2 l))) |
236 (insert "(desktop-buffer") | 244 (progn |
237 (mapcar | 245 (insert "(desktop-buffer") |
238 (function (lambda (e) | 246 (mapcar |
239 (insert "\n ") | 247 (function (lambda (e) |
240 (prin1 e (current-buffer)))) | 248 (insert "\n ") |
241 l) | 249 (prin1 e (current-buffer)))) |
242 (insert ")\n\n"))))) | 250 l) |
243 info) | 251 (insert ")\n\n"))))) |
252 info)) | |
244 (setq default-directory dirname) | 253 (setq default-directory dirname) |
245 (if (file-exists-p filename) (delete-file filename)) | 254 (if (file-exists-p filename) (delete-file filename)) |
246 (write-region (point-min) (point-max) filename nil 'nomessage))) | 255 (write-region (point-min) (point-max) filename nil 'nomessage))) |
247 (setq desktop-dirname dirname)) | 256 (setq desktop-dirname dirname)) |
248 ;; ---------------------------------------------------------------------------- | 257 ;; ---------------------------------------------------------------------------- |
286 (progn | 295 (progn |
287 (require 'info) | 296 (require 'info) |
288 (Info-find-node (nth 0 misc) (nth 1 misc)) | 297 (Info-find-node (nth 0 misc) (nth 1 misc)) |
289 t))) | 298 t))) |
290 ;; ---------------------------------------------------------------------------- | 299 ;; ---------------------------------------------------------------------------- |
291 (defun desktop-buffer-rmail () "Load a RMAIL file." | 300 (defun desktop-buffer-rmail () "Load an RMAIL file." |
292 (if (equal 'rmail-mode mam) | 301 (if (eq 'rmail-mode mam) |
293 (progn (rmail-input fn) t))) | 302 (progn (rmail-input fn) t))) |
294 ;; ---------------------------------------------------------------------------- | 303 ;; ---------------------------------------------------------------------------- |
295 (defun desktop-buffer-dired () "Load a directory using dired." | 304 (defun desktop-buffer-dired () "Load a directory using dired." |
296 (if (equal 'dired-mode mam) | 305 (if (eq 'dired-mode mam) |
297 (progn | 306 (progn |
298 (dired (car misc)) | 307 (dired (car misc)) |
299 (mapcar (function dired-maybe-insert-subdir) (cdr misc)) | 308 (mapcar (function dired-maybe-insert-subdir) (cdr misc)) |
300 t))) | 309 t))) |
301 ;; ---------------------------------------------------------------------------- | 310 ;; ---------------------------------------------------------------------------- |
317 (handler)) | 326 (handler)) |
318 (while (and (not result) hlist) | 327 (while (and (not result) hlist) |
319 (setq handler (car hlist)) | 328 (setq handler (car hlist)) |
320 (setq result (funcall handler)) | 329 (setq result (funcall handler)) |
321 (setq hlist (cdr hlist))) | 330 (setq hlist (cdr hlist))) |
322 (if (equal result t) | 331 (if (eq result t) |
323 (progn | 332 (progn |
324 (if (not (equal (buffer-name) bn)) | 333 (if (not (equal (buffer-name) bn)) |
325 (rename-buffer bn)) | 334 (rename-buffer bn)) |
326 (if (nth 0 mim) | 335 (if (nth 0 mim) |
327 (overwrite-mode 1) | 336 (overwrite-mode 1) |
344 )))) | 353 )))) |
345 ;; ---------------------------------------------------------------------------- | 354 ;; ---------------------------------------------------------------------------- |
346 (provide 'desktop) | 355 (provide 'desktop) |
347 | 356 |
348 ;; desktop.el ends here. | 357 ;; desktop.el ends here. |
349 |