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))))
53 ((and gnus-use-picons (not (eq gnus-picons-display-where 'article)))
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 ("*Score Trace*" 1.0)))
141 ("*Score Words*" 1.0)))
145 (message 1.0 point))))
146 "Window configuration for all possible Gnus buffers.
147 This variable is a list of lists. Each of these lists has a NAME and
148 a RULE. The NAMEs are commonsense names like `group', which names a
149 rule used when displaying the group buffer; `summary', which names a
150 rule for what happens when you enter a group and do not display an
151 article buffer; and so on. See the value of this variable for a
152 complete list of NAMEs.
154 Each RULE is a list of vectors. The first element in this vector is
155 the name of the buffer to be displayed; the second element is the
156 percentage of the screen this buffer is to occupy (a number in the
157 0.0-0.99 range); the optional third element is `point', which should
158 be present to denote which buffer point is to go to after making this
159 buffer configuration.")
161 (defvar gnus-window-to-buffer
162 '((group . gnus-group-buffer)
163 (summary . gnus-summary-buffer)
164 (article . gnus-article-buffer)
165 (server . gnus-server-buffer)
166 (browse . "*Gnus Browse Server*")
167 (edit-group . gnus-group-edit-buffer)
168 (edit-form . gnus-edit-form-buffer)
169 (edit-server . gnus-server-edit-buffer)
170 (group-carpal . gnus-carpal-group-buffer)
171 (summary-carpal . gnus-carpal-summary-buffer)
172 (server-carpal . gnus-carpal-server-buffer)
173 (browse-carpal . gnus-carpal-browse-buffer)
174 (edit-score . gnus-score-edit-buffer)
175 (message . gnus-message-buffer)
176 (mail . gnus-message-buffer)
177 (post-news . gnus-message-buffer)
178 (faq . gnus-faq-buffer)
179 (picons . "*Picons*")
180 (tree . gnus-tree-buffer)
181 (info . gnus-info-buffer)
182 (article-copy . gnus-article-copy)
183 (draft . gnus-draft-buffer))
184 "Mapping from short symbols to buffer names or buffer variables.")
186 (defvar gnus-created-frames nil)
188 (defun gnus-kill-gnus-frames ()
189 "Kill all frames Gnus has created."
190 (while gnus-created-frames
191 (when (frame-live-p (car gnus-created-frames))
192 ;; We slap a condition-case around this `delete-frame' to ensure
193 ;; against errors if we try do delete the single frame that's left.
195 (delete-frame (car gnus-created-frames))
197 (pop gnus-created-frames)))
199 (defun gnus-window-configuration-element (list)
201 (not (assq (car list) gnus-window-configuration)))
203 (cadr (assq (car list) gnus-window-configuration)))
205 (defun gnus-windows-old-to-new (setting)
206 ;; First we take care of the really, really old Gnus 3 actions.
207 (when (symbolp setting)
209 ;; Take care of ooold GNUS 3.x values.
210 (cond ((eq setting 'SelectArticle) 'article)
211 ((memq setting '(SelectNewsgroup SelectSubject ExpandSubject))
213 ((memq setting '(ExitNewsgroup)) 'group)
215 (if (or (listp setting)
216 (not (and gnus-window-configuration
217 (memq setting '(group summary article)))))
222 (gnus-window-configuration-element
223 '(group newsgroups ExitNewsgroup)))
224 ((eq setting 'summary)
225 (gnus-window-configuration-element
226 '(summary SelectNewsgroup SelectSubject ExpandSubject)))
227 ((eq setting 'article)
228 (gnus-window-configuration-element
229 '(article SelectArticle)))))
230 (total (apply '+ elem))
231 (types '(group summary article))
232 (pbuf (if (eq setting 'newsgroups) 'group 'summary))
236 (or (not (numberp (nth i elem)))
239 (setq perc (if (= i 2)
241 (/ (float (nth i elem)) total)))
242 (push (if (eq pbuf (nth i types))
243 (list (nth i types) perc 'point)
244 (list (nth i types) perc))
247 `(vertical 1.0 ,@(nreverse out)))))
250 (defun gnus-add-configuration (conf)
251 "Add the window configuration CONF to `gnus-buffer-configuration'."
252 (setq gnus-buffer-configuration
253 (cons conf (delq (assq (car conf) gnus-buffer-configuration)
254 gnus-buffer-configuration))))
256 (defvar gnus-frame-list nil)
258 (defun gnus-configure-frame (split &optional window)
259 "Split WINDOW according to SPLIT."
261 (setq window (get-buffer-window (current-buffer))))
262 (select-window window)
263 ;; This might be an old-stylee buffer config.
264 (when (vectorp split)
265 (setq split (append split nil)))
266 (when (or (consp (car split))
267 (vectorp (car split)))
269 (push 'vertical split))
270 ;; The SPLIT might be something that is to be evaled to
271 ;; return a new SPLIT.
272 (while (and (not (assq (car split) gnus-window-to-buffer))
273 (gnus-functionp (car split)))
274 (setq split (eval split)))
275 (let* ((type (car split))
277 (len (if (eq type 'horizontal) (window-width) (window-height)))
279 (window-min-width (or gnus-window-min-width window-min-width))
280 (window-min-height (or gnus-window-min-height window-min-height))
281 s result new-win rest comp-subs size sub)
283 ;; Nothing to do here.
285 ;; Don't switch buffers.
287 (and (memq 'point split) window))
288 ;; This is a buffer to be selected.
289 ((not (memq type '(frame horizontal vertical)))
290 (let ((buffer (cond ((stringp type) type)
291 (t (cdr (assq type gnus-window-to-buffer)))))
294 (error "Illegal buffer type: %s" type))
295 (unless (setq buf (get-buffer (if (symbolp buffer)
296 (symbol-value buffer) buffer)))
297 (setq buf (get-buffer-create (if (symbolp buffer)
298 (symbol-value buffer) buffer))))
299 (switch-to-buffer buf)
300 ;; We return the window if it has the `point' spec.
301 (and (memq 'point split) window)))
302 ;; This is a frame split.
304 (unless gnus-frame-list
305 (setq gnus-frame-list (list (window-frame
306 (get-buffer-window (current-buffer))))))
308 params frame fresult)
309 (while (< i (length subs))
310 ;; Frame parameter is gotten from the sub-split.
311 (setq params (cadr (elt subs i)))
312 ;; It should be a list.
313 (unless (listp params)
315 ;; Create a new frame?
316 (unless (setq frame (elt gnus-frame-list i))
317 (nconc gnus-frame-list (list (setq frame (make-frame params))))
318 (push frame gnus-created-frames))
319 ;; Is the old frame still alive?
320 (unless (frame-live-p frame)
321 (setcar (nthcdr i gnus-frame-list)
322 (setq frame (make-frame params))))
323 ;; Select the frame in question and do more splits there.
325 (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
327 ;; Select the frame that has the selected buffer.
329 (select-frame (window-frame fresult)))))
330 ;; This is a normal split.
332 (when (> (length subs) 0)
333 ;; First we have to compute the sizes of all new windows.
335 (setq sub (append (pop subs) nil))
336 (while (and (not (assq (car sub) gnus-window-to-buffer))
337 (gnus-functionp (car sub)))
338 (setq sub (eval sub)))
341 (setq size (cadar comp-subs))
342 (cond ((equal size 1.0)
343 (setq rest (car comp-subs))
346 (setq s (floor (* size len))))
350 (error "Illegal size: %s" size)))
351 ;; Try to make sure that we are inside the safe limits.
353 ((eq type 'horizontal)
354 (setq s (max s window-min-width)))
356 (setq s (max s window-min-height))))
357 (setcar (cdar comp-subs) s)
359 ;; Take care of the "1.0" spec.
361 (setcar (cdr rest) (- len total))
362 (error "No 1.0 specs in %s" split))
363 ;; The we do the actual splitting in a nice recursive
365 (setq comp-subs (nreverse comp-subs))
367 (if (null (cdr comp-subs))
368 (setq new-win window)
370 (split-window window (cadar comp-subs)
371 (eq type 'horizontal))))
372 (setq result (or (gnus-configure-frame
373 (car comp-subs) window) result))
374 (select-window new-win)
375 (setq window new-win)
376 (setq comp-subs (cdr comp-subs))))
377 ;; Return the proper window, if any.
379 (select-window result))))))
381 (defvar gnus-frame-split-p nil)
383 (defun gnus-configure-windows (setting &optional force)
384 (setq setting (gnus-windows-old-to-new setting))
385 (let ((split (if (symbolp setting)
386 (cadr (assq setting gnus-buffer-configuration))
390 (setq gnus-frame-split-p nil)
393 (error "No such setting: %s" setting))
395 (if (and (setq all-visible (gnus-all-windows-visible-p split))
397 ;; All the windows mentioned are already visible, so we just
398 ;; put point in the assigned buffer, and do not touch the
400 (select-window all-visible)
402 ;; Either remove all windows or just remove all Gnus windows.
403 (let ((frame (selected-frame)))
405 (if gnus-use-full-window
406 ;; We want to remove all other windows.
407 (if (not gnus-frame-split-p)
408 ;; This is not a `frame' split, so we ignore the
410 (delete-other-windows)
411 ;; This is a `frame' split, so we delete all windows
415 (unless (eq (cdr (assq 'minibuffer
416 (frame-parameters frame)))
419 (delete-other-windows)))
421 ;; Just remove some windows.
422 (gnus-remove-some-windows)
423 (switch-to-buffer nntp-server-buffer))
424 (select-frame frame)))
426 (switch-to-buffer nntp-server-buffer)
427 (gnus-configure-frame split (get-buffer-window (current-buffer))))))
429 (defun gnus-all-windows-visible-p (split)
430 "Say whether all buffers in SPLIT are currently visible.
431 In particular, the value returned will be the window that
433 (let ((stack (list split))
436 (while (and (setq split (pop stack))
438 ;; Be backwards compatible.
439 (when (vectorp split)
440 (setq split (append split nil)))
441 (when (or (consp (car split))
442 (vectorp (car split)))
444 (push 'vertical split))
445 ;; The SPLIT might be something that is to be evaled to
446 ;; return a new SPLIT.
447 (while (and (not (assq (car split) gnus-window-to-buffer))
448 (gnus-functionp (car split)))
449 (setq split (eval split)))
451 (setq type (elt split 0))
456 ((not (memq type '(horizontal vertical frame)))
457 (setq buffer (cond ((stringp type) type)
458 (t (cdr (assq type gnus-window-to-buffer)))))
460 (error "Illegal buffer type: %s" type))
461 (when (setq buf (get-buffer (if (symbolp buffer)
462 (symbol-value buffer)
464 (setq win (get-buffer-window buf t)))
466 (when (memq 'point split)
467 (setq all-visible win))
468 (setq all-visible nil)))
470 (when (eq type 'frame)
471 (setq gnus-frame-split-p t))
472 (setq stack (append (cddr split) stack)))))
473 (unless (eq all-visible t)
476 (defun gnus-window-top-edge (&optional window)
477 (nth 1 (window-edges window)))
479 (defun gnus-remove-some-windows ()
480 (let ((buffers gnus-window-to-buffer)
481 buf bufs lowest-buf lowest)
483 ;; Remove windows on all known Gnus buffers.
485 (setq buf (cdar buffers))
487 (setq buf (and (boundp buf) (symbol-value buf))))
489 (get-buffer-window buf)
491 (setq bufs (cons buf bufs))
494 (< (gnus-window-top-edge) lowest))
496 (setq lowest (gnus-window-top-edge))
497 (setq lowest-buf buf)))))
498 (setq buffers (cdr buffers)))
499 ;; Remove windows on *all* summary buffers.
502 (let ((buf (window-buffer win)))
503 (if (string-match "^\\*Summary" (buffer-name buf))
505 (setq bufs (cons buf bufs))
508 (< (gnus-window-top-edge) lowest))
510 (setq lowest-buf buf)
511 (setq lowest (gnus-window-top-edge)))))))))
514 (pop-to-buffer lowest-buf)
515 (switch-to-buffer nntp-server-buffer)))
517 (and (not (eq (car bufs) lowest-buf))
518 (delete-windows-on (car bufs)))
519 (setq bufs (cdr bufs))))))
523 ;;; gnus-win.el ends here