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 (or (null riece-xfaceb-channels)
136 (member (riece-identity-prefix riece-current-channel)
137 riece-xfaceb-channels)))
138 (let ((users (ignore-errors
139 (riece-with-server-buffer
140 (riece-identity-server riece-current-channel)
141 (riece-channel-get-users (riece-identity-prefix
142 riece-current-channel))))))
144 (let* ((name (regexp-quote (caar users)))
145 (str (cons 'ircnick name))
146 (records (bbdb-search (bbdb-records) nil nil nil str nil))
150 (setq xface (bbdb-record-getprop record 'face))
151 (setq cface (bbdb-record-getprop record 'cface)))
153 (when (or cface xface)
154 (with-current-buffer riece-user-list-buffer
155 (goto-char (point-min))
156 (re-search-forward (regexp-quote name) nil t)
158 (let ((ext (extent-at (point))))
161 (or riece-xfaceb-prefer-cface-to-xface
163 (riece-xfaceb-add-glyph 'cface ext cface))
164 (xface (riece-xfaceb-add-glyph 'xface ext xface))
166 (setq users (cdr users))))))
168 (defun riece-xfaceb-requires ()
171 (defun riece-xfaceb-user-list-mode-hook ()
172 (add-hook 'riece-update-buffer-functions
173 'riece-xfaceb-update-user-list-buffer t t))
175 (defun riece-xfaceb-insinuate ()
176 (if riece-user-list-buffer
177 (with-current-buffer riece-user-list-buffer
178 (riece-xfaceb-user-list-mode-hook)))
179 (add-hook 'riece-user-list-mode-hook
180 'riece-xfaceb-user-list-mode-hook))
182 (defun riece-xfaceb-uninstall ()
183 (if riece-user-list-buffer
184 (with-current-buffer riece-user-list-buffer
185 (remove-hook 'riece-update-buffer-functions
186 'riece-xfaceb-update-user-list-buffer t)))
187 (remove-hook 'riece-user-list-mode-hook
188 'riece-xfaceb-user-list-mode-hook))
190 (defun riece-xfaceb-enable ()
191 (add-to-list 'riece-saved-forms 'riece-xfaceb-channels)
192 (define-key riece-command-mode-map "\C-c\C-cx"
193 #'riece-xfaceb-addremove-channel)
194 (if riece-current-channel
195 (riece-emit-signal 'user-list-changed riece-current-channel)))
197 (defun riece-xfaceb-disable ()
198 (setq riece-saved-forms
199 (remove 'riece-xfaceb-channels riece-saved-forms))
200 (define-key riece-command-mode-map "\C-c\C-cx" nil)
201 (if riece-current-channel
202 (riece-emit-signal 'user-list-changed riece-current-channel)))
204 (provide 'riece-xfaceb)
206 ;;; riece-xfaceb.el ends here