[comp.emacs] Another context saving file

neves@ai.WISC.EDU (David M. Neves) (11/19/87)

Here is a .el file that saves context between GNUemacs sessions.
Currently it saves only the value of the point for each file when you
exit Emacs.  When you next read in the file (e.g. with ^x^f) you will
find yourself back at that point and not at the beginning of the file.


;;;------cut here-----
;;; context.el
;;; Wed Nov 18 13:39:05 1987
;;;
;;; This is a slightly tested version.  Use at own risk.  It is
;;; being submitted to get suggestions.
;;; Bugs, suggestions to 
;;;   (david neves, neves@cs.wisc.edu, neves@uwvax.UUCP)
;;;
;;; Documentation:
;;; Save some context between editing sessions.  Currently only
;;; the location of the point is saved (in the file ~/.emacs_context).
;;; Thereafter, whenever a file is read into a buffer you will find 
;;; yourself back at the point where you left off.
;;;
;;; The context is saved when the user types Meta-x save-context or
;;; when exiting Emacs with the save-context flag set to true.
;;;
;;; To use:
;;; Put the following in your .emacs file
;;; (load "context.elc") ;i.e. after byte compiling this file
;;; (read-context)       ;reads the context from the context file.
;;;
;;; Known bugs:
;;; a. If you read in a file by giving it as an argument to emacs,
;;;      e.g. emacs foo
;;;   you will find yourself at the beginning of foo, not at the context
;;;   point.  Might be able to kludge around this bug but a better fix
;;;   is for the GNU people to change the goto-line in startup.el so
;;;   that it is only called when line is not equal to 0.
;;; b. If you revert a buffer you find yourself at the context point
;;;   and not at the point you were at when you reverted the buffer.
;;;   Probably should do something with revert-buffer-function to
;;;   temporarily set the context-flag to nil.
;;; c. If you are running multiple Emacs then the last one exited will
;;;   determine the final form of the context file.  I'm not sure
;;;   how to fix this.
 
(defconst context-file "~/.emacs_context" "*File for Emacs context")

