1 ;;; liece-window.el --- Window configuration style utility.
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; Keywords: window, window configuration
9 ;; This file is part of Liece.
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
36 (eval-when-compile (require 'cl))
38 (defgroup liece-window nil
39 "Window configuration"
40 :tag "Window configuration"
43 (defcustom liece-window-min-width 2
44 "Minimal width of liece window."
48 (defcustom liece-window-min-height 2
49 "Minimal height of liece window."
53 (defcustom liece-window-style-directory nil
54 "Normal position of style configuration files."
58 (defcustom liece-window-default-style "bottom"
63 (defcustom liece-window-to-buffer
64 '((channel . liece-channel-buffer)
65 (others . liece-others-buffer)
66 (dialogue . liece-dialogue-buffer)
67 (command . liece-command-buffer)
68 (channel-list . liece-channel-list-buffer)
69 (nick . liece-nick-buffer))
70 "Window abbreviation to buffer alist."
72 (cons (symbol :tag "Abbrev")
73 (symbol :tag "Buffer")))
76 (defconst liece-window-split-types '(horizontal vertical))
78 (defvar liece-window-style-configuration-alist nil)
79 (defvar liece-window-current-style nil)
80 (defvar liece-window-configuration-stack nil)
82 (defun liece-window-field-match-method-as-default-rule
83 (calist field-type field-value)
84 (let* ((field (assq field-type calist)) (value (cdr field)))
86 (cons (cons field-type field-value) calist))
87 ((and (symbolp field-value) (eq field-value 'any))
89 ((and (symbolp value) (eq field-value value))
92 (define-calist-field-match-method
94 'liece-window-field-match-method-as-default-rule)
96 (define-calist-field-match-method
98 'liece-window-field-match-method-as-default-rule)
100 (define-calist-field-match-method
102 'liece-window-field-match-method-as-default-rule)
104 (define-calist-field-match-method
105 'channel-list-buffer-mode
106 'liece-window-field-match-method-as-default-rule)
108 (defmacro liece-window-add-style (&rest calist)
109 `(ctree-set-calist-strictly 'liece-window-style-configuration-alist
112 (defmacro liece-window-define-reconfiguration-predicate (name &rest body)
113 `(defun-maybe ,name ,@body))
115 (put 'liece-window-define-reconfiguration-predicate
116 'lisp-indent-function 'defun)
118 (defmacro liece-window-set-default-style ()
119 "Set window configuration with fallback style."
120 '(liece-window-add-style
121 (command-buffer-mode . any)
122 (channel-buffer-mode . any)
123 (nick-buffer-mode . any)
124 (channel-list-buffer-mode . any)
129 (command 4 point)))))
131 (defsubst liece-window-load-style-file (style)
135 (if (null liece-window-style-directory)
136 (setq liece-window-style-directory
137 (liece-locate-path "styles")))
138 (setq liece-window-style-configuration-alist nil)
139 (load (expand-file-name style liece-window-style-directory))
140 (setq liece-window-current-style style))
142 (liece-message "Style file load failed.")
143 (liece-window-set-default-style))))
145 (defmacro liece-window-percent-to-rate (percent)
148 (defmacro liece-window-to-buffer-helper (window)
149 `(cond ((symbolp ,window)
150 (symbol-value ,window))
153 (defmacro liece-window-safe-select-window (window)
154 `(if ,window (select-window ,window)))
157 (defun liece-command-set-window-style (style)
159 (let ((styles (directory-files liece-window-style-directory)))
161 (liece-minibuffer-completing-read
162 "Window style: " (list-to-alist styles) nil t nil nil
163 liece-window-current-style))))
164 (liece-window-load-style-file style))
166 (defun liece-command-reload-window-style ()
168 (liece-window-load-style-file
169 (or liece-window-current-style
170 liece-window-default-style)))
172 (defmacro liece-window-default-reconfiguration-predicate ()
173 '(or (one-window-p t)
174 (null (liece-get-buffer-window liece-command-buffer))
175 (and (not liece-channel-buffer-mode)
176 (null (liece-get-buffer-window liece-dialogue-buffer)))
177 (and liece-channel-buffer-mode
178 (null (liece-get-buffer-window liece-channel-buffer))
179 (null (liece-get-buffer-window liece-others-buffer)))
180 (and liece-channel-buffer-mode
181 (if liece-nick-buffer-mode
182 (null (liece-get-buffer-window liece-nick-buffer))
183 (not (null (liece-get-buffer-window liece-nick-buffer)))))
184 (if liece-channel-list-buffer-mode
185 (null (liece-get-buffer-window liece-channel-list-buffer))
186 (not (null (liece-get-buffer-window liece-channel-list-buffer))))))
189 (defun liece-configure-windows ()
190 (let ((liece-nick-buffer-mode liece-nick-buffer-mode)
191 (liece-channel-buffer-mode liece-channel-buffer-mode)
192 situation calist split predicate)
193 (if (and (get 'liece-nick-buffer-mode 'hide)
194 liece-nick-window-auto-hide)
195 (setq liece-nick-buffer-mode nil))
196 (if (not (liece-channel-last
197 (if (eq liece-command-buffer-mode 'chat)
198 liece-current-chat-partners
199 liece-current-channels)))
200 (setq liece-channel-buffer-mode nil))
202 `((channel-buffer-mode . ,liece-channel-buffer-mode)
203 (nick-buffer-mode . ,liece-nick-buffer-mode)
204 (channel-list-buffer-mode . ,liece-channel-list-buffer-mode)
205 (command-buffer-mode . ,liece-command-buffer-mode)))
206 (or liece-window-current-style
207 (liece-command-set-window-style liece-window-default-style))
208 (setq calist (ctree-match-calist liece-window-style-configuration-alist
210 split (cadr (assq 'configuration calist))
211 predicate (cdr (assq 'reconfiguration-predicate calist)))
215 (liece-functionp predicate)
216 (funcall predicate))))
217 (if (not (eq liece-truncate-partial-width-windows
218 truncate-partial-width-windows))
219 (setq truncate-partial-width-windows
220 liece-truncate-partial-width-windows))
221 (if liece-use-full-window (delete-other-windows))
223 (switch-to-buffer liece-command-buffer) ;; u-mu.
224 (liece-window-configure-frame split)))))
226 (defun liece-window-configure-frame (split &optional window)
228 (setq window (get-buffer-window (current-buffer))))
229 (liece-window-safe-select-window window)
230 (while (and (not (assq (car split) liece-window-to-buffer))
231 (liece-functionp (car split)))
232 (setq split (eval split)))
233 (let* ((type (car split))
235 (len (if (eq type 'horizontal) (window-width) (window-height)))
238 (or liece-window-min-width window-min-width))
240 (or liece-window-min-height window-min-height))
241 s result new-win rest comp-subs size sub)
243 ;; Nothing to do here.
245 ;; Don't switch buffers.
247 (and (memq 'point split) window))
248 ;; This is a buffer to be selected.
249 ((not (memq type '(horizontal vertical)))
250 (let ((buffer (cond ((stringp type) type)
251 (t (cdr (assq type liece-window-to-buffer))))))
253 (error "Illegal buffer type: %s" type))
255 (liece-window-to-buffer-helper buffer))
256 ;; We return the window if it has the `point' spec.
257 (and (memq 'point split) window)))
259 (when (> (length subs) 0)
260 ;; First we have to compute the sizes of all new windows.
262 (setq sub (append (pop subs) nil))
263 (while (and (not (assq (car sub) liece-window-to-buffer))
264 (liece-functionp (car sub)))
265 (setq sub (eval sub)))
268 (setq size (cadar comp-subs))
269 (cond ((equal size 1.0)
270 (setq rest (car comp-subs))
273 (setq s (floor (* size len))))
279 (* (liece-window-percent-to-rate
283 (error "Illegal size: %s" size)))
284 ;; Try to make sure that we are inside the safe limits.
286 ((eq type 'horizontal)
287 (setq s (max s window-min-width)))
289 (setq s (max s window-min-height))))
290 (setcar (cdar comp-subs) s)
292 ;; Take care of the "1.0" spec.
294 (setcar (cdr rest) (- len total))
295 (error "No 1.0 specs in %s" split))
296 ;; The we do the actual splitting in a nice recursive
298 (setq comp-subs (nreverse comp-subs))
300 (if (null (cdr comp-subs))
301 (setq new-win window)
303 (split-window window (cadar comp-subs)
304 (eq type 'horizontal))))
305 (setq result (or (liece-window-configure-frame
306 (car comp-subs) window)
308 (liece-window-safe-select-window new-win)
309 (setq window new-win)
310 (setq comp-subs (cdr comp-subs))))
311 ;; Return the proper window, if any.
312 (liece-window-safe-select-window result)))))
314 (defun liece-window-configuration-push ()
315 (let ((frame (selected-frame))
316 (config (current-window-configuration)))
317 (push (list frame config)
318 liece-window-configuration-stack)))
320 (defun liece-window-configuration-pop ()
321 (let* ((frame (selected-frame))
322 (triple (assq frame liece-window-configuration-stack)))
323 (when (and triple (window-configuration-p (cadr triple)))
324 (set-window-configuration (cadr triple))
325 (if (setq frame (assq frame liece-window-configuration-stack))
326 (setq liece-window-configuration-stack
327 (delq frame liece-window-configuration-stack))))
328 liece-window-configuration-stack))
330 (provide 'liece-window)
332 ;;; liece-window.el ends here