1 ;;; gnus-win.el --- window configuration functions for Gnus
2 ;; Copyright (C) 1996 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
30 (defvar gnus-use-full-window t
31 "*If non-nil, use the entire Emacs screen.")
33 (defvar gnus-window-configuration nil
34 "Obsolete variable. See `gnus-buffer-configuration'.")
36 (defvar gnus-window-min-width 2
37 "*Minimum width of Gnus buffers.")
39 (defvar gnus-window-min-height 1
40 "*Minimum height of Gnus buffers.")
42 (defvar gnus-buffer-configuration
46 (if gnus-carpal '(group-carpal 4))))
50 (if gnus-carpal '(summary-carpal 4))))
57 (if gnus-carpal '(summary-carpal 4))
59 (vertical ((height . 5) (width . 15)
61 (left . -1) (top . 1))
71 (if gnus-carpal '(summary-carpal 4))
76 (if gnus-carpal '(server-carpal 2))))
80 (if gnus-carpal '(browse-carpal 2))))
100 (edit-form 1.0 point)))
104 (edit-score 1.0 point)))
111 (message 1.0 point)))
114 (message 1.0 point)))
117 (message 1.0 point)))
121 (message 1.0 point)))
128 (if gnus-carpal '(summary-carpal 4))
129 ("*Shell Command Output*" 1.0)))
132 ("*Gnus Help Bug*" 0.5)
133 ("*Gnus Bug*" 1.0 point)))
137 (message 1.0 point))))
138 "Window configuration for all possible Gnus buffers.
139 This variable is a list of lists. Each of these lists has a NAME and
140 a RULE. The NAMEs are commonsense names like `group', which names a
141 rule used when displaying the group buffer; `summary', which names a
142 rule for what happens when you enter a group and do not display an
143 article buffer; and so on. See the value of this variable for a
144 complete list of NAMEs.
146 Each RULE is a list of vectors. The first element in this vector is
147 the name of the buffer to be displayed; the second element is the
148 percentage of the screen this buffer is to occupy (a number in the
149 0.0-0.99 range); the optional third element is `point', which should
150 be present to denote which buffer point is to go to after making this
151 buffer configuration.")
153 (defvar gnus-window-to-buffer
154 '((group . gnus-group-buffer)
155 (summary . gnus-summary-buffer)
156 (article . gnus-article-buffer)
157 (server . gnus-server-buffer)
158 (browse . "*Gnus Browse Server*")
159 (edit-group . gnus-group-edit-buffer)
160 (edit-form . gnus-edit-form-buffer)
161 (edit-server . gnus-server-edit-buffer)
162 (group-carpal . gnus-carpal-group-buffer)
163 (summary-carpal . gnus-carpal-summary-buffer)
164 (server-carpal . gnus-carpal-server-buffer)
165 (browse-carpal . gnus-carpal-browse-buffer)
166 (edit-score . gnus-score-edit-buffer)
167 (message . gnus-message-buffer)
168 (mail . gnus-message-buffer)
169 (post-news . gnus-message-buffer)
170 (faq . gnus-faq-buffer)
171 (picons . "*Picons*")
172 (tree . gnus-tree-buffer)
173 (info . gnus-info-buffer)
174 (article-copy . gnus-article-copy)
175 (draft . gnus-draft-buffer))
176 "Mapping from short symbols to buffer names or buffer variables.")
178 (defvar gnus-created-frames nil)
180 (defun gnus-kill-gnus-frames ()
181 "Kill all frames Gnus has created."
182 (while gnus-created-frames
183 (when (frame-live-p (car gnus-created-frames))
184 ;; We slap a condition-case around this `delete-frame' to ensure
185 ;; against errors if we try do delete the single frame that's left.
187 (delete-frame (car gnus-created-frames))
189 (pop gnus-created-frames)))
191 (defun gnus-windows-old-to-new (setting)
192 ;; First we take care of the really, really old Gnus 3 actions.
193 (when (symbolp setting)
195 ;; Take care of ooold GNUS 3.x values.
196 (cond ((eq setting 'SelectArticle) 'article)
197 ((memq setting '(SelectSubject ExpandSubject)) 'summary)
198 ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group)
200 (if (or (listp setting)
201 (not (and gnus-window-configuration
202 (memq setting '(group summary article)))))
204 (let* ((setting (if (eq setting 'group)
205 (if (assq 'newsgroup gnus-window-configuration)
207 'newsgroups) setting))
208 (elem (cadr (assq setting gnus-window-configuration)))
209 (total (apply '+ elem))
210 (types '(group summary article))
211 (pbuf (if (eq setting 'newsgroups) 'group 'summary))
216 (or (not (numberp (nth i elem)))
219 (setq perc (if (= i 2)
221 (/ (float (nth 0 elem)) total)))
222 (setq out (cons (if (eq pbuf (nth i types))
223 (list (nth i types) perc 'point)
224 (list (nth i types) perc))
227 `(vertical 1.0 ,@(nreverse out)))))
230 (defun gnus-add-configuration (conf)
231 "Add the window configuration CONF to `gnus-buffer-configuration'."
232 (setq gnus-buffer-configuration
233 (cons conf (delq (assq (car conf) gnus-buffer-configuration)
234 gnus-buffer-configuration))))
236 (defvar gnus-frame-list nil)
238 (defun gnus-configure-frame (split &optional window)
239 "Split WINDOW according to SPLIT."
241 (setq window (get-buffer-window (current-buffer))))
242 (select-window window)
243 ;; This might be an old-stylee buffer config.
244 (when (vectorp split)
245 (setq split (append split nil)))
246 (when (or (consp (car split))
247 (vectorp (car split)))
249 (push 'vertical split))
250 ;; The SPLIT might be something that is to be evaled to
251 ;; return a new SPLIT.
252 (while (and (not (assq (car split) gnus-window-to-buffer))
253 (gnus-functionp (car split)))
254 (setq split (eval split)))
255 (let* ((type (car split))
257 (len (if (eq type 'horizontal) (window-width) (window-height)))
259 (window-min-width (or gnus-window-min-width window-min-width))
260 (window-min-height (or gnus-window-min-height window-min-height))
261 s result new-win rest comp-subs size sub)
263 ;; Nothing to do here.
265 ;; Don't switch buffers.
267 (and (memq 'point split) window))
268 ;; This is a buffer to be selected.
269 ((not (memq type '(frame horizontal vertical)))
270 (let ((buffer (cond ((stringp type) type)
271 (t (cdr (assq type gnus-window-to-buffer)))))
274 (error "Illegal buffer type: %s" type))
275 (unless (setq buf (get-buffer (if (symbolp buffer)
276 (symbol-value buffer) buffer)))
277 (setq buf (get-buffer-create (if (symbolp buffer)
278 (symbol-value buffer) buffer))))
279 (switch-to-buffer buf)
280 ;; We return the window if it has the `point' spec.
281 (and (memq 'point split) window)))
282 ;; This is a frame split.
284 (unless gnus-frame-list
285 (setq gnus-frame-list (list (window-frame
286 (get-buffer-window (current-buffer))))))
288 params frame fresult)
289 (while (< i (length subs))
290 ;; Frame parameter is gotten from the sub-split.
291 (setq params (cadr (elt subs i)))
292 ;; It should be a list.
293 (unless (listp params)
295 ;; Create a new frame?
296 (unless (setq frame (elt gnus-frame-list i))
297 (nconc gnus-frame-list (list (setq frame (make-frame params))))
298 (push frame gnus-created-frames))
299 ;; Is the old frame still alive?
300 (unless (frame-live-p frame)
301 (setcar (nthcdr i gnus-frame-list)
302 (setq frame (make-frame params))))
303 ;; Select the frame in question and do more splits there.
305 (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
307 ;; Select the frame that has the selected buffer.
309 (select-frame (window-frame fresult)))))
310 ;; This is a normal split.
312 (when (> (length subs) 0)
313 ;; First we have to compute the sizes of all new windows.
315 (setq sub (append (pop subs) nil))
316 (while (and (not (assq (car sub) gnus-window-to-buffer))
317 (gnus-functionp (car sub)))
318 (setq sub (eval sub)))
321 (setq size (cadar comp-subs))
322 (cond ((equal size 1.0)
323 (setq rest (car comp-subs))
326 (setq s (floor (* size len))))
330 (error "Illegal size: %s" size)))
331 ;; Try to make sure that we are inside the safe limits.
333 ((eq type 'horizontal)
334 (setq s (max s window-min-width)))
336 (setq s (max s window-min-height))))
337 (setcar (cdar comp-subs) s)
339 ;; Take care of the "1.0" spec.
341 (setcar (cdr rest) (- len total))
342 (error "No 1.0 specs in %s" split))
343 ;; The we do the actual splitting in a nice recursive
345 (setq comp-subs (nreverse comp-subs))
347 (if (null (cdr comp-subs))
348 (setq new-win window)
350 (split-window window (cadar comp-subs)
351 (eq type 'horizontal))))
352 (setq result (or (gnus-configure-frame
353 (car comp-subs) window) result))
354 (select-window new-win)
355 (setq window new-win)
356 (setq comp-subs (cdr comp-subs))))
357 ;; Return the proper window, if any.
359 (select-window result))))))
361 (defvar gnus-frame-split-p nil)
363 (defun gnus-configure-windows (setting &optional force)
364 (setq setting (gnus-windows-old-to-new setting))
365 (let ((split (if (symbolp setting)
366 (cadr (assq setting gnus-buffer-configuration))
370 (setq gnus-frame-split-p nil)
373 (error "No such setting: %s" setting))
375 (if (and (setq all-visible (gnus-all-windows-visible-p split))
377 ;; All the windows mentioned are already visible, so we just
378 ;; put point in the assigned buffer, and do not touch the
380 (select-window all-visible)
382 ;; Either remove all windows or just remove all Gnus windows.
383 (let ((frame (selected-frame)))
385 (if gnus-use-full-window
386 ;; We want to remove all other windows.
387 (if (not gnus-frame-split-p)
388 ;; This is not a `frame' split, so we ignore the
390 (delete-other-windows)
391 ;; This is a `frame' split, so we delete all windows
395 (unless (eq (cdr (assq 'minibuffer
396 (frame-parameters frame)))
399 (delete-other-windows)))
401 ;; Just remove some windows.
402 (gnus-remove-some-windows)
403 (switch-to-buffer nntp-server-buffer))
404 (select-frame frame)))
406 (switch-to-buffer nntp-server-buffer)
407 (gnus-configure-frame split (get-buffer-window (current-buffer))))))
409 (defun gnus-all-windows-visible-p (split)
410 "Say whether all buffers in SPLIT are currently visible.
411 In particular, the value returned will be the window that
413 (let ((stack (list split))
416 (while (and (setq split (pop stack))
418 ;; Be backwards compatible.
419 (when (vectorp split)
420 (setq split (append split nil)))
421 (when (or (consp (car split))
422 (vectorp (car split)))
424 (push 'vertical split))
425 ;; The SPLIT might be something that is to be evaled to
426 ;; return a new SPLIT.
427 (while (and (not (assq (car split) gnus-window-to-buffer))
428 (gnus-functionp (car split)))
429 (setq split (eval split)))
431 (setq type (elt split 0))
436 ((not (memq type '(horizontal vertical frame)))
437 (setq buffer (cond ((stringp type) type)
438 (t (cdr (assq type gnus-window-to-buffer)))))
440 (error "Illegal buffer type: %s" type))
441 (when (setq buf (get-buffer (if (symbolp buffer)
442 (symbol-value buffer)
444 (setq win (get-buffer-window buf t)))
446 (when (memq 'point split)
447 (setq all-visible win))
448 (setq all-visible nil)))
450 (when (eq type 'frame)
451 (setq gnus-frame-split-p t))
452 (setq stack (append (cddr split) stack)))))
453 (unless (eq all-visible t)
456 (defun gnus-window-top-edge (&optional window)
457 (nth 1 (window-edges window)))
459 (defun gnus-remove-some-windows ()
460 (let ((buffers gnus-window-to-buffer)
461 buf bufs lowest-buf lowest)
463 ;; Remove windows on all known Gnus buffers.
465 (setq buf (cdar buffers))
467 (setq buf (and (boundp buf) (symbol-value buf))))
469 (get-buffer-window buf)
471 (setq bufs (cons buf bufs))
474 (< (gnus-window-top-edge) lowest))
476 (setq lowest (gnus-window-top-edge))
477 (setq lowest-buf buf)))))
478 (setq buffers (cdr buffers)))
479 ;; Remove windows on *all* summary buffers.
482 (let ((buf (window-buffer win)))
483 (if (string-match "^\\*Summary" (buffer-name buf))
485 (setq bufs (cons buf bufs))
488 (< (gnus-window-top-edge) lowest))
490 (setq lowest-buf buf)
491 (setq lowest (gnus-window-top-edge)))))))))
494 (pop-to-buffer lowest-buf)
495 (switch-to-buffer nntp-server-buffer)))
497 (and (not (eq (car bufs) lowest-buf))
498 (delete-windows-on (car bufs)))
499 (setq bufs (cdr bufs))))))
503 ;;; gnus-win.el ends here