home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / epoch / epoch-config.el < prev    next >
Encoding:
Text File  |  1991-06-03  |  7.3 KB  |  204 lines
  1. ; Path: dg-rtp!rock.concert.net!mcnc!gatech!usenet.ins.cwru.edu!magnus.acs.ohio-state.edu!zaphod.mps.ohio-state.edu!wuarchive!uunet!mcsun!inesc!dec4pt.puug.pt!spa
  2. ; From: spa@dec4pt.puug.pt (Salvador Pinto Abreu)
  3. ; Newsgroups: gnu.emacs.sources,gnu.epoch.misc
  4. ; Subject: epoch-config.el: save/restore epoch screen configuration (new version)
  5. ; Date: 30 May 91 17:04:30 GMT
  6. ; Organization: Portuguese Unix User's Group
  7. ; 
  8. ; OK, here's another try.
  9. ; 
  10. ; This file allows the user to save the epoch screen configuration (ie.
  11. ; the size&position of most relevant screens [relevant => eg. not
  12. ; *scratch*], as well as the screens' contents (buffer name, file name
  13. ; and major mode are saved as well)).
  14. ; 
  15. ; It produces (with C-x S [upper-case S]) a file suitable for loading
  16. ; into epoch via M-x load-file (or C-x L), which will restore the state
  17. ; of the screens.
  18. ; 
  19. ; Useful esp. when you're running a window manager with a large virtual
  20. ; desktop, such as TVTWM (in fact, I've only tested it with tvtwm), and
  21. ; want to keep lots of windows around, carefully positioned.
  22. ; 
  23. ; It still needs some work for:
  24. ; 
  25. ;  1) support of other window managers (it makes some assumptions about
  26. ;     window containment that may apply only to tvtwm).
  27. ;  2) handling of non-file buffers, such as dired or monkey buffers.
  28. ; 
  29. ; It now supports screens with more than one window, and preserves the
  30. ; information regarding what part of the buffer is visible (ie. the
  31. ; first line on the window), and the value of (point).
  32. ; 
  33. ; Enjoy,
  34. ; /.salvador
  35.  
  36. ; Save and restore Epoch screen/window configuration.
  37.  
  38. ;; Copyright (C) 1991 Salvador Pinto Abreu <spa@fct.unl.pt>.
  39. ;; Copyright (C) 1991 Free Software Foundation, Inc.
  40.  
  41. ;; This file is part of GNU Emacs.
  42.  
  43. ;; GNU Emacs is distributed in the hope that it will be useful,
  44. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  45. ;; accepts responsibility to anyone for the consequences of using it
  46. ;; or for whether it serves any particular purpose or works at all,
  47. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  48. ;; License for full details.
  49.  
  50. ;; Everyone is granted permission to copy, modify and redistribute
  51. ;; GNU Emacs, but only under the conditions described in the
  52. ;; GNU Emacs General Public License.   A copy of this license is
  53. ;; supposed to have been given to you along with GNU Emacs so you
  54. ;; can know your rights and responsibilities.  It should be in a
  55. ;; file named COPYING.  Among other things, the copyright notice
  56. ;; and this notice must be preserved on all copies.
  57.  
  58. (provide 'epoch-config)
  59.  
  60. (defun epoch-info ()
  61.   (mapcar 'epoch-screen-info (epoch::screen-list)))
  62.  
  63. (defun dump-epoch-info (buffer)
  64.   (let ((info (epoch-info)))
  65.     (set-buffer buffer)
  66.     (goto-char (point-max))
  67.     (while info
  68.       (cond ((epoch-screen-ok (car info)) (print (car info))))
  69.       (setq info (cdr info)))))
  70.  
  71. (defun epoch-screen-ok (info)
  72.   "Decide whether a screen should be saved in the configuration or not.
  73. For the moment, this saves everything except screens whose name starts with
  74. a '*'."
  75.   (not (= ?* (aref (nth 1 info) 0))))
  76.  
  77. (defun save-epoch-configuration (the-file)
  78.   "Save the current window configuration to THE-FILE."
  79.   (interactive "FSave configuration to file: ")
  80.   (let* ((the-buffer (get-buffer-create "*screen-config*"))
  81.      (standard-output the-buffer))
  82.     (set-buffer the-buffer) (erase-buffer)
  83.     (insert ";;; File automatically generated by epoch-save-configuration.\n")
  84.     (insert (format ";;; Dumped by %s@%s (%s) at %s.\n"
  85.             (user-real-login-name) (system-name) (user-full-name)
  86.             (current-time-string)))
  87.     (dump-epoch-info the-buffer)
  88.     (set-buffer the-buffer) (write-file the-file)
  89.     (kill-buffer the-buffer)))
  90.  
  91. (defun epoch-screen-info (screen)
  92.   (epoch::select-screen screen)
  93.  
  94.   (let* ((parent-window    (car (cdr (epoch::query-tree screen))))
  95.      (vdesk-window     (car (cdr (epoch::query-tree parent-window))))
  96.      (root-window      (car (epoch::query-tree screen)))
  97.  
  98.      (vdesk-info       (cond ((eq vdesk-window root-window) nil)
  99.                  (t (screen-information vdesk-window))))
  100.  
  101.      (x-offset (cond (vdesk-info (- (nth 0 vdesk-info))) (t 0)))
  102.      (y-offset (cond (vdesk-info (- (nth 1 vdesk-info))) (t 0)))
  103.  
  104.      (screen-info      (screen-information))
  105.      (screen-x         (+ (nth 0 screen-info) x-offset))
  106.      (screen-y         (+ (nth 1 screen-info) y-offset))
  107.      (screen-width     (epoch::screen-width screen))
  108.      (screen-height    (epoch::screen-height screen))
  109.      (screen-title     (get-property "WM_NAME"      screen))
  110.      (screen-icon-name (get-property "WM_ICON_NAME" screen))
  111.      (border-width     (nth 4 screen-info))
  112.      (map-state        (nth 5 screen-info))
  113.      (windows          (mapcar 'epoch-window-info
  114.                    (epoch-window-list screen))))
  115.     (list 'epoch-select-one-screen
  116.       screen-title screen-icon-name
  117.       screen-x screen-y
  118.       screen-width screen-height
  119.       (cons 'list windows))))
  120.  
  121.  
  122. (defun epoch-window-list (screen &optional first this)
  123.   "Return the list of windows displayed on SCREEN."
  124.  
  125.   (cond (first (cond
  126.         ((and (not (eq first this))
  127.               (eq screen (epoch::screen-of-window this)))
  128.          (cons this
  129.                (epoch-window-list screen first (next-window this))))))
  130.     (t (let ((first (epoch::first-window screen)))
  131.          (cons first
  132.            (epoch-window-list screen first (next-window first)))))))
  133.  
  134.  
  135. (defun epoch-window-info (window)
  136.   "Return a list (BUFFER-NAME FILE-NAME MAJOR-MODE WINDOW-HEIGHT
  137. WINDOW-START POINT) for WINDOW."
  138.   (save-window-excursion
  139.     (select-window window)
  140.     (` (list (, (buffer-name))        ; 0
  141.          (, (buffer-file-name))    ; 1
  142.          (quote (, major-mode))    ; 2
  143.          (, (window-height))    ; 3
  144.          (, (window-start))        ; 6
  145.          (, (point))))))        ; 7
  146.  
  147.  
  148. (defun epoch-select-one-screen (title icon-name x y width height windows)
  149.   "This function is called from files saved by (dump-epoch-info)."
  150.  
  151.   (let* ((n-windows (length windows))
  152.      (screen-attributes
  153.       (append
  154.        (list (cons 'title title)
  155.          (cons 'icon-name icon-name)
  156.          (cons 'geometry (compute-epoch-geometry x y width height)))
  157.        epoch::screen-properties))
  158.      (screen (create-screen
  159.           (cond ((> n-windows 1) (get-buffer-create-screen "*junk*"))
  160.             (t (let* ((the-window (car windows))
  161.                   (the-buffer (nth 0 the-window))
  162.                   (the-file   (nth 1 the-window))
  163.                   (the-mode   (nth 2 the-window))
  164.                   (w-start    (nth 4 the-window))
  165.                   (p          (nth 5 the-window)))
  166.                  (prog1
  167.                  (set-buffer (find-file-noselect the-file))
  168.                    (funcall the-mode)
  169.                    (cond (w-start
  170.                       (goto-char w-start)
  171.                       (recenter 0)))
  172.                    (cond (p (goto-char p)
  173.                     (beginning-of-line 1)))))))
  174.           screen-attributes)))
  175.  
  176.     (epoch::select-screen screen)
  177.  
  178. ;;; Split screen in as many windows as needed, and select the
  179. ;;; appropriate buffer for each window.
  180.  
  181.     (cond ((> n-windows 1)
  182.        (let ((d-w-height (/ height n-windows)))
  183.          (while windows
  184.            (let* ((the-window (car windows))
  185.               (the-buffer (nth 0 the-window))
  186.               (the-file   (nth 1 the-window))
  187.               (the-mode   (nth 2 the-window))
  188.               (w-start    (nth 4 the-window))
  189.               (p          (nth 5 the-window)))
  190.          (switch-to-buffer (find-file the-file))
  191.          (funcall the-mode)
  192.          (setq windows (cdr windows))
  193.          (cond (windows (split-window (selected-window)
  194.                           (cond (w-height) (d-w-height)))))
  195.          (other-window 1))))
  196.  
  197.             (kill-buffer "*junk*")))))
  198.  
  199. (defun compute-epoch-geometry (x y w h)
  200.   (format "%dx%d+%d+%d" w h x y))
  201.  
  202. (global-set-key "\C-xL" 'load-file)
  203. (global-set-key "\C-xS" 'save-epoch-configuration)
  204.