cgit.sxemacs.org Git - emchat/blob - emchat-wharf.el

   1 ;;; emchat-wharf.el --- DockApp/status window for EMchat
   2
   3 ;; Copyright (C) 2001 - 2011 Steve Youngs, Erik Arneson
   4
   5 ;; Author:        Erik Arneson <erik@emchat.org>
   6 ;; Maintainer:    Erik Arneson <erik@emchat.org>
   7 ;; Created:       Aug 10, 2001
   8 ;; Homepage:      http://www.emchat.org/
   9 ;; Keywords:      comm ICQ
  10
  11 ;; This file is part of EMchat.
  12
  13 ;; Redistribution and use in source and binary forms, with or without
  14 ;; modification, are permitted provided that the following conditions
  15 ;; are met:
  16 ;;
  17 ;; 1. Redistributions of source code must retain the above copyright
  18 ;;    notice, this list of conditions and the following disclaimer.
  19 ;;
  20 ;; 2. Redistributions in binary form must reproduce the above copyright
  21 ;;    notice, this list of conditions and the following disclaimer in the
  22 ;;    documentation and/or other materials provided with the distribution.
  23 ;;
  24 ;; 3. Neither the name of the author nor the names of any contributors
  25 ;;    may be used to endorse or promote products derived from this
  26 ;;    software without specific prior written permission.
  27 ;;
  28 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  29 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  30 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  31 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  32 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  33 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  34 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  35 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  36 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  37 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  38 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  39
  40 (defvar emchat-wharf-frame nil
  41   "Frame in which EMchatWharf is running.")
  42
  43 (defvar emchat-wharf-frame-props
  44   '((name . "EMchatWharf")
  45     (height . 5)
  46     (width . 8)
  47     (unsplittable . t)
  48     (minibuffer . none)
  49     (menubar-visible-p . nil)
  50     (has-modeline-p . nil)
  51     (default-gutter-visible-p . nil)
  52     (default-toolbar-visible-p . nil)
  53     (scrollbar-height . 0)
  54     (scrollbar-width . 0)
  55     (text-cursor-visible-p . nil))
  56   "Frame properties for EMchatWharf.")
  57
  58 (defvar emchat-wharf-buf nil
  59   "Buffer in which EMchatWharf is running.")
  60
  61 (defgroup emchat-wharf nil
  62   "Miniature EMchat status window."
  63   :prefix "emchat-wharf-"
  64   :group 'emchat)
  65
  66 (defface emchat-wharf-default-face
  67   '((((class color))
  68      (:foreground "Green" :family "fixed" :size "9pt"))
  69     (t
  70      (:family "fixed" :size "9pt")))
  71   "Face used in EMchatWharf window.
  72
  73 If you want this to be dockable, make sure you use a small but readable
  74 font."
  75   :group 'emchat-wharf)
  76
  77 (defcustom emchat-wharf-notice-riece-flag nil
  78   "When non-nil, indicate Riece activity in EMchatWharf.
  79
  80 This requires riece-biff to be set up and active."
  81   :type 'boolean
  82   :group 'emchat-wharf)
  83
  84 ;; Riece activity indicator face
  85 (make-face 'emchat-wharf-riece-active-face
  86            "Face used in EMchat Wharf when there is activity from Riece.")
  87 (set-face-parent 'emchat-wharf-riece-active-face
  88                  'emchat-wharf-default-face)
  89 (set-face-foreground 'emchat-wharf-riece-active-face "Red")
  90
  91 (make-face 'emchat-wharf-riece-inactive-face
  92            "Face used in EMchat Wharf when there is no activity from Riece.")
  93 (set-face-parent 'emchat-wharf-riece-inactive-face
  94                  'emchat-wharf-default-face)
  95 (set-face-foreground 'emchat-wharf-riece-inactive-face "Black")
  96
  97
  98 ;;;###autoload
  99 (defcustom emchat-wharf-frame-use-p nil
 100   "If non-NIL, start up the EMchatWharf mini-frame."
 101   :type 'boolean
 102   :group 'emchat-wharf
 103   :tag "EMchatWharf mini-frame")
 104
 105 ;;; Internal variables
 106
 107 ;;; Riece integration
 108 (defvar emchat-riece-activity nil
 109   "This is non-nil when riece-biff has been triggered.")
 110
 111 ;; Advise a couple of Riece functions to run some hooks for us.
 112 (defadvice riece-biff-after-display-message-function (after biffon (&rest args) activate)
 113   "Update the EMchatWharf Riece indicator."
 114   (when (eq riece-biff-mode-string 'riece-biff-biff-mode-string)
 115     (run-hooks 'riece-biff-activity-hook)))
 116
 117 (defadvice riece-biff-clear (after biffoff (&rest args) activate)
 118   "Update the EMchatWharf Riece indicator."
 119   (when (eq riece-biff-mode-string 'riece-biff-default-mode-string)
 120     (run-hooks 'riece-biff-clear-hook)))
 121
 122 (defun emchat-wharf-riece-active ()
 123   "Make the EMchatWharf Riece indicator active."
 124   (let ((emchat-riece-activity t))
 125     (emchat-wharf-update-riece)))
 126
 127 (defun emchat-wharf-riece-inactive ()
 128   "Make the EMchatWharf Riece indicator inactive."
 129   (let ((emchat-riece-activity nil))
 130     (emchat-wharf-update-riece)))
 131
 132 (defun emchat-wharf-update-riece ()
 133   "Update the status line in EMchatWharf."
 134   (when emchat-wharf-buf
 135     (save-excursion
 136       (set-buffer emchat-wharf-buf)
 137       (goto-line 4)
 138       (delete-region (point-at-bol) (point-at-eol))
 139       (insert-face "Riece" (if emchat-riece-activity
 140                                'emchat-wharf-riece-active-face
 141                              'emchat-wharf-riece-inactive-face)))))
 142
 143 ;;;###autoload
 144 (defun emchat-wharf-new-frame ()
 145   "Create new EMchatWharf frame."
 146   (unless (frame-live-p emchat-wharf-frame)
 147     (setq emchat-wharf-frame (new-frame emchat-wharf-frame-props))
 148     (select-frame emchat-wharf-frame)
 149     (unless (buffer-live-p emchat-wharf-buf)
 150       (setq emchat-wharf-buf (get-buffer-create "*EMchatWharf*"))
 151       (set-buffer-dedicated-frame emchat-wharf-buf emchat-wharf-frame)
 152       (save-excursion
 153         (set-buffer emchat-wharf-buf)
 154         (insert "New 000\nSys 000\n")
 155         (set-extent-face (make-extent (point-min) (point-max) emchat-wharf-buf)
 156                          'emchat-wharf-default-face)
 157         (insert-face emchat-user-status (emchat-status-face emchat-user-status))
 158         (when emchat-wharf-notice-riece-flag
 159           (insert "\n")
 160           (insert-face "Riece" (if emchat-riece-activity
 161                                    'emchat-wharf-riece-active-face
 162                                  'emchat-wharf-riece-inactive-face)))
 163         ))
 164     (if (fboundp 'set-specifier)
 165         (progn
 166           (set-specifier horizontal-scrollbar-visible-p nil
 167                          (cons emchat-wharf-frame nil))
 168           (set-specifier vertical-scrollbar-visible-p nil
 169                          (cons emchat-wharf-frame nil))))
 170     (set-face-font 'default
 171                    (face-font-name 'emchat-wharf-default-face)
 172                    emchat-wharf-frame)
 173     (set-window-buffer nil emchat-wharf-buf)))
 174
 175 (defun emchat-wharf-change-messages (type num)
 176   (let (oldnum newnum)
 177     (if emchat-wharf-buf
 178         (save-excursion
 179           (set-buffer emchat-wharf-buf)
 180           (goto-char (point-min))
 181           (if (re-search-forward (concat "^\\("
 182                                          type
 183                                          " *\\([0-9]+\\)\\)$")
 184                                  nil t)
 185               (progn
 186                 (setq oldnum (string-to-int (match-string 2))
 187                       newnum (+ oldnum num))
 188                 (if (> 0 newnum)
 189                     (setq newnum 0))
 190                 (replace-match (format "%-3s %03d" type newnum))))))))
 191
 192 (defun emchat-wharf-inc-messages ()
 193   "Increment number of new messages in EMchatWharf."
 194   (emchat-wharf-change-messages "New" 1))
 195
 196 (defun emchat-wharf-dec-messages ()
 197   "Decrement number of new messages in EMchatWharf."
 198   (emchat-wharf-change-messages "New" -1))
 199
 200 (defun emchat-wharf-inc-system ()
 201   "Increment number of system messages in EMchatWharf."
 202   (emchat-wharf-change-messages "Sys" 1))
 203
 204 (defun emchat-wharf-dec-system ()
 205   "Decrement number of system messages in EMchatWharf."
 206   (emchat-wharf-change-messages "Sys" -1))
 207
 208 (defun emchat-wharf-update-status ()
 209   "Update the status line in EMchatWharf."
 210   (when emchat-wharf-buf
 211     (save-excursion
 212       (set-buffer emchat-wharf-buf)
 213       (goto-line 3)
 214       (delete-region (point-at-bol) (point-at-eol))
 215       (insert-face emchat-user-status (emchat-status-face emchat-user-status)))))
 216
 217 (provide 'emchat-wharf)
 218 ;;; emchat-wharf.el ends here