;;; emchat-status.el --- Status code for EMchat

;; Copyright (C) 2002 - 2007 Steve Youngs

;; Author:        Steve Youngs <steve@emchat.org>
;; Maintainer:    Steve Youngs <steve@emchat.org>
;; Created:       2002-10-02
;; 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.

(eval-and-compile
  (require 'emchat-log)
  (require 'emchat-world)
  (require 'emchat-meta)
  (require 'emchat)
  (require 'wid-edit))

(eval-when-compile
  (defvar emchat-buddy-view)
  (defvar emchat-wharf-frame-use-p))

(autoload 'emchat-buddy-update-face "emchat-buddy")


(defcustom emchat-buddy-status-color-hint-flag t
  "*Non-nil means put status color hints."
  :type 'boolean
  :group 'emchat-buddy)

;;;###autoload
(defcustom emchat-status-window-height 8
  "*Height of window for `emchat-status-buffer'."
  :group 'emchat-interface)

(defcustom emchat-status-use-gutter nil
  "*When non-nil, display statuses in the gutter, not in a buffer."
  :type 'boolean
  :group 'emchat-interface)

(defcustom emchat-status-gutter-orientation 'top
  "Where to display the status gutter.

Valid values are: top, bottom, left, right."
  :type '(choice (item :tag "Top" :value top)
		 (item :tag "Bottom" :value bottom)
		 (item :tag "Left" :value left)
		 (item :tag "Right" :value right))
  :group 'emchat-interface)

;;;###autoload
(defvar emchat-valid-statuses
  '("online" "away" "occ" "dnd" "ffc" "na")
  "All statuses valid for selection.
Used by `emchat-change-status' and in `emchat-buddy-buffer'.")

;;;###autoload
(defcustom emchat-user-initial-status "online"
  "*Initial user status when login."
  :group 'emchat-option
  :type
  (cons 'choice
        (mapcar
         (lambda (x) (list 'item x))
         emchat-valid-statuses)))

(defcustom emchat-status-update-hook nil
  "*Hooks to run when a buddy change his status.
Dynamically ALIAS and STATUS are binded to be used in hooks."
  :group 'emchat-option
  :type 'hook)

(defface emchat-face-online
  '((((background dark))
     (:foreground "green"))
    (((background light))
     (:foreground "green4")))
  "Face for ONLINE status."
  :group 'emchat-buddy)

(defface emchat-face-away
  '((((background dark))
     (:foreground "red"))
    (((background light))
     (:foreground "red4")))
  "Face for AWAY status."
  :group 'emchat-buddy)

(defface emchat-face-occ
  '((((background dark))
     (:foreground "orange"))
    (((background light))
     (:foreground "orange4")))
  "Face for OCCUPIED status."
  :group 'emchat-buddy)

(defface emchat-face-dnd
  '((((background dark))
     (:foreground "lightblue"))
    (((background light))
     (:foreground "blue")))
  "Face for DO NOT DISTURB status."
  :group 'emchat-buddy)

(defface emchat-face-ffc
  '((((background dark))
     (:foreground "yellow"))
    (((background light))
     (:foreground "yellow4")))
  "Face for FREE FOR CHAT status."
  :group 'emchat-buddy)

(defface emchat-face-na
  '((((background dark))
     (:foreground "pink"))
    (((background light))
     (:foreground "deeppink")))
  "Face for NOT AVAILABLE status."
  :group 'emchat-buddy)

(defface emchat-face-invisible
  '((((background dark))
     (:foreground "grey"))
    (((background light))
     (:foreground "grey40")))
  "Face for OFFLINE status."
  :group 'emchat-buddy)

;;; Internal variables

(defvar emchat-statuses
  ;; basically status is only ONE byte (except for invisible?)
  ;; byte after status byte is random
  '((online "online" emchat-face-online)
    (away "away" emchat-face-away emchat-auto-reply-away)
    (na "na" emchat-face-na emchat-auto-reply-na)
    (occupied "occ" emchat-face-occ emchat-auto-reply-occ)
    (dnd "dnd" emchat-face-dnd emchat-auto-reply-dnd)
    (ffc "ffc" emchat-face-ffc)
    (offline "offline" nil)
    (invisible "invisible" emchat-face-invisible))
  "Status info: v8 status, text code, face, auto-reply.")

(defun emchat-status-face (name)
  "Return the face of status from its NAME."
  (caddar
   (member* name emchat-statuses
            :key 'second
            :test 'string=)))

(defun emchat-status-v8 (name)
  "Return the symbol for status NAME."
  (caar
   (member* name emchat-statuses
	    :key 'second
	    :test 'string=)))

(defun emchat-status-auto-reply (name)
  "Return the symbol of auto-reply of status from its NAME."
  (fourth (car
           (member* name emchat-statuses
            :key 'second
            :test 'string=))))

(defun emchat-status-idle-reply (name)
  "Return the symbol of idle-reply of status from its NAME."
  (let ((sym (emchat-status-auto-reply name)))
    (with-temp-buffer
      (insert (symbol-name sym))
      (while (search-backward "auto" nil t)
	(replace-match "idle" nil t))
      (intern (buffer-string)))))

(defun emchat-status-name (proto-status)
  "Return the name of status from its the binary string BIN."
  (cadr (assoc proto-status emchat-statuses)))

(defun emchat-buddy-update-status (alias status)
  "Update ALIAS with new STATUS."
  ;; update alias variables
  (unless (member status (mapcar 'second emchat-statuses))
    (push (cons 'unknown-status emchat-recent-packet)
          emchat-error-packets)
    (emchat-log-error "Unknown status: %s" status)
    (setq status "online"))             ; assumed online

  ;; kludge-o-matic
  (when (and (equal alias emchat-user-alias)
	     (string= status "invisible"))
    (setq status emchat-user-status))

  (unless (emchat-world-getf alias 'status)
    (emchat-world-putf alias 'status "offline"))

  (unless (equal status (emchat-world-getf alias 'status))
    (emchat-world-putf alias 'status status)
    (emchat-log-buddy-status alias "***| %s" status)
    (when (string= status "online")
      (emchat-play-sound-maybe 'buddy-sound))
    (if (string= status "offline")
	(if (member alias emchat-connected-aliases)
	    (setq emchat-connected-aliases
		  (delete alias emchat-connected-aliases))
	  (emchat-log-buddy-status alias "***| has been invisible"))
      ;; if not offline
      (add-to-list 'emchat-connected-aliases alias))

    ;; update buffer

    ;; view != all + offline -> delete
    ;; view = all + offline -> offline-face
    (if (and (string= status "offline")
	     (not (eq emchat-buddy-view 'emchat-all-aliases)))
	(emchat-buddy-update-face alias 'delete)
      (if (or (member alias (symbol-value emchat-buddy-view))
	      (string= status "offline"))
	  (emchat-buddy-update-face alias)))))

;;;###autoload
(defvar emchat-user-status "offline"
  "Current user status.")

(defun emchat-do-status-update (ectx uin status)
  "Handle server command 01a4 in PACKET."
  (let ((alias (emchat-uin-alias (emchat-stringular-uin uin)))
        (status (emchat-status-name status)))
    (emchat-buddy-update-status alias status)
    (run-hooks 'emchat-status-update-hook)))

(defun emchat-turn-on-invisibility ()
  (emchat-v8-snac-cli-setstatus
   emchat-ctx (append (list (emchat-status-v8 emchat-user-status))
		    (and emchat-user-meta-web-aware '(web-aware))
		    '(invisible)))
  (emchat-log-buddy-status emchat-user-alias "***| %s (invisible)" emchat-user-status)
  (setq emchat-user-meta-invisible t))

(defun emchat-turn-off-invisibility ()
  (emchat-v8-snac-cli-setstatus
   emchat-ctx (append (list (emchat-status-v8 emchat-user-status))
		    (and emchat-user-meta-web-aware '(web-aware))))
  (emchat-log-buddy-status emchat-user-alias "***| %s (visible)" emchat-user-status)
  (setq emchat-user-meta-invisible nil))

(defun emchat-toggle-invisibility ()
  "Toggle \"invisible\" status."
  (interactive)
  (setq emchat-user-meta-invisible (null emchat-user-meta-invisible))
  (if emchat-user-meta-invisible
      (emchat-turn-on-invisibility)
    (emchat-turn-off-invisibility))
  (with-current-buffer emchat-log-buffer
    (emchat-log-update-modeline)))
  
(defun emchat-change-status (status &optional no-network)
  "Change to new STATUS.
Non-nil NO-NETWORK means not to send any network packet, only update
variable and modeline."
  (interactive
   (list (emchat-completing-read "status: " emchat-valid-statuses nil t)))
  (unless (equal status emchat-user-status)
    (when emchat-user-auto-away-p
      (setq emchat-user-auto-away-p nil))
    (emchat-log-system "Changed status to %s" status)
    (when (equal status "online")
      (setq emchat-auto-reply-never emchat-auto-response-never-send-to)
      (loop for alias in emchat-online-notifiers
	do (emchat-v8-send-simple-message
	    emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))
	    "I'm back online.
You won't be notified again unless you re-request 
it with \",,notify-me\".")
	do (emchat-log-system (format "Online notification sent to: %s" alias)))
      (setq emchat-online-notifiers nil))
    (setq emchat-user-status status)
    (when emchat-wharf-frame-use-p
      (declare-fboundp (emchat-wharf-update-status)))
    (redraw-modeline 'all)
    (unless no-network
      (emchat-v8-snac-cli-setstatus
       emchat-ctx (append (list (emchat-status-v8 status))
			(and emchat-user-meta-web-aware '(web-aware))
			(and emchat-user-meta-invisible '(invisible)))))))

;;;###autoload
(defvar emchat-status-buffer nil
  "Buffer for statuses.")

;;;###autoload
(defun emchat-status-show-buffer (&optional new no-select)
  "Switch to `emchat-status-buffer'.
Create buffer if buffer does not exists already or
NEW is non-nil.
Don't select status window if NO-SELECT is non-nil."
  (interactive)
  (when (or (not (buffer-live-p emchat-status-buffer))
            new)
    (setq emchat-status-buffer (get-buffer-create "*Status*"))
    (set-buffer emchat-status-buffer)
    (set-specifier horizontal-scrollbar-visible-p nil 
		   (cons (current-buffer) nil))
    (set-specifier vertical-scrollbar-visible-p nil
		   (cons (current-buffer) nil))
    (set-specifier has-modeline-p nil
		   (cons (current-buffer) nil))
    (erase-buffer)
    (set (make-local-variable 'widget-button-face) 'emchat-face-online)
    (widget-create 'link
		   :help-echo "Change status to \"Online\""
		   :action (lambda (&rest ignore)
			     (emchat-change-status "online"))
		   "Online")
    (widget-insert "\n")
    (set (make-local-variable 'widget-button-face) 'emchat-face-away)
    (widget-create 'link
		   :help-echo "Change status to \"Away\""
		   :action (lambda (&rest ignore)
			     (emchat-change-status "away"))
		   "Away")
    (widget-insert "\n")
    (set (make-local-variable 'widget-button-face) 'emchat-face-occ)
    (widget-create 'link
		   :help-echo "Change status to \"Occupied\""
		   :action (lambda (&rest ignore)
			     (emchat-change-status "occ"))
		   "Occupied")
    (widget-insert "\n")
    (set (make-local-variable 'widget-button-face) 'emchat-face-dnd)
    (widget-create 'link
		   :help-echo "Change status to \"Do Not Disturb\""
		   :action (lambda (&rest ignore)
			     (emchat-change-status "dnd"))
		   "Do Not Disturb")
    (widget-insert "\n")
    (set (make-local-variable 'widget-button-face) 'emchat-face-na)
    (widget-create 'link
		   :help-echo "Change status to \"Not Available\""
		   :action (lambda (&rest ignore)
			     (emchat-change-status "na"))
		   "Not Available")
    (widget-insert "\n")
    (set (make-local-variable 'widget-button-face) 'emchat-face-ffc)
    (widget-create 'link
		   :help-echo "Change status to \"Free For Chat\""
		   :action (lambda (&rest ignore)
			     (emchat-change-status "ffc"))
		   "Free For Chat")
    (widget-insert "\n")
    (set (make-local-variable 'widget-button-face) 'emchat-face-invisible)
    (widget-create 'link
		   :help-echo "Toggle your visibility"
		   :action (lambda (&rest ignore)
			     (emchat-toggle-invisibility))
		   "Invisible on/off")
    (toggle-read-only 1)
    (unless no-select
      (switch-to-buffer emchat-status-buffer))))

;;; Status gutter 
;;; WARNING: This is experimental and unfinished.
(defvar emchat-status-gutter-tab nil
  "A tab widget in the gutter for switching online statuses.
Do not set this.  Use `set-glyph-image' to change the properties of
the tab.")

(defun emchat-status-maybe-login ()
  "Convenience function for the status gutter.
If a connection to the ICQ server exists, just change status to
online, otherwise login."
  (if (emchat-connected-p emchat-ctx)
      (emchat-change-status "online")
    (emchat-login)))

(defvar emchat-status-tabs
  '(["Online" (emchat-status-maybe-login)
     :selected (equal emchat-user-status "online")]
    ["Away" (emchat-change-status "away")
     :selected (equal emchat-user-status "away")]
    ["Occupied" (emchat-change-status "occ")
     :selected (equal emchat-user-status "occ")]
    ["Do Not Disturb" (emchat-change-status "dnd")
     :selected (equal emchat-user-status "dnd")]
    ["Not Available" (emchat-change-status "na")
     :selected (equal emchat-user-status "na")]
    ["FFC" (emchat-change-status "ffc")
     :selected (equal emchat-user-status "ffc")]
    ["Inv on/off" (emchat-toggle-invisibility) :selected nil]
    ["Offline" (emchat-logout)
     :selected (equal emchat-user-status "offline")])
  "Buttons for the EMchat status gutter.")

;;; FIXME: Left and right gutters are broken, also, I don't like
;;; setting `default-gutter-position' to change the orientation
;;; although the docs seem to suggest that this is the only way to
;;; do it... 
;;   ,----[ C-h v right-gutter RET ]
;;   | `right-gutter' is a built-in constant specifier variable.
;;   | 
;;   | Value: #<gutter-specifier global=<unspecified> fallback=((nil)) 0x145>
;;   | 
;;   | Documentation:
;;   | Specifier for the gutter at the right edge of the frame.
;;   | Use `set-specifier' to change this.
;;   | See `default-gutter' for a description of a valid gutter instantiator.
;;   | 
;;   | Note that, unless the `default-gutter-position' is `right', by
;;   | default the height of the right gutter (controlled by
;;   | `right-gutter-width') is 0; thus, a right gutter will not be
;;   | displayed even if you provide a value for `right-gutter'.
;;   `----

(defun emchat-add-tab-to-gutter ()
  (let* ((gutter-string (copy-sequence "\n"))
	 (status-gutter-extent (make-extent 0 1 gutter-string)))
    (set-extent-begin-glyph status-gutter-extent
			    (setq emchat-status-gutter-tab
				  (make-glyph)))
    (mapcar
     (lambda (x)
       (remove-gutter-element top-gutter 'status-tab emchat-frame x)
       (remove-gutter-element bottom-gutter 'status-tab emchat-frame x)
       (remove-gutter-element left-gutter 'status-tab emchat-frame x)
       (remove-gutter-element right-gutter 'status-tab emchat-frame x))
     (console-type-list))
    (mapcar
     (lambda (x)
       (when (valid-image-instantiator-format-p 'tab-control x)
	 (cond ((eq emchat-status-gutter-orientation 'top)
		(set-default-gutter-position 'top)
		(set-specifier top-gutter-visible-p t emchat-frame x)
		(set-specifier top-gutter-border-width 0 emchat-frame x)
		(set-gutter-element top-gutter 'status-tab 
				    gutter-string emchat-frame x))
	       ((eq emchat-status-gutter-orientation 'bottom)
		(set-default-gutter-position 'bottom)
		(set-specifier bottom-gutter-visible-p t emchat-frame x)
		(set-specifier bottom-gutter-border-width 0 emchat-frame x)
		(set-gutter-element bottom-gutter 'status-tab
				    gutter-string emchat-frame x))
	       ((eq emchat-status-gutter-orientation 'left)
		(set-default-gutter-position 'left)
		(set-specifier left-gutter-visible-p t emchat-frame x)
		(set-specifier left-gutter-border-width 0 emchat-frame x)
		(set-gutter-element left-gutter 'status-tab
				    gutter-string emchat-frame x))
	       ((eq emchat-status-gutter-orientation 'right)
		(set-default-gutter-position 'right)
		(set-specifier right-gutter-visible-p t emchat-frame x)
		(set-specifier right-gutter-border-width 0 emchat-frame x)
		(set-gutter-element right-gutter 'status-tab
				    gutter-string emchat-frame x)))))
     (console-type-list))))

;;; FIXME: When the gutter code in (S)XEmacs can put different faces
;;; on different buttons update this so that the status tabs have the
;;; right faces... emchat-face-{online,away,na,occ,dnd,ffc,invisible}.
(defun emchat-update-tab-in-gutter ()
  "Update the tab control in the gutter area."
  (unless (or (window-dedicated-p (frame-selected-window emchat-frame))
	      (frame-property emchat-frame 'popup))
    (emchat-add-tab-to-gutter)
    (when (valid-image-instantiator-format-p 'tab-control emchat-frame)
      (set-glyph-image
       emchat-status-gutter-tab
       (vector 'tab-control :descriptor "Status"
	       :face 'bold
	       :orientation emchat-status-gutter-orientation
	       (if (or (eq emchat-status-gutter-orientation 'top)
		       (eq emchat-status-gutter-orientation 'bottom))
		   :pixel-width :pixel-height)
	       (if (or (eq emchat-status-gutter-orientation 'top)
		       (eq emchat-status-gutter-orientation 'bottom))
		   '(gutter-pixel-width) '(gutter-pixel-height)) 
	       :items (eval 'emchat-status-tabs))
       emchat-frame)
      ;; set-glyph-image will not make the gutter dirty
      (set-gutter-dirty-p emchat-status-gutter-orientation))))

(provide 'emchat-status)

;;; emchat-status.el ends here