;;; $Header: emacs-save.el,v 1.1 89/09/25 14:34:01 sarantos Exp $
;;; Author: Sarantos Kapidakis, sarantos@princeton.edu

;;; This file is not part of the GNU Emacs distribution (yet).

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; this file, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;;; To automatically recover the previous emacs configuration if a
;;; file ".emacs_<user>" exists in the current directory, add:
;;; (load (expand-file-name (concat ".emacs_" user-real-login-name)) t t t)
;;; in your "~/.emacs" file, possibly only under some conditions,
;;; like (null (cdr command-line-args)), and if you want to save the
;;; emacs configuration every time you exit emacs, execute the command
;;; (possibly on the "~/.emacs" file, too):
;;; (setq kill-emacs-hook (function emacs-save-status))
;;; or add a call to the emacs-save-status on your kill-emacs-hook hook.

;;; But I believe that it is better to call them only when you need them.
;;; To load a file, just say: "emacs -l .emacs_<user>", and to write it
;;; M-x save-emacs-status.
;;; The only (autoload) command you need in your "~/.emacs" file is:
;;load: (autoload 'emacs-save-status "emacs-save" nil t)

;;; The format that I use to write the ".emacs_<user>" file (emacs lisp
;;; code) is easily extendable to include more information, can load
;;; fast and error detection is done by emacs!!!  The user can
;;; understand and change the file easily, even manually, like when a
;;; file is renamed.  The loading phase is also stand alone, no
;;; functions defined in this file are used.  Users can use the -l
;;; option on the command line, to load emacs configuration files,
;;; either theirs, or created by other users.  This has not only the
;;; advantage that there is no need for autoloading packets when
;;; recovering a configuration, but also there is no inconsistency
;;; problems with different versions of the emacs-save-status
;;; function, and even many versions of this function can be used at
;;; the same time.

;;; You can recover using a ".emacs_<user>" file even from another
;;; directory (by just specifying that file on the -l emacs option)
;;; since all files are present using absolute paths.  The function
;;; also works fine even for buffers visiting files with the same tail
;;; names and buffers in more than one windows.

;;; For better performance, lower level functions can be used, like:
;;; (set-buffer (find-file-noselect xxx)), instead of (find-file xxx)
;;; (set-buffer (get-buffer-create xxx)), instead of (switch-to-buffer xxx)
;;; etc, but the result will be less user friendly.
;;; If you use this procedure often (like, in every emacs call), and
;;; you want to make it more efficient, without keeping all that
;;; information, create a new function (by removing code from the
;;; original one, like the buffer variables that are saved) and name
;;; it emacs-save-tiny-status.  On the other hand, if you want to save
;;; more environment, you can keep the same function name.

;;; The most difficult part to implement was the saving of the window
;;; configuration, that is to find the window structure and give the
;;; commands to recreate it.

(defvar save-context-per-host nil
  "Flag to determine if contexts should be defined per-host, in addition
to per-user.")

(defvar emacs-save-defuns nil
  "*Normally functions are defined in the customization files,
or in the autoloaded packages, and there is no need to save them here.
But if you have some functions that you really want to save,
put their names in this list.")

(defvar emacs-save-global-variables nil
  "*Normally global variables are set in the customization files,
or in the autoloaded packages, and there is no need to save them here.
But if you have some global variables that you really want to save,
put their names in this list.")

;;; Maybe I should use a variables-not-save variable instead !!!
(defvar emacs-save-buffer-variables '(buffer-read-only default-directory)
  "*A list of variable names, the variables to save on each buffer.")


(defvar emacs-save-reject-files '"\\(^\\(/usr\\)?/tmp/\\|/TAGS$\\)"
  "*Regular expression for file names, the buffers that visit these files
will not be saved.
Used in the function emacs-save-buffer-named.")

(defvar emacs-save-reject-buffers "[* ]"
  "*Regular expression for buffer names, the buffers not to save.
Only buffers without a visiting file fall into this case.
Given a string that matches all buffers (like \"\"), will reject all
buffers not visiting a file.
Used in the function emacs-save-buffer-named.")

(defvar emacs-save-buffer-predicates '(emacs-save-buffer-named)
  "*A list of functions that are used to decide it the current buffer
should be saved.  All of them should return non nil, or the buffer will
not be saved.  Some predefined functions are:
emacs-save-buffer-named
emacs-save-buffer-window.")

(defvar emacs-save-status-hooks nil
  "*A list of functions that the user may provide.  They are called
after each buffer construction data are written, and can write more
lisp commands for the current buffer for restoring more buffer
parameters.")

;;; Some example predicate functions follow:

(defun emacs-save-buffer-named ()
  "Return nil if the buffer is rejected, using emacs-save-reject-buffers
and emacs-save-reject-files."
  (null (if buffer-file-name
	    (string-match emacs-save-reject-files buffer-file-name)
	  (string-match emacs-save-reject-buffers (buffer-name)))))

(defun emacs-save-buffer-window ()
  "Return nil if the buffer has no window assosiated."
  (get-buffer-window (current-buffer)))

;;; As undocumented result (may be changed later), windows belonging
;;; to buffers not saved, will contain the current buffer.
;;; By creating the windows before visiting the files, all these windows
;;; would be visiting the scratch buffer (as well as if I use other
;;; commands for visiting the files).

;;; If the windows cannot fit on the screen, the windows on the screen
;;; will visit some of the buffers that should be on a window, but
;;; which of them and in which screen places is just UNDEFINED, since
;;; some windows may have been created.  I could just leave one window
;;; in the screen, the current buffer, but I believe I should not
;;; destroy the so far created windows, the user can easily do that
;;; (delete-other-windows).  I could put all buffers in equally sized
;;; windows, but they may not fit either, or the user may want to
;;; arrange them differently anyway.  After all, it is not such
;;; important, it only happens if the new screen is so smaller, that
;;; some windows cannot fit in the screen at all.

;;; A more complex algorithm could guarantee to make as many windows
;;; as possible (from the original ones), while this algorithm aborts
;;; on the first error.  Also, could guarantee to assign the correct
;;; buffers to the already existing windows, when only some of them
;;; are restored.  Write now this is only done when there is no error
;;; on loading the windows.
;;; If many people have problems with the current behavior, and they
;;; often use much smaller windows, I'll start thinking of more such
;;; algorithms.  I avoid that for the time being, since that case is
;;; not the usual case anyway, and such additions increase the execution
;;; time.

;;; Also, when a variable (or function) should be saved and it does not
;;; exist, an error will be signalled.  This way misspelllings will be
;;; found.  Maybe I should just ignore that variable.
;;; If there is such need in the future (that is, saving a variable that
;;; may exist), I'll change that.

(defun emacs-save-status (&optional file-name)
  "Save the emacs status in a file, so that loading that file will
create an editing session very similar to the current one.  The
resulting file is an emacs-lisp file, and it can be loaded with the
load-file command, or the -l emacs option.  The exact window
configuration is preserved, if the new terminal dimensions permit it.

All buffers that are not rejected by any of the functions in the list
emacs-save-buffer-predicates (by returning nil) are recovered in
reverse last access order (for the buffers that normally do not have a
window), with point, mark, major and minor modes, restriction and some
buffer local variables, (see the variable emacs-save-buffer-variables)
as the default-directory and the buffer-read-only flag.

Selected functions and global variables can be saved too (see the
variables emacs-save-defuns and emacs-save-global-variables).

Even buffers not visiting a file will be saved, by saving their
contents.  But in that case the file created can be big.  Using
commands in the ~/.emacs file, you can arrange automatic context
saving and recovery."
  (interactive)
  ;; list will be the list of buffers (before our scratch buffer is created).
  (let ((list (reverse (buffer-list)))
	(standard-output (get-buffer-create " save emacs status "))
	keep hook)
    (set-buffer standard-output)
    (erase-buffer)
    ;; Save the defuns and global variables first.
    (let ((list emacs-save-defuns))
      (while list
	(princ "(fset '")
	(princ (car list))
	(princ " (function ")
	(prin1 (symbol-function (car list)))
	(princ "))\n")
	(setq list (cdr list))))
    (let ((list emacs-save-global-variables))
      (while list
	(princ "(setq ")
	(princ (car list))
	(princ " ")
	(if (symbol-value (car list))
	    (if (eq (symbol-value (car list)) t) nil (princ "'")))
	(prin1 (symbol-value (car list)))
	(princ ")\n")
	(setq list (cdr list))))
    ;; Write information for each buffer
    (while list
      (set-buffer (car list))
      (setq hook emacs-save-buffer-predicates)
      (while (and hook (funcall (car hook))) (setq hook (cdr hook)))
      (if hook
	  ;; The buffer was rejected.
	  nil
	(setq keep (cons (car list) keep))
	;; Create the buffer and fill its contents.
	(if buffer-file-name
	    (progn
	      (princ "(find-file ")
	      (prin1 buffer-file-name)
	      (princ ")\n")
	      (if (string-equal (buffer-name)
				(file-name-nondirectory buffer-file-name))
		  nil
		;; This may be needed, mainly with names like A<1>,
		;; to be sure that they correspond to the same buffer names.
		(princ "(if (string-equal (buffer-name) ")
		(prin1 (buffer-name))
		(princ ") nil (rename-buffer ")
		(prin1 (buffer-name))
		(princ "))\n")))
	  (princ "(switch-to-buffer ")
	  (prin1 (buffer-name))
	  (princ ")\n")
	  (if (null (zerop (buffer-size)))
	      (progn (princ "(insert ")
		     (prin1 (buffer-string))
		     (princ ")\n(set-buffer-modified-p nil)\n"))))
	;; Restore major mode, point and mark.
	;; Point may not be needed for buffers that are displayed in
	;; windows, but if an error happens during the window creation,
	;; like it cannot fit on the screen, we need it.
	(princ "(if (eq major-mode '")
	(princ major-mode)
	(princ ") nil (")
	(princ major-mode)
	(princ "))\n(goto-char ")
	(princ (point))
	(if (mark) (progn (princ ")\n(set-mark ") (princ (mark))))
	(princ ")\n")
	;; The list of minor modes is saved too.
	(let ((list minor-mode-alist))
	  (while list
	    (if (eval (car (car list)))
		(progn
		  (princ "(")
		  (princ (if (eq (car (car list)) 'auto-fill-hook)
			     'auto-fill-mode (car (car list))))
		  (princ " 1)\n")))
	    (setq list (cdr list))))
	;; print any restriction
	(if (let ((min (point-min)) (max (point-max)))
	      (save-restriction
		(widen)
		(and (= min (point-min)) (= max (point-max)))))
	    ;; There was no restriction
	    nil
	  (princ "(narrow-to-region ")
	  (princ (point-min))
	  (princ " ")
	  (princ (point-max))
	  (princ ")\n"))
	;; Save the buffer local variables needed.
	(let ((list emacs-save-buffer-variables))
	  (while list
	    (if (and (boundp (car list))
		     (null (and (eq (car list) 'default-directory)
				;; Write the default directory only if needed.
				buffer-file-name
				(string-equal default-directory
					      (file-name-directory
					       buffer-file-name)))))
		(progn (princ "(setq ")
		       (princ (car list))
		       (princ " ")
		       (if (symbol-value (car list))
			   (if (eq (symbol-value (car list)) t) nil (princ "'")))
		       (prin1 (symbol-value (car list)))
		       (princ ")\n")))
	    (setq list (cdr list))))
	;; Call the user hooks for every buffer.
	(let ((list emacs-save-status-hooks))
	  (while list (funcall (car list)) (setq list (cdr list)))))
      (setq list (cdr list)))

    ;; Write the commands to create the windows.
    ;; The screen will be split on the correct way,
    ;; but the buffers are not assosiated with the windows.
    ;; This way, the user can supply (in a future version maybe)
    ;; an alternative window configuration procedure in case an error
    ;; happens (the windows could not fit), like to divide the screen
    ;; into equal parts.
    ;; The top window is also the: (next-window (minibuffer-window))
    (let ((w (selected-window)) (fwd 0) (adv 0))
      (while (let ((edges (window-edges w)))
	       (null (and (zerop (car edges)) (zerop (car (cdr edges))))))
	(setq fwd (1- fwd) w (next-window w 0)))
      ;; If there is only one window, I don't want to generate extra code:
      (if (eq w (next-window w 0))
	  nil				;
	(let ((maxx (screen-width))
	      (maxy (- (screen-height) (window-height (minibuffer-window))))
	      (top w)
	      topedges x y)
	  (princ "(condition-case nil (progn\n")
	  ;; Print the commands to create the windows.
	  (emacs-save-windows)
	  (princ ") (args-out-of-range))\n")))
      ;; move back to the top window.
      (setq adv (1+ adv))
      (if (let ((n adv) (win w))
	    (while (null (zerop n)) (setq win (next-window win 0) n (1- n)))
	    (eq win w))
	  (setq adv 0))
      ;; Starting from the top window, assosiate buffers with windows.
      ;; For windows that their buffer is not saved, do nothing.
      ;; Starting from the top window makes the output file more readable,
      ;; although we may produce an extra other-window command.
      (let ((win w))
	(while
	    (progn
	      ;; If the buffer was not rejected.
	      (if (memq (window-buffer win) keep)
		  (progn
		    ;; move to the next window (rejected windows can be
		    ;; between this and the previous one)
		    (if (zerop adv)
			nil
		      (princ "(other-window ")
		      (princ adv)
		      (princ ")\n")
		      (setq adv 0))
		    ;; Print information about the buffer that is hosted.
		    (princ "(set-window-buffer (selected-window) ")
		    (prin1 (buffer-name (window-buffer win)))
		    (princ ")\n")
		    (princ "(set-window-start (selected-window) ")
		    (princ (window-start win))
		    (princ ")\n")
		    (princ "(set-window-point (selected-window) ")
		    (princ (window-point win))
		    (princ ")\n")))
	      (null (eq (setq win (next-window win 0)) w)))
	  (setq adv (1+ adv)))
	;; Go to the selected window now.
	(if (zerop (+ adv fwd))
	    ;; We already are in the selected window
	    nil
	  (princ "(other-window ")
	  (princ (+ adv fwd))
	  (princ ")\n"))))

    ;; Unfortunatelly, (default-value 'default-directory) does not work
    ;; and the emacs directory can be consinderred that of the *scratch*
    ;; buffer.  If you want to change that, change the default value of
    ;; the default-directory.
    
    (if (null file-name)
	(setq file-name (concat
			 (or (default-value 'default-directory)
			     (progn (set-buffer (get-buffer-create "*scratch*"))
				    default-directory))
			 ".emacs_"
			 (if save-context-per-host (concat (system-name) "_") "")
			 (user-real-login-name))))
    (set-buffer standard-output)
    (if (zerop (buffer-size))
	;; If empty ... try to delete
	(if (file-exists-p file-name)
	    (condition-case nil (delete-file file-name) (file-error)))
      ;; If not writable, ask for another directory.
      (while (null (or (string-equal file-name "")
		       (file-writable-p file-name)))
	(read-file-name (format "Cannot write %s (default: none) " file-name)))
      (if (null (string-equal file-name ""))
	  (write-region (point-min) (point-max) file-name)))
      (kill-buffer standard-output)))

;;(defun emacs-save-screen ()
;;  "Return the number of windows before termination"
;;  (interactive)
;;  (let ((maxx (screen-width))
;;	(maxy (- (screen-height) (window-height (minibuffer-window))))
;;	(top (next-window (minibuffer-window)))
;;	(adv 0)
;;	topedges x y)
;;    (princ "(condition-case nil (progn")
;;    (emacs-save-windows)
;;    (princ ") (args-out-of-range))")))

;; Used by emacs-save-screen ONLY.
;; It needs variables: top maxx maxy adv topedges x y
;; Top-most left window is top, and we recursively want to split the
;; window that extends up to maxx and maxy into its subwindows.
;; The variable adv (initialized to 0) counts how many windows we should
;; move forward to move out of this window and its subwindow (and either
;; move to the next, or wrap to the beginning, for the original window).
;; The variables topedges x and y have really local meaning, but are reset
;; on each recursive call.  They are global just for space efficiency.
;; We don't expect to have many recursions anyway.
;; The idea is: We try to find any (the first, in this algorithm) window
;; boundary that extends to the whole window.  Then split our window there
;; and recursively try to split the subwindows.  That boundary can be either
;; horizontal (mode line) or vertical.  In either case, it extends up to the
;; end of the screen (either right, or down) and no part of any window so far
;; was after it (below or to the right).
(defun emacs-save-windows ()
  (let* ((w top) (edges (window-edges w)))
    (setq topedges edges x 0 y 0)
    (while
	(if (= (nth 2 edges) maxx)
	    (if (< (nth 3 edges) y)
		t
	      (if (= (nth 3 edges) maxy)
		  ;; End of searching, one window covering the area.
		  nil
		(if (zerop adv)
		    nil
		  (princ "(other-window ")
		  (princ adv)
		  (princ ")\n")
		  (setq adv 0))
		(princ "(split-window nil ")
		(princ (- (nth 3 edges) (nth 1 topedges)))
		(princ ")\n")
		(if (zerop y)
		    nil
		  (let ((maxy (nth 3 edges))) (emacs-save-windows)))
		(setq top nil)
		t))
	  (if (= (nth 3 edges) maxy)
	      (if (< (nth 2 edges) x)
		  nil
		(if (zerop adv)
		    nil
		  (princ "(other-window ")
		  (princ adv)
		  (princ ")\n")
		  (setq adv 0))
		(princ "(split-window nil ")
		(princ (- (nth 2 edges) (nth 0 topedges)))
		(princ " t)\n")
		(if (zerop x)
		    nil
		  (let ((maxx (nth 2 edges))) (emacs-save-windows)))
		(setq top nil)))
	  t)
      (setq w (next-window w 0))
      (setq edges (window-edges w))
      (if top
	  (progn
	    (if (> (nth 3 edges) y) (setq y (nth 3 edges)))
	    (if (> (nth 2 edges) x) (setq x (nth 2 edges))))
	(setq top w topedges edges x 0 y 0)
	(setq adv (1+ adv))))))

;;; Not supported (for the time being since some of these can be added
;;; easily, but I don't think of anyone really needing them) are:
;;; Window configuration on equvallent terminals
;;; Processes (shell, compilation, inferior processes ...)
;;;	I cannot see any way to save the state of any process, without really
;;;	keeping the process alive.
;;; mark-ring & kill-ring
;;;	Easy to add, but usually not needed.
;;;	Who does remember what was killed last, for example ?
;;; autoload packets
;;;	are easy to add (use the list features to produce require commands),
;;;	but they will be loaded anyway when needed.
;;;	The only reason to load them manually, would be to apply customization
;;;	changes (variables, etc) afterwards.
;;; symbol-plist
;;;	This is too far.  Nobody really defines them interactivelly,
;;;	and so there is no need to save them.
;;;
;;; If you think of anything else, tell me.  Something that is not set
;;; or cannot be set by the loaded files in any normal way.

(define-key esc-map "\"" 'emacs-save-status)


;; Better recovery from error: (select-window (next-window (minibuffer-window)))
;; and do not overwrite that.