Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/wconfig.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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)