home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / browser2.zip / context.el < prev    next >
Lisp/Scheme  |  1995-02-10  |  12KB  |  353 lines
  1. ;;;;;; SAVE / RESTORE EMACS CONFIGURATION.
  2. ;;;;;; Copyright (C) 1993 Gerd Moellmann.
  3. ;;;;;; Altenbergstr. 6, D-4000 Duesseldorf 1, Germany
  4. ;;; $Id: context.el,v 1.1 1995/02/10 18:01:01 mmann Exp $
  5.  
  6. ;;; This file replaces SAVE-CONF.EL.  Features are:
  7. ;;;
  8. ;;; * Saves and restores bookmarks
  9. ;;; * Saves and restores DIRED buffers
  10. ;;; * Saves and restores C++ BROWSER buffers (see browser.el)
  11. ;;; * Saves and restores window positions, sizes, points, start
  12. ;;;   points
  13.  
  14. ;; This file is part of GNU Emacs.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  18. ;; accepts responsibility to anyone for the consequences of using it
  19. ;; or for whether it serves any particular purpose or works at all,
  20. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  21. ;; License for full details.
  22.  
  23. ;; Everyone is granted permission to copy, modify and redistribute
  24. ;; GNU Emacs, but only under the conditions described in the
  25. ;; GNU Emacs General Public License.   A copy of this license is
  26. ;; supposed to have been given to you along with GNU Emacs so you
  27. ;; can know your rights and responsibilities.  It should be in a
  28. ;; file named COPYING.    Among other things, the copyright notice
  29. ;; and this notice must be preserved on all copies.
  30.  
  31. (provide 'context)
  32.  
  33.  
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =========
  35. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; VARIABLES
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =========
  37.  
  38. (defvar context-file (concat "~/" (if (eq system-type 'ms-dos)
  39.                       "_" ".")
  40.                  "emacs_" (user-login-name))
  41.   "*Holds the path of the file in which SAVE-CONTEXT saves the current
  42. buffer list when exiting EMACS. The same file is used by RESTORE-CONTEXT
  43. to reconstruct the buffer list when EMACS is started again.")
  44.  
  45. (defvar context-save-dired-buffers t
  46.   "*Set this variable to NIL if you don't want to restore DIRED buffers
  47. the next time EMACS is started.")
  48.  
  49. (defvar context-save-browser-buffers t
  50.   "*Set this variable to NIL if you don't want to restore BROWSER tree
  51. buffers the next time EMACS is started.")
  52.  
  53. (defvar context-save-registers t
  54.   "*Set this variable to NIL if you don't want to restore bookmarks
  55. the next time EMACS is started.")
  56.  
  57. (defvar context-buffer-alist nil
  58.   "Temporary used to hold an alist of all buffers saved/ restored
  59. with an associated index that is used to restore window buffers.")
  60.  
  61. (defvar context-buffer-index 0
  62.   "Running index used as key or value in CONTEXT-BUFFER-ALIST.")
  63.  
  64. (defvar context-buffer nil
  65.   "The buffer for context information.")
  66.  
  67. (defvar context-browser-buffers nil
  68.   "A list of lists describing browser buffers.")
  69.  
  70.  
  71. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ====
  72. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MISC
  73. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ====
  74.  
  75. (if (not (fboundp 'just-kill-emacs))
  76.     (fset 'just-kill-emacs (symbol-function 'kill-emacs)))
  77.  
  78. (defun kill-emacs (&optional query)
  79.   "End this Emacs session.
  80. Prefix ARG or optional first ARG non-nil means exit with no questions asked,
  81. even if there are unsaved buffers.  If Emacs is running non-interactively
  82. and ARG is an integer, then Emacs exits with ARG as its exit code."
  83.   (interactive "P")
  84.   (if (and (null purify-flag)
  85.        (not query))
  86.       (context-save))
  87.   (just-kill-emacs query))
  88.  
  89. (defun context-prin1 (object)
  90.   (prin1 object context-buffer)
  91.   (princ " " context-buffer))
  92.  
  93. (defun context-print (&rest forms)
  94.   (mapcar 'context-prin1 forms)
  95.   (princ "\n" context-buffer))
  96.  
  97. (defun context-reset ()
  98.   (setq context-buffer-alist nil
  99.     context-buffer-index 0
  100.     context-browser-buffers nil))
  101.  
  102. (defun context-startup-dir ()
  103.   (save-excursion
  104.     (set-buffer (get-buffer-create "*scratch*"))
  105.     default-directory))
  106.  
  107.  
  108. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =============
  109. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINES
  110. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =============
  111.  
  112. (defun context-save ()
  113.   "Save buffers, bookmarks, windows to file CONTEXT-FILE, so that
  114. they can be restored with a call to CONTEXT-RESTORE."
  115.   (interactive)
  116.   (setq context-buffer (get-buffer-create "*Context*"))
  117.   (context-reset)
  118.   (set-buffer context-buffer)
  119.   (save-excursion
  120.     (erase-buffer)
  121.     (if context-save-registers
  122.     (context-save-registers))
  123.     (mapcar '(lambda (b)
  124.            (set-buffer b)
  125.            (let* ((locals (buffer-local-variables b))
  126.               (mode (cdr (assoc 'major-mode locals))))
  127.          (cond ((and (eq mode 'dired-mode)
  128.                  context-save-dired-buffers)
  129.             (context-save-dired-buffer))
  130.                ((and (eq mode nil)
  131.                  context-save-browser-buffers)
  132.             (context-record-browser-buffer b))
  133.                (t
  134.             (context-save-normal-buffer)))))
  135.         (reverse (buffer-list)))
  136.     (context-save-browser-buffers)
  137.     (context-save-windows))
  138.   (write-region (point-min) (point-max) context-file nil 'shut-up)
  139.   (set-buffer-modified-p nil)
  140.   (kill-buffer context-buffer))
  141.  
  142. (defun context-restore ()
  143.   "Restore the buffer list saved in the file whose path is given by
  144. CONTEXT-FILE, a global variable. If command line arguments are
  145. specified for emacs, do not restore the previous buffer list."
  146.   (interactive)
  147.   (if (and (file-readable-p context-file)
  148.        (= (length command-line-args) 1))
  149.       (progn
  150.     (context-reset)
  151.     (let ((buffer (get-buffer-create "*Context*"))
  152.           bname)
  153.       (set-buffer buffer)
  154.       (erase-buffer)
  155.       (insert-file-contents context-file)
  156.       (set-buffer-modified-p nil)
  157.  
  158.       (while (setq bname (read buffer))
  159.         (let ((reg (read buffer))
  160.           (bpoint (read buffer)))
  161.           (save-excursion
  162.         (find-file bname)
  163.         (goto-char bpoint)
  164.         (point-to-register reg))))
  165.  
  166.       (while (setq bname (read buffer))
  167.         (let ((bpoint (read buffer)))
  168.           (cond ((eq bname 'tree-mode)
  169.              (let ((p (read buffer))
  170.                (stand-alone (read buffer)))
  171.                (save-excursion
  172.              (browse bpoint)
  173.              (goto-char p)
  174.              (context-record-buffer context-buffer-index
  175.                         (current-buffer))
  176.              (if stand-alone
  177.                  (tree-mark-stand-alone)))))
  178.             (t
  179.              (save-excursion
  180.                (find-file bname)
  181.                (context-record-buffer context-buffer-index
  182.                           (current-buffer))
  183.                (goto-char bpoint))))))
  184.       (context-restore-windows)
  185.       (context-reset)
  186.       (kill-buffer buffer)))))
  187.  
  188.  
  189. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =========
  190. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REGISTERS
  191. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =========
  192.  
  193. (defun context-save-registers ()
  194.   (mapcar '(lambda (reg)
  195.          (let ((value (cdr reg))
  196.            (name (car reg)))
  197.            (if (and (markerp value)
  198.             (buffer-file-name (marker-buffer value)))
  199.            (let ((mbuffer (marker-buffer value))
  200.              (mpos (marker-position value)))
  201.              (context-print (buffer-file-name mbuffer)
  202.                     name
  203.                     (marker-position value))))))
  204.       register-alist)
  205.   (context-print nil))
  206.  
  207.  
  208. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =======
  209. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BUFFERS
  210. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =======
  211.  
  212. (defun context-record-buffer (key value)
  213.   (setq context-buffer-alist (cons (cons key value) context-buffer-alist)
  214.     context-buffer-index (1+ context-buffer-index)))
  215.  
  216. (defun context-save-browser-buffer (info)
  217.   (context-record-buffer (nth 3 info) context-buffer-index)
  218.   (context-print 'tree-mode
  219.          (nth 0 info)        ;tags file name
  220.          (nth 2 info)        ;point
  221.          (nth 1 info)))        ;stand-alone
  222.  
  223. (defun context-save-browser-buffers ()
  224.   (let (buffer-info)
  225.     (mapcar '(lambda (info)
  226.            (if (nth 1 info)
  227.            (context-save-browser-buffer info)
  228.          (setq buffer-info info)))
  229.         context-browser-buffers)
  230.     (if buffer-info
  231.     (context-save-browser-buffer buffer-info))
  232.     (context-print nil)))
  233.  
  234. (defun context-record-browser-buffer (buffer)
  235.   (let ((locals (buffer-local-variables buffer)))
  236.     (setq context-browser-buffers
  237.       (cons (list (cdr (assoc 'browse-tags-filename locals))
  238.               (cdr (assoc 'tree-stand-alone locals))
  239.               (point)
  240.               buffer)
  241.         context-browser-buffers))))
  242.  
  243. (defun context-save-dired-buffer ()
  244.   (let ((dir (cdr (assoc 'dired-directory (buffer-local-variables)))))
  245.     (context-record-buffer (current-buffer) context-buffer-index)
  246.     (context-print dir (point))))
  247.  
  248. (defun context-save-normal-buffer ()
  249.   (cond (buffer-file-name
  250.      (context-record-buffer (current-buffer) context-buffer-index)
  251.      (context-print (buffer-file-name) (point)))))
  252.  
  253.  
  254. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =======
  255. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; WINDOWS
  256. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; =======
  257.  
  258. (defun context-fullscreen (window)
  259.   (or (= (screen-height) (window-height window))
  260.       (= (screen-width) (window-width window))))
  261.  
  262. (defun context-window-area (window)
  263.   (* (window-width window) (window-height window)))
  264.  
  265. (defun context-window-less-p (a b)
  266.   (cond ((context-fullscreen a) t)
  267.     ((context-fullscreen b) nil)
  268.     (t (> (context-window-area a) (context-window-area b)))))
  269.  
  270. (defun context-save-windows ()
  271.   (mapcar '(lambda (window)
  272.          (context-print (window-edges window)
  273.                 (window-point window)
  274.                 (window-start window)
  275.                 (cdr (assoc (window-buffer window)
  276.                     context-buffer-alist))))
  277.       (sort (context-window-list) 'context-window-less-p))
  278.   (context-reset)
  279.   (context-print nil))
  280.  
  281. (defun context-restore-windows ()
  282.   (let (edges
  283.     window-list
  284.     (buffer (current-buffer)))
  285.     (while (setq edges (read buffer))
  286.       (let ((point (read buffer))
  287.         (start (read buffer))
  288.         (index (read buffer)))
  289.     (setq window-list (cons (list edges point start index)
  290.                 window-list))))
  291.     (mapcar 'context-create-window (nreverse window-list))))
  292.  
  293. (defun context-create-window (info)
  294.   (let ((edges (nth 0 info))
  295.     (point (nth 1 info))
  296.     (start (nth 2 info))
  297.     (index (nth 3 info)))
  298.     (save-excursion
  299.       (context-split-windows edges)
  300.       (let ((window (context-window-containing edges))
  301.         (buffer (cdr (assoc index context-buffer-alist))))
  302.     (cond ((and buffer window)
  303.            (set-window-buffer window buffer)
  304.            (set-window-point window point)
  305.            (set-window-start window start)))))))
  306.  
  307. (defun context-window-containing (edges)
  308.   (car (delq nil
  309.          (mapcar '(lambda (w)
  310.             (let ((wedges (window-edges w)))
  311.               (if (and (<= (nth 0 wedges) (nth 0 edges))
  312.                    (<= (nth 1 wedges) (nth 1 edges))
  313.                    (>= (nth 2 wedges) (nth 2 edges))
  314.                    (>= (nth 3 wedges) (nth 3 edges)))
  315.                   w)))
  316.              (context-window-list)))))
  317.  
  318. (defun context-window-list ()
  319.   (let (list first-window)
  320.     (save-window-excursion
  321.       (while (not (eq first-window (selected-window)))
  322.     (let ((window (selected-window)))
  323.       (or first-window
  324.           (setq first-window window))
  325.       (setq list (cons window list)))
  326.     (other-window 1)))
  327.     list))
  328.  
  329. (defun context-split-windows (edges)
  330.   (let ((window (context-window-containing edges)))
  331.     (if (windowp window)
  332.     (let ((wedges (window-edges window)))
  333.       (if (not (equal edges wedges))
  334.           (progn
  335.         (cond
  336.          ((> (nth 0 edges) (nth 0 wedges))
  337.           (split-window
  338.            window (- (nth 0 edges) (nth 0 wedges)) t))
  339.          ((> (nth 1 edges) (nth 1 wedges))
  340.           (split-window
  341.            window (- (nth 1 edges) (nth 1 wedges))))
  342.          ((< (nth 2 edges) (nth 2 wedges))
  343.           (split-window
  344.            window (- (nth 2 edges) (nth 0 wedges)) t))
  345.          ((< (nth 3 edges) (nth 3 wedges))
  346.           (split-window
  347.            window (- (nth 3 edges) (nth 1 wedges)))))
  348.         (context-split-windows edges)))))))
  349.  
  350. ;;;; end of context.el
  351.  
  352.  
  353.