gnus-win.el 15.9 KB
Newer Older
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1
;;; gnus-win.el --- window configuration functions for Gnus
2

3
;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
4

5
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
6 7 8 9
;; Keywords: news

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
14 15 16

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
18 19 20
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
22 23 24 25 26

;;; Commentary:

;;; Code:

27 28
(eval-when-compile (require 'cl))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
29
(require 'gnus)
30
(require 'gnus-util)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55

(defgroup gnus-windows nil
  "Window configuration."
  :group 'gnus)

(defcustom gnus-use-full-window t
  "*If non-nil, use the entire Emacs screen."
  :group 'gnus-windows
  :type 'boolean)

(defcustom gnus-window-min-width 2
  "*Minimum width of Gnus buffers."
  :group 'gnus-windows
  :type 'integer)

(defcustom gnus-window-min-height 1
  "*Minimum height of Gnus buffers."
  :group 'gnus-windows
  :type 'integer)

(defcustom gnus-always-force-window-configuration nil
  "*If non-nil, always force the Gnus window configurations."
  :group 'gnus-windows
  :type 'boolean)

56
(defcustom gnus-use-frames-on-any-display nil
Paul Eggert's avatar
Paul Eggert committed
57
  "*If non-nil, frames on all displays will be considered usable by Gnus.
58 59
When nil, only frames on the same display as the selected frame will be
used to display Gnus windows."
60
  :version "22.1"
61 62 63
  :group 'gnus-windows
  :type 'boolean)

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
64 65 66
(defvar gnus-buffer-configuration
  '((group
     (vertical 1.0
67
	       (group 1.0 point)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
68 69
    (summary
     (vertical 1.0
70
	       (summary 1.0 point)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
71 72 73 74 75 76 77 78 79
    (article
     (cond
      (gnus-use-trees
       '(vertical 1.0
		  (summary 0.25 point)
		  (tree 0.25)
		  (article 1.0)))
      (t
       '(vertical 1.0
80 81
		  (summary 0.25 point)
		  (article 1.0)))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
82 83
    (server
     (vertical 1.0
84
	       (server 1.0 point)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
85 86
    (browse
     (vertical 1.0
87
	       (browse 1.0 point)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
88 89 90 91 92 93 94 95 96 97 98 99 100
    (message
     (vertical 1.0
	       (message 1.0 point)))
    (pick
     (vertical 1.0
	       (article 1.0 point)))
    (info
     (vertical 1.0
	       (info 1.0 point)))
    (summary-faq
     (vertical 1.0
	       (summary 0.25)
	       (faq 1.0 point)))
101 102 103
    (only-article
     (vertical 1.0
	       (article 1.0 point)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
104 105 106 107 108 109 110 111 112 113 114
    (edit-article
     (vertical 1.0
	       (article 1.0 point)))
    (edit-form
     (vertical 1.0
	       (group 0.5)
	       (edit-form 1.0 point)))
    (edit-score
     (vertical 1.0
	       (summary 0.25)
	       (edit-score 1.0 point)))
115 116 117 118
    (edit-server
     (vertical 1.0
	       (server 0.5)
	       (edit-form 1.0 point)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
119 120 121 122 123
    (post
     (vertical 1.0
	       (post 1.0 point)))
    (reply
     (vertical 1.0
124
	       (article 0.5)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141
	       (message 1.0 point)))
    (forward
     (vertical 1.0
	       (message 1.0 point)))
    (reply-yank
     (vertical 1.0
	       (message 1.0 point)))
    (mail-bounce
     (vertical 1.0
	       (article 0.5)
	       (message 1.0 point)))
    (pipe
     (vertical 1.0
	       (summary 0.25 point)
	       ("*Shell Command Output*" 1.0)))
    (bug
     (vertical 1.0
142
	       (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
143 144 145 146 147 148 149 150 151
	       ("*Gnus Bug*" 1.0 point)))
    (score-trace
     (vertical 1.0
	       (summary 0.5 point)
	       ("*Score Trace*" 1.0)))
    (score-words
     (vertical 1.0
	       (summary 0.5 point)
	       ("*Score Words*" 1.0)))
152 153 154 155 156 157 158
    (split-trace
     (vertical 1.0
	       (summary 0.5 point)
	       ("*Split Trace*" 1.0)))
    (category
     (vertical 1.0
	       (category 1.0)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
159 160 161
    (compose-bounce
     (vertical 1.0
	       (article 0.5)
162 163
	       (message 1.0 point)))
    (display-term
164 165 166 167 168 169
     (vertical 1.0
	       ("*display*" 1.0)))
    (mml-preview
     (vertical 1.0
	       (message 0.5)
	       (mml-preview 1.0 point))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
  "Window configuration for all possible Gnus buffers.
See the Gnus manual for an explanation of the syntax used.")

(defvar gnus-window-to-buffer
  '((group . gnus-group-buffer)
    (summary . gnus-summary-buffer)
    (article . gnus-article-buffer)
    (server . gnus-server-buffer)
    (browse . "*Gnus Browse Server*")
    (edit-group . gnus-group-edit-buffer)
    (edit-form . gnus-edit-form-buffer)
    (edit-server . gnus-server-edit-buffer)
    (edit-score . gnus-score-edit-buffer)
    (message . gnus-message-buffer)
    (mail . gnus-message-buffer)
    (post-news . gnus-message-buffer)
    (faq . gnus-faq-buffer)
    (tree . gnus-tree-buffer)
188
    (score-trace . "*Score Trace*")
189
    (split-trace . "*Split Trace*")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
190
    (info . gnus-info-buffer)
191
    (category . gnus-category-buffer)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
192
    (article-copy . gnus-article-copy)
193 194
    (draft . gnus-draft-buffer)
    (mml-preview . mml-preview-buffer))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
195 196
  "Mapping from short symbols to buffer names or buffer variables.")

197 198
(defcustom gnus-configure-windows-hook nil
  "*A hook called when configuring windows."
199
  :version "22.1"
200 201 202
  :group 'gnus-windows
  :type 'hook)

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
203 204 205 206 207 208
;;; Internal variables.

(defvar gnus-current-window-configuration nil
  "The most recently set window configuration.")

(defvar gnus-created-frames nil)
209
(defvar gnus-window-frame-focus nil)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229

(defun gnus-kill-gnus-frames ()
  "Kill all frames Gnus has created."
  (while gnus-created-frames
    (when (frame-live-p (car gnus-created-frames))
      ;; We slap a condition-case around this `delete-frame' to ensure
      ;; against errors if we try do delete the single frame that's left.
      (ignore-errors
	(delete-frame (car gnus-created-frames))))
    (pop gnus-created-frames)))

;;;###autoload
(defun gnus-add-configuration (conf)
  "Add the window configuration CONF to `gnus-buffer-configuration'."
  (setq gnus-buffer-configuration
	(cons conf (delq (assq (car conf) gnus-buffer-configuration)
			 gnus-buffer-configuration))))

(defvar gnus-frame-list nil)

230 231 232 233 234 235 236 237 238 239
(defun gnus-window-to-buffer-helper (obj)
  (cond ((not (symbolp obj))
	 obj)
	((boundp obj)
	 (symbol-value obj))
	((fboundp obj)
	 (funcall obj))
	(t
	 nil)))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
240 241
(defun gnus-configure-frame (split &optional window)
  "Split WINDOW according to SPLIT."
242 243
  (let* ((current-window (or (get-buffer-window (current-buffer)) (selected-window)))
         (window (or window current-window)))
244
    (select-window window)
Paul Eggert's avatar
Paul Eggert committed
245
    ;; The SPLIT might be something that is to be evalled to
246 247
    ;; return a new SPLIT.
    (while (and (not (assq (car split) gnus-window-to-buffer))
248
		(symbolp (car split)) (fboundp (car split)))
249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270
      (setq split (eval split)))
    (let* ((type (car split))
	   (subs (cddr split))
	   (len (if (eq type 'horizontal) (window-width) (window-height)))
	   (total 0)
	   (window-min-width (or gnus-window-min-width window-min-width))
	   (window-min-height (or gnus-window-min-height window-min-height))
	   s result new-win rest comp-subs size sub)
      (cond
       ;; Nothing to do here.
       ((null split))
       ;; Don't switch buffers.
       ((null type)
	(and (memq 'point split) window))
       ;; This is a buffer to be selected.
       ((not (memq type '(frame horizontal vertical)))
	(let ((buffer (cond ((stringp type) type)
			    (t (cdr (assq type gnus-window-to-buffer))))))
	  (unless buffer
	    (error "Invalid buffer type: %s" type))
	  (let ((buf (gnus-get-buffer-create
		      (gnus-window-to-buffer-helper buffer))))
271 272 273 274
	    (when (buffer-name buf)
	      (if (eq buf (window-buffer (selected-window)))
		  (set-buffer buf)
		(switch-to-buffer buf))))
275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312
	  (when (memq 'frame-focus split)
	    (setq gnus-window-frame-focus window))
	  ;; We return the window if it has the `point' spec.
	  (and (memq 'point split) window)))
       ;; This is a frame split.
       ((eq type 'frame)
	(unless gnus-frame-list
	  (setq gnus-frame-list (list (window-frame current-window))))
	(let ((i 0)
	      params frame fresult)
	  (while (< i (length subs))
	    ;; Frame parameter is gotten from the sub-split.
	    (setq params (cadr (elt subs i)))
	    ;; It should be a list.
	    (unless (listp params)
	      (setq params nil))
	    ;; Create a new frame?
	    (unless (setq frame (elt gnus-frame-list i))
	      (nconc gnus-frame-list (list (setq frame (make-frame params))))
	      (push frame gnus-created-frames))
	    ;; Is the old frame still alive?
	    (unless (frame-live-p frame)
	      (setcar (nthcdr i gnus-frame-list)
		      (setq frame (make-frame params))))
	    ;; Select the frame in question and do more splits there.
	    (select-frame frame)
	    (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
	    (incf i))
	  ;; Select the frame that has the selected buffer.
	  (when fresult
	    (select-frame (window-frame fresult)))))
       ;; This is a normal split.
       (t
	(when (> (length subs) 0)
	  ;; First we have to compute the sizes of all new windows.
	  (while subs
	    (setq sub (append (pop subs) nil))
	    (while (and (not (assq (car sub) gnus-window-to-buffer))
313
			(symbolp (car sub)) (fboundp (car sub)))
314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356
	      (setq sub (eval sub)))
	    (when sub
	      (push sub comp-subs)
	      (setq size (cadar comp-subs))
	      (cond ((equal size 1.0)
		     (setq rest (car comp-subs))
		     (setq s 0))
		    ((floatp size)
		     (setq s (floor (* size len))))
		    ((integerp size)
		     (setq s size))
		    (t
		     (error "Invalid size: %s" size)))
	      ;; Try to make sure that we are inside the safe limits.
	      (cond ((zerop s))
		    ((eq type 'horizontal)
		     (setq s (max s window-min-width)))
		    ((eq type 'vertical)
		     (setq s (max s window-min-height))))
	      (setcar (cdar comp-subs) s)
	      (incf total s)))
	  ;; Take care of the "1.0" spec.
	  (if rest
	      (setcar (cdr rest) (- len total))
	    (error "No 1.0 specs in %s" split))
	  ;; The we do the actual splitting in a nice recursive
	  ;; fashion.
	  (setq comp-subs (nreverse comp-subs))
	  (while comp-subs
	    (if (null (cdr comp-subs))
		(setq new-win window)
	      (setq new-win
		    (split-window window (cadar comp-subs)
				  (eq type 'horizontal))))
	    (setq result (or (gnus-configure-frame
			      (car comp-subs) window)
			     result))
	    (select-window new-win)
	    (setq window new-win)
	    (setq comp-subs (cdr comp-subs))))
	;; Return the proper window, if any.
	(when result
	  (select-window result)))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
357 358 359 360

(defvar gnus-frame-split-p nil)

(defun gnus-configure-windows (setting &optional force)
361 362 363 364 365 366 367
  (cond
   ((null setting)
    ;; Do nothing.
    )
   ((window-configuration-p setting)
    (set-window-configuration setting))
   (t
368 369 370
    (setq gnus-current-window-configuration setting)
    (setq force (or force gnus-always-force-window-configuration))
    (let ((split (if (symbolp setting)
371 372 373
                     (cadr (assq setting gnus-buffer-configuration))
                   setting))
          all-visible)
374 375 376 377

      (setq gnus-frame-split-p nil)

      (unless split
378
        (error "No such setting in `gnus-buffer-configuration': %s" setting))
379 380

      (if (and (setq all-visible (gnus-all-windows-visible-p split))
381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417
               (not force))
          ;; All the windows mentioned are already visible, so we just
          ;; put point in the assigned buffer, and do not touch the
          ;; winconf.
          (select-window all-visible)

        ;; Make sure "the other" buffer, nntp-server-buffer, is live.
        (unless (gnus-buffer-live-p nntp-server-buffer)
          (nnheader-init-server-buffer))

        ;; Either remove all windows or just remove all Gnus windows.
        (let ((frame (selected-frame)))
          (unwind-protect
              (if gnus-use-full-window
                  ;; We want to remove all other windows.
                  (if (not gnus-frame-split-p)
                      ;; This is not a `frame' split, so we ignore the
                      ;; other frames.
                      (delete-other-windows)
                    ;; This is a `frame' split, so we delete all windows
                    ;; on all frames.
                    (gnus-delete-windows-in-gnusey-frames))
                ;; Just remove some windows.
                (gnus-remove-some-windows)
                (if (featurep 'xemacs)
                    (switch-to-buffer nntp-server-buffer)
                  (set-buffer nntp-server-buffer)))
            (select-frame frame)))

        (let (gnus-window-frame-focus)
          (if (featurep 'xemacs)
              (switch-to-buffer nntp-server-buffer)
            (set-buffer nntp-server-buffer))
          (gnus-configure-frame split)
          (run-hooks 'gnus-configure-windows-hook)
          (when gnus-window-frame-focus
            (gnus-select-frame-set-input-focus
418
             (window-frame gnus-window-frame-focus)))))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
419 420 421

(defun gnus-delete-windows-in-gnusey-frames ()
  "Do a `delete-other-windows' in all frames that have Gnus windows."
422
  (let ((buffers (gnus-buffers)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446
    (mapcar
     (lambda (frame)
       (unless (eq (cdr (assq 'minibuffer
			      (frame-parameters frame)))
		   'only)
	 (select-frame frame)
	 (let (do-delete)
	   (walk-windows
	    (lambda (window)
	      (when (memq (window-buffer window) buffers)
		(setq do-delete t))))
	   (when do-delete
	     (delete-other-windows)))))
     (frame-list))))

(defun gnus-all-windows-visible-p (split)
  "Say whether all buffers in SPLIT are currently visible.
In particular, the value returned will be the window that
should have point."
  (let ((stack (list split))
	(all-visible t)
	type buffer win buf)
    (while (and (setq split (pop stack))
		all-visible)
447
      (when (consp (car split))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
448 449
	(push 1.0 split)
	(push 'vertical split))
Paul Eggert's avatar
Paul Eggert committed
450
      ;; The SPLIT might be something that is to be evalled to
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
451 452
      ;; return a new SPLIT.
      (while (and (not (assq (car split) gnus-window-to-buffer))
453
		  (symbolp (car split)) (fboundp (car split)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
454 455 456 457 458 459 460 461 462 463 464
	(setq split (eval split)))

      (setq type (elt split 0))
      (cond
       ;; Nothing here.
       ((null split) t)
       ;; A buffer.
       ((not (memq type '(horizontal vertical frame)))
	(setq buffer (cond ((stringp type) type)
			   (t (cdr (assq type gnus-window-to-buffer)))))
	(unless buffer
465
	  (error "Invalid buffer type: %s" type))
466
	(if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer)))
467
		 (setq win (gnus-get-buffer-window buf t)))
468
	    (if (memq 'point split)
469
		(setq all-visible win))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
470 471 472 473 474 475 476 477 478
	  (setq all-visible nil)))
       (t
	(when (eq type 'frame)
	  (setq gnus-frame-split-p t))
	(setq stack (append (cddr split) stack)))))
    (unless (eq all-visible t)
      all-visible)))

(defun gnus-window-top-edge (&optional window)
479
  "Return the top coordinate of WINDOW."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
480 481 482
  (nth 1 (window-edges window)))

(defun gnus-remove-some-windows ()
483
  (let ((buffers (gnus-buffers))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
484 485 486
	buf bufs lowest-buf lowest)
    (save-excursion
      ;; Remove windows on all known Gnus buffers.
487 488 489 490 491 492 493 494
      (while (setq buf (pop buffers))
	(when (get-buffer-window buf)
	  (push buf bufs)
	  (pop-to-buffer buf)
	  (when (or (not lowest)
		    (< (gnus-window-top-edge) lowest))
	    (setq lowest (gnus-window-top-edge)
		  lowest-buf buf))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
495 496
      (when lowest-buf
	(pop-to-buffer lowest-buf)
497 498 499
	(if (featurep 'xemacs)
	    (switch-to-buffer nntp-server-buffer)
	  (set-buffer nntp-server-buffer)))
500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522
      (mapcar (lambda (b) (delete-windows-on b t))
	      (delq lowest-buf bufs)))))

(eval-and-compile
  (cond
   ((fboundp 'frames-on-display-list)
    (defalias 'gnus-frames-on-display-list 'frames-on-display-list))
   ((and (featurep 'xemacs) (fboundp 'frame-device))
    (defun gnus-frames-on-display-list ()
      (apply 'filtered-frame-list 'identity (list (frame-device nil)))))
   (t
    (defalias 'gnus-frames-on-display-list 'frame-list))))

(defun gnus-get-buffer-window (buffer &optional frame)
  (cond ((and (null gnus-use-frames-on-any-display)
	      (memq frame '(t 0 visible)))
	 (car
	  (let ((frames (gnus-frames-on-display-list)))
	    (gnus-remove-if (lambda (win) (not (memq (window-frame win)
						     frames)))
			    (get-buffer-window-list buffer nil frame)))))
	(t
	 (get-buffer-window buffer frame))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
523 524 525 526

(provide 'gnus-win)

;;; gnus-win.el ends here