cgit.sxemacs.org Git - riece/blob - lisp/riece-layout.el

   1 ;;; riece-layout.el --- layout management
   2 ;; Copyright (C) 1998-2003 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;;      TAKAHASHI "beatmaria" Kaoru <kaoru@kaisei.org>
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program 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)
  13 ;; any later version.
  14
  15 ;; This program 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.
  19
  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.
  24
  25 ;;; Code:
  26
  27 (require 'riece-globals)
  28 (require 'riece-misc)
  29
  30 (autoload 'ring-empty-p "ring")
  31 (autoload 'ring-ref "ring")
  32
  33 (defgroup riece-layout nil
  34   "Manage window layouts"
  35   :prefix "riece-"
  36   :group 'riece)
  37
  38 (defcustom riece-layout "default"
  39   "Current layout setting."
  40   :type 'string
  41   :group 'riece-layout)
  42
  43 (defcustom riece-layout-alist
  44   '(("default" riece-configure-windows riece-reconfigure-windows-predicate)
  45     ("top" riece-configure-windows-top riece-reconfigure-windows-predicate))
  46   "An alist mapping the names to layout functions.
  47 An element of this alist is in the following form:
  48 (NAME CONFIGURE-FUNCTION RECONFIGURE-PREDICATE)
  49 NAME is a string which specifies the layout setting.
  50 CONFIGURE-FUNCTION is a function which does window splitting, etc.
  51 RECONFIGURE-PREDICATE is a function to examine whether windows
  52 reconfiguration is needed."
  53   :type 'list
  54   :group 'riece-layout)
  55
  56 (defun riece-redraw-layout (&optional force)
  57   "Reconfigure windows with the current layout.
  58 If optional argument FORCE is non-nil, window reconfiguration will
  59 happen unconditionally."
  60   (let ((layout (cdr (assoc riece-layout riece-layout-alist))))
  61     (unless layout
  62       (error "No such layout!"))
  63     (if (or force
  64             (funcall (nth 1 layout)))
  65         (funcall (car layout)))))
  66
  67 (defun riece-set-window-points ()
  68   (if (get-buffer-window riece-user-list-buffer)
  69       (with-current-buffer riece-user-list-buffer
  70         (unless (riece-frozen riece-user-list-buffer)
  71           (set-window-start (get-buffer-window riece-user-list-buffer)
  72                             (point-min)))))
  73   (if (get-buffer-window riece-channel-list-buffer)
  74       (with-current-buffer riece-channel-list-buffer
  75         (unless (riece-frozen riece-channel-list-buffer)
  76           (set-window-start (get-buffer-window riece-channel-list-buffer)
  77                             (point-min))))))
  78
  79 (defun riece-configure-windows ()
  80   "Configure windows.
  81 This function is used by \"default\" layout."
  82   (let ((buffer (window-buffer))
  83         (show-user-list
  84          (and riece-user-list-buffer-mode
  85               riece-current-channel
  86               ;; User list buffer is nuisance for private conversation.
  87               (riece-channel-p (riece-identity-prefix
  88                                 riece-current-channel)))))
  89     ;; Can't expand minibuffer to full frame.
  90     (if (eq (selected-window) (minibuffer-window))
  91         (other-window 1))
  92     (delete-other-windows)
  93     (if (and riece-current-channel
  94              (or show-user-list riece-channel-list-buffer-mode))
  95         (let ((rest-window (split-window (selected-window)
  96                                          (/ (window-width) 5) t)))
  97           (if (and show-user-list riece-channel-list-buffer-mode)
  98               (progn
  99                 (set-window-buffer (split-window)
 100                                    riece-channel-list-buffer)
 101                 (set-window-buffer (selected-window)
 102                                    riece-user-list-buffer))
 103             (if show-user-list
 104                 (set-window-buffer (selected-window)
 105                                    riece-user-list-buffer)
 106               (if riece-channel-list-buffer-mode
 107                   (set-window-buffer (selected-window)
 108                                      riece-channel-list-buffer))))
 109           (select-window rest-window)))
 110     (if (and riece-current-channel
 111              riece-channel-buffer-mode)
 112         (let ((rest-window (split-window)))
 113           (set-window-buffer (selected-window)
 114                              riece-channel-buffer)
 115           (set-window-buffer (split-window rest-window 4)
 116                              riece-others-buffer)
 117           (with-current-buffer riece-channel-buffer
 118             (setq truncate-partial-width-windows nil))
 119           (with-current-buffer riece-others-buffer
 120             (setq truncate-partial-width-windows nil))
 121           (set-window-buffer rest-window
 122                              riece-command-buffer))
 123       (set-window-buffer (split-window (selected-window) 4)
 124                          riece-dialogue-buffer)
 125       (set-window-buffer (selected-window)
 126                          riece-command-buffer))
 127     (riece-set-window-points)
 128     (select-window (or (get-buffer-window buffer)
 129                        (get-buffer-window riece-command-buffer)))))
 130
 131 (defun riece-reconfigure-windows-predicate ()
 132   "Return t, if window reconfiguration is needed.
 133 This function is used by \"default\" layout."
 134   ;; The current channel is changed, and some buffers are visible.
 135   (unless (or (ring-empty-p riece-channel-history)
 136               (equal (ring-ref riece-channel-history 0)
 137                      riece-current-channel))
 138     (let ((buffers riece-buffer-list))
 139       (catch 'found
 140         (while buffers
 141           (if (and (buffer-live-p (car buffers))
 142                    (get-buffer-window (car buffers)))
 143               (throw 'found t)
 144             (setq buffers (cdr buffers))))))))
 145
 146 (defun riece-configure-windows-top (&optional plist)
 147   "Candidate of `riece-configure-windows-function'.
 148 PLIST accept :command-height, :user-list-width, and :channel-list-width."
 149   (let ((command-height (or (plist-get plist :command-height) 4))
 150         (user-list-width (or (plist-get plist :user-list-width) (+ 9 1 1)))
 151         (channel-list-width (or (plist-get plist :channel-list-width) 18))
 152         (buffer (window-buffer))
 153         (show-user-list
 154          (and riece-user-list-buffer-mode
 155               riece-current-channel
 156               ;; User list buffer is nuisance for private conversation.
 157               (riece-channel-p (riece-identity-prefix
 158                                 riece-current-channel)))))
 159     ;; Can't expand minibuffer to full frame.
 160     (when (eq (selected-window) (minibuffer-window))
 161       (other-window 1))
 162     (delete-other-windows)
 163     ;; top of frame
 164     (let ((rest-window (split-window (selected-window) command-height)))
 165       (set-window-buffer (selected-window)
 166                          riece-command-buffer)
 167       (select-window rest-window))
 168     ;; middle of frame (vertical-spilit when need)
 169     (when (or (and riece-current-channel riece-channel-buffer-mode)
 170               show-user-list)
 171       (let ((rest-window
 172              (split-window (selected-window)
 173                            (/ (* 5 (+ (window-height) command-height)) 8))))
 174         (cond
 175          ;; channel-buffer + user-list
 176          ((and show-user-list
 177                (and riece-current-channel riece-channel-buffer-mode))
 178           (let ((user-list-window (split-window (selected-window) nil t)))
 179             (set-window-buffer (selected-window) riece-channel-buffer)
 180             (set-window-buffer user-list-window riece-user-list-buffer)
 181             (select-window user-list-window)
 182             (shrink-window-horizontally (- (window-width) user-list-width))
 183             (setq truncate-partial-width-windows nil)))
 184          ;; only user-list
 185          (show-user-list
 186           (set-window-buffer (selected-window) riece-user-list-buffer))
 187          ;; only channel-buffer
 188          (riece-channel-buffer-mode
 189           (set-window-buffer (selected-window) riece-channel-buffer)))
 190         (select-window rest-window)))
 191     ;; bottom of frame
 192     (if (and riece-current-channel
 193              riece-channel-list-buffer-mode)
 194         (let ((channel-list-window (split-window (selected-window) nil t)))
 195           (set-window-buffer (selected-window) riece-others-buffer)
 196           (set-window-buffer channel-list-window riece-channel-list-buffer)
 197           (select-window channel-list-window)
 198           (shrink-window-horizontally (- (window-width) channel-list-width))
 199           (setq truncate-partial-width-windows nil))
 200       (set-window-buffer (selected-window) riece-dialogue-buffer))
 201     (riece-set-window-points)
 202     (select-window (or (get-buffer-window buffer)
 203                        (get-buffer-window riece-command-buffer)))))
 204
 205 (provide 'riece-layout)
 206
 207 ;;; riece-layout.el ends here