1 ;;; gnus-win.el --- window configuration functions for Gnus
2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
3 ;; Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
29 (eval-when-compile (require 'cl))
33 (defgroup gnus-windows nil
34 "Window configuration."
37 (defcustom gnus-use-full-window t
38 "*If non-nil, use the entire Emacs screen."
42 (defvar gnus-window-configuration nil
43 "Obsolete variable. See `gnus-buffer-configuration'.")
45 (defcustom gnus-window-min-width 2
46 "*Minimum width of Gnus buffers."
50 (defcustom gnus-window-min-height 1
51 "*Minimum height of Gnus buffers."
55 (defcustom gnus-always-force-window-configuration nil
56 "*If non-nil, always force the Gnus window configurations."
60 (defvar gnus-buffer-configuration
64 (if gnus-carpal '(group-carpal 4))))
68 (if gnus-carpal '(summary-carpal 4))))
72 (eq gnus-picons-display-where 'picons))
76 (if gnus-carpal '(summary-carpal 4))
78 (vertical ((height . 5) (width . 15)
80 (left . -1) (top . 1))
90 (if gnus-carpal '(summary-carpal 4))
95 (if gnus-carpal '(server-carpal 2))))
99 (if gnus-carpal '(browse-carpal 2))))
102 (message 1.0 point)))
105 (article 1.0 point)))
115 (article 1.0 point)))
119 (edit-form 1.0 point)))
123 (edit-score 1.0 point)))
130 (message 1.0 point)))
133 (message 1.0 point)))
136 (message 1.0 point)))
140 (message 1.0 point)))
144 (if gnus-carpal '(summary-carpal 4))
145 ("*Shell Command Output*" 1.0)))
148 (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
149 ("*Gnus Bug*" 1.0 point)))
153 ("*Score Trace*" 1.0)))
157 ("*Score Words*" 1.0)))
161 ("*Split Trace*" 1.0)))
168 (message 1.0 point)))
172 "Window configuration for all possible Gnus buffers.
173 See the Gnus manual for an explanation of the syntax used.")
175 (defvar gnus-window-to-buffer
176 '((group . gnus-group-buffer)
177 (summary . gnus-summary-buffer)
178 (article . gnus-article-buffer)
179 (server . gnus-server-buffer)
180 (browse . "*Gnus Browse Server*")
181 (edit-group . gnus-group-edit-buffer)
182 (edit-form . gnus-edit-form-buffer)
183 (edit-server . gnus-server-edit-buffer)
184 (group-carpal . gnus-carpal-group-buffer)
185 (summary-carpal . gnus-carpal-summary-buffer)
186 (server-carpal . gnus-carpal-server-buffer)
187 (browse-carpal . gnus-carpal-browse-buffer)
188 (edit-score . gnus-score-edit-buffer)
189 (message . gnus-message-buffer)
190 (mail . gnus-message-buffer)
191 (post-news . gnus-message-buffer)
192 (faq . gnus-faq-buffer)
193 (picons . gnus-picons-buffer-name)
194 (tree . gnus-tree-buffer)
195 (score-trace . "*Score Trace*")
196 (split-trace . "*Split Trace*")
197 (info . gnus-info-buffer)
198 (category . gnus-category-buffer)
199 (article-copy . gnus-article-copy)
200 (draft . gnus-draft-buffer))
201 "Mapping from short symbols to buffer names or buffer variables.")
203 ;;; Internal variables.
205 (defvar gnus-current-window-configuration nil
206 "The most recently set window configuration.")
208 (defvar gnus-created-frames nil)
209 (defvar gnus-window-frame-focus nil)
211 (defun gnus-kill-gnus-frames ()
212 "Kill all frames Gnus has created."
213 (while gnus-created-frames
214 (when (frame-live-p (car gnus-created-frames))
215 ;; We slap a condition-case around this `delete-frame' to ensure
216 ;; against errors if we try do delete the single frame that's left.
218 (delete-frame (car gnus-created-frames))))
219 (pop gnus-created-frames)))
221 (defun gnus-window-configuration-element (list)
223 (not (assq (car list) gnus-window-configuration)))
225 (cadr (assq (car list) gnus-window-configuration)))
227 (defun gnus-windows-old-to-new (setting)
228 ;; First we take care of the really, really old Gnus 3 actions.
229 (when (symbolp setting)
231 ;; Take care of ooold GNUS 3.x values.
232 (cond ((eq setting 'SelectArticle) 'article)
233 ((memq setting '(SelectNewsgroup SelectSubject ExpandSubject))
235 ((memq setting '(ExitNewsgroup)) 'group)
237 (if (or (listp setting)
238 (not (and gnus-window-configuration
239 (memq setting '(group summary article)))))
244 (gnus-window-configuration-element
245 '(group newsgroups ExitNewsgroup)))
246 ((eq setting 'summary)
247 (gnus-window-configuration-element
248 '(summary SelectNewsgroup SelectSubject ExpandSubject)))
249 ((eq setting 'article)
250 (gnus-window-configuration-element
251 '(article SelectArticle)))))
252 (total (apply '+ elem))
253 (types '(group summary article))
254 (pbuf (if (eq setting 'newsgroups) 'group 'summary))
258 (or (not (numberp (nth i elem)))
261 (setq perc (if (= i 2)
263 (/ (float (nth i elem)) total)))
264 (push (if (eq pbuf (nth i types))
265 (list (nth i types) perc 'point)
266 (list (nth i types) perc))
269 `(vertical 1.0 ,@(nreverse out)))))
272 (defun gnus-add-configuration (conf)
273 "Add the window configuration CONF to `gnus-buffer-configuration'."
274 (setq gnus-buffer-configuration
275 (cons conf (delq (assq (car conf) gnus-buffer-configuration)
276 gnus-buffer-configuration))))
278 (defvar gnus-frame-list nil)
280 (defun gnus-window-to-buffer-helper (obj)
281 (cond ((not (symbolp obj))
290 (defun gnus-configure-frame (split &optional window)
291 "Split WINDOW according to SPLIT."
292 (let ((current-window
293 (or (get-buffer-window (current-buffer)) (selected-window))))
295 (setq window current-window))
296 (select-window window)
297 ;; This might be an old-stylee buffer config.
298 (when (vectorp split)
299 (setq split (append split nil)))
300 (when (or (consp (car split))
301 (vectorp (car split)))
303 (push 'vertical split))
304 ;; The SPLIT might be something that is to be evaled to
305 ;; return a new SPLIT.
306 (while (and (not (assq (car split) gnus-window-to-buffer))
307 (gnus-functionp (car split)))
308 (setq split (eval split)))
309 (let* ((type (car split))
311 (len (if (eq type 'horizontal) (window-width) (window-height)))
313 (window-min-width (or gnus-window-min-width window-min-width))
314 (window-min-height (or gnus-window-min-height window-min-height))
315 s result new-win rest comp-subs size sub)
317 ;; Nothing to do here.
319 ;; Don't switch buffers.
321 (and (memq 'point split) window))
322 ;; This is a buffer to be selected.
323 ((not (memq type '(frame horizontal vertical)))
324 (let ((buffer (cond ((stringp type) type)
325 (t (cdr (assq type gnus-window-to-buffer))))))
327 (error "Invalid buffer type: %s" type))
328 (let ((buf (gnus-get-buffer-create
329 (gnus-window-to-buffer-helper buffer))))
330 (if (eq buf (window-buffer (selected-window))) (set-buffer buf)
331 (switch-to-buffer buf)))
332 (when (memq 'frame-focus split)
333 (setq gnus-window-frame-focus window))
334 ;; We return the window if it has the `point' spec.
335 (and (memq 'point split) window)))
336 ;; This is a frame split.
338 (unless gnus-frame-list
339 (setq gnus-frame-list (list (window-frame current-window))))
341 params frame fresult)
342 (while (< i (length subs))
343 ;; Frame parameter is gotten from the sub-split.
344 (setq params (cadr (elt subs i)))
345 ;; It should be a list.
346 (unless (listp params)
348 ;; Create a new frame?
349 (unless (setq frame (elt gnus-frame-list i))
350 (nconc gnus-frame-list (list (setq frame (make-frame params))))
351 (push frame gnus-created-frames))
352 ;; Is the old frame still alive?
353 (unless (frame-live-p frame)
354 (setcar (nthcdr i gnus-frame-list)
355 (setq frame (make-frame params))))
356 ;; Select the frame in question and do more splits there.
358 (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
360 ;; Select the frame that has the selected buffer.
362 (select-frame (window-frame fresult)))))
363 ;; This is a normal split.
365 (when (> (length subs) 0)
366 ;; First we have to compute the sizes of all new windows.
368 (setq sub (append (pop subs) nil))
369 (while (and (not (assq (car sub) gnus-window-to-buffer))
370 (gnus-functionp (car sub)))
371 (setq sub (eval sub)))
374 (setq size (cadar comp-subs))
375 (cond ((equal size 1.0)
376 (setq rest (car comp-subs))
379 (setq s (floor (* size len))))
383 (error "Invalid size: %s" size)))
384 ;; Try to make sure that we are inside the safe limits.
386 ((eq type 'horizontal)
387 (setq s (max s window-min-width)))
389 (setq s (max s window-min-height))))
390 (setcar (cdar comp-subs) s)
392 ;; Take care of the "1.0" spec.
394 (setcar (cdr rest) (- len total))
395 (error "No 1.0 specs in %s" split))
396 ;; The we do the actual splitting in a nice recursive
398 (setq comp-subs (nreverse comp-subs))
400 (if (null (cdr comp-subs))
401 (setq new-win window)
403 (split-window window (cadar comp-subs)
404 (eq type 'horizontal))))
405 (setq result (or (gnus-configure-frame
406 (car comp-subs) window)
408 (select-window new-win)
409 (setq window new-win)
410 (setq comp-subs (cdr comp-subs))))
411 ;; Return the proper window, if any.
413 (select-window result)))))))
415 (defvar gnus-frame-split-p nil)
417 (defun gnus-configure-windows (setting &optional force)
418 (if (window-configuration-p setting)
419 (set-window-configuration setting)
420 (setq gnus-current-window-configuration setting)
421 (setq force (or force gnus-always-force-window-configuration))
422 (setq setting (gnus-windows-old-to-new setting))
423 (let ((split (if (symbolp setting)
424 (cadr (assq setting gnus-buffer-configuration))
428 (setq gnus-frame-split-p nil)
431 (error "No such setting in `gnus-buffer-configuration': %s" setting))
433 (if (and (setq all-visible (gnus-all-windows-visible-p split))
435 ;; All the windows mentioned are already visible, so we just
436 ;; put point in the assigned buffer, and do not touch the
438 (select-window all-visible)
440 ;; Make sure "the other" buffer, nntp-server-buffer, is live.
441 (unless (gnus-buffer-live-p nntp-server-buffer)
442 (nnheader-init-server-buffer))
444 ;; Either remove all windows or just remove all Gnus windows.
445 (let ((frame (selected-frame)))
447 (if gnus-use-full-window
448 ;; We want to remove all other windows.
449 (if (not gnus-frame-split-p)
450 ;; This is not a `frame' split, so we ignore the
452 (delete-other-windows)
453 ;; This is a `frame' split, so we delete all windows
455 (gnus-delete-windows-in-gnusey-frames))
456 ;; Just remove some windows.
457 (gnus-remove-some-windows)
458 (if (featurep 'xemacs)
459 (switch-to-buffer nntp-server-buffer)
460 (set-buffer nntp-server-buffer)))
461 (select-frame frame)))
463 (let (gnus-window-frame-focus)
464 (if (featurep 'xemacs)
465 (switch-to-buffer nntp-server-buffer)
466 (set-buffer nntp-server-buffer))
467 (gnus-configure-frame split)
468 (when gnus-window-frame-focus
469 (select-frame (window-frame gnus-window-frame-focus))))))))
471 (defun gnus-delete-windows-in-gnusey-frames ()
472 "Do a `delete-other-windows' in all frames that have Gnus windows."
473 (let ((buffers (gnus-buffers)))
476 (unless (eq (cdr (assq 'minibuffer
477 (frame-parameters frame)))
483 (when (memq (window-buffer window) buffers)
484 (setq do-delete t))))
486 (delete-other-windows)))))
489 (defun gnus-all-windows-visible-p (split)
490 "Say whether all buffers in SPLIT are currently visible.
491 In particular, the value returned will be the window that
493 (let ((stack (list split))
496 (while (and (setq split (pop stack))
498 ;; Be backwards compatible.
499 (when (vectorp split)
500 (setq split (append split nil)))
501 (when (or (consp (car split))
502 (vectorp (car split)))
504 (push 'vertical split))
505 ;; The SPLIT might be something that is to be evaled to
506 ;; return a new SPLIT.
507 (while (and (not (assq (car split) gnus-window-to-buffer))
508 (gnus-functionp (car split)))
509 (setq split (eval split)))
511 (setq type (elt split 0))
516 ((not (memq type '(horizontal vertical frame)))
517 (setq buffer (cond ((stringp type) type)
518 (t (cdr (assq type gnus-window-to-buffer)))))
520 (error "Invalid buffer type: %s" type))
521 (if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer)))
522 (setq win (get-buffer-window buf t)))
523 (if (memq 'point split)
524 (setq all-visible win))
525 (setq all-visible nil)))
527 (when (eq type 'frame)
528 (setq gnus-frame-split-p t))
529 (setq stack (append (cddr split) stack)))))
530 (unless (eq all-visible t)
533 (defun gnus-window-top-edge (&optional window)
534 (nth 1 (window-edges window)))
536 (defun gnus-remove-some-windows ()
537 (let ((buffers (gnus-buffers))
538 buf bufs lowest-buf lowest)
540 ;; Remove windows on all known Gnus buffers.
541 (while (setq buf (pop buffers))
542 (when (get-buffer-window buf)
545 (when (or (not lowest)
546 (< (gnus-window-top-edge) lowest))
547 (setq lowest (gnus-window-top-edge)
550 (pop-to-buffer lowest-buf)
551 (if (featurep 'xemacs)
552 (switch-to-buffer nntp-server-buffer)
553 (set-buffer nntp-server-buffer)))
554 (mapcar (lambda (b) (delete-windows-on b t))
555 (delq lowest-buf bufs)))))
559 ;;; gnus-win.el ends here