cgit.sxemacs.org Git - riece/blob - lisp/riece-xfaceb.el

   1 ;;; riece-xfaceb.el --- display X-Face/Colour Face in IRC buffers
   2 ;; Copyright (C) 2005 Daiki Ueno
   3
   4 ;; Author: Steve Youngs <steve@sxemacs.org>
   5 ;; Created: 2005-09-03
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; NOTE: This is an add-on module for Riece.  It is adapted from
  28 ;; `riece-xface' but gets the image data from BBDB instead of LSDB.
  29
  30 ;; This add-on displays either X-Face or colour Face images in the
  31 ;; Riece "Users" buffers.  The image data comes from entries in a BBDB
  32 ;; db.  Consequently it does require a little setting up in BBDB...
  33
  34 ;; BBDB Setup:
  35
  36 ;; You need a new field called "ircnick" for each IRC contact that is
  37 ;; in your BBDB.  Its value is the IRC nickname of the contact (what
  38 ;; is listed in the Riece "Users" buffer).
  39
  40 ;;   M-x bbdb-insert-new-field RET ircnick RET
  41 ;;   answer `yes' to the prompt about the field not being defined
  42 ;;   then give it a value which will be that record's IRC nickname
  43
  44 ;; Then you'll need to collect X-Face: and Face: headers from your mail.
  45 ;; To do that see: <http://www.emacswiki.org/cgi-bin/wiki/BbdbFaces>
  46
  47 ;;; Code:
  48
  49 (require 'riece-identity)
  50 (require 'riece-globals)
  51 (require 'riece-display)
  52
  53 (ignore-errors
  54   (autoload 'bbdb-records "bbdb")
  55   (autoload 'bbdb-record-getprop "bbdb"))
  56
  57 (defconst riece-xfaceb-description
  58   "Display X-Face & Colour Face images in IRC buffers \(BBDB\).")
  59
  60 (defcustom riece-xfaceb-prefer-cface-to-xface (featurep 'png)
  61   "*When non-nil, display colour face images instead of X-Face."
  62   :type 'boolean
  63   :group 'riece-looks)
  64
  65 (defun riece-xfaceb-face-to-png (face)
  66   "Base64 decode a Face header into a PNG.
  67 Returns a string."
  68   (with-temp-buffer
  69     (insert face)
  70     (base64-decode-region (point-min) (point-max))
  71     (buffer-string)))
  72
  73 (defun riece-xfaceb-update-user-list-buffer ()
  74   "Add X-Face or Colour Face images to channel users' buffer."
  75   (when (get 'riece-xfaceb 'riece-addon-enabled)
  76     (let ((users (ignore-errors
  77                    (riece-with-server-buffer
  78                        (riece-identity-server riece-current-channel)
  79                      (riece-channel-get-users (riece-identity-prefix
  80                                                riece-current-channel)))))
  81           all-records cface xface nick name record)
  82       (while users
  83         (setq name (caar users))
  84         (setq all-records (bbdb-records))
  85         (while all-records
  86           (setq record (car all-records)
  87                 nick (bbdb-record-getprop record 'ircnick)
  88                 xface (bbdb-record-getprop record 'face)
  89                 cface (bbdb-record-getprop record 'cface))
  90           (when (and (equal nick name)
  91                      (or xface cface))
  92             (with-current-buffer riece-user-list-buffer
  93               (goto-char (point-min))
  94               (re-search-forward (regexp-quote name) nil t)
  95               (beginning-of-line)
  96               (when (and xface
  97                          (or (not riece-xfaceb-prefer-cface-to-xface)
  98                              (not cface)))
  99                 (set-extent-begin-glyph
 100                  (extent-at (point))
 101                  (make-glyph (list (vector 'xface
 102                                            :data (concat "X-Face: " xface)
 103                                            :foreground "black"
 104                                            :background "white")))))
 105               (when (and (featurep 'png)
 106                          riece-xfaceb-prefer-cface-to-xface
 107                          cface)
 108                 (set-extent-begin-glyph
 109                  (extent-at (point))
 110                  (make-glyph (list (vector 'png
 111                                            :data (riece-xfaceb-face-to-png cface)))))))
 112             ;; We have a match, get out of the inner loop
 113             (setq all-records nil))
 114           (setq all-records (cdr all-records)))
 115         (setq users (cdr users))))))
 116
 117 (defun riece-xfaceb-requires ()
 118   )
 119
 120 (defun riece-xfaceb-user-list-mode-hook ()
 121   (add-hook 'riece-update-buffer-functions
 122             'riece-xfaceb-update-user-list-buffer t t))
 123
 124 (defun riece-xfaceb-insinuate ()
 125   (if riece-user-list-buffer
 126       (with-current-buffer riece-user-list-buffer
 127         (riece-xfaceb-user-list-mode-hook)))
 128   (add-hook 'riece-user-list-mode-hook
 129             'riece-xfaceb-user-list-mode-hook))
 130
 131 (defun riece-xfaceb-uninstall ()
 132   (if riece-user-list-buffer
 133       (with-current-buffer riece-user-list-buffer
 134         (remove-hook 'riece-update-buffer-functions
 135                      'riece-xfaceb-update-user-list-buffer t)))
 136   (remove-hook 'riece-user-list-mode-hook
 137                'riece-xfaceb-user-list-mode-hook))
 138
 139 (defun riece-xfaceb-enable ()
 140   (if riece-current-channel
 141       (riece-emit-signal 'user-list-changed riece-current-channel)))
 142
 143 (defun riece-xfaceb-disable ()
 144   (if riece-current-channel
 145       (riece-emit-signal 'user-list-changed riece-current-channel)))
 146
 147 (provide 'riece-xfaceb)
 148
 149 ;;; riece-xfaceb.el ends here
 150