1;;; gnus-win.el --- window configuration functions for Gnus 2 3;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 7;; Keywords: news 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs 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) 14;; any later version. 15 16;; GNU Emacs 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. 20 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., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;;; Code: 29 30(eval-when-compile (require 'cl)) 31 32(require 'gnus) 33(require 'gnus-util) 34 35(defgroup gnus-windows nil 36 "Window configuration." 37 :group 'gnus) 38 39(defcustom gnus-use-full-window t 40 "*If non-nil, use the entire Emacs screen." 41 :group 'gnus-windows 42 :type 'boolean) 43 44(defvar gnus-window-configuration nil 45 "Obsolete variable. See `gnus-buffer-configuration'.") 46 47(defcustom gnus-window-min-width 2 48 "*Minimum width of Gnus buffers." 49 :group 'gnus-windows 50 :type 'integer) 51 52(defcustom gnus-window-min-height 1 53 "*Minimum height of Gnus buffers." 54 :group 'gnus-windows 55 :type 'integer) 56 57(defcustom gnus-always-force-window-configuration nil 58 "*If non-nil, always force the Gnus window configurations." 59 :group 'gnus-windows 60 :type 'boolean) 61 62(defcustom gnus-use-frames-on-any-display nil 63 "*If non-nil, frames on all displays will be considered useable by Gnus. 64When nil, only frames on the same display as the selected frame will be 65used to display Gnus windows." 66 :version "22.1" 67 :group 'gnus-windows 68 :type 'boolean) 69 70(defvar gnus-buffer-configuration 71 '((group 72 (vertical 1.0 73 (group 1.0 point) 74 (if gnus-carpal '(group-carpal 4)))) 75 (summary 76 (vertical 1.0 77 (summary 1.0 point) 78 (if gnus-carpal '(summary-carpal 4)))) 79 (article 80 (cond 81 (gnus-use-trees 82 '(vertical 1.0 83 (summary 0.25 point) 84 (tree 0.25) 85 (article 1.0))) 86 (t 87 '(vertical 1.0 88 (summary 0.25 point) 89 (if gnus-carpal '(summary-carpal 4)) 90 (article 1.0))))) 91 (server 92 (vertical 1.0 93 (server 1.0 point) 94 (if gnus-carpal '(server-carpal 2)))) 95 (browse 96 (vertical 1.0 97 (browse 1.0 point) 98 (if gnus-carpal '(browse-carpal 2)))) 99 (message 100 (vertical 1.0 101 (message 1.0 point))) 102 (pick 103 (vertical 1.0 104 (article 1.0 point))) 105 (info 106 (vertical 1.0 107 (info 1.0 point))) 108 (summary-faq 109 (vertical 1.0 110 (summary 0.25) 111 (faq 1.0 point))) 112 (edit-article 113 (vertical 1.0 114 (article 1.0 point))) 115 (edit-form 116 (vertical 1.0 117 (group 0.5) 118 (edit-form 1.0 point))) 119 (edit-score 120 (vertical 1.0 121 (summary 0.25) 122 (edit-score 1.0 point))) 123 (post 124 (vertical 1.0 125 (post 1.0 point))) 126 (reply 127 (vertical 1.0 128 (article 0.5) 129 (message 1.0 point))) 130 (forward 131 (vertical 1.0 132 (message 1.0 point))) 133 (reply-yank 134 (vertical 1.0 135 (message 1.0 point))) 136 (mail-bounce 137 (vertical 1.0 138 (article 0.5) 139 (message 1.0 point))) 140 (pipe 141 (vertical 1.0 142 (summary 0.25 point) 143 (if gnus-carpal '(summary-carpal 4)) 144 ("*Shell Command Output*" 1.0))) 145 (bug 146 (vertical 1.0 147 (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5)) 148 ("*Gnus Bug*" 1.0 point))) 149 (score-trace 150 (vertical 1.0 151 (summary 0.5 point) 152 ("*Score Trace*" 1.0))) 153 (score-words 154 (vertical 1.0 155 (summary 0.5 point) 156 ("*Score Words*" 1.0))) 157 (split-trace 158 (vertical 1.0 159 (summary 0.5 point) 160 ("*Split Trace*" 1.0))) 161 (category 162 (vertical 1.0 163 (category 1.0))) 164 (compose-bounce 165 (vertical 1.0 166 (article 0.5) 167 (message 1.0 point))) 168 (display-term 169 (vertical 1.0 170 ("*display*" 1.0)))) 171 "Window configuration for all possible Gnus buffers. 172See the Gnus manual for an explanation of the syntax used.") 173 174(defvar gnus-window-to-buffer 175 '((group . gnus-group-buffer) 176 (summary . gnus-summary-buffer) 177 (article . gnus-article-buffer) 178 (server . gnus-server-buffer) 179 (browse . "*Gnus Browse Server*") 180 (edit-group . gnus-group-edit-buffer) 181 (edit-form . gnus-edit-form-buffer) 182 (edit-server . gnus-server-edit-buffer) 183 (group-carpal . gnus-carpal-group-buffer) 184 (summary-carpal . gnus-carpal-summary-buffer) 185 (server-carpal . gnus-carpal-server-buffer) 186 (browse-carpal . gnus-carpal-browse-buffer) 187 (edit-score . gnus-score-edit-buffer) 188 (message . gnus-message-buffer) 189 (mail . gnus-message-buffer) 190 (post-news . gnus-message-buffer) 191 (faq . gnus-faq-buffer) 192 (tree . gnus-tree-buffer) 193 (score-trace . "*Score Trace*") 194 (split-trace . "*Split Trace*") 195 (info . gnus-info-buffer) 196 (category . gnus-category-buffer) 197 (article-copy . gnus-article-copy) 198 (draft . gnus-draft-buffer)) 199 "Mapping from short symbols to buffer names or buffer variables.") 200 201(defcustom gnus-configure-windows-hook nil 202 "*A hook called when configuring windows." 203 :version "22.1" 204 :group 'gnus-windows 205 :type 'hook) 206 207;;; Internal variables. 208 209(defvar gnus-current-window-configuration nil 210 "The most recently set window configuration.") 211 212(defvar gnus-created-frames nil) 213(defvar gnus-window-frame-focus nil) 214 215(defun gnus-kill-gnus-frames () 216 "Kill all frames Gnus has created." 217 (while gnus-created-frames 218 (when (frame-live-p (car gnus-created-frames)) 219 ;; We slap a condition-case around this `delete-frame' to ensure 220 ;; against errors if we try do delete the single frame that's left. 221 (ignore-errors 222 (delete-frame (car gnus-created-frames)))) 223 (pop gnus-created-frames))) 224 225(defun gnus-window-configuration-element (list) 226 (while (and list 227 (not (assq (car list) gnus-window-configuration))) 228 (pop list)) 229 (cadr (assq (car list) gnus-window-configuration))) 230 231(defun gnus-windows-old-to-new (setting) 232 ;; First we take care of the really, really old Gnus 3 actions. 233 (when (symbolp setting) 234 (setq setting 235 ;; Take care of ooold GNUS 3.x values. 236 (cond ((eq setting 'SelectArticle) 'article) 237 ((memq setting '(SelectNewsgroup SelectSubject ExpandSubject)) 238 'summary) 239 ((memq setting '(ExitNewsgroup)) 'group) 240 (t setting)))) 241 (if (or (listp setting) 242 (not (and gnus-window-configuration 243 (memq setting '(group summary article))))) 244 setting 245 (let* ((elem 246 (cond 247 ((eq setting 'group) 248 (gnus-window-configuration-element 249 '(group newsgroups ExitNewsgroup))) 250 ((eq setting 'summary) 251 (gnus-window-configuration-element 252 '(summary SelectNewsgroup SelectSubject ExpandSubject))) 253 ((eq setting 'article) 254 (gnus-window-configuration-element 255 '(article SelectArticle))))) 256 (total (apply '+ elem)) 257 (types '(group summary article)) 258 (pbuf (if (eq setting 'newsgroups) 'group 'summary)) 259 (i 0) 260 perc out) 261 (while (< i 3) 262 (or (not (numberp (nth i elem))) 263 (zerop (nth i elem)) 264 (progn 265 (setq perc (if (= i 2) 266 1.0 267 (/ (float (nth i elem)) total))) 268 (push (if (eq pbuf (nth i types)) 269 (list (nth i types) perc 'point) 270 (list (nth i types) perc)) 271 out))) 272 (incf i)) 273 `(vertical 1.0 ,@(nreverse out))))) 274 275;;;###autoload 276(defun gnus-add-configuration (conf) 277 "Add the window configuration CONF to `gnus-buffer-configuration'." 278 (setq gnus-buffer-configuration 279 (cons conf (delq (assq (car conf) gnus-buffer-configuration) 280 gnus-buffer-configuration)))) 281 282(defvar gnus-frame-list nil) 283 284(defun gnus-window-to-buffer-helper (obj) 285 (cond ((not (symbolp obj)) 286 obj) 287 ((boundp obj) 288 (symbol-value obj)) 289 ((fboundp obj) 290 (funcall obj)) 291 (t 292 nil))) 293 294(defun gnus-configure-frame (split &optional window) 295 "Split WINDOW according to SPLIT." 296 (let ((current-window 297 (or (get-buffer-window (current-buffer)) (selected-window)))) 298 (unless window 299 (setq window current-window)) 300 (select-window window) 301 ;; This might be an old-style buffer config. 302 (when (vectorp split) 303 (setq split (append split nil))) 304 (when (or (consp (car split)) 305 (vectorp (car split))) 306 (push 1.0 split) 307 (push 'vertical split)) 308 ;; The SPLIT might be something that is to be evaled to 309 ;; return a new SPLIT. 310 (while (and (not (assq (car split) gnus-window-to-buffer)) 311 (functionp (car split))) 312 (setq split (eval split))) 313 (let* ((type (car split)) 314 (subs (cddr split)) 315 (len (if (eq type 'horizontal) (window-width) (window-height))) 316 (total 0) 317 (window-min-width (or gnus-window-min-width window-min-width)) 318 (window-min-height (or gnus-window-min-height window-min-height)) 319 s result new-win rest comp-subs size sub) 320 (cond 321 ;; Nothing to do here. 322 ((null split)) 323 ;; Don't switch buffers. 324 ((null type) 325 (and (memq 'point split) window)) 326 ;; This is a buffer to be selected. 327 ((not (memq type '(frame horizontal vertical))) 328 (let ((buffer (cond ((stringp type) type) 329 (t (cdr (assq type gnus-window-to-buffer)))))) 330 (unless buffer 331 (error "Invalid buffer type: %s" type)) 332 (let ((buf (gnus-get-buffer-create 333 (gnus-window-to-buffer-helper buffer)))) 334 (if (eq buf (window-buffer (selected-window))) (set-buffer buf) 335 (switch-to-buffer buf))) 336 (when (memq 'frame-focus split) 337 (setq gnus-window-frame-focus window)) 338 ;; We return the window if it has the `point' spec. 339 (and (memq 'point split) window))) 340 ;; This is a frame split. 341 ((eq type 'frame) 342 (unless gnus-frame-list 343 (setq gnus-frame-list (list (window-frame current-window)))) 344 (let ((i 0) 345 params frame fresult) 346 (while (< i (length subs)) 347 ;; Frame parameter is gotten from the sub-split. 348 (setq params (cadr (elt subs i))) 349 ;; It should be a list. 350 (unless (listp params) 351 (setq params nil)) 352 ;; Create a new frame? 353 (unless (setq frame (elt gnus-frame-list i)) 354 (nconc gnus-frame-list (list (setq frame (make-frame params)))) 355 (push frame gnus-created-frames)) 356 ;; Is the old frame still alive? 357 (unless (frame-live-p frame) 358 (setcar (nthcdr i gnus-frame-list) 359 (setq frame (make-frame params)))) 360 ;; Select the frame in question and do more splits there. 361 (select-frame frame) 362 (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) 363 (incf i)) 364 ;; Select the frame that has the selected buffer. 365 (when fresult 366 (select-frame (window-frame fresult))))) 367 ;; This is a normal split. 368 (t 369 (when (> (length subs) 0) 370 ;; First we have to compute the sizes of all new windows. 371 (while subs 372 (setq sub (append (pop subs) nil)) 373 (while (and (not (assq (car sub) gnus-window-to-buffer)) 374 (functionp (car sub))) 375 (setq sub (eval sub))) 376 (when sub 377 (push sub comp-subs) 378 (setq size (cadar comp-subs)) 379 (cond ((equal size 1.0) 380 (setq rest (car comp-subs)) 381 (setq s 0)) 382 ((floatp size) 383 (setq s (floor (* size len)))) 384 ((integerp size) 385 (setq s size)) 386 (t 387 (error "Invalid size: %s" size))) 388 ;; Try to make sure that we are inside the safe limits. 389 (cond ((zerop s)) 390 ((eq type 'horizontal) 391 (setq s (max s window-min-width))) 392 ((eq type 'vertical) 393 (setq s (max s window-min-height)))) 394 (setcar (cdar comp-subs) s) 395 (incf total s))) 396 ;; Take care of the "1.0" spec. 397 (if rest 398 (setcar (cdr rest) (- len total)) 399 (error "No 1.0 specs in %s" split)) 400 ;; The we do the actual splitting in a nice recursive 401 ;; fashion. 402 (setq comp-subs (nreverse comp-subs)) 403 (while comp-subs 404 (if (null (cdr comp-subs)) 405 (setq new-win window) 406 (setq new-win 407 (split-window window (cadar comp-subs) 408 (eq type 'horizontal)))) 409 (setq result (or (gnus-configure-frame 410 (car comp-subs) window) 411 result)) 412 (select-window new-win) 413 (setq window new-win) 414 (setq comp-subs (cdr comp-subs)))) 415 ;; Return the proper window, if any. 416 (when result 417 (select-window result))))))) 418 419(defvar gnus-frame-split-p nil) 420 421(defun gnus-configure-windows (setting &optional force) 422 (if (window-configuration-p setting) 423 (set-window-configuration setting) 424 (setq gnus-current-window-configuration setting) 425 (setq force (or force gnus-always-force-window-configuration)) 426 (setq setting (gnus-windows-old-to-new setting)) 427 (let ((split (if (symbolp setting) 428 (cadr (assq setting gnus-buffer-configuration)) 429 setting)) 430 all-visible) 431 432 (setq gnus-frame-split-p nil) 433 434 (unless split 435 (error "No such setting in `gnus-buffer-configuration': %s" setting)) 436 437 (if (and (setq all-visible (gnus-all-windows-visible-p split)) 438 (not force)) 439 ;; All the windows mentioned are already visible, so we just 440 ;; put point in the assigned buffer, and do not touch the 441 ;; winconf. 442 (select-window all-visible) 443 444 ;; Make sure "the other" buffer, nntp-server-buffer, is live. 445 (unless (gnus-buffer-live-p nntp-server-buffer) 446 (nnheader-init-server-buffer)) 447 448 ;; Either remove all windows or just remove all Gnus windows. 449 (let ((frame (selected-frame))) 450 (unwind-protect 451 (if gnus-use-full-window 452 ;; We want to remove all other windows. 453 (if (not gnus-frame-split-p) 454 ;; This is not a `frame' split, so we ignore the 455 ;; other frames. 456 (delete-other-windows) 457 ;; This is a `frame' split, so we delete all windows 458 ;; on all frames. 459 (gnus-delete-windows-in-gnusey-frames)) 460 ;; Just remove some windows. 461 (gnus-remove-some-windows) 462 (if (featurep 'xemacs) 463 (switch-to-buffer nntp-server-buffer) 464 (set-buffer nntp-server-buffer))) 465 (select-frame frame))) 466 467 (let (gnus-window-frame-focus) 468 (if (featurep 'xemacs) 469 (switch-to-buffer nntp-server-buffer) 470 (set-buffer nntp-server-buffer)) 471 (gnus-configure-frame split) 472 (run-hooks 'gnus-configure-windows-hook) 473 (when gnus-window-frame-focus 474 (select-frame (window-frame gnus-window-frame-focus)))))))) 475 476(defun gnus-delete-windows-in-gnusey-frames () 477 "Do a `delete-other-windows' in all frames that have Gnus windows." 478 (let ((buffers (gnus-buffers))) 479 (mapcar 480 (lambda (frame) 481 (unless (eq (cdr (assq 'minibuffer 482 (frame-parameters frame))) 483 'only) 484 (select-frame frame) 485 (let (do-delete) 486 (walk-windows 487 (lambda (window) 488 (when (memq (window-buffer window) buffers) 489 (setq do-delete t)))) 490 (when do-delete 491 (delete-other-windows))))) 492 (frame-list)))) 493 494(defun gnus-all-windows-visible-p (split) 495 "Say whether all buffers in SPLIT are currently visible. 496In particular, the value returned will be the window that 497should have point." 498 (let ((stack (list split)) 499 (all-visible t) 500 type buffer win buf) 501 (while (and (setq split (pop stack)) 502 all-visible) 503 ;; Be backwards compatible. 504 (when (vectorp split) 505 (setq split (append split nil))) 506 (when (or (consp (car split)) 507 (vectorp (car split))) 508 (push 1.0 split) 509 (push 'vertical split)) 510 ;; The SPLIT might be something that is to be evaled to 511 ;; return a new SPLIT. 512 (while (and (not (assq (car split) gnus-window-to-buffer)) 513 (functionp (car split))) 514 (setq split (eval split))) 515 516 (setq type (elt split 0)) 517 (cond 518 ;; Nothing here. 519 ((null split) t) 520 ;; A buffer. 521 ((not (memq type '(horizontal vertical frame))) 522 (setq buffer (cond ((stringp type) type) 523 (t (cdr (assq type gnus-window-to-buffer))))) 524 (unless buffer 525 (error "Invalid buffer type: %s" type)) 526 (if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer))) 527 (setq win (gnus-get-buffer-window buf t))) 528 (if (memq 'point split) 529 (setq all-visible win)) 530 (setq all-visible nil))) 531 (t 532 (when (eq type 'frame) 533 (setq gnus-frame-split-p t)) 534 (setq stack (append (cddr split) stack))))) 535 (unless (eq all-visible t) 536 all-visible))) 537 538(defun gnus-window-top-edge (&optional window) 539 (nth 1 (window-edges window))) 540 541(defun gnus-remove-some-windows () 542 (let ((buffers (gnus-buffers)) 543 buf bufs lowest-buf lowest) 544 (save-excursion 545 ;; Remove windows on all known Gnus buffers. 546 (while (setq buf (pop buffers)) 547 (when (get-buffer-window buf) 548 (push buf bufs) 549 (pop-to-buffer buf) 550 (when (or (not lowest) 551 (< (gnus-window-top-edge) lowest)) 552 (setq lowest (gnus-window-top-edge) 553 lowest-buf buf)))) 554 (when lowest-buf 555 (pop-to-buffer lowest-buf) 556 (if (featurep 'xemacs) 557 (switch-to-buffer nntp-server-buffer) 558 (set-buffer nntp-server-buffer))) 559 (mapcar (lambda (b) (delete-windows-on b t)) 560 (delq lowest-buf bufs))))) 561 562(eval-and-compile 563 (cond 564 ((fboundp 'frames-on-display-list) 565 (defalias 'gnus-frames-on-display-list 'frames-on-display-list)) 566 ((and (featurep 'xemacs) (fboundp 'frame-device)) 567 (defun gnus-frames-on-display-list () 568 (apply 'filtered-frame-list 'identity (list (frame-device nil))))) 569 (t 570 (defalias 'gnus-frames-on-display-list 'frame-list)))) 571 572(defun gnus-get-buffer-window (buffer &optional frame) 573 (cond ((and (null gnus-use-frames-on-any-display) 574 (memq frame '(t 0 visible))) 575 (car 576 (let ((frames (gnus-frames-on-display-list))) 577 (gnus-remove-if (lambda (win) (not (memq (window-frame win) 578 frames))) 579 (get-buffer-window-list buffer nil frame))))) 580 (t 581 (get-buffer-window buffer frame)))) 582 583(provide 'gnus-win) 584 585;;; arch-tag: ccd5a394-2ddf-4397-b8f8-6d80d3e46e2b 586;;; gnus-win.el ends here 587