1 ;;; riece-xfaceb.el --- display X-Face/Colour Face in IRC buffers -*- lexical-binding: t -*-
2 ;; Copyright (C) 2005 Daiki Ueno
4 ;; Author: Steve Youngs <steve@sxemacs.org>
6 ;; Keywords: IRC, riece
8 ;; This file is part of Riece.
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)
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.
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.
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.
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...
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).
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
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>
49 (require 'riece-identity)
50 (require 'riece-globals)
51 (require 'riece-display)
53 (autoload 'bbdb-records "bbdb")
54 (autoload 'bbdb-record-getprop "bbdb")
56 ;; `bbdb-search' is defined as a macro in bbdb-com.
62 (defconst riece-xfaceb-description
63 "Display X-Face & Colour Face images in IRC buffers \(BBDB\).")
65 (defcustom riece-xfaceb-channels nil
66 "*If non-nil, faces are only added in channels in this list.
68 You really want to set this to a list of small-ish channels that
69 you're in because having it set globally can slow Emacs to a crawl,
70 rendering it unusable if you're in some busy channels.
72 `riece-xfaceb-addremove-channel' can be used to interactively add or
73 remove the current channel to/from this list."
74 :type '(repeat string)
77 (defcustom riece-xfaceb-prefer-cface-to-xface (featurep 'png)
78 "*When non-nil, display colour face images instead of X-Face."
82 (defun riece-xfaceb-addremove-channel (&optional remove)
83 "*Add the current channel to `riece-xfaceb-channels'.
85 With optional argument, REMOVE, remove the current channel from the
88 (if (or current-prefix-arg remove)
91 (setq riece-xfaceb-channels
92 (remove (riece-identity-prefix riece-current-channel)
93 riece-xfaceb-channels))
94 (message "Channel: %s removed from riece-xfaceb channel list."
95 (riece-identity-prefix riece-current-channel)))
97 (add-to-list 'riece-xfaceb-channels
98 (riece-identity-prefix riece-current-channel))
99 (message "Channel: %s added to riece-xfaceb channel list."
100 (riece-identity-prefix riece-current-channel)))
101 (riece-emit-signal 'user-list-changed riece-current-channel))
103 (defun riece-xfaceb-face-to-png (face)
104 "Base64 decode a Face header into a PNG.
108 (base64-decode-region (point-min) (point-max))
111 (defun riece-xfaceb-add-glyph (type extent data)
112 "Adds a cface or xface glyph to an extent.
114 TYPE is a symbol, either `cface', or `xface'.
115 EXTENT is the extent to add the glyph to.
116 DATA is the image data from BBDB."
119 (let ((glyph (riece-xfaceb-face-to-png data)))
120 (set-extent-begin-glyph
122 (make-glyph `([png :data ,glyph])))))
124 (let ((glyph (concat "X-Face: " data)))
125 (set-extent-begin-glyph
127 (make-glyph `([xface :data ,glyph
129 :background "white"])))))
132 (defun riece-xfaceb-update-user-list-buffer ()
133 "Add X-Face or Colour Face images to channel users' buffer."
134 (when (and (get 'riece-xfaceb 'riece-addon-enabled)
135 riece-current-channel
136 (or (null riece-xfaceb-channels)
137 (member (riece-identity-prefix riece-current-channel)
138 riece-xfaceb-channels)))
139 (let ((users (ignore-errors
140 (riece-with-server-buffer
141 (riece-identity-server riece-current-channel)
142 (riece-channel-get-users (riece-identity-prefix
143 riece-current-channel))))))
145 (let* ((name (regexp-quote (caar users)))
146 (str (cons 'ircnick name))
147 (records (bbdb-search (bbdb-records) nil nil nil str nil))
151 (setq xface (bbdb-record-getprop record 'face))
152 (setq cface (bbdb-record-getprop record 'cface)))
154 (when (or cface xface)
155 (with-current-buffer riece-user-list-buffer
156 (goto-char (point-min))
157 (re-search-forward (regexp-quote name) nil t)
159 (let ((ext (extent-at (point))))
162 (or riece-xfaceb-prefer-cface-to-xface
164 (riece-xfaceb-add-glyph 'cface ext cface))
165 (xface (riece-xfaceb-add-glyph 'xface ext xface))
167 (setq users (cdr users))))))
169 (defun riece-xfaceb-requires ()
172 (defun riece-xfaceb-user-list-mode-hook ()
173 (add-hook 'riece-update-buffer-functions
174 'riece-xfaceb-update-user-list-buffer t t))
176 (defun riece-xfaceb-insinuate ()
177 (if riece-user-list-buffer
178 (with-current-buffer riece-user-list-buffer
179 (riece-xfaceb-user-list-mode-hook)))
180 (add-hook 'riece-user-list-mode-hook
181 'riece-xfaceb-user-list-mode-hook))
183 (defun riece-xfaceb-uninstall ()
184 (if riece-user-list-buffer
185 (with-current-buffer riece-user-list-buffer
186 (remove-hook 'riece-update-buffer-functions
187 'riece-xfaceb-update-user-list-buffer t)))
188 (remove-hook 'riece-user-list-mode-hook
189 'riece-xfaceb-user-list-mode-hook))
191 (defun riece-xfaceb-enable ()
192 (add-to-list 'riece-saved-forms 'riece-xfaceb-channels)
193 (define-key riece-command-mode-map "\C-c\C-cx"
194 #'riece-xfaceb-addremove-channel)
195 (if riece-current-channel
196 (riece-emit-signal 'user-list-changed riece-current-channel)))
198 (defun riece-xfaceb-disable ()
199 (setq riece-saved-forms
200 (remove 'riece-xfaceb-channels riece-saved-forms))
201 (define-key riece-command-mode-map "\C-c\C-cx" nil)
202 (if riece-current-channel
203 (riece-emit-signal 'user-list-changed riece-current-channel)))
205 (provide 'riece-xfaceb)
207 ;;; riece-xfaceb.el ends here