d504d2bc25668dacbe6cd3c630667fb0c5692028
[riece] / lisp / riece-xfaceb.el
1 ;;; riece-xfaceb.el --- display X-Face/Colour Face in IRC buffers -*- lexical-binding: t -*-
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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, 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 (autoload 'bbdb-records "bbdb")
54 (autoload 'bbdb-record-getprop "bbdb")
55
56 (defconst riece-xfaceb-description
57   "Display X-Face & Colour Face images in IRC buffers \(BBDB\).")
58
59 (defcustom riece-xfaceb-prefer-cface-to-xface (featurep 'png)
60   "*When non-nil, display colour face images instead of X-Face."
61   :type 'boolean
62   :group 'riece-looks)
63
64 (defun riece-xfaceb-face-to-png (face)
65   "Base64 decode a Face header into a PNG.
66 Returns a string."
67   (with-temp-buffer
68     (insert face)
69     (base64-decode-region (point-min) (point-max))
70     (buffer-string)))
71
72 (defun riece-xfaceb-update-user-list-buffer ()
73   "Add X-Face or Colour Face images to channel users' buffer."
74   (when (get 'riece-xfaceb 'riece-addon-enabled)
75     (let ((users (ignore-errors 
76                    (riece-with-server-buffer
77                        (riece-identity-server riece-current-channel)
78                      (riece-channel-get-users (riece-identity-prefix
79                                                riece-current-channel)))))
80           all-records cface xface nick name record)
81       (while users
82         (setq name (caar users))
83         (setq all-records (bbdb-records))
84         (while all-records
85           (setq record (car all-records)
86                 nick (bbdb-record-getprop record 'ircnick)
87                 xface (bbdb-record-getprop record 'face)
88                 cface (bbdb-record-getprop record 'cface))
89           (when (and (equal nick name)
90                      (or xface cface))
91             (with-current-buffer riece-user-list-buffer
92               (goto-char (point-min))
93               (re-search-forward (regexp-quote name) nil t)
94               (beginning-of-line)
95               (when (and xface
96                          (or (not riece-xfaceb-prefer-cface-to-xface)
97                              (not cface)))
98                 (set-extent-begin-glyph
99                  (extent-at (point))
100                  (make-glyph (list (vector 'xface
101                                            :data (concat "X-Face: " xface)
102                                            :foreground "black"
103                                            :background "white")))))
104               (when (and (featurep 'png)
105                          riece-xfaceb-prefer-cface-to-xface
106                          cface)
107                 (set-extent-begin-glyph
108                  (extent-at (point))
109                  (make-glyph (list (vector 'png
110                                            :data (riece-xfaceb-face-to-png cface)))))))
111             ;; We have a match, get out of the inner loop
112             (setq all-records nil))
113           (setq all-records (cdr all-records)))
114         (setq users (cdr users))))))
115
116 (defun riece-xfaceb-requires ()
117   )
118
119 (defun riece-xfaceb-user-list-mode-hook ()
120   (add-hook 'riece-update-buffer-functions
121             'riece-xfaceb-update-user-list-buffer t t))
122
123 (defun riece-xfaceb-insinuate ()
124   (if riece-user-list-buffer
125       (with-current-buffer riece-user-list-buffer
126         (riece-xfaceb-user-list-mode-hook)))
127   (add-hook 'riece-user-list-mode-hook
128             'riece-xfaceb-user-list-mode-hook))
129
130 (defun riece-xfaceb-uninstall ()
131   (if riece-user-list-buffer
132       (with-current-buffer riece-user-list-buffer
133         (remove-hook 'riece-update-buffer-functions
134                      'riece-xfaceb-update-user-list-buffer t)))
135   (remove-hook 'riece-user-list-mode-hook
136                'riece-xfaceb-user-list-mode-hook))
137
138 (defun riece-xfaceb-enable ()
139   (if riece-current-channel
140       (riece-emit-signal 'user-list-changed riece-current-channel)))
141
142 (defun riece-xfaceb-disable ()
143   (if riece-current-channel
144       (riece-emit-signal 'user-list-changed riece-current-channel)))
145
146 (provide 'riece-xfaceb)
147
148 ;;; riece-xfaceb.el ends here
149