;;; emchat-wharf.el --- DockApp/status window for EMchat

;; Copyright (C) 2001 - 2011 Steve Youngs, Erik Arneson

;; Author:        Erik Arneson <erik@emchat.org>
;; Maintainer:    Erik Arneson <erik@emchat.org>
;; Created:       Aug 10, 2001
;; 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.

(defvar emchat-wharf-frame nil
  "Frame in which EMchatWharf is running.")

(defvar emchat-wharf-frame-props
  '((name . "EMchatWharf")
    (height . 5)
    (width . 8)
    (unsplittable . t)
    (minibuffer . none)
    (menubar-visible-p . nil)
    (has-modeline-p . nil)
    (default-gutter-visible-p . nil)
    (default-toolbar-visible-p . nil)
    (scrollbar-height . 0)
    (scrollbar-width . 0)
    (text-cursor-visible-p . nil))
  "Frame properties for EMchatWharf.")

(defvar emchat-wharf-buf nil
  "Buffer in which EMchatWharf is running.")

(defgroup emchat-wharf nil
  "Miniature EMchat status window."
  :prefix "emchat-wharf-"
  :group 'emchat)

(defface emchat-wharf-default-face
  '((((class color))
     (:foreground "Green" :family "fixed" :size "9pt"))
    (t
     (:family "fixed" :size "9pt")))
  "Face used in EMchatWharf window.

If you want this to be dockable, make sure you use a small but readable
font."
  :group 'emchat-wharf)

(defcustom emchat-wharf-notice-riece-flag nil
  "When non-nil, indicate Riece activity in EMchatWharf.

This requires riece-biff to be set up and active."
  :type 'boolean
  :group 'emchat-wharf)

;; Riece activity indicator face
(make-face 'emchat-wharf-riece-active-face
	   "Face used in EMchat Wharf when there is activity from Riece.")
(set-face-parent 'emchat-wharf-riece-active-face
		 'emchat-wharf-default-face)
(set-face-foreground 'emchat-wharf-riece-active-face "Red")

(make-face 'emchat-wharf-riece-inactive-face
	   "Face used in EMchat Wharf when there is no activity from Riece.")
(set-face-parent 'emchat-wharf-riece-inactive-face
		 'emchat-wharf-default-face)
(set-face-foreground 'emchat-wharf-riece-inactive-face "Black")


;;;###autoload
(defcustom emchat-wharf-frame-use-p nil
  "If non-NIL, start up the EMchatWharf mini-frame."
  :type 'boolean
  :group 'emchat-wharf
  :tag "EMchatWharf mini-frame")

;;; Internal variables

;;; Riece integration
(defvar emchat-riece-activity nil
  "This is non-nil when riece-biff has been triggered.")

;; Advise a couple of Riece functions to run some hooks for us.
(defadvice riece-biff-after-display-message-function (after biffon (&rest args) activate)
  "Update the EMchatWharf Riece indicator."
  (when (eq riece-biff-mode-string 'riece-biff-biff-mode-string)
    (run-hooks 'riece-biff-activity-hook)))

(defadvice riece-biff-clear (after biffoff (&rest args) activate)
  "Update the EMchatWharf Riece indicator."
  (when (eq riece-biff-mode-string 'riece-biff-default-mode-string)
    (run-hooks 'riece-biff-clear-hook)))

(defun emchat-wharf-riece-active ()
  "Make the EMchatWharf Riece indicator active."
  (let ((emchat-riece-activity t))
    (emchat-wharf-update-riece)))

(defun emchat-wharf-riece-inactive ()
  "Make the EMchatWharf Riece indicator inactive."
  (let ((emchat-riece-activity nil))
    (emchat-wharf-update-riece)))

(defun emchat-wharf-update-riece ()
  "Update the status line in EMchatWharf."
  (when emchat-wharf-buf
    (save-excursion
      (set-buffer emchat-wharf-buf)
      (goto-line 4)
      (delete-region (point-at-bol) (point-at-eol))
      (insert-face "Riece" (if emchat-riece-activity
			       'emchat-wharf-riece-active-face
			     'emchat-wharf-riece-inactive-face)))))

;;;###autoload
(defun emchat-wharf-new-frame ()
  "Create new EMchatWharf frame."
  (unless (frame-live-p emchat-wharf-frame)
    (setq emchat-wharf-frame (new-frame emchat-wharf-frame-props))
    (select-frame emchat-wharf-frame)
    (unless (buffer-live-p emchat-wharf-buf)
      (setq emchat-wharf-buf (get-buffer-create "*EMchatWharf*"))
      (set-buffer-dedicated-frame emchat-wharf-buf emchat-wharf-frame)
      (save-excursion
	(set-buffer emchat-wharf-buf)
	(insert "New 000\nSys 000\n")
	(set-extent-face (make-extent (point-min) (point-max) emchat-wharf-buf)
			 'emchat-wharf-default-face)
	(insert-face emchat-user-status (emchat-status-face emchat-user-status))
	(when emchat-wharf-notice-riece-flag
	  (insert "\n")
	  (insert-face "Riece" (if emchat-riece-activity
				   'emchat-wharf-riece-active-face
				 'emchat-wharf-riece-inactive-face)))
	))
    (if (fboundp 'set-specifier)
	(progn
	  (set-specifier horizontal-scrollbar-visible-p nil
			 (cons emchat-wharf-frame nil))
	  (set-specifier vertical-scrollbar-visible-p nil
			 (cons emchat-wharf-frame nil))))
    (set-face-font 'default
		   (face-font-name 'emchat-wharf-default-face)
		   emchat-wharf-frame)
    (set-window-buffer nil emchat-wharf-buf)))

(defun emchat-wharf-change-messages (type num)
  (let (oldnum newnum)
    (if emchat-wharf-buf
	(save-excursion
	  (set-buffer emchat-wharf-buf)
	  (goto-char (point-min))
	  (if (re-search-forward (concat "^\\("
					 type
					 " *\\([0-9]+\\)\\)$")
				 nil t)
	      (progn
		(setq oldnum (string-to-int (match-string 2))
		      newnum (+ oldnum num))
		(if (> 0 newnum)
		    (setq newnum 0))
		(replace-match (format "%-3s %03d" type newnum))))))))

(defun emchat-wharf-inc-messages ()
  "Increment number of new messages in EMchatWharf."
  (emchat-wharf-change-messages "New" 1))

(defun emchat-wharf-dec-messages ()
  "Decrement number of new messages in EMchatWharf."
  (emchat-wharf-change-messages "New" -1))

(defun emchat-wharf-inc-system ()
  "Increment number of system messages in EMchatWharf."
  (emchat-wharf-change-messages "Sys" 1))

(defun emchat-wharf-dec-system ()
  "Decrement number of system messages in EMchatWharf."
  (emchat-wharf-change-messages "Sys" -1))

(defun emchat-wharf-update-status ()
  "Update the status line in EMchatWharf."
  (when emchat-wharf-buf
    (save-excursion
      (set-buffer emchat-wharf-buf)
      (goto-line 3)
      (delete-region (point-at-bol) (point-at-eol))
      (insert-face emchat-user-status (emchat-status-face emchat-user-status)))))

(provide 'emchat-wharf)
;;; emchat-wharf.el ends here