(eval-when-compile
(require 'advice)
- (require 'bbdb))
+ (require 'bbdb)
+ (autoload #'bbdb-search "bbdb-com" nil nil 'macro))
(defgroup emchat-buddy nil
"Contact list preferences."
(item emchat-active-aliases))
:initialize 'custom-initialize-default)
-(defcustom emchat-buddy-show-xface nil
- "*When non-nil, display XFace images in the buddy buffer.
+(defcustom emchat-buddy-show-avatar nil
+ "*When non-nil, display avatar images in the buddy buffer.
The images come from BBDB. For an image to display in the buddy
buffer there has to be an existing BBDB entry for the contact that
-has both a `face' field, for the image, and a `icqnick' field, to
-match from the contact name in the buddy buffer."
+has both a `face', or `cface' field, for the image, and a `icqnick'
+field, to match from the contact name in the buddy buffer."
:type 'boolean
:group 'emchat-buddy
:require 'bbdb)
+(make-obsolete-variable 'emchat-buddy-show-xface
+ 'emchat-buddy-show-avatar
+ "2015-05-29")
+
(defcustom emchat-buddy-prefer-cface-to-xface (featurep 'png)
"*When non-nil, display colour faces instead of X-Face if available."
:type 'boolean
:group 'emchat-buddy)
+(defcustom emchat-buddy-xface-foreground "black"
+ "*Foreground colour used for X-Face avatars."
+ :type 'string
+ :group 'emchat-buddy)
+
+(defcustom emchat-buddy-xface-background "white"
+ "*Background colour used for X-Face avatars."
+ :type 'string
+ :group 'emchat-buddy)
+
(defface emchat-face-selected
'((((background dark))
(:foreground "darkblue" :background "yellow"))
(base64-decode-region (point-min) (point-max))
(buffer-string)))
-(defun emchat-buddy-show-xface (alias)
- "Display an XFace image in the buddy buffer."
- (unless (featurep '(and xface bbdb-autoloads))
- (error 'unimplemented "X-Face and/or BBDB"))
- (save-excursion
- (when (buffer-live-p emchat-buddy-buffer)
- (set-buffer emchat-buddy-buffer)
- (goto-char (point-min))
- (when (search-forward-regexp (concat "^" (regexp-quote alias) "$") nil t)
- (let ((ext (extent-at (point)))
- (all-records (bbdb-records))
- face cface nick record)
- (while all-records
- (setq record (car all-records)
- nick (bbdb-record-getprop record 'icqnick)
- face (bbdb-record-getprop record 'face)
- cface (bbdb-record-getprop record 'cface))
- (if (stringp nick)
- (setq nick (split-string nick ",\\| " 'omitnulls)))
- (when (and (member alias nick)
- (or face cface))
- ;; put some whitespace between the image and the name
- (set-extent-begin-glyph
- (make-extent (point-at-bol) (point-at-eol))
- (make-glyph " "))
- ;; Insert the X-Face
- (when (and face
- (or (not emchat-buddy-prefer-cface-to-xface)
- (not cface)))
- (set-extent-begin-glyph
- ext
- (make-glyph (list (vector 'xface
- :data (concat "X-Face: " face)
- :foreground "black"
- :background "white")))))
- ;; Insert the cface
- (when (and (featurep 'png)
- cface
- emchat-buddy-prefer-cface-to-xface)
- (set-extent-begin-glyph
- ext
- (make-glyph (list (vector 'png
- :data (emchat-face-to-png cface)))))))
- (setq all-records (cdr all-records))))))))
+(defun emchat-buddy-make-avatar (type extent data)
+ "Returns an avatar glyph.
+
+TYPE is a symbol, either `cface', or `xface'.
+EXTENT is the extent to add the glyph to.
+DATA is the image data from BBDB."
+ (cond
+ ((eq type 'cface)
+ (set-extent-begin-glyph
+ extent
+ (make-glyph (list (vector 'png
+ :data (emchat-face-to-png data))))))
+ ((eq type 'xface)
+ (set-extent-begin-glyph
+ extent
+ (make-glyph
+ (list (vector 'xface
+ :data (concat "X-Face: " data)
+ :foreground emchat-buddy-xface-foreground
+ :background emchat-buddy-xface-background)))))
+ (t nil)))
+
+;;;###autoload
+(defun emchat-buddy-show-avatar (alias)
+ "Display an avatar image in the buddy buffer."
+ ;; We might already have what we need in emchat-world
+ (let ((cface (emchat-world-getf alias 'cface))
+ (xface (emchat-world-getf alias 'xface)))
+ (unless (or cface xface)
+ ;; Nope, we don't. Search bbdb.
+ (unless (featurep 'bbdb-autoloads)
+ (error 'unimplemented "BBDB"))
+ (let* ((str (cons 'icqnick (regexp-quote alias)))
+ (records (bbdb-search (bbdb-records) nil nil nil str nil)))
+ (mapcar
+ #'(lambda (record)
+ (when (or (bbdb-record-getprop record 'face)
+ (bbdb-record-getprop record 'cface))
+ (setq xface (bbdb-record-getprop record 'face))
+ (setq cface (bbdb-record-getprop record 'cface))
+ (emchat-world-putf alias 'xface xface)
+ (emchat-world-putf alias 'cface cface)))
+ records)))
+ ;; Now we have what we need.
+ (save-excursion
+ (when (buffer-live-p emchat-buddy-buffer)
+ (set-buffer emchat-buddy-buffer)
+ (goto-char (point-min))
+ (when (search-forward-regexp (concat "^" (regexp-quote alias) "$") nil t)
+ (let ((ext (extent-at (point))))
+ ;; put some whitespace between the image and the name
+ (set-extent-begin-glyph
+ (make-extent (point-at-bol) (point-at-eol))
+ (make-glyph " "))
+ (cond
+ ((and cface
+ (or emchat-buddy-prefer-cface-to-xface
+ (not xface)))
+ (emchat-buddy-make-avatar 'cface ext cface))
+ (xface (emchat-buddy-make-avatar 'xface ext xface))
+ (t nil))))))))
;;;###autoload
(defun emchat-buddy-show-buffer (&optional new no-select)
as status = (emchat-world-getf alias 'status)
as face = (emchat-status-face status)
do (insert-face (concat alias "\n") face)
- do (when emchat-buddy-show-xface (emchat-buddy-show-xface alias))
+ do (when emchat-buddy-show-avatar (emchat-buddy-show-avatar alias))
do (emchat-buddy-update-face alias))
(emchat-buddy-mode))
(unless no-select
(eval-when-compile (defvar emchat-history-directory))
-(defun emchat-buddy-show-xface-in-balloon (alias)
- "Display an XFace image in the balloon-help buffer."
- (unless (featurep '(and xface bbdb-autoloads))
- (error 'unimplemented "X-Face and/or BBDB"))
- (save-excursion
- (let ((ext (or (extent-at (point))
- (make-extent (point-min) (point-min))))
- (all-records (bbdb-records))
- face cface nick record)
- (while all-records
- (setq record (car all-records)
- nick (bbdb-record-getprop record 'icqnick)
- face (bbdb-record-getprop record 'face)
- cface (bbdb-record-getprop record 'cface))
- (when (and (equal nick alias)
- (or face cface))
- ;; put some whitespace between the image and the name
- (set-extent-begin-glyph
- (make-extent (point-min) (point-min))
- (make-glyph " "))
- ;; Insert the X-Face
- (when (and face
- (or (not emchat-buddy-prefer-cface-to-xface)
- (not cface)))
- (set-extent-begin-glyph
- ext
- (make-glyph (list (vector 'xface
- :data (concat "X-Face: " face)
- :foreground "black"
- :background "white")))))
- ;; Insert the cface
- (when (and (featurep 'png)
- cface
- emchat-buddy-prefer-cface-to-xface)
- (set-extent-begin-glyph
- ext
- (make-glyph (list (vector 'png
- :data (emchat-face-to-png cface)))))))
- (setq all-records (cdr all-records))))))
-
-(defadvice balloon-help-display-help (after emchat-balloon-xface (&rest args) activate)
+(defun emchat-buddy-show-avatar-in-balloon (alias)
+ "Display an avatar image in the balloon-help buffer."
+ (let ((cface (emchat-world-getf alias 'cface))
+ (xface (emchat-world-getf alias 'xface))
+ ext)
+ (when (or cface xface)
+ (setq ext (make-extent (point-min) (point-min))))
+ (cond
+ ((and cface
+ (or emchat-buddy-prefer-cface-to-xface
+ (not xface)))
+ (emchat-buddy-make-avatar 'cface ext cface))
+ (xface (emchat-buddy-make-avatar 'xface ext xface))
+ (t nil))))
+
+(defadvice balloon-help-display-help (after emchat-buddy-show-avatar-in-balloon (&rest args) activate)
"Display an X-Face or cface image in the balloon."
- (when emchat-buddy-show-xface
+ (when emchat-buddy-show-avatar
(let ((alias (progn
(set-buffer balloon-help-buffer)
(goto-char (point-min))
(when (re-search-forward "\\(^.*\\) (" (point-at-eol) t)
(substring (match-string 1) 1)))))
(when alias
- (emchat-buddy-show-xface-in-balloon alias)))))
+ (emchat-buddy-show-avatar-in-balloon alias)))))
(defun emchat-buddy-update-face (alias &optional delete)
"Update face of ALIAS.
projects / emchat / blobdiff