From ec4c6f225a81e08f64ba3d16b2a0c10744bddc54 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 6 Jan 1994 11:34:51 +0000 Subject: [PATCH] (desktop-buffer-mh): New function for mh mail system. (desktop-buffer-handlers): Add desktop-buffer-mh. (desktop-buffer): Correct setting of auto-fill-mode. Make the compilation silent using (eval-when-compile ...) (old-kill-emacs): New explicit variable (for Emacs 18 comp.) (desktop-globals-to-save): Add the history rings for interactive searches. (postv18): Remove. (desktop-create-buffer-form): New variable. (desktop-save): Use desktop-create-buffer-form. (desktop-value-to-string): New function. (desktop-outvar): Clean-up using desktop-value-to-string. (desktop-save): clean-up Using desktop-value-to-string. (desktop-save): Decide Emacs version at compile time. (desktop-locals-to-save): New variable. (desktop-truncate): New function. --- lisp/desktop.el | 238 +++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 157 insertions(+), 81 deletions(-) diff --git a/lisp/desktop.el b/lisp/desktop.el index 66f8417a8cb..7b17c120099 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Morten Welinder -;; Version: 2.03 +;; Version: 2.05 ;; Keywords: customization ;; Favourite-brand-of-beer: None, I hate beer. @@ -33,10 +33,7 @@ ;; - the point ;; - the mark & mark-active ;; - buffer-read-only -;; - truncate-lines -;; - case-fold-search -;; - case-replace -;; - fill-column +;; - some local variables ;; To use this, first put these three lines in the bottom of your .emacs ;; file (the later the better): @@ -45,21 +42,46 @@ ;; (desktop-load-default) ;; (desktop-read) ;; +;; 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. ;; 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. -;; +;; 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. + ;; 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. + +;; 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. ;; --------------------------------------------------------------------------- ;; TODO: ;; @@ -70,6 +92,15 @@ ;;; Code: +;; 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))) +;; ---------------------------------------------------------------------------- ;; USER OPTIONS -- settings you might want to play with. ;; ---------------------------------------------------------------------------- (defconst desktop-basefilename @@ -85,13 +116,27 @@ Otherwise simply ignore the file.") (defvar desktop-globals-to-save (list 'desktop-missing-file-warning ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer - ;; 'kill-ring + ;; 'kill-ring 'tags-file-name 'tags-table-list + 'search-ring + 'regexp-search-ring ;; 'desktop-globals-to-save ; Itself! ) "List of global variables to save when killing Emacs.") +(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.") + ;; 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). @@ -102,6 +147,7 @@ Otherwise simply ignore the file.") (defvar desktop-buffer-handlers '(desktop-buffer-dired desktop-buffer-rmail + desktop-buffer-mh desktop-buffer-info desktop-buffer-file) "*List of functions to call in order to create a buffer. The functions are @@ -109,6 +155,9 @@ 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. If the function returns t then the buffer is considered created.") + +(defvar desktop-create-buffer-form "(desktop-create-buffer 205" + "Opening of form for creation of new buffers.") ;; ---------------------------------------------------------------------------- (defvar desktop-dirname nil "The directory in which the current desktop file resides.") @@ -119,10 +168,12 @@ If the function returns t then the buffer is considered created.") ;; -------------------------------------------------------------------------- " "*Header to place in Desktop file.") ;; ---------------------------------------------------------------------------- -(defconst postv18 - (string-lessp "19" emacs-version) - "t if Emacs version 19 or later.") - +(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)))) +;; ---------------------------------------------------------------------------- (defun desktop-clear () "Empty the Desktop." (interactive) (setq kill-ring nil) @@ -132,11 +183,13 @@ If the function returns t then the buffer is considered created.") ;; ---------------------------------------------------------------------------- ;; This is a bit dirty for version 18 because that version of Emacs was not ;; toilet-trained considering hooks. -(if (not (boundp 'desktop-kill)) - (if postv18 - (add-hook 'kill-emacs-hook 'desktop-kill) - (setq old-kill-emacs kill-emacs-hook) - (setq kill-emacs-hook +(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 (function (lambda () (progn (desktop-kill) (if (or (null old-kill-emacs) @@ -149,23 +202,27 @@ If the function returns t then the buffer is considered created.") (progn (desktop-save desktop-dirname)))) ;; ---------------------------------------------------------------------------- +(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)))) +;; ---------------------------------------------------------------------------- (defun desktop-outvar (var) "Output a setq statement for VAR to the desktop file." (if (boundp var) - (let ((print-escape-newlines t) - (val (symbol-value var))) - (insert "(setq ") - (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)) - (insert ")\n")))) + (insert "(setq " + (symbol-name var) + " " + (desktop-value-to-string (symbol-value var)) + ")\n"))) ;; ---------------------------------------------------------------------------- -(defun desktop-save-buffer-p (filename bufname mode) +(defun desktop-save-buffer-p (filename bufname mode &rest dummy) "Return t if the desktop should record a particular buffer for next startup. FILENAME is the visited file name, BUFNAME is the buffer name, and MODE is the major mode." @@ -187,35 +244,39 @@ MODE is the major mode." (list (buffer-file-name) (buffer-name) - (list 'quote major-mode) - (list 'quote - (list overwrite-mode - (not (null - (if postv18 - auto-fill-function - auto-fill-hook))))) + major-mode + (list ; list explaining minor modes + (not (null + (if (eval-when-compile postv18) + auto-fill-function + auto-fill-hook)))) (point) - (if postv18 - (list 'quote (list (mark t) mark-active)) + (if (eval-when-compile postv18) + (list (mark t) mark-active) (mark)) buffer-read-only - truncate-lines - fill-column - case-fold-search - case-replace - (list - 'quote - (cond ((equal major-mode 'Info-mode) - (list Info-current-file - Info-current-node)) - ((equal major-mode 'dired-mode) - (if postv18 - (nreverse - (mapcar - (function car) - dired-subdir-alist)) - (list default-directory))) - )) + (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) ))) (buffer-list)))) (buf (get-buffer-create "*desktop*"))) @@ -237,16 +298,13 @@ MODE is the major mode." (let ((print-escape-newlines t)) (mapcar (function (lambda (l) - (if (desktop-save-buffer-p - (car l) - (nth 1 l) - (nth 1 (nth 2 l))) + (if (apply 'desktop-save-buffer-p l) (progn - (insert "(desktop-buffer") + (insert desktop-create-buffer-form) (mapcar (function (lambda (e) - (insert "\n ") - (prin1 e (current-buffer)))) + (insert "\n " + (desktop-value-to-string e)))) l) (insert ")\n\n"))))) info)) @@ -280,7 +338,7 @@ MODE is the major mode." ;; ---------------------------------------------------------------------------- (defun desktop-load-default () "Load the `default' start-up library manually. Also inhibit further loading -of it. Call this from your `.emacs' file to provide correct modes for +of it. Call this from your `.emacs' file to provide correct modes for autoloaded files." (if (not inhibit-default-init) ; safety check (progn @@ -288,10 +346,9 @@ autoloaded files." (setq inhibit-default-init t)))) ;; ---------------------------------------------------------------------------- ;; Note: the following functions use the dynamic variable binding in Lisp. -;; The byte compiler may therefore complain of undeclared variables. ;; (defun desktop-buffer-info () "Load an info file." - (if (equal 'Info-mode mam) + (if (eq 'Info-mode mam) (progn (require 'info) (Info-find-node (nth 0 misc) (nth 1 misc)) @@ -301,6 +358,14 @@ autoloaded files." (if (eq 'rmail-mode mam) (progn (rmail-input fn) t))) ;; ---------------------------------------------------------------------------- +(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))) +;; ---------------------------------------------------------------------------- (defun desktop-buffer-dired () "Load a directory using dired." (if (eq 'dired-mode mam) (progn @@ -320,7 +385,7 @@ autoloaded files." ;; ---------------------------------------------------------------------------- ;; Create a buffer, load its file, set is mode, ...; called from Desktop file ;; only. -(defun desktop-buffer (fn bn mam mim pt mk ro tl fc cfs cr misc) +(defun desktop-create-buffer (ver fn bn mam mim pt mk ro misc &optional locals) (let ((hlist desktop-buffer-handlers) (result) (handler)) @@ -332,12 +397,7 @@ autoloaded files." (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)) + (auto-fill-mode (if (nth 0 mim) 1 0)) (goto-char pt) (if (consp mk) (progn @@ -346,11 +406,27 @@ autoloaded files." (set-mark mk)) ;; Never override file system if the file really is read-only marked. (if ro (setq buffer-read-only ro)) - (setq truncate-lines tl) - (setq fill-column fc) - (setq case-fold-search cfs) - (setq case-replace cr) + (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))) )))) + +;; 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))))) ;; ---------------------------------------------------------------------------- (provide 'desktop) -- 2.11.4.GIT