home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / hyperbole / wconfig.el < prev    next >
Encoding:
Text File  |  1995-04-17  |  6.9 KB  |  183 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         wconfig.el
  4. ;; SUMMARY:      Saves and yanks from save ring of window configurations.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     frames, hypermedia
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Brown U.
  10. ;;
  11. ;; ORIG-DATE:    15-Mar-89
  12. ;; LAST-MOD:     14-Apr-95 at 16:26:27 by Bob Weiner
  13. ;;
  14. ;; This file is part of Hyperbole.
  15. ;; Available for use and distribution under the same terms as GNU Emacs.
  16. ;;
  17. ;; Copyright (C) 1989-1995, Free Software Foundation, Inc.
  18. ;; Developed with support from Motorola Inc.
  19. ;;
  20. ;; DESCRIPTION:  
  21. ;;
  22. ;;   This library provides two unrelated means of managing window
  23. ;;   configurations, (the set of windows and associated buffers within a
  24. ;;   frame).  The first means associates a name with each stored window
  25. ;;   configuration.  The name can then be used to retrieve the window
  26. ;;   configuration later.  The following functions provide this behavior:
  27. ;;
  28. ;;      wconfig-add-by-name
  29. ;;      wconfig-delete-by-name
  30. ;;      wconfig-restore-by-name
  31. ;;
  32. ;;   The second means of window configuration management is through the use
  33. ;;   of a ring structure, just like the Emacs kill ring except the elements
  34. ;;   stored are window configurations instead of textual regions.  The
  35. ;;   following functions support storage and sequential retrieval of window
  36. ;;   configurations:
  37. ;;
  38. ;;      wconfig-ring-save
  39. ;;      wconfig-yank-pop
  40. ;;      wconfig-delete-pop
  41. ;;
  42. ;;   None of this information is stored between Emacs sessions, so your
  43. ;;   window configurations will last only through a single session of use.
  44. ;;
  45. ;;   Based in part on kill-ring code from simple.el.
  46. ;;
  47. ;; DESCRIP-END.
  48.  
  49. ;;; ************************************************************************
  50. ;;; Recommended key bindings
  51. ;;; ************************************************************************
  52.  
  53. ;;; Set up in local "hyperbole.el".
  54.  
  55. ;;; ************************************************************************
  56. ;;; Other required Elisp libraries
  57. ;;; ************************************************************************
  58. (require 'hargs)
  59. (require 'set)
  60.  
  61. ;;; ************************************************************************
  62. ;;; Public variables
  63. ;;; ************************************************************************
  64.  
  65. (defconst wconfig-ring-max 10
  66.   "*Maximum length of window configuration ring before oldest elements are deleted.")
  67.  
  68. ;;; ************************************************************************
  69. ;;; Public functions
  70. ;;; ************************************************************************
  71.  
  72. ;;; Handling of name associations with each stored window configuration.
  73. ;;;###autoload
  74. (defun wconfig-add-by-name (name)
  75.   "Saves the current window configuration under the string NAME.
  76. When called interactively and a window configuration already exists under
  77. NAME, confirms whether or not to replace it."
  78.   (interactive "sName for current window configuration: ")
  79.   (or (stringp name)
  80.       (error "(wconfig-add-by-name): NAME argument is not a string: %s" name))
  81.   (let ((set:equal-op (function (lambda (key elt)
  82.                   (equal key (car elt))))))
  83.     (if (or (not (interactive-p))
  84.         (not (set:member name wconfig-names))
  85.         (y-or-n-p
  86.           (format "Replace existing '%s' window configuration: " name)))
  87.     (progn (setq wconfig-names
  88.              (set:replace name (current-window-configuration)
  89.                   wconfig-names))
  90.            (if (interactive-p)
  91.            (message "Window configuration '%s' saved.  Use 'wconfig-restore-by-name' to restore." name))))))
  92.  
  93. ;;;###autoload
  94. (defun wconfig-delete-by-name (name)
  95.   "Deletes window configuration saved under NAME."
  96.   (interactive (list (hargs:read-match "Delete window configuration named: "
  97.                        wconfig-names nil t)))
  98.   (or (stringp name)
  99.       (error "(wconfig-delete-by-name): NAME argument is not a string: %s" name))
  100.   (let ((set:equal-op (function (lambda (key elt)
  101.                   (equal key (car elt))))))
  102.     (setq wconfig-names (set:remove name wconfig-names))))
  103.  
  104. ;;;###autoload
  105. (defun wconfig-restore-by-name (name)
  106.   "Restores window configuration saved under NAME."
  107.   (interactive (list (hargs:read-match "Restore window configuration named: "
  108.                        wconfig-names nil t)))
  109.   (or (stringp name)
  110.       (error "(wconfig-restore-by-name): NAME argument is not a string: %s" name))
  111.   (let ((wconfig (set:get name wconfig-names)))
  112.     (if wconfig
  113.     (set-window-configuration wconfig)
  114.       (error "(wconfig-restore-by-name): No window configuration named '%s'" name))))
  115.  
  116. ;;; Window configuration ring management (like text kill ring).
  117. ;;;###autoload
  118. (defun wconfig-delete-pop ()
  119.   "Replaces current window config with most recently saved config in ring.
  120. Then deletes this new configuration from the ring."
  121.   (interactive)
  122.   (if (not wconfig-ring)
  123.       (error "(wconfig-delete-pop): Window configuration save ring is empty")
  124.     (set-window-configuration (car wconfig-ring))
  125.     (and (eq wconfig-ring wconfig-ring-yank-pointer)
  126.      (setq wconfig-ring-yank-pointer (cdr wconfig-ring)))
  127.     (setq wconfig-ring (cdr wconfig-ring))))
  128.  
  129. ;;;###autoload
  130. (defun wconfig-ring-save ()
  131.   "Saves the current window configuration onto the save ring.
  132. Use {\\[wconfig-yank-pop]} to restore it at a later time."
  133.   (interactive)
  134.   (setq wconfig-ring (cons (current-window-configuration) wconfig-ring))
  135.   (if (> (length wconfig-ring) wconfig-ring-max)
  136.       (setcdr (nthcdr (1- wconfig-ring-max) wconfig-ring) nil))
  137.   (setq wconfig-ring-yank-pointer wconfig-ring)
  138.   (wconfig-rotate-yank-pointer (1- (length wconfig-ring-yank-pointer)))
  139.   (if (interactive-p)
  140.       (message
  141.     "Window configuration saved.  Use 'wconfig-yank-pop' to restore.")))
  142.  
  143. (defun wconfig-rotate-yank-pointer (arg)
  144.   "Rotates the yanking point prefix ARG elements in the window configuration save ring.
  145. Interactively, default value of ARG = 1."
  146.   (interactive "p")
  147.   (let ((length (length wconfig-ring)))
  148.     (if (zerop length)
  149.     (error "(wconfig-rotate-yank-pointer): Window configuration save ring is empty")
  150.       (setq wconfig-ring-yank-pointer
  151.         (nthcdr (% (+ arg (- length (length wconfig-ring-yank-pointer)))
  152.                length)
  153.             wconfig-ring)))))
  154.  
  155. ;;;###autoload
  156. (defun wconfig-yank-pop (n)
  157.   "Replaces current window config with prefix arg Nth prior one in save ring.
  158. Interactively, default value of N = 1, meaning the last saved window
  159. configuration is displayed.
  160.  
  161. The sequence of window configurations wraps around, so that after the oldest
  162. one comes the newest one."
  163.   (interactive "p")
  164.   (wconfig-rotate-yank-pointer n)
  165.   (set-window-configuration (car wconfig-ring-yank-pointer)))
  166.  
  167. ;;; ************************************************************************
  168. ;;; Private variables
  169. ;;; ************************************************************************
  170.  
  171. (defvar wconfig-names (set:create)
  172.   "Set of (name . window-configuration) elements.")
  173.  
  174. (defvar wconfig-ring nil
  175.   "List of window configurations saved in a ring.")
  176.  
  177. (defvar wconfig-ring-yank-pointer nil
  178.   "The tail of the window configuration ring whose car is the last thing yanked.")
  179.  
  180. (run-hooks 'wconfig-load-hook)
  181.  
  182. (provide 'wconfig)
  183.