;;; liece-message.el --- generate and display message line
;; Copyright (C) 1999 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999-05-30
;; Keywords: message

;; 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:

(defgroup liece-message nil
  "Messages"
  :tag "Message"
  :prefix "liece-"
  :group 'liece)

(defcustom liece-message-brackets
  '(((type notice)
     ("-" "-"))
    ((and (type action) (direction outgoing))
     ("]" "["))
    ((type action)
     ("[" "]"))
    ((and (range private) (direction incoming))
     ("=" "="))
    ((direction outgoing)
     (">" "<"))
    ((range external)
     ("(" ")"))
    (t
     ("<" ">")))
  "Brackets."
  :group 'liece-message)

(defcustom liece-message-tags
  '(((and (direction outgoing) (range private))
     (liece-message-target liece-message-target))
    ((range private)
     (liece-message-speaker liece-message-speaker))
    (t
     (liece-message-speaker
      (concat liece-message-target ":" liece-message-speaker))))
  "Primary tags."
  :group 'liece-message)

(defcustom liece-message-empty-predicate
  (function (lambda (message) (string-equal "" message)))
  "Return non-nil if message is regarded as empty string."
  :group 'liece-message)
     
(defvar liece-message-type nil)
(defvar liece-message-target nil)
(defvar liece-message-speaker nil)
(defvar liece-message-direction nil)

(defun liece-message-predicate (val)
  (cond
   ((null val)
    nil)
   ((eq val t)
    t)
   ((listp val)
    (let ((pred (pop val)))
      (cond
       ((eq pred 'or)
	(apply 'liece-or (mapcar 'liece-message-predicate val)))
       ((eq pred 'and)
	(apply 'liece-and (mapcar 'liece-message-predicate val)))
       ((eq pred 'not)
	(not (liece-message-predicate (car val))))
       ((eq pred 'type)
	(eq liece-message-type (car val)))
       ((eq pred 'direction)
	(cond
	 ((eq (car val) 'outgoing)
	  liece-message-direction)
	 ((eq (car val) 'incoming)
	  (not liece-message-direction))))
       ((eq pred 'mode)
	(eq liece-command-buffer-mode (car val)))
       ((eq pred 'range)
	(cond
	 ((eq (car val) 'private)
	  (not (liece-channel-p (liece-channel-real liece-message-target))))
	 ((eq (car val) 'external)
	  (not (liece-channel-member
		liece-message-target (liece-nick-get-joined-channels
				       liece-message-speaker))))))
       ((liece-functionp pred)
	(liece-eval-form (cons pred val)))
       (t
	(liece-message-predicate pred)))))
   (t
    (liece-eval-form val))))

(defun liece-message-brackets-function ()
  (let* ((specs liece-message-brackets) spec
	 (brackets
	  (catch 'found
	    (while specs
	      (setq spec (pop specs))
	      (if (liece-message-predicate (car spec))
		  (throw 'found (cadr spec)))))))
    brackets))
  
(defun liece-message-tags-function ()
  (let* ((specs liece-message-tags) spec
	 (tags
	  (catch 'found
	    (while specs
	      (setq spec (pop specs))
	      (if (liece-message-predicate (car spec))
		  (throw 'found (cadr spec)))))))
    (list (eval (car tags)) (eval (cadr tags)))))

(defun liece-message-buffer-function ()
  (let* ((target (if (liece-message-predicate
		      '(and (range private) (direction incoming)))
		     liece-message-speaker
		   liece-message-target))
	 (buffer (liece-pick-buffer target)))
    (cond
     ((car buffer) buffer)
     (liece-auto-join-partner
      (liece-channel-prepare-partner target)
      (liece-pick-buffer target)))))

(defun liece-message-parent-buffer (cbuffer)
  (if (or (and (car cbuffer) (liece-frozen (car cbuffer)))
	  (and (eq liece-command-buffer-mode 'channel)
	       liece-current-channel
	       (not (liece-channel-equal liece-message-target
					 liece-current-channel)))
	  (and (eq liece-command-buffer-mode 'chat)
	       liece-current-chat-partner
	       (not (eq liece-message-direction 'outgoing))
	       (or
		(not (liece-nick-equal liece-message-speaker
				       liece-current-chat-partner))
		(not (liece-nick-equal liece-message-target
				       (liece-current-nickname))))))
      (append liece-D-buffer liece-O-buffer)
    liece-D-buffer))

;;;###liece-autoload
(defun liece-display-message (temp)
  (let* ((brackets (liece-message-brackets-function))
	 (tags (liece-message-tags-function))
	 (buffer (liece-message-buffer-function))
	 (parent (liece-message-parent-buffer buffer)))
    (liece-insert buffer
		   (concat (car brackets) (car tags) (cadr brackets)
			   " " temp "\n"))
    (liece-insert parent
		  (concat (car brackets) (cadr tags) (cadr brackets)
			  " " temp "\n"))
    (run-hook-with-args 'liece-display-message-hook temp)))
   
(provide 'liece-message)

;;; liece-message.el ends here