;;; liece-window.el --- Window configuration style utility.
;; Copyright (C) 1998-2000 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999-01-08
;; Revised: 1999-07-05
;; Keywords: window, window configuration

;; This file is part of Liece.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:
;; 

;;; Code:

(require 'liece-misc)
(require 'liece-intl)

(require 'calist)
(eval-when-compile (require 'cl))

(defgroup liece-window nil
  "Window configuration"
  :tag "Window configuration"
  :group 'liece)

(defcustom liece-window-min-width 2
  "Minimal width of liece window."
  :type 'integer
  :group 'liece-window)

(defcustom liece-window-min-height 2
  "Minimal height of liece window."
  :type 'integer
  :group 'liece-window)

(defcustom liece-window-style-directory nil
  "Normal position of style configuration files."
  :type 'directory
  :group 'liece-window)

(defcustom liece-window-default-style "bottom"
  "Default style."
  :type 'string
  :group 'liece-window)

(defcustom liece-window-to-buffer
  '((channel . liece-channel-buffer)
    (others . liece-others-buffer)
    (dialogue . liece-dialogue-buffer)
    (command . liece-command-buffer)
    (channel-list . liece-channel-list-buffer)
    (nick . liece-nick-buffer))
  "Window abbreviation to buffer alist."
  :type '(repeat
	  (cons (symbol :tag "Abbrev")
		(symbol :tag "Buffer")))
  :group 'liece-window)

(defconst liece-window-split-types '(horizontal vertical))

(defvar liece-window-style-configuration-alist nil)
(defvar liece-window-current-style nil)
(defvar liece-window-configuration-stack nil)

(defun liece-window-field-match-method-as-default-rule
  (calist field-type field-value)
  (let* ((field (assq field-type calist)) (value (cdr field)))
    (cond ((null field)
	   (cons (cons field-type field-value) calist))
	  ((and (symbolp field-value) (eq field-value 'any))
	   calist)
	  ((and (symbolp value) (eq field-value value))
	   calist))))

(define-calist-field-match-method
  'command-buffer-mode
  'liece-window-field-match-method-as-default-rule)

(define-calist-field-match-method
  'channel-buffer-mode
  'liece-window-field-match-method-as-default-rule)

(define-calist-field-match-method
  'nick-buffer-mode
  'liece-window-field-match-method-as-default-rule)

(define-calist-field-match-method
  'channel-list-buffer-mode
  'liece-window-field-match-method-as-default-rule)

(defmacro liece-window-add-style (&rest calist)
  `(ctree-set-calist-strictly 'liece-window-style-configuration-alist
			      ',calist))

(defmacro liece-window-define-reconfiguration-predicate (name &rest body)
  `(defun-maybe ,name ,@body))
  
(put 'liece-window-define-reconfiguration-predicate
     'lisp-indent-function 'defun)

(defmacro liece-window-set-default-style ()
  "Set window configuration with fallback style."
  '(liece-window-add-style
    (command-buffer-mode . any)
    (channel-buffer-mode . any)
    (nick-buffer-mode . any)
    (channel-list-buffer-mode . any)
    (configuration
     (vertical
      1.0
      (dialogue 1.0)
      (command 4 point)))))
     
(defsubst liece-window-load-style-file (style)
  "Load style file."
  (condition-case nil
      (progn
	(if (null liece-window-style-directory)
	    (setq liece-window-style-directory
		  (liece-locate-path "styles")))
	(setq liece-window-style-configuration-alist nil)
	(load (expand-file-name style liece-window-style-directory))
	(setq liece-window-current-style style))
    (error
     (liece-message "Style file load failed.")
     (liece-window-set-default-style))))

(defmacro liece-window-percent-to-rate (percent)
  `(/ ,percent 100.0))

(defmacro liece-window-to-buffer-helper (window)
  `(cond ((symbolp ,window)
	  (symbol-value ,window))
	 (t ,window)))

(defmacro liece-window-safe-select-window (window)
  `(if ,window (select-window ,window)))

;;;###liece-autoload
(defun liece-command-set-window-style (style)
  (interactive
   (let ((styles (directory-files liece-window-style-directory)))
     (list
      (liece-minibuffer-completing-read
       "Window style: " (list-to-alist styles) nil t nil nil
       liece-window-current-style))))
  (liece-window-load-style-file style))

(defun liece-command-reload-window-style ()
  (interactive)
  (liece-window-load-style-file
   (or liece-window-current-style
       liece-window-default-style)))

(defmacro liece-window-default-reconfiguration-predicate ()
  '(or (one-window-p t)
       (null (liece-get-buffer-window liece-command-buffer))
       (and (not liece-channel-buffer-mode)
	    (null (liece-get-buffer-window liece-dialogue-buffer)))
       (and liece-channel-buffer-mode
	    (null (liece-get-buffer-window liece-channel-buffer))
	    (null (liece-get-buffer-window liece-others-buffer)))
       (and liece-channel-buffer-mode
	    (if liece-nick-buffer-mode
		(null (liece-get-buffer-window liece-nick-buffer))
	      (not (null (liece-get-buffer-window liece-nick-buffer)))))
       (if liece-channel-list-buffer-mode
	   (null (liece-get-buffer-window liece-channel-list-buffer))
	 (not (null (liece-get-buffer-window liece-channel-list-buffer))))))

;;;###liece-autoload
(defun liece-configure-windows ()
  (let ((liece-nick-buffer-mode liece-nick-buffer-mode)
	(liece-channel-buffer-mode liece-channel-buffer-mode)
	situation calist split predicate)
    (if (and (get 'liece-nick-buffer-mode 'hide)
	     liece-nick-window-auto-hide)
	(setq liece-nick-buffer-mode nil))
    (if (not (liece-channel-last
	      (if (eq liece-command-buffer-mode 'chat)
		  liece-current-chat-partners
		liece-current-channels)))
	(setq liece-channel-buffer-mode nil))
    (setq situation
	  `((channel-buffer-mode . ,liece-channel-buffer-mode)
	    (nick-buffer-mode . ,liece-nick-buffer-mode)
	    (channel-list-buffer-mode . ,liece-channel-list-buffer-mode)
	    (command-buffer-mode . ,liece-command-buffer-mode)))
    (or liece-window-current-style
	(liece-command-set-window-style liece-window-default-style))
    (setq calist (ctree-match-calist liece-window-style-configuration-alist
				     situation)
	  split (cadr (assq 'configuration calist))
	  predicate (cdr (assq 'reconfiguration-predicate calist)))
    (when (and split
	       (or (null predicate)
		   (and predicate
			(liece-functionp predicate)
			(funcall predicate))))
      (if (not (eq liece-truncate-partial-width-windows
		   truncate-partial-width-windows))
	  (setq truncate-partial-width-windows
		liece-truncate-partial-width-windows))
      (if liece-use-full-window (delete-other-windows))
      (save-excursion
	(switch-to-buffer liece-command-buffer) ;; u-mu.
	(liece-window-configure-frame split)))))

(defun liece-window-configure-frame (split &optional window)
  (or window
      (setq window (get-buffer-window (current-buffer))))
  (liece-window-safe-select-window window)
  (while (and (not (assq (car split) liece-window-to-buffer))
              (liece-functionp (car split)))
    (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 liece-window-min-width window-min-width))
	 (window-min-height
	  (or liece-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 '(horizontal vertical)))
      (let ((buffer (cond ((stringp type) type)
			  (t (cdr (assq type liece-window-to-buffer))))))
	(unless buffer
	  (error "Illegal buffer type: %s" type))
	(switch-to-buffer
	 (liece-window-to-buffer-helper buffer))
	;; We return the window if it has the `point' spec.
	(and (memq 'point split) window)))
     (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) liece-window-to-buffer))
		      (liece-functionp (car sub)))
	    (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))
		  ((symbolp size)
		   (setq s
			 (floor
			  (* (liece-window-percent-to-rate
			      (symbol-value size))
			     len))))
		  (t
		   (error "Illegal 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 (liece-window-configure-frame
			    (car comp-subs) window)
			   result))
	  (liece-window-safe-select-window new-win)
	  (setq window new-win)
	  (setq comp-subs (cdr comp-subs))))
      ;; Return the proper window, if any.
      (liece-window-safe-select-window result)))))

(defun liece-window-configuration-push ()
  (let ((frame (selected-frame))
	(config (current-window-configuration)))
    (push (list frame config)
	  liece-window-configuration-stack)))

(defun liece-window-configuration-pop ()
  (let* ((frame (selected-frame))
         (triple (assq frame liece-window-configuration-stack)))
    (when (and triple (window-configuration-p (cadr triple)))
      (set-window-configuration (cadr triple))
      (if (setq frame (assq frame liece-window-configuration-stack))
	  (setq liece-window-configuration-stack
		(delq frame liece-window-configuration-stack))))
    liece-window-configuration-stack))

(provide 'liece-window)

;;; liece-window.el ends here