|
0
|
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
|
|
100
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 15-Mar-89
|
|
100
|
12 ;; LAST-MOD: 9-Dec-96 at 18:39:50 by Bob Weiner
|
|
0
|
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
|
|
100
|
68 (defvar wconfig-names (set:create)
|
|
|
69 "Set of (name . window-configuration) elements.")
|
|
|
70
|
|
|
71 (defvar wconfig-ring nil
|
|
|
72 "List of window configurations saved in a ring.")
|
|
|
73
|
|
|
74 (defvar wconfig-ring-yank-pointer nil
|
|
|
75 "The tail of the window configuration ring whose car is the last thing yanked.")
|
|
|
76
|
|
0
|
77 ;;; ************************************************************************
|
|
|
78 ;;; Public functions
|
|
|
79 ;;; ************************************************************************
|
|
|
80
|
|
|
81 ;;; Handling of name associations with each stored window configuration.
|
|
|
82 ;;;###autoload
|
|
|
83 (defun wconfig-add-by-name (name)
|
|
|
84 "Saves the current window configuration under the string NAME.
|
|
|
85 When called interactively and a window configuration already exists under
|
|
|
86 NAME, confirms whether or not to replace it."
|
|
|
87 (interactive "sName for current window configuration: ")
|
|
|
88 (or (stringp name)
|
|
|
89 (error "(wconfig-add-by-name): NAME argument is not a string: %s" name))
|
|
|
90 (let ((set:equal-op (function (lambda (key elt)
|
|
|
91 (equal key (car elt))))))
|
|
|
92 (if (or (not (interactive-p))
|
|
|
93 (not (set:member name wconfig-names))
|
|
|
94 (y-or-n-p
|
|
|
95 (format "Replace existing '%s' window configuration: " name)))
|
|
|
96 (progn (setq wconfig-names
|
|
|
97 (set:replace name (current-window-configuration)
|
|
|
98 wconfig-names))
|
|
|
99 (if (interactive-p)
|
|
|
100 (message "Window configuration '%s' saved. Use 'wconfig-restore-by-name' to restore." name))))))
|
|
|
101
|
|
|
102 ;;;###autoload
|
|
|
103 (defun wconfig-delete-by-name (name)
|
|
|
104 "Deletes window configuration saved under NAME."
|
|
|
105 (interactive (list (hargs:read-match "Delete window configuration named: "
|
|
|
106 wconfig-names nil t)))
|
|
|
107 (or (stringp name)
|
|
|
108 (error "(wconfig-delete-by-name): NAME argument is not a string: %s" name))
|
|
|
109 (let ((set:equal-op (function (lambda (key elt)
|
|
|
110 (equal key (car elt))))))
|
|
|
111 (setq wconfig-names (set:remove name wconfig-names))))
|
|
|
112
|
|
|
113 ;;;###autoload
|
|
|
114 (defun wconfig-restore-by-name (name)
|
|
|
115 "Restores window configuration saved under NAME."
|
|
|
116 (interactive (list (hargs:read-match "Restore window configuration named: "
|
|
|
117 wconfig-names nil t)))
|
|
|
118 (or (stringp name)
|
|
|
119 (error "(wconfig-restore-by-name): NAME argument is not a string: %s" name))
|
|
|
120 (let ((wconfig (set:get name wconfig-names)))
|
|
|
121 (if wconfig
|
|
|
122 (set-window-configuration wconfig)
|
|
|
123 (error "(wconfig-restore-by-name): No window configuration named '%s'" name))))
|
|
|
124
|
|
|
125 ;;; Window configuration ring management (like text kill ring).
|
|
|
126 ;;;###autoload
|
|
|
127 (defun wconfig-delete-pop ()
|
|
|
128 "Replaces current window config with most recently saved config in ring.
|
|
|
129 Then deletes this new configuration from the ring."
|
|
|
130 (interactive)
|
|
|
131 (if (not wconfig-ring)
|
|
|
132 (error "(wconfig-delete-pop): Window configuration save ring is empty")
|
|
|
133 (set-window-configuration (car wconfig-ring))
|
|
|
134 (and (eq wconfig-ring wconfig-ring-yank-pointer)
|
|
|
135 (setq wconfig-ring-yank-pointer (cdr wconfig-ring)))
|
|
|
136 (setq wconfig-ring (cdr wconfig-ring))))
|
|
|
137
|
|
|
138 ;;;###autoload
|
|
|
139 (defun wconfig-ring-save ()
|
|
|
140 "Saves the current window configuration onto the save ring.
|
|
|
141 Use {\\[wconfig-yank-pop]} to restore it at a later time."
|
|
|
142 (interactive)
|
|
|
143 (setq wconfig-ring (cons (current-window-configuration) wconfig-ring))
|
|
|
144 (if (> (length wconfig-ring) wconfig-ring-max)
|
|
|
145 (setcdr (nthcdr (1- wconfig-ring-max) wconfig-ring) nil))
|
|
|
146 (setq wconfig-ring-yank-pointer wconfig-ring)
|
|
|
147 (wconfig-rotate-yank-pointer (1- (length wconfig-ring-yank-pointer)))
|
|
|
148 (if (interactive-p)
|
|
|
149 (message
|
|
|
150 "Window configuration saved. Use 'wconfig-yank-pop' to restore.")))
|
|
|
151
|
|
|
152 (defun wconfig-rotate-yank-pointer (arg)
|
|
|
153 "Rotates the yanking point prefix ARG elements in the window configuration save ring.
|
|
|
154 Interactively, default value of ARG = 1."
|
|
|
155 (interactive "p")
|
|
|
156 (let ((length (length wconfig-ring)))
|
|
|
157 (if (zerop length)
|
|
|
158 (error "(wconfig-rotate-yank-pointer): Window configuration save ring is empty")
|
|
|
159 (setq wconfig-ring-yank-pointer
|
|
|
160 (nthcdr (% (+ arg (- length (length wconfig-ring-yank-pointer)))
|
|
|
161 length)
|
|
|
162 wconfig-ring)))))
|
|
|
163
|
|
|
164 ;;;###autoload
|
|
|
165 (defun wconfig-yank-pop (n)
|
|
|
166 "Replaces current window config with prefix arg Nth prior one in save ring.
|
|
|
167 Interactively, default value of N = 1, meaning the last saved window
|
|
|
168 configuration is displayed.
|
|
|
169
|
|
|
170 The sequence of window configurations wraps around, so that after the oldest
|
|
|
171 one comes the newest one."
|
|
|
172 (interactive "p")
|
|
|
173 (wconfig-rotate-yank-pointer n)
|
|
|
174 (set-window-configuration (car wconfig-ring-yank-pointer)))
|
|
|
175
|
|
|
176 ;;; ************************************************************************
|
|
|
177 ;;; Private variables
|
|
|
178 ;;; ************************************************************************
|
|
|
179
|
|
|
180 (run-hooks 'wconfig-load-hook)
|
|
|
181
|
|
|
182 (provide 'wconfig)
|
