;;; erc-members.el --- ERC member management

;; Copyright (C) 2003  Free Software Foundation, Inc.

;; Author: Andreas Fuchs <asf@void.at>, 
;;         Alex Schroeder <alex@gnu.org>

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

;; An implementation of management functions which act as a
;; replacement of the erc-channel-member lists.  Note that when lines
;; are parsed from the server, the nick is not downcased using
;; `erc-downcase'.  Thus, when comparing nicks, we always have to call
;; `erc-downcase'.  `erc-members' is a hash of hashes, where the
;; second hash uses the downcased version of nicks as the key.
;; Whenever gethash or puthash is used on it, this has to be
;; considered.

;; Eventually, remove erc-update-channel-info-buffer!

;;; Code:

;; Avoid miscompiling macro `erc-log' and `with-erc-channel-buffer' in
;; absence of loaded definition from 'erc.
;; See 2004-03-15_23-01_macro_err_1.txt in
;; http://labb.contactor.se/~matsl/smoketest/logs/
;; or newer results for miscompiled macros.
(eval-when-compile (require 'erc))

(require 'cl); for defstruct

(defvar erc-members (makehash 'eq)
  "A hash containing all channel members.
The key is the `erc-process', and the value is yet another hash.  This
other hash uses the erc-downcased nick name as a key, and returns an
erc-person structure.")

(defcustom erc-members-changed-hook nil
  "*This hook is called everytime the variable `erc-members' changes.
Note that if a bunch of changes happen at the same time, the hook is only
called once, at the end."
  :group 'erc-hooks
  :type 'hook)

(make-obsolete-variable 'erc-channel-members-changed-hook 'erc-members-changed-hook)

(when (and (boundp 'erc-channel-members-changed-hook)
	   erc-channel-members-changed-hook)
  (nconc erc-members-changed-hook erc-channel-members-changed-hook))

;; These erc-person structures are created in erc-add-nick-to-channel
(defstruct erc-person nick user host full-name email info channels)
;; When creating a new erc-person, make sure to use (makehash 'equal)
;;   for CHANNELS!
;; CHANNELS is a hashtable of channel names as key and a list of modes,
;;   starting with nil, as a value.  Other members of this list are 'op
;;   and 'voice.  That is, if a person is in channel foo, (gethash "foo"
;;   CHANNELS) returns (nil), or (op) or (voice) or even (op voice).

(defun erc-person-debug (person)
  "Return a human readable representation of PERSON.
PERSON is an erc-person structure."
  (list
   (erc-person-nick person)
   (erc-person-user person)
   (erc-person-host person)
   (erc-person-full-name person)
   (let (result)
     (maphash (lambda (key val)
		(if (equal val '(nil))
		    (setq result (cons key result))
		  (setq result (cons (cons key val) result))))
	      (erc-person-channels person))
     result)))

;(eval-when-compile
;  (let ((p (make-erc-person :nick "test" :channels (makehash 'equal))))
;    (erc-add-person-to-channel p "foo" '(ga))
;    (erc-person-debug p)))

(defun erc-members-debug ()
  "Return a human readable representation of `erc-members'."
  (let (result)
    (maphash
     (lambda (key val)
       (setq result (cons (cons key
				(let (l)
				  (maphash (lambda (k v)
					     (setq l (cons (cons k
								 (list (erc-person-debug v)))
							   l)))
					   val)
				  l))
			  result)))
     erc-members)
    result))

;;; Accessor Functions.

;; In many cases there are two accessors: One for persons -- these are
;; internal functions, and one for nicks -- these are the functions to
;; be used from the outside.  The goal is to call `erc-person' only
;; once per nick.

(defun erc-members-reset ()
  "Clear the `erc-members' hash-table."
  (setq erc-members (makehash 'eq)))

(defun erc-members (&optional process)
  "Return the hash of nicks for PROCESS.
If PROCESS is nil, return the nick names for `erc-process'."
  (gethash (or process erc-process) erc-members))

(defun erc-person-in-channel (person channel)
  "Return non-nil if PERSON is in CHANNEL.
PERSON is an erc-person structure."
  (gethash channel (erc-person-channels person)))

(defun erc-person (nick &optional process)
  "Return the erc-person structure for NICK and PROCESS.
If PROCESS is nil, use `erc-process'."
  (gethash (erc-downcase nick) (erc-members process)))

(defun erc-nick-in-channel (nick channel &optional process)
  "Return non-nil if NICK is in CHANNEL for PROCESS.
If PROCESS is nil, use `erc-process'."
  (let ((person (erc-person nick process)))
    (when person
      (erc-person-in-channel person channel))))

(defun erc-nick-channels (nick &optional process)
  "Return the list of channels NICK is in.
If PROCESS is nil, use `erc-process'."
  (let ((person (erc-person nick process)))
    (when person
;; someone was trying to pass in a second arg 'process'?
      (erc-person-channels person))))


(defun erc-add-person-to-channel (person channel modes)
  "Add PERSON to CHANNEL with MODES.
PERSON is an `erc-person' structure.
CHANNEL is a string.
MODES is a list of modes such as 'op or 'voice.
If MODES is nil, the list (nil) will be used."
  (puthash channel
	   (or modes '(nil))
	   (erc-person-channels person))
  ;; when doing batch changes, bind erc-members-changed-hook to nil
  (run-hooks 'erc-members-changed-hook))

(defun erc-add-nick-to-channel (nick channel modes &optional process)
  "Add NICK to CHANNEL for PROCESS with MODES.
NICK is string
CHANNEL is a string.
MODES is a list of modes such as 'op or 'voice, or nil.
If PROCESS is nil, use `erc-process'."
  (let ((nicks (gethash process erc-members))
	person)
    (unless nicks
      (setq nicks (makehash 'equal))
      (puthash process nicks erc-members))
    (setq person (erc-person nick process))
    (unless person
      (setq person (make-erc-person :nick nick :channels (makehash 'equal)))
      (puthash (erc-downcase nick) person nicks))
    (erc-add-person-to-channel person channel modes)))

(defun erc-remove-person-from-channel (person channel)
  "Remove PERSON from CHANNEL.
PERSON is an `erc-person' structure.
CHANNEL is a string."
  (remhash channel (erc-person-channels person))
  ;; when doing batch changes, bind erc-members-changed-hook to nil
  (run-hooks 'erc-members-changed-hook))

(defun erc-remove-nick-from-channel (nick channel &optional process)
  "Remove NICK from CHANNEL for PROCESS.
If PROCESS is nil, use `erc-process'."
  (erc-remove-person-from-channel (erc-person nick process) channel))

(defun erc-person-get-mode-in-channel (person channel mode)
  "Return non-nil if PERSON in CHANNEL has MODE.
PERSON is an erc-person structure.
CHANNEL is a string.
MODE is a symbol such as `op'"
  (memq mode (gethash channel (erc-person-channels person))))

(defun erc-person-set-mode-in-channel (person channel mode status)
  "Give PERSON MODE STATUS in CHANNEL.
PERSON is an erc-person structure.
MODE is the symbol `op' or `voice'.
STATUS is nil or t.
CHANNEL is a string."
  (let ((modes (gethash channel (erc-person-channels person))))
    (unless modes
      (error "%S is not in channel %s" person channel))
    (if status
	(or (memq mode modes)
	    (puthash channel
		     (cons mode modes)
		     (erc-person-channels person)))
      (or (not (memq mode modes))
	  (puthash channel
		   (delq mode modes)
		   (erc-person-channels person))))))

(defun erc-get-channel-members (channel &optional process)
  "Return a list of erc-person structures for CHANNEL.
If PROCESS is nil, use `erc-process'."
  (let (result)
    (maphash (lambda (nick person)
	       (when (erc-person-in-channel person channel)
		 (setq result (cons person result))))
	     (erc-members process))
    result))

(defun erc-refresh-channel-members (channel names-string &optional add)
  "Update channel members for CHANNEL.
All the nicks listed in NAMES-STRING are on that channel.
If optional ADD is non-nil, do not remove existing names from the list.
This refers to the channel named CHANNEL associated with the current
`erc-process' only."
  (unless erc-process
    (error "No erc-process in %S" (current-buffer)))
  ;; We need to delete "" because in XEmacs, (split-string "a ")
  ;; returns ("a" "").  Based on the nick names used in NAMES-STRING,
  ;; we determine their op and voice capabilities, we create a
  ;; hashtable where each key is the nick name, and the value has the
  ;; form (OP VOICE), where OP and VOICE are either nil or t.
  (let ((names (makehash))
	(erc-members-changed-hook nil)); bulk changes
    ;; fill names table
    (dolist (name (delete "" (split-string names-string)))
      (cond ((string-match "^@\\(.*\\)$" name)
	     (puthash (match-string 1 name) '(op) names))
	    ((string-match "^+\\(.*\\)$" name)
	     (puthash (match-string 1 name) '(voice) names))
	    (t
	     (puthash name nil names))))
    ;; clear all channel members, if add is nil
    (unless add
      (mapc (lambda (person)
	      (erc-remove-person-from-channel person channel))
	    (erc-get-channel-members channel)))
    ;; add all names now -- overwriting their previous modes
    (maphash (lambda (nick modes)
	       (erc-add-nick-to-channel nick channel modes erc-process))
	     names))
  (run-hooks 'erc-members-changed-hook))

(defun erc-update-member (channel nick &optional new-nick add op voice host 
				  email full-name info)
  ;; when adding new arguments, be sure to check the test at the end
  ;; before erc-members-changed-hook runs
  "Update the user info in the channel CHANNEL.
All non-nil attributes will be used to update the info we have.

The user's NICK will be changed to NEW-NICK.  If ADD is non-nil, add
the user to CHANNEL.  The other optional arguments OP, VOICE, HOST,
EMAIL and FULL-NAME change the appropriate fields.  INFO is the
additional info such as sign-on time or comments.

Note: If OP or VOICE is nil, the status does not change, so use `on'
or `off' to set the status instead of t and nil.

If the info is actually updated, return non-nil and call
`erc-channel-members-updated-hook'."
  (unless erc-process
    (error "No erc-process in %S" (current-buffer)))
  (when (string= nick new-nick)
    (setq new-nick nil));; backwards compatibility
  (let ((person (erc-person nick))
	(erc-members-changed-hook nil));; call it only once
    (erc-log (format "update-member: old %S" person))
    (when new-nick
      (setf (erc-person-nick person) new-nick)
      (remhash nick (erc-members))
      (puthash (erc-downcase new-nick) person (erc-members)))
    (if add
	(let (modes)
	  (when (eq op 'on)
	    (setq modes (cons 'op modes)))
	  (when (eq voice 'on)
	    (setq modes (cons 'voice modes)))
	  (erc-add-person-to-channel person channel modes))
      (when (erc-person-in-channel person channel)
	(when op
	  (erc-person-set-mode-in-channel person channel 'op (eq op 'on)))
	(when voice
	  (erc-person-set-mode-in-channel person channel 'op (eq voice 'on)))))
    (when host
      (setf (erc-person-host person) host))
    (when email
      (setf (erc-person-email person) email))
    (when full-name
      (setf (erc-person-full-name person) full-name))
    (when info
      (setf (erc-person-info person) info))
    (erc-log (format "update-member: new %S" person)))
  (let ((changes (or new-nick add op voice host email full-name info)))
    (when changes (run-hooks 'erc-members-changed-hook))
    changes))

(make-obsolete 'erc-update-channel-member 'erc-update-member)

(defalias 'erc-update-channel-member 'erc-update-member)

(defun erc-buffer-list-with-nick (nick &optional process)
  "Return buffers where NICK is online.
If PROCESS is nil, use `erc-process'."
  (let ((channels (erc-nick-channels nick process)))
    (erc-buffer-filter
     (lambda ()
       (member (erc-default-target) channels))
     process)))

;; FIXME: erc-format-nick and erc-format-@nick calling convention is
;; not backwards compatible -- make a note of this!  Search for other
;; calls to these functions and fix them.

(defun erc-format-nick (person)
  "Standard nickname formatting function.
Returns the nick of PERSON.
PERSON is an erc-person structure."
  (erc-person-nick person))

(defun erc-format-@nick (person)
  "Format a nickname such that @ or + are prefixed to the nick of PERSON,
if OP or VOICE are t for the current `erc-default-target' respectively.
PERSON is an erc-person structure."
  (let ((channel (erc-default-target)))
    (when channel
      (concat (if (erc-person-get-mode-in-channel person channel 'voice)
		  "+" "")
	      (if (erc-person-get-mode-in-channel person channel 'op)
		  "@" "")
	      nick))))

(defun erc-server-PRIVMSG-or-NOTICE (proc parsed)
  (let ((sspec (aref parsed 1))
	(cmd (aref parsed 0))
	(tgt (aref parsed 2))
	(msg (aref parsed 3)))
    (if (or (erc-ignored-user-p sspec)
	    (erc-ignored-reply-p msg tgt proc))
	(if erc-minibuffer-ignored
	    (message "Ignored %s from %s to %s" cmd sspec tgt))
      (let* ((sndr (erc-parse-user sspec))
	     (nick (nth 0 sndr))
	     (login (nth 1 sndr))
	     (host (nth 2 sndr))
	     (msgp (string= cmd "PRIVMSG"))
	     (noticep (string= cmd "NOTICE"))
	     ;; S.B. downcase *both* tgt and current nick
	     (privp (erc-current-nick-p tgt))
	     s buffer
	     fnick)
	(setq buffer (erc-get-buffer (if privp nick tgt) proc))
	(when buffer
	  (with-current-buffer buffer
	    ;; update the chat partner info.  Add to the list if private
	    ;; message.	 We will accumulate private identities indefinitely
	    ;; at this point.
	    (if (erc-update-channel-member (if privp nick tgt) nick nick
					   privp nil nil host login)
		(erc-update-channel-info-buffer (if privp nick tgt)))
	    (setq fnick (funcall erc-format-nick-function (erc-person nick)))))
	(cond
	 ((erc-is-message-ctcp-p msg)
	  (setq s (if msgp
		      (erc-process-ctcp-query proc parsed nick login host)
		    (erc-process-ctcp-reply proc parsed nick login host
					    (match-string 1 msg)))))
	 (t
	  (setcar last-peers nick)
	  (setq s (erc-format-privmessage (or fnick nick) msg privp msgp))))
	(when s
	  (when (and noticep privp erc-echo-notices-in-minibuffer-flag)
	    (message (concat "NOTICE: " s)))
	  (erc-display-message parsed nil buffer s))))))

(defun erc-remove-channel-member (channel nick)
  "Remove NICK from CHANNEL in PROCESS.
If PROCESS is nil, use `erc-process'."
  (erc-remove-nick-from-channel nick channel))

(make-obsolete 'erc-remove-channel-member 'erc-remove-nick-from-channel)

;; We should delete these stupid info buffers anyway.  Improve our
;; feature karma!  Or at least move them out into a module that works
;; using the erc-members-changed-hook.

(make-obsolete 'erc-update-channel-info-buffer 'ignore)

(make-obsolete 'erc-channel-member-to-user-spec 'erc-format-user)

(defun erc-format-user (person)
  "Return a user string of the form nick!user@host for person.
PERSON is an erc-person structure."
  (format "%s!%s@%s"
	  (or (erc-person-nick person) "")
	  (or (erc-person-user person) "")
	  (or (erc-person-host person) "")))

(defun erc-ignored-reply-p (message target process)
  "Send MESSAGE to TARGET in PROCESS and maybe return return non-nil.
We return non-nil, when MESSAGE is addressed to an ignored user, ie. a user
matching any regexp in `erc-ignore-reply-list'."
  (let ((target-nick (erc-message-target message)))
    (unless target-nick
      (with-erc-channel-buffer target process
	(when (erc-nick-in-channel target-nick target process)
	  (erc-list-match erc-ignore-reply-list
			  (erc-format-user
			   (erc-person target-nick process))))))))

;;; Testing

;; Use (erc-members-debug) when looking at the data structure!
;; I recommend M-x ielm for that.
;(eval-when-compile
;  (let ((p (make-erc-person :channels (makehash 'equal)))
;	(erc-process 'proc))
 ;   (erc-members-reset)
  ;  (erc-add-person-to-channel p "foo" nil)
   ; (assert (erc-person-in-channel p "foo"))
    ;(assert (not (erc-person-in-channel p "bar")))
    ;(erc-person-set-mode-in-channel p "foo" 'op t)
    ;(assert (erc-person-get-mode-in-channel p "foo" 'op))
    ;(assert (not (erc-person-get-mode-in-channel p "foo" 'voice)))
    ;(assert (not (erc-person-get-mode-in-channel p "bar" 'op)))
    ;(erc-remove-person-from-channel p "foo")
    ;(assert (not (erc-person-in-channel p "foo")))
    ;(erc-refresh-channel-members "foo" "alex fritz @andi" t)
    ;(assert (equal '(nil) (erc-nick-in-channel "alex" "foo")))
    ;(assert (equal '(op) (erc-nick-in-channel "andi" "foo")))
    ;(erc-update-member "foo" "alex" "kensanata")
    ;(assert (not (erc-nick-in-channel "alex" "foo")))
    ;(assert (erc-nick-in-channel "kensanata" "foo"))))

;; FIXME: test if erc-buffer-list-with-nick returns query buffers, too
;; FIXME: test what happens when a nick in a query buffer renames itself

(provide 'erc-members)

;;; erc-members.el ends here
