;;; liece-handle.el --- implementation of IRC message handlers
;; Copyright (C) 1998-2000 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1998-09-28
;; Revised: 1998-11-25
;; Keywords: IRC, liece

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

(eval-when-compile
  (require 'liece-inlines)
  (require 'liece-misc)
  (require 'liece-intl))

(require 'liece-message)
(require 'liece-filter)

(require 'liece-handler)

(defmacro liece-handle-prepare-comment (rest &optional quote)
  `(if (zerop (length ,rest))
       ""
     (if ,quote
	 (regexp-quote (format " (%s)" ,rest))
       (format " (%s)" ,rest))))

(defmacro liece-handle-message-check-empty (msg)
  `(string= ,msg ""))

(defmacro liece-handle-message-check-ignored (prefix rest)
  `(and ,prefix
	(liece-ignore-this-p ,prefix liece-user-at-host)
	(liece-message-from-ignored ,prefix ,rest)))

(defmacro liece-handle-check-changes-ignored ()
  'liece-ignore-changes)

(defconst liece-handle-ctcp-message-regexp "\001\\(.*\\)\001")

(defmacro liece-handle-ctcp-message-p (msg)
  `(string-match liece-handle-ctcp-message-regexp ,msg))

(autoload 'liece-ctcp-message "liece-ctcp")
(autoload 'liece-ctcp-notice "liece-ctcp")


(liece-handler-define-backend "generic")

(mapcar
 (lambda (message)
   (liece-handler-define-function
    message '(prefix rest "generic")
    (intern (format "liece-handle-%s-message" message)))
   (defvar ,(intern (format "liece-%s-hook" message)) nil)
   (defvar ,(intern (format "liece-after-%s-hook" message)) nil))
 '("nick" "notice" "privmsg" "ping" "wall" "wallops" "quit" "topic"
   "mode" "kick" "invite" "kill" "join" "part" "silence"))

(defun* liece-handle-nick-message (prefix rest)
  (let ((chnls (liece-nick-get-joined-channels prefix)))
    (liece-nick-change prefix rest)
    (cond
     ((liece-nick-equal prefix liece-real-nickname)
      (setq liece-nickname-last liece-real-nickname
	    liece-real-nickname rest))
     ((liece-nick-member prefix liece-current-chat-partners)
      (setq liece-current-chat-partners
	    (string-list-modify-ignore-case (list (cons prefix rest))
					    liece-current-chat-partners))
      (setcar (string-assoc-ignore-case prefix liece-nick-buffer-alist)
	      rest)
      (setcar (string-assoc-ignore-case prefix liece-channel-buffer-alist)
	      rest)
      (if (liece-nick-equal prefix liece-current-chat-partner)
	  (setq liece-current-chat-partner rest))
      (add-to-list 'chnls rest)
      (liece-channel-change)))
    (if (liece-handle-check-changes-ignored)
	(return-from liece-handle-nick-message))
    (liece-insert-change (append (liece-pick-buffer chnls)
				  liece-D-buffer liece-O-buffer)
			  (format (_ "%s is now known as %s\n") prefix rest))))

(defun* liece-handle-notice-message (prefix rest)
  (if (liece-handle-message-check-ignored prefix rest)
      (return-from liece-handle-notice-message))
  (or liece-ignore-extra-notices
	prefix
	(string-match "as being away" rest)
	(return-from liece-handle-notice-message))

  ;; No prefix. This is a server notice.
  (when (and (null prefix) (string-match "^[^ ]* +:?" rest))
    (liece-insert-notice (append liece-D-buffer liece-O-buffer)
			  (concat (substring rest (match-end 0)) "\n"))
    (return-from liece-handle-notice-message))
  (multiple-value-bind (chnl temp) (liece-split-line rest)
    ;; This is a ctcp reply but contains additional messages
    ;; at the left or/and right side.
    (if (liece-handle-ctcp-message-p temp)
	(setq temp (liece-ctcp-notice prefix temp)))
    (if (liece-handle-message-check-empty temp)
	(return-from liece-handle-notice-message))

    ;; Normal message via notice.
    (setq chnl (liece-channel-virtual chnl))
    (let ((liece-message-target chnl)
	  (liece-message-speaker prefix)
	  (liece-message-type 'notice))
      (liece-display-message temp))))

(defun* liece-handle-privmsg-message (prefix rest)
  (if (liece-handle-message-check-ignored prefix rest)
      (return-from liece-handle-privmsg-message))
  (multiple-value-bind (chnl temp) (liece-split-line rest)
    (setq temp (or temp ""))
    ;; This is a ctcp request but contains additional messages
    ;; at the left or/and right side.
    (if (liece-handle-ctcp-message-p temp)
	(setq temp (liece-ctcp-message prefix chnl temp)))
    (if (liece-handle-message-check-empty temp)
	(return-from liece-handle-privmsg-message))

    (setq chnl (liece-channel-virtual chnl))
      
    (when liece-beep-on-bells
      (if (string-match "\007" rest)
	  (liece-beep))
      (if (liece-nick-equal chnl liece-real-nickname)
	  (and liece-beep-when-privmsg (liece-beep))
	(with-current-buffer (if liece-channel-buffer-mode
				 (liece-pick-buffer-1 chnl)
			       liece-dialogue-buffer)
	  (if liece-beep
	      (liece-beep))))
      (dolist (word liece-beep-words-list)
	(if (string-match word rest)
	    (liece-beep))))

    ;; Append timestamp if we are being away.
    (if (and (string-equal "A" liece-away-indicator)
	     (liece-nick-equal chnl liece-real-nickname))
	(setq temp
	      (concat temp " ("
		      (funcall liece-format-time-function (current-time))
		      ")")))

    ;; Normal message.
    (let ((liece-message-target chnl)
	  (liece-message-speaker prefix)
	  (liece-message-type 'privmsg))
      (liece-display-message temp))

    ;; Append to the unread list.
    (let ((item (if (eq liece-command-buffer-mode 'chat)
		    liece-current-chat-partner
		  liece-current-channel)))
      (unless (liece-channel-equal chnl item)
	(if (liece-channel-unread-p chnl)
	    (setq liece-channel-unread-list
		  (delete chnl liece-channel-unread-list)))
	(setq liece-channel-unread-list
	      (cons chnl liece-channel-unread-list))
      (run-hook-with-args 'liece-channel-unread-functions chnl)))

    (if (and (liece-nick-equal chnl liece-real-nickname)
	     (not (liece-nick-equal prefix liece-current-chat-partner)))
	(liece-message (_ "A private message has arrived from %s")
		       prefix))))

(defun liece-handle-ping-message (prefix rest)
  (liece-send "PONG :%s" rest)
  (liece-command-timestamp-if-interval-expired t)
  (liece-maybe-poll))

(defun liece-handle-wall-message (prefix rest)
  (liece-insert-broadcast (append liece-D-buffer liece-O-buffer)
			   (concat (if prefix (concat "from " prefix) "") " "
				   rest "\n")))

(defun liece-handle-wallops-message (prefix rest)
  (if liece-show-wallops
      (liece-insert-wallops (append liece-D-buffer liece-O-buffer)
			     (concat (if prefix prefix "UNKNOWN")
				     ": " rest "\n")))
  (liece-insert-wallops liece-W-buffer
			 (concat (if prefix (concat "from " prefix) "") " "
				 rest "\n")))

(defun* liece-handle-quit-message (prefix rest)
  (let ((chnls (liece-nick-get-joined-channels prefix)) text match default)
    ;; Mark temporary apart, if quitting user is one of our chat partners.
    (when (liece-nick-member prefix liece-current-chat-partners)
      (add-to-list 'chnls prefix)
      (liece-nick-mark-as-part t prefix))
    (if (liece-handle-check-changes-ignored)
	(return-from liece-handle-quit-message))
    (cond
     (liece-compress-changes
      (setq text (format (_ " \\(has\\|have\\) left IRC%s")
			 (liece-handle-prepare-comment rest t))
	    match (format "^%s%s.*%s$"
			  (if liece-display-time
			      liece-time-prefix-regexp "")
			  (regexp-quote liece-change-prefix)
			  (regexp-quote text))
	    default (format (_ "%s%s has left IRC%s\n")
			    liece-change-prefix prefix
			    (liece-handle-prepare-comment rest)))
      (liece-replace (append (liece-pick-buffer chnls)
			      liece-D-buffer liece-O-buffer)
		      match default text
		      (format (_ ", %s have left IRC%s")
			      prefix (liece-handle-prepare-comment rest))))
     (t
      (liece-insert-change (append (liece-pick-buffer chnls)
				    liece-D-buffer liece-O-buffer)
			    (format (_ "%s has left IRC%s\n")
				    (liece-handle-prepare-comment rest)))))
    (liece-nick-change prefix nil)))

(defun* liece-handle-topic-message (prefix rest)
  (multiple-value-bind (chnl topic) (liece-split-line rest)
    (setq chnl (liece-channel-virtual chnl)
	  topic (or topic ""))
    (liece-channel-set-topic topic chnl)
    (if (liece-handle-check-changes-ignored)
	(return-from liece-handle-topic-message))
    (liece-insert-change (liece-pick-buffer chnl)
			  (format (_ "New topic on channel %s set by %s: %s\n")
				  chnl prefix topic))
    (liece-insert-change (if (liece-nick-equal chnl liece-current-channel)
			      liece-D-buffer
			    (append liece-D-buffer liece-O-buffer))
			  (format (_ "New topic on channel %s set by %s: %s\n")
				  chnl prefix topic))
    (liece-set-channel-indicator)))

(defun* liece-handle-mode-message (prefix rest)
  (if (liece-handle-check-changes-ignored)
      (return-from liece-handle-mode-message))
  (let (mflgs margs val chnl mode chnlp)
    (if (string-match "\\([^ ]*\\) *:?" rest)
	(progn
	  (setq chnl (match-string 1 rest)
		mode (substring rest (match-end 0)))
	  (if (liece-channel-p chnl)
	      (setq chnl (liece-channel-virtual chnl) chnlp t))
	  (if (string-match " *$" mode)
	      (setq mode (substring mode 0 (match-beginning 0)))))
      (return-from liece-handle-mode-message))
    ;; parse modes
    (when (string-match "\\([^ ]*\\) *" mode)
      (setq mflgs (liece-string-to-list (match-string 1 mode))
	    margs (delete "" (split-string
			      (substring mode (match-end 0))
			      "[ ]+")))
      (while mflgs
	(cond ((eq ?- (car mflgs)) (setq val nil))
	      ((eq ?+ (car mflgs)) (setq val t))
	      ((and chnlp (eq ?o (car mflgs)))
	       (liece-channel-set-operator chnl (car margs) val)
	       (setq margs (cdr margs)))
	      ((and chnlp (eq ?v (car mflgs)))
	       (liece-channel-set-voice chnl (car margs) val)
	       (setq margs (cdr margs)))
	      ((and chnlp (eq ?b (car mflgs)))
	       (liece-channel-set-ban chnl (car margs) val)
	       (setq margs (cdr margs)))
	      ((and chnlp (eq ?e (car mflgs)))
	       (liece-channel-set-exception chnl (car margs) val)
	       (setq margs (cdr margs)))
	      ((and chnlp (eq ?I (car mflgs)))
	       (liece-channel-set-invite chnl (car margs) val)
	       (setq margs (cdr margs)))
	      (chnlp (liece-channel-set-mode chnl (car mflgs) val))
	      (t (liece-nick-set-mode chnl (car mflgs) val)))
	(setq mflgs (cdr mflgs))))
    (liece-set-channel-indicator)
    (cond
     (liece-compress-changes
      (let* ((text (concat (regexp-quote rest) "\n"))
	     (match (format (_ "^%s%sNew mode for %s set by %s: ")
			    (if liece-display-time
				liece-time-prefix-regexp "")
			    (regexp-quote liece-change-prefix)
			    (regexp-quote chnl) (regexp-quote prefix)))
	     (default (format (_ "%sNew mode for %s set by %s: %s\n")
			      liece-change-prefix chnl prefix mode)))
	(liece-replace (liece-pick-buffer chnl)
			match default text (concat ", " mode "\n"))
	(liece-replace (if (and liece-current-channel
				 (liece-channel-equal
				  chnl liece-current-channel))
			    liece-D-buffer
			  (append liece-D-buffer liece-O-buffer))
			match default text (concat ", " mode "\n"))))
     (t
      (liece-insert-change (liece-pick-buffer chnl)
			    (format (_ "New mode for %s set by %s: %s\n")
				    chnl prefix mode))
      (liece-insert-change (if (and liece-current-channel
				     (liece-channel-equal
				      chnl liece-current-channel))
				liece-D-buffer
			      (append liece-D-buffer liece-O-buffer))
			    (format (_ "New mode for %s set by %s: %s\n")
				    chnl prefix mode))))))

(defun* liece-handle-kick-message (prefix rest)
  (if (/= 3 (length (setq rest (liece-split-line rest))))
      (return-from liece-handle-kick-message))
  (multiple-value-bind (chnl nick message) rest
    (setq chnl (liece-channel-virtual chnl))
    
    (if (liece-nick-equal nick liece-real-nickname)
	(progn
	  (liece-insert-change
	   (liece-pick-buffer chnl)
	   (format (_ "You were kicked off channel %s by %s (%s).\n")
		   chnl prefix message))
	  (liece-channel-part chnl))
      (liece-nick-part nick chnl))
    
    (if (liece-handle-check-changes-ignored)
	(return-from liece-handle-kick-message))

    (liece-insert-change
     (append (liece-pick-buffer chnl)
	     (if (liece-channel-equal chnl liece-current-channel)
		 liece-D-buffer
	       (append liece-D-buffer liece-O-buffer)))
     (format "%s has kicked %s out%s%s\n"
	     prefix nick
	     (if (string= (or liece-current-channel "") chnl)
		 ""
	       (format " from channel %s" chnl))
	     (if (not message)
		 ""
	       (format " (%s)" message))))))

(defun* liece-handle-invite-message (prefix rest)
  (or (string-match " +:" rest)
      (return-from liece-handle-invite-message))
  (and liece-beep-when-invited liece-beep-on-bells
       (liece-beep))
  (let ((chnl (liece-channel-virtual (substring rest (match-end 0)))))
    (liece-insert-info (append liece-D-buffer liece-O-buffer)
			(format "%s invites you to channel %s\n"
				prefix chnl))
    (setq liece-default-channel-candidate chnl)))

(defun* liece-handle-kill-message (prefix rest)
  (or (string-match " +:" rest)
      (return-from liece-handle-kill-message))
  (let ((path (substring rest (match-end 0))))
    (liece-insert-info (append liece-D-buffer liece-O-buffer)
			(format "You were killed by %s. (Path: %s. RIP)\n"
				prefix path)))
  (liece-close-server))

(defun* liece-handle-join-message (prefix rest)
  (let (flag (xnick prefix) (nick prefix) (chnl rest))
    (cond
     ((string-match "\007[ov]" chnl)
      (setq flag (aref (match-string 0 chnl) 1)
	    chnl (substring rest 0 (match-beginning 0))))
     ((string-match " +$" chnl)
      (setq chnl (substring chnl 0 (match-beginning 0)))))
    (setq chnl (liece-channel-virtual chnl))
    (liece-nick-set-user-at-host nick liece-user-at-host)
    (if (liece-nick-equal nick liece-real-nickname)
	(progn
	  (and liece-gather-channel-modes
	       (not (liece-channel-modeless-p (liece-channel-real chnl)))
	       (liece-send "MODE %s " (liece-channel-real chnl)))
	  (liece-channel-join chnl))
      (liece-nick-join nick chnl))
    (cond
     ((eq flag ?o)
      (liece-channel-set-operator chnl xnick t)
      (setq xnick (concat "@" xnick)))
     ((eq flag ?v)
      (liece-channel-set-voice chnl xnick t)
      (setq xnick (concat "+" xnick))))
    (if (liece-handle-check-changes-ignored)
	(return-from liece-handle-join-message))
    ;; Restore the private conversation to its original state.
    (when (and (liece-nick-member nick liece-current-chat-partners)
	       (get (intern nick liece-obarray) 'part))
      (liece-insert-change (liece-pick-buffer nick)
			    (format (_ "%s has come back as (%s)\n")
				    nick liece-user-at-host))
      (liece-nick-mark-as-part nil nick))
    (cond
     (liece-compress-changes
      (let* ((text (format (_ " \\(has\\|have\\) joined channel %s")
			   (regexp-quote chnl)))
	     (match (format "^%s%s.*%s$"
			    (if liece-display-time
				liece-time-prefix-regexp "")
			    (regexp-quote liece-change-prefix)
			    (regexp-quote text)))
	     (default (format (_ "%s%s (%s) has joined channel %s\n")
			      liece-change-prefix
			      nick liece-user-at-host chnl)))
	(liece-replace (liece-pick-buffer chnl)
			match default text
			(format (_ ", %s (%s) have joined channel %s")
				nick liece-user-at-host chnl))
	(liece-replace (if (and liece-current-channel
				 (liece-channel-equal chnl
						       liece-current-channel))
			    liece-D-buffer
			  (append liece-D-buffer liece-O-buffer))
			match default text
			(format (_ ", %s (%s) have joined channel %s")
				nick liece-user-at-host chnl))))
     (t
      (liece-insert-change (liece-pick-buffer chnl)
			    (format (_ "%s (%s) has joined channel %s\n")
				    nick liece-user-at-host chnl))
      (liece-insert-change (if (liece-channel-equal chnl
						      liece-current-channel)
				liece-D-buffer
			      (append liece-D-buffer liece-O-buffer))
			    (format (_ "%s (%s) has joined channel %s\n")
				    nick liece-user-at-host chnl))))))

(defun* liece-handle-part-message (prefix rest)
  (multiple-value-bind (chnl comment text match default buf) (liece-split-line rest)
    (setq chnl (liece-channel-virtual chnl)
	  comment (liece-handle-prepare-comment comment))
    
    (if (liece-nick-equal prefix liece-real-nickname)
	(liece-channel-part chnl)
      (liece-nick-part prefix chnl))
    
    (if (liece-handle-check-changes-ignored)
	(return-from liece-handle-part-message))
    
    (setq buf (append liece-D-buffer (liece-pick-buffer chnl)))
    (unless (and liece-current-channel
		 (liece-channel-equal chnl liece-current-channel))
      (setq buf (append buf liece-O-buffer)))
    (cond
     (liece-compress-changes
      (setq text (format (_ " \\(has\\|have\\) left channel %s%s")
			 (regexp-quote chnl) (regexp-quote comment))
	    match (format "^%s%s.*%s$"
			  (if liece-display-time
			      liece-time-prefix-regexp "")
			  (regexp-quote liece-change-prefix)
			  (regexp-quote text))
	    default (format (_ "%s%s has left channel %s%s\n")
			    liece-change-prefix prefix chnl comment))
      (liece-replace buf
		      match default text
		      (format (_ ", %s have left channel %s%s")
			      prefix chnl comment)))
     (t
      (liece-insert-change buf
			    (format (_ "%s has left channel %s%s\n")
				    prefix chnl comment))))))
    
(defun* liece-handle-silence-message (prefix rest)
  (let* ((flag (aref rest 0)) (rest (substring rest 1)))
    (liece-insert-info (append liece-D-buffer liece-O-buffer)
			(concat "User " rest
				(if (eq flag ?-) "unsilenced" "silenced")))))

(provide 'liece-handle)

;;; liece-handle.el ends here