;;; emchat-world.el --- EMchat contact list management

;; Copyright (C) 2002 - 2007 Steve Youngs

;; Author:        Steve Youngs <steve@emchat.org>
;; Maintainer:    Steve Youngs <steve@emchat.org>
;; Created:       2002-10-01
;; Homepage:      http://www.emchat.org/
;; Keywords:      comm ICQ

;; This file is part of EMchat.

;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;;
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; 3. Neither the name of the author nor the names of any contributors
;;    may be used to endorse or promote products derived from this
;;    software without specific prior written permission.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

;;; Commentary:
;;

(eval-and-compile
  (require 'emchat-meta)
  (require 'emchat-menu))

(autoload 'emchat-search-by-uin "emchat" nil t)
(autoload 'emchat-buddy-show-buffer "emchat-buddy" nil t)
(autoload 'emchat-process-alias-input "emchat")
(autoload 'emchat-buddy-update-face "emchat-buddy")
(autoload 'emchat-completing-aliases "emchat")
(autoload 'emchat-valid-uin-p "emchat")

(eval-when-compile
  (require 'font-lock)
  (require 'sort))

(defcustom emchat-world-rc-filename (expand-file-name "world" emchat-directory)
  "*Filename for resource file."
  :type 'file
  :group 'emchat-info)

(defcustom emchat-recently-added-by-filename
  (expand-file-name "recent-adds" emchat-directory)
  "*File containing UIN's of people who have added you to their list."
  :type 'file
  :group 'emchat-info)

(defcustom emchat-world-track-all-adds nil
  "*When non-nil, every UIN of people adding you is tracked.

The default, nil, means that only people who are not in your contact
list will be tracked."
  :type 'boolean
  :group 'emchat-info)

(defvar emchat-world-recently-added-by nil
  "Contains the UIN's of anyone who adds you to their list.

This is for the current session only.  But these people are saved in
`emchat-recently-added-by-filename' for future reference.")

;;; Internal variables

(defcustom emchat-user-alias "me"
  "*Your alias in `emchat-world'.
Run `emchat-world-update' after modifying this variable."
  :group 'emchat-info)

(defvar emchat-user-bin nil
  "User alias in binary string.
The mere purpose is to speed up operations.
Updated by `emchat-world-update'.")

(defvar emchat-all-uin nil
  "All uin in `emchat-world'.
The mere purpose is to speed up operations.
Updated by `emchat-world-update'.")

(defvar emchat-world nil
  "List of alias, uin, and plist.")

(defvar emchat-all-aliases nil
  "All aliases in `emchat-world'.
The mere purpose is to speed up operations.
Updated by `emchat-world-update'.")

(defvar emchat-add-user-p nil)
(defvar emchat-new-buddy nil)
(defvar emchat-world-new-user-hash nil)

(eval-and-compile
  (unless (featurep 'sxemacs)
    (defalias #'defregexp #'defconst)))

(defregexp emchat-world-ssi-LastUpdateTime-regexp
  (if (featurep '(or sxemacs raw-strings))
      #r"^::LastUpdateTime:\s-(\([0-9]+\)\s-.\s-\([0-9]+\))$"
    "^::LastUpdateTime:\\s-(\\([0-9]+\\)\\s-.\\s-\\([0-9]+\\))$")
  "Regular expression to match the last update time in world.")

(defregexp emchat-world-ssi-count-regexp
  (if (featurep '(or sxemacs raw-strings))
      #r"^::Count:\s-\(.*\)$"
    "^::Count:\\s-\\(.*\\)$")
  "Regular expression to match the entries count in world.")

(defregexp emchat-world-ssi-id-regexp
  (if (featurep '(or sxemacs raw-strings))
      #r"\(?:[ 	]{SSIgrp=\([0-9]+\)[ 	]SSIid=\([0-9]+\)}\)"
    "\\(?:[ 	]{SSIgrp=\\([0-9]+\\)[ 	]SSIid=\\([0-9]+\\)}\\)")
  "Regular expression matching SSI id numbers in world.")

(defregexp emchat-world-rc-regexp
  (if (featurep '(or sxemacs raw-strings))
      #r"^:icq[ 	]+\([0-9]+\)[ 	]+\([^:]+?\)[ 	]?\(:.*\)*$"
    "^:icq[ 	]+\\([0-9]+\\)[ 	]+\\([^:]+?\\)[ 	]?\\(:.*\\)*$")
  "Regular expression for rc file.
Format: :icq uin alias group(s)
Group is prefixed by a colon :.  Anything between uin and group including
white spaces is alias.  For example,

:icq 409533 fire :linux :emchat
:icq 123456 the hatter :unreal

The regexp paren groupings are as follows:

  1 -- UIN
  2 -- Alias
  3 -- groups \(local, not SSI\)")

(defun emchat-world-ssi-mod-time ()
  "Extract and return the last update time from local copy of SSI.

This time is kept in `emchat-world-rc-filename', if it doesn't exist,
return zero."
  (let ((modt (cons 0 0)))
    (with-current-buffer (find-file-noselect emchat-world-rc-filename)
      (goto-char (point-max))
      (when (re-search-backward emchat-world-ssi-LastUpdateTime-regexp nil t)
	(setq modt (cons (string-to-number (match-string 1))
			 (string-to-number (match-string 2)))))
      modt)))

(defun emchat-world-ssi-count ()
  "Extract and return the item count from local copy of SSI.

This count is kept in `emchat-world-rc-filename', if it doesn't exist,
return zero."
  (let ((count 0))
    (with-current-buffer (find-file-noselect emchat-world-rc-filename)
      (goto-char (point-max))
      (when (re-search-backward emchat-world-ssi-count-regexp nil t)
	(setq count (string-to-number (match-string 1))))
      count)))

(defun emchat-world-update-world-count (count time)
  "Update the entries COUNT and LastUpdateTime TIME in world."
  (with-current-buffer (find-file-noselect emchat-world-rc-filename)
    (goto-char (point-max))
    (condition-case nil
	(progn
	  (save-excursion
	    (re-search-backward emchat-world-ssi-LastUpdateTime-regexp)
	    (replace-string
	     (substring (match-string 0)
			(- (+ 5 (length (match-string 1))
			      (length (match-string 2)))))
	     (format "%S" time)))
	  (re-search-backward emchat-world-ssi-count-regexp)
	  (replace-string (match-string 1) (format "%d" count)))
      ;; count/time markers don't exist, add em.
      (t
       (goto-char (point-at-bol))
       (insert (format "::Count: %d\n" count)
	       (format "::LastUpdateTime: %S" time))))
    (save-buffer)
    (kill-buffer nil)))

(defun emchat-world-ssi-grp ()
  "Return the first non-zero SSI group ID to use for new contacts."
  (let ((buf (find-file-noselect emchat-world-rc-filename))
	(id nil))
    (with-current-buffer buf
      (goto-char (point-min))
      (while (not id)
	(re-search-forward emchat-world-ssi-id-regexp nil t)
	(unless (zerop (string-to-number (match-string 1)))
	  (setq id (string-to-number (match-string 1))))))
    id))

(defun emchat-world-next-ssi-id ()
  "Return the next server side contact ID number."
  (let ((buf (find-file-noselect emchat-world-rc-filename))
	(idlist nil))
    (with-current-buffer buf
      (goto-char (point-min))
      (while (re-search-forward emchat-world-ssi-id-regexp nil t)
	(push (string-to-number (match-string 2)) idlist)))
    (1+ (apply #'max idlist))))

(defun emchat-world-sync-ssi-maybe (uin grpid id alias)
  "Possibly synchronise entries from SSI to local world.

UIN is the UIN of the contact.
GRPID is the SSI group id number \(needed for modifying/deleting\).
ID is the SSI id of this contact \(needed for modifying/deleting\).
ALIAS is the \"nick\" of the contact as listed in your SSI.

Note that you shouldn't call this function directly, it doesn't
save any changes it makes to your world file.  That is done by
`emchat-v8-snac-srv-ssi-reply', which calls this."
  (let ((world (find-file-noselect emchat-world-rc-filename))
	(known-uin (member (emchat-stringular-uin uin) emchat-all-uin)))
    (with-current-buffer world
      (goto-char (point-min))
      (if known-uin
	  (when (re-search-forward (regexp-quote (emchat-stringular-uin uin)))
	    (if (re-search-forward emchat-world-ssi-id-regexp (point-at-eol) t)
		(progn
		  (or (= grpid (string-to-number (match-string 1)))
		      (replace-match (match-string 1) (format "%s" grpid)))
		  (or (= id (string-to-number (match-string 2)))
		      (replace-match (match-string 2) (format "%s" id))))
	      (goto-char (point-at-eol))
	      (insert (format " {SSIgrp=%s SSIid=%s}" grpid id))))
	(or (and (re-search-forward emchat-world-ssi-count-regexp nil t)
		 (forward-line -1))
	    (goto-char (point-max)))
	(insert (format "\n:icq %s %s {SSIgrp=%s SSIid=%s}\n"
			uin (aref alias 0) grpid id))
	(emchat-add-new-user-to-buddy-buffer
	 (emchat-stringular-uin uin) (aref alias 0))))))
      
(defun emchat-world-add-new-user ()
  "Add a new user to world."
  (let ((uin (gethash :uin emchat-world-new-user-hash))
	(nick (gethash :nick emchat-world-new-user-hash))
	(ssi-grp (gethash :ssi-grp emchat-world-new-user-hash))
	(id (gethash :id emchat-world-new-user-hash))
	(egrps (gethash :egrps emchat-world-new-user-hash))
	(status (gethash :status emchat-world-new-user-hash)))
    (set-buffer
     (find-file-noselect (expand-file-name emchat-world-rc-filename)))
    (goto-char (point-max))
    (if (re-search-backward emchat-world-ssi-count-regexp nil t)
	(progn
	  (insert (format ":icq %d %s %s {SSIgrp=%d SSIid=%d}\n\n"
			  uin nick egrps ssi-grp id))
	  (save-buffer (current-buffer))
	  (kill-buffer (current-buffer))
	  ;; Inform the user in the log.
	  (emchat-log-info
	   (emchat-decode-string
	    (format "Alias: %s, UIN: %d added to contact list."
		    nick uin)))
	  (emchat-add-new-user-to-buddy-buffer
	   (emchat-stringular-uin uin) nick status))
      (emchat-log-error "Malformed world file"))))

(defun emchat-add-new-user-to-buddy-buffer (uin nick &optional status)
  "Push the nick name from `emchat-add-user' into the buddy buffer.
Sort of a cut-down version or `emchat-world-update'"
  (if (member uin emchat-all-uin)
      (emchat-log-error "%s is already in your contact list" nick)
    (if (or (null status)
	    (and (eq status 'online)
		 (not (eq emchat-buddy-view 'emchat-active-aliases)))
	    (and (eq status 'offline)
		 (eq emchat-buddy-view 'emchat-all-aliases)))
	(add-to-list (symbol-value 'emchat-buddy-view) nick))

    (let* ((bhelp (format "%s (%s)\n\n Status: %s\n Groups: %s\nHistory: %s\n"
			  nick 
			  uin
			  (or (emchat-world-getf nick 'status) "offline")
			  (or (emchat-world-getf nick 'group) "none")
			  (or (emchat-world-getf nick 'history) "none"))))
      (set-extent-properties
       (make-extent 0 (length nick) nick)
       `(highlight t duplicable t start-open t keymap ,emchat-alias-map
		   balloon-help ,bhelp)))
    (save-excursion
      (set-buffer (find-file-noselect emchat-world-rc-filename))
      (goto-char (point-max))
      (search-backward-regexp emchat-world-rc-regexp nil t)
      (let* ((buddy (list nick uin 'rc-index (point))))
	(push buddy emchat-world)))
    (setq emchat-all-aliases (mapcar 'first emchat-world))
    (setq emchat-all-uin (mapcar 'second emchat-world))
    (emchat-buddy-show-buffer 'new 'no-select)
    (setq emchat-add-user-p nil)))

;;; Code - group:

(defun emchat-group-put (group name)
  "Put something into GROUP.
NAME can be either an alias or another group name."
  (let ((list (assoc group emchat-world)))
    (cond
     (list
      (setcdr list (list (pushnew name (cadr list) :test 'equal))))
     (t
      (push (list group (list name)) emchat-world)))))

(defun emchat-group-get (group)
  "Get members from GROUP."
  (cadr (assoc group emchat-world)))

(defun emchat-group-get-all-aliases (group)
  "Recursively get all aliases from GROUP."
  (loop for x in (emchat-group-get group)
    as expanded-x = (emchat-group-get x)
    if (atom expanded-x) collect x
    else append (emchat-group-get-all-aliases x)))

(defun emchat-group-select-aliases (state &rest aliases)
  "Select aliases and update buddy buffer.
Nil STATE means deselect, 'toggle means invert current state, and other
non-nil means select.

See `emchat-process-alias-input'."
  (interactive '(select))
  (emchat-process-alias-input 'aliases)
  (loop for x in aliases
    do (when (eq state 'toggle)
	 (setq state (not (emchat-world-getf x 'selected))))
    do (emchat-world-putf x 'selected state)
    do (emchat-buddy-update-face x))
  (emchat-buddy-show-buffer 'new 'noselect))

(defun emchat-world-getf (alias tag)
  "For ALIAS get property of TAG.
If TAG is 'all, return the plist."
  (let ((plist (cddr (assoc alias emchat-world))))
    (if (eq tag 'all)
        plist
      (getf plist tag))))

(defun emchat-world-putf (alias tag value)
  "For ALIAS put property of TAG with VALUE."
  (let* ((buddy (assoc alias emchat-world))
         (plist (cddr buddy)))
    (if buddy (setcdr (cdr buddy) (putf plist tag value)))))

(defun emchat-alias-uin (alias)
  "Return an uin from an ALIAS in `emchat-world'.
Return uin if ALIAS is already an uin.
Return 0 if no corresponding uin or invalid uin.
If called interactively, display and push uin into `kill-ring'."
  (interactive (emchat-completing-aliases "UIN from alias: " 'single))
  (let ((uin (second (assoc alias emchat-world))))
    (unless uin
      (when (emchat-valid-uin-p alias)
        (setq uin alias)))
    (when (interactive-p)
      (message uin)
      (kill-new uin))
    uin))

(defun emchat-uin-alias (uin)
  "Return an alias from an UIN in `emchat-world'.
Return UIN if no corresponding ALIAS.
If called interactively, display and push alias into `kill-ring'."
  (interactive (list (read-string "alias from uin: ")))
  (let ((alias (or (first (find uin emchat-world :key 'second :test 'string=))
                   ;; not found, return uin
                   uin)))
    (when (interactive-p)
      (message alias)
      (kill-new alias))
    alias))

;;;###autoload
(defun emchat-world-update ()
  "Read `emchat-world-rc-filename' and update various user variables.
Need to call this whenever RC is modified and to be updated.
RC file is not closed if it is the buffer of current window or it is modified."
  (interactive)
  (save-excursion
    (let (no-killing-at-last)
      (setq emchat-world nil)
      (set-buffer (find-file-noselect emchat-world-rc-filename))
      ;; don't kill if rc file is buffer in current window
      (setq no-killing-at-last
            (or (buffer-modified-p)
                (eq (window-buffer) (current-buffer))))
      (goto-char (point-min))
      (while (search-forward-regexp emchat-world-rc-regexp nil t)
        (let* ((uin (match-string 1))
               (alias (replace-regexp-in-string
		       emchat-world-ssi-id-regexp ""
		       (match-string 2)))
               (group (replace-regexp-in-string
		       emchat-world-ssi-id-regexp ""
		       (or (match-string 3) "")))
               buddy)

          ;; idea from Erik Arneson <erik@starseed.com>
          (set-extent-properties
           ;; We may consider moving to emchat-uin-alias or somewhere else, if
           ;; we don't want to waste enourmous unused extents.
           (make-extent 0 (length alias) alias)
           `(highlight t duplicable t start-open t keymap ,emchat-alias-map))

          (setq buddy (list alias uin 'rc-index (point)))

          ;; group stuff not used yet
          (if group
              (setq buddy
                    (append buddy (read (format "(group (%s))" group)))))
          (push buddy emchat-world)))
      (setq emchat-world (nreverse emchat-world))
      (unless no-killing-at-last
	(kill-buffer (current-buffer)))))

  (setq emchat-all-aliases (mapcar 'first emchat-world))
  (setq emchat-all-uin (mapcar 'second emchat-world))
  ;; Add history files to emchat-world if enabled
  (when emchat-history-enabled-flag
    (mapcar
     #'(lambda (alias)
	 (emchat-world-putf alias 'history
			    (expand-file-name alias emchat-history-directory)))
     emchat-all-aliases)))

(defun emchat-world-info (alias)
  "Return local info of buddy ALIAS."
  ;; TODO
  (assoc alias emchat-world))

;;; FIXME: Putting the rc file into `outline-minor-mode' is throwing a
;;; "keymapp nil" error.
(defun world-mode ()
  "emchat resource file mode.
Quick hack for font-lock. Each record is separated by \"==== \" at the
beginning of the line."
  (interactive)
  (kill-all-local-variables)
  (setq mode-name "world")
  (setq major-mode 'world-mode)
  (setq fill-column 100)
  (auto-fill-mode 1)
  ;; hiding details for privacy
  ;(outline-minor-mode)
  ;(set (make-local-variable 'outline-regexp)
  ;     "==== ")
  (setq font-lock-keywords
 	;; highlight separator
 	'(("^==== " 0 font-lock-warning-face t)
 	  ;; highlight keyword prefixed with :
 	  (":\\(\\w\\|-\\)+" 0 font-lock-reference-face t)))
  (font-lock-mode 1))

(defun world-sort ()
  (interactive)
  (beginning-of-buffer)
  (sort-subr nil 'world-next-friend 'world-end-friend))

(defun world-next-friend ()
  (interactive)
  (let ((result (search-forward "====" nil t)))
    ;; go back before ====
    (if result (backward-char 4)
      ;; required by sort-subr
      (end-of-buffer))))

(defun world-end-friend ()
  (interactive)
  ;; skip current friend
  (forward-char 1)
  (let ((result (search-forward "====" nil t)))
    ;; go back before ====
    (if result (backward-char 5)
      (end-of-buffer))))

(defun world-find (alias)
  "Goto a friend record of ALIAS in `emchat-world-rc-filename'.
Prefix argument means do not use (load) emchat completing alias feature."
  (interactive
   (if current-prefix-arg
       (list (read-string "find: "))
     (progn
       (require 'emchat)
       (emchat-completing-aliases "find: " 'single))))
  (find-file emchat-world-rc-filename)
  (goto-char (point-min))
  (re-search-forward
   (concat "^:icq.*?"
           (regexp-quote alias)
           "\\b.*$")))

(provide 'emchat-world)

;;; emchat-world.el ends here