home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
browser2.zip
/
context.el
< prev
next >
Wrap
Lisp/Scheme
|
1995-02-10
|
12KB
|
353 lines
;;;;;; SAVE / RESTORE EMACS CONFIGURATION.
;;;;;; Copyright (C) 1993 Gerd Moellmann.
;;;;;; Altenbergstr. 6, D-4000 Duesseldorf 1, Germany
;;; $Id: context.el,v 1.1 1995/02/10 18:01:01 mmann Exp $
;;; This file replaces SAVE-CONF.EL. Features are:
;;;
;;; * Saves and restores bookmarks
;;; * Saves and restores DIRED buffers
;;; * Saves and restores C++ BROWSER buffers (see browser.el)
;;; * Saves and restores window positions, sizes, points, start
;;; points
;; This file is part of GNU Emacs.
;; GNU Emacs 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
;; GNU Emacs, 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.
(provide 'context)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =========
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; VARIABLES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =========
(defvar context-file (concat "~/" (if (eq system-type 'ms-dos)
"_" ".")
"emacs_" (user-login-name))
"*Holds the path of the file in which SAVE-CONTEXT saves the current
buffer list when exiting EMACS. The same file is used by RESTORE-CONTEXT
to reconstruct the buffer list when EMACS is started again.")
(defvar context-save-dired-buffers t
"*Set this variable to NIL if you don't want to restore DIRED buffers
the next time EMACS is started.")
(defvar context-save-browser-buffers t
"*Set this variable to NIL if you don't want to restore BROWSER tree
buffers the next time EMACS is started.")
(defvar context-save-registers t
"*Set this variable to NIL if you don't want to restore bookmarks
the next time EMACS is started.")
(defvar context-buffer-alist nil
"Temporary used to hold an alist of all buffers saved/ restored
with an associated index that is used to restore window buffers.")
(defvar context-buffer-index 0
"Running index used as key or value in CONTEXT-BUFFER-ALIST.")
(defvar context-buffer nil
"The buffer for context information.")
(defvar context-browser-buffers nil
"A list of lists describing browser buffers.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ====
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MISC
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ====
(if (not (fboundp 'just-kill-emacs))
(fset 'just-kill-emacs (symbol-function 'kill-emacs)))
(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."
(interactive "P")
(if (and (null purify-flag)
(not query))
(context-save))
(just-kill-emacs query))
(defun context-prin1 (object)
(prin1 object context-buffer)
(princ " " context-buffer))
(defun context-print (&rest forms)
(mapcar 'context-prin1 forms)
(princ "\n" context-buffer))
(defun context-reset ()
(setq context-buffer-alist nil
context-buffer-index 0
context-browser-buffers nil))
(defun context-startup-dir ()
(save-excursion
(set-buffer (get-buffer-create "*scratch*"))
default-directory))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =============
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =============
(defun context-save ()
"Save buffers, bookmarks, windows to file CONTEXT-FILE, so that
they can be restored with a call to CONTEXT-RESTORE."
(interactive)
(setq context-buffer (get-buffer-create "*Context*"))
(context-reset)
(set-buffer context-buffer)
(save-excursion
(erase-buffer)
(if context-save-registers
(context-save-registers))
(mapcar '(lambda (b)
(set-buffer b)
(let* ((locals (buffer-local-variables b))
(mode (cdr (assoc 'major-mode locals))))
(cond ((and (eq mode 'dired-mode)
context-save-dired-buffers)
(context-save-dired-buffer))
((and (eq mode nil)
context-save-browser-buffers)
(context-record-browser-buffer b))
(t
(context-save-normal-buffer)))))
(reverse (buffer-list)))
(context-save-browser-buffers)
(context-save-windows))
(write-region (point-min) (point-max) context-file nil 'shut-up)
(set-buffer-modified-p nil)
(kill-buffer context-buffer))
(defun context-restore ()
"Restore the buffer list saved in the file whose path is given by
CONTEXT-FILE, a global variable. If command line arguments are
specified for emacs, do not restore the previous buffer list."
(interactive)
(if (and (file-readable-p context-file)
(= (length command-line-args) 1))
(progn
(context-reset)
(let ((buffer (get-buffer-create "*Context*"))
bname)
(set-buffer buffer)
(erase-buffer)
(insert-file-contents context-file)
(set-buffer-modified-p nil)
(while (setq bname (read buffer))
(let ((reg (read buffer))
(bpoint (read buffer)))
(save-excursion
(find-file bname)
(goto-char bpoint)
(point-to-register reg))))
(while (setq bname (read buffer))
(let ((bpoint (read buffer)))
(cond ((eq bname 'tree-mode)
(let ((p (read buffer))
(stand-alone (read buffer)))
(save-excursion
(browse bpoint)
(goto-char p)
(context-record-buffer context-buffer-index
(current-buffer))
(if stand-alone
(tree-mark-stand-alone)))))
(t
(save-excursion
(find-file bname)
(context-record-buffer context-buffer-index
(current-buffer))
(goto-char bpoint))))))
(context-restore-windows)
(context-reset)
(kill-buffer buffer)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =========
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REGISTERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =========
(defun context-save-registers ()
(mapcar '(lambda (reg)
(let ((value (cdr reg))
(name (car reg)))
(if (and (markerp value)
(buffer-file-name (marker-buffer value)))
(let ((mbuffer (marker-buffer value))
(mpos (marker-position value)))
(context-print (buffer-file-name mbuffer)
name
(marker-position value))))))
register-alist)
(context-print nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =======
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BUFFERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =======
(defun context-record-buffer (key value)
(setq context-buffer-alist (cons (cons key value) context-buffer-alist)
context-buffer-index (1+ context-buffer-index)))
(defun context-save-browser-buffer (info)
(context-record-buffer (nth 3 info) context-buffer-index)
(context-print 'tree-mode
(nth 0 info) ;tags file name
(nth 2 info) ;point
(nth 1 info))) ;stand-alone
(defun context-save-browser-buffers ()
(let (buffer-info)
(mapcar '(lambda (info)
(if (nth 1 info)
(context-save-browser-buffer info)
(setq buffer-info info)))
context-browser-buffers)
(if buffer-info
(context-save-browser-buffer buffer-info))
(context-print nil)))
(defun context-record-browser-buffer (buffer)
(let ((locals (buffer-local-variables buffer)))
(setq context-browser-buffers
(cons (list (cdr (assoc 'browse-tags-filename locals))
(cdr (assoc 'tree-stand-alone locals))
(point)
buffer)
context-browser-buffers))))
(defun context-save-dired-buffer ()
(let ((dir (cdr (assoc 'dired-directory (buffer-local-variables)))))
(context-record-buffer (current-buffer) context-buffer-index)
(context-print dir (point))))
(defun context-save-normal-buffer ()
(cond (buffer-file-name
(context-record-buffer (current-buffer) context-buffer-index)
(context-print (buffer-file-name) (point)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =======
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; WINDOWS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =======
(defun context-fullscreen (window)
(or (= (screen-height) (window-height window))
(= (screen-width) (window-width window))))
(defun context-window-area (window)
(* (window-width window) (window-height window)))
(defun context-window-less-p (a b)
(cond ((context-fullscreen a) t)
((context-fullscreen b) nil)
(t (> (context-window-area a) (context-window-area b)))))
(defun context-save-windows ()
(mapcar '(lambda (window)
(context-print (window-edges window)
(window-point window)
(window-start window)
(cdr (assoc (window-buffer window)
context-buffer-alist))))
(sort (context-window-list) 'context-window-less-p))
(context-reset)
(context-print nil))
(defun context-restore-windows ()
(let (edges
window-list
(buffer (current-buffer)))
(while (setq edges (read buffer))
(let ((point (read buffer))
(start (read buffer))
(index (read buffer)))
(setq window-list (cons (list edges point start index)
window-list))))
(mapcar 'context-create-window (nreverse window-list))))
(defun context-create-window (info)
(let ((edges (nth 0 info))
(point (nth 1 info))
(start (nth 2 info))
(index (nth 3 info)))
(save-excursion
(context-split-windows edges)
(let ((window (context-window-containing edges))
(buffer (cdr (assoc index context-buffer-alist))))
(cond ((and buffer window)
(set-window-buffer window buffer)
(set-window-point window point)
(set-window-start window start)))))))
(defun context-window-containing (edges)
(car (delq nil
(mapcar '(lambda (w)
(let ((wedges (window-edges w)))
(if (and (<= (nth 0 wedges) (nth 0 edges))
(<= (nth 1 wedges) (nth 1 edges))
(>= (nth 2 wedges) (nth 2 edges))
(>= (nth 3 wedges) (nth 3 edges)))
w)))
(context-window-list)))))
(defun context-window-list ()
(let (list first-window)
(save-window-excursion
(while (not (eq first-window (selected-window)))
(let ((window (selected-window)))
(or first-window
(setq first-window window))
(setq list (cons window list)))
(other-window 1)))
list))
(defun context-split-windows (edges)
(let ((window (context-window-containing edges)))
(if (windowp window)
(let ((wedges (window-edges window)))
(if (not (equal edges wedges))
(progn
(cond
((> (nth 0 edges) (nth 0 wedges))
(split-window
window (- (nth 0 edges) (nth 0 wedges)) t))
((> (nth 1 edges) (nth 1 wedges))
(split-window
window (- (nth 1 edges) (nth 1 wedges))))
((< (nth 2 edges) (nth 2 wedges))
(split-window
window (- (nth 2 edges) (nth 0 wedges)) t))
((< (nth 3 edges) (nth 3 wedges))
(split-window
window (- (nth 3 edges) (nth 1 wedges)))))
(context-split-windows edges)))))))
;;;; end of context.el