(defvar context-alist nil "Association list holding some file context.
  The structure is ( (file-name1 point) (file-name2 point) ...)")

(defvar context-max-size 50 ;why 50?  why not?
  "*Maximum number of files that context is saved for.
If not a number (e.g. nil) then the number of files is allowed to
grow arbitrarily large.  This will result in slower performance because
the context-alist is searched linearly.")

(defvar context-flag t
  "*If non-nil the `save-context' command will always be run before Emacs is
exited and context will be applied to files that are read in.  In other words,
you can turn off all context processing by setting this flag to nil.")

;;; change kill-emacs so that context will be saved out when you leave emacs.
(if (not (fboundp 'original-kill-emacs))
    (fset 'original-kill-emacs (symbol-function 'kill-emacs)))

;;; Call get-context when a file is loaded into a buffer.
;;; Should only add get-context to file-file-hooks if it isn't there.
;;;  (just in case the file is loaded more than once.)
;;; There is no member or pushnew function in GNUEmacs but the following should
;;; work most of the time.
(if (not (eq (car find-file-hooks) 'get-context))
    (setq find-file-hooks (cons 'get-context find-file-hooks)))

(defun read-context ()
   "Read in an Emacs context.  Usually done when Emacs is initially called.
    This function should be called in .emacs ."
   (interactive)
      (if (not (file-exists-p context-file)) (setq context-alist nil)
	(load context-file t t t)))

(defmacro second (l)  (list 'car (list 'cdr l)))
(defmacro context-get-point (l)  (list 'second l))

;;; Apply the context that is saved for the current file.
;;; Called in find-file-hooks (i.e. when a file is loaded).
;;; Doesn't apply context if context-flag is nil.
(defun get-context nil
  (if context-flag
      (let* ((buf (current-buffer))
	     (file-name (buffer-file-name buf))
	     file-data)
	(if (null file-name) nil
	  (setq file-data (assoc file-name context-alist))
	  (if (null file-data) nil
	    (goto-char (context-get-point file-data)))))))

(defun save-context ()
  "Save context (currently, the point) of all Emacs buffers.
The context information goes into a file whose name is stored 
in the variable 'context-file')."
  (interactive)
  (save-excursion
    (mapcar (function read-buffer-context) (buffer-list))
    (let ((buf (get-buffer-create "*context*"))
	  nth-part)
      (cond ((numberp context-max-size)
	     (setq nth-part (nthcdr (1- context-max-size) context-alist))
	     (if nth-part (rplacd nth-part nil))));reduce size of context-alist
      (set-buffer buf)
      (erase-buffer)
      (insert "(setq context-alist '(")
      (mapcar (function (lambda (l) 
			  ;; print function in 18.4x outputs 2 newlines
			  ;; so use terpri and prin1 instead
			  (terpri buf)
			  (prin1 l buf))) context-alist)
      (insert "))")
      (if (file-exists-p context-file) (delete-file context-file))
      (write-region 1 (point-max) context-file nil 'nomessage)
      (kill-buffer buf))))

;;; place buffer context in the list "context-alist".
;;; If it already exists in that list then also move that
;;; information to the front of the alist.
(defun read-buffer-context (buf)
  (let ((file-name (buffer-file-name buf))
	buffer-data
	assoc-result
	before
	point-loc
	start-of-buffer-flag
	file-data)
    (set-buffer buf)
    (setq pointloc (point))
    (setq start-of-buffer-flag (eql 1 pointloc))
    (setq buffer-data (list pointloc)) ;only save the point
    ;; since we are currently only saving the point, don't
    ;; save out context if the point is at the beginning of
    ;; the buffer (i.e. is equal to 1).
    (if (or (null file-name) start-of-buffer-flag) nil
      (setq assoc-result (context-assoc file-name context-alist))
      (setq file-data (car assoc-result))
      (if (null file-data) (setq context-alist 
				 (cons (cons file-name buffer-data) 
				       context-alist))
	(rplacd file-data buffer-data) ;associate new context with file name
	;; move (file data) to front of alist.
	;; The first n entries are deleted when emacs is finished.
	(setq before (second assoc-result))
	(if (null before) nil                  ;already at front
	  (rplacd before (cdr (cdr before)))   ;else splice it out
	  ;; again, only save context if point is not at start of buffer
	  (if (not start-of-buffer-flag)
	      (setq context-alist (cons file-data context-alist))))))))


(defun kill-emacs (&optional query)
  "End this Emacs session.
Prefix ARG or optional first ARG non-nil means exit with no questions asked,
even if there are unsaved buffers.  If Emacs is running non-interactively
and ARG is an integer, then Emacs exits with ARG as its exit code.

If the variable `context-flag' is non-nil,
the function save-context will be called first."
  (interactive "P")
  (if context-flag (save-context))
  (original-kill-emacs query))

;;; version of assoc that returns 2 values (in a list)
;;; (pair found, position before it)
;;; e.g. (context-assoc 'foo '((a b) (c d) (foo bar) (e f)))
;;;      ((foo bar) ((c d) (foo bar) (e f)))
;;; We are also returning the position before it
;;;  so that we can splice it out of the list with rplacd.
;;; if car of result is nil then failure - we failed to find the item.
;;; if cadr of result is nil then the item is at the front of the list.
(defun context-assoc (key alist)
  (let ((before nil) (current alist))
    (if (equal key (car (car current))) nil
      (setq current (cdr current))
      (while (and current (not (equal key (car (car current)))))
	(setq before current)
	(setq current (cdr current))))
    (list (car current) before)))
;;;------cut here-----


David Neves, Computer Sciences Department, University of Wisconsin-Madison
Usenet:  {rutgers,ucbvax,ihnp4}!uwvax!neves
Arpanet: neves@cs.wisc.edu

wilkes@mips.UUCP (John Wilkes) (11/24/87)

I tried byte-compiling context.el and got the following complaint:
"Variable read-buffer-context seen on pass 2 of byte compiler but not pass 1"

If I load-file context.el, it appears to work fine.  This is with version
18.35 (I have 18.49 at home, but have not tried it there yet).  I can see
for myself that read-buffer-context is defun'ed, and as I am realtively
gnew to GNU Emacs, I am unsure of the meaning of the error message.  Any
clues would be appreciated.

Thanks!

John Wilkes

-- 
-- @work: {ames,decwrl,prls,pyramid}!mips!wilkes   OR   wilkes@mips.com
-- @home: {mips,elxsi}!maow!john   OR   maow!john@ucscc.UCSC.EDU