Rework and optimise the XFace/CFace code.

The old way of finding and displaying XFace/CFace avatar images was
to crawl through the entire bbdb each and every time an image was
needed. Pfft!

The NEW way is to do a specific search on the `icqnick' field a
(hopefully) maximum of once per contact, per emacs session.  Once
an avatar is found, it is stored in `emchat-world' for easier and
faster access from then on.

The `*-xface' defuns and vars were renamed to `*-avatar', which seems
to make more sense in this context.

It is also now possible to customise the fore/back colours of XFace
avatars (black on red looks pretty sexy, BTW).  See:
`emchat-buddy-xface-foreground' and `emchat-buddy-xface-background'

	* emchat-buddy.el (top level): Autoload #'bbdb-search at compile
	time.
	(emchat-buddy-show-avatar): New, renamed from
	`emchat-buddy-show-xface'.
	(emchat-buddy-show-xface): Made obsolete.
	(emchat-buddy-xface-foreground): New customisable variable.
	(emchat-buddy-xface-background): New customisable variable.
	(emchat-buddy-make-avatar): New.  Returns a glyph object from
	either an X-Face or cface.
	(emchat-buddy-show-avatar): New.  Replaces the now removed
	`emchat-buddy-show-xface' function.  Uses #'bbdb-search instead of
	walking through the entire bbdb.  Stores the cface/xface in
	emchat-world.
	(emchat-buddy-show-buffer): Use it.
	(emchat-buddy-show-avatar-in-balloon): New.  Replaces
	`emchat-buddy-show-xface-in-balloon'.  Gets the face info from
	emchat-world instead of crawling through the bbdb.
	(balloon-help-display-help): Use it.

	* emchat-world.el (emchat-world-update): Ensure that avatars are
	not lost.

	* emchat-status.el (emchat-status-face): Autoload it.

Signed-off-by: Steve Youngs <steve@emchat.org>

diff --git a/emchat-buddy.el b/emchat-buddy.el
index 357a834..bd5ab12 100644 (file)
--- a/emchat-buddy.el
+++ b/emchat-buddy.el
@@ -45,7 +45,8 @@
 
 (eval-when-compile
   (require 'advice)
-  (require 'bbdb))
+  (require 'bbdb)
+  (autoload #'bbdb-search "bbdb-com" nil nil 'macro))
 
 (defgroup emchat-buddy nil
   "Contact list preferences."
@@ -70,22 +71,36 @@ See `emchat-buddy-view-all', `emchat-buddy-view-connected', and
                 (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"))
@@ -135,50 +150,67 @@ Returns a string."
     (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)
@@ -197,7 +229,7 @@ See `emchat-buddy-view' and `emchat-buddy-status-color-hint-flag'."
       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
@@ -223,56 +255,31 @@ See `emchat-buddy-view' and `emchat-active-aliases'."
 
 (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.

diff --git a/emchat-status.el b/emchat-status.el
index 1d9a535..a8782e1 100644 (file)
--- a/emchat-status.el
+++ b/emchat-status.el
@@ -169,6 +169,7 @@ Dynamically ALIAS and STATUS are binded to be used in hooks."
     (invisible "invisible" emchat-face-invisible))
   "Status info: v8 status, text code, face, auto-reply.")
 
+;;;###autoload
 (defun emchat-status-face (name)
   "Return the face of status from its NAME."
   (caddar

diff --git a/emchat-world.el b/emchat-world.el
index 7c2c488..9b04447 100644 (file)
--- a/emchat-world.el
+++ b/emchat-world.el
@@ -397,51 +397,68 @@ If called interactively, display and push alias into `kill-ring'."
 Need to call this whenever RC is modified and to be updated.
 RC file is not closed if it is the buffer of current window or it is modified."
   (interactive)
-  (save-excursion
-    (let (no-killing-at-last)
-      (setq emchat-world nil)
-      (set-buffer (find-file-noselect emchat-world-rc-filename))
-      ;; don't kill if rc file is buffer in current window
-      (setq no-killing-at-last
-           (or (buffer-modified-p)
-               (eq (window-buffer) (current-buffer))))
-      (goto-char (point-min))
-      (while (search-forward-regexp emchat-world-rc-regexp nil t)
-       (let* ((uin (match-string 1))
-              (alias (replace-regexp-in-string
-                      emchat-world-ssi-id-regexp ""
-                      (match-string 2)))
-              (group (replace-regexp-in-string
-                      emchat-world-ssi-id-regexp ""
-                      (or (match-string 3) "")))
-              buddy)
-
-         ;; idea from Erik Arneson <erik@starseed.com>
-         (set-extent-properties
-          ;; We may consider moving to emchat-uin-alias or somewhere else, if
-          ;; we don't want to waste enourmous unused extents.
-          (make-extent 0 (length alias) alias)
-          `(highlight t duplicable t start-open t keymap ,emchat-alias-map))
-
-         (setq buddy (list alias uin 'rc-index (point)))
-
-         ;; group stuff not used yet
-         (if group
-             (setq buddy
-                   (append buddy (read (format "(group (%s))" group)))))
-         (push buddy emchat-world)))
-      (setq emchat-world (nreverse emchat-world))
-      (unless no-killing-at-last
-       (kill-buffer (current-buffer)))))
-
-  (setq emchat-all-aliases (mapcar 'first emchat-world))
-  (setq emchat-all-uin (mapcar 'second emchat-world))
-  ;; Add history files to emchat-world if enabled
-  (when emchat-history-enabled-flag
+  (let (avatars)
+    (mapcar
+     #'(lambda (a)
+        (let ((cface (emchat-world-getf a 'cface))
+              (xface (emchat-world-getf a 'xface)))
+          (and cface (push (cons (concat a "-c") cface) avatars))
+          (and xface (push (cons (concat a "-x") xface) avatars))))
+     emchat-all-aliases)
+    (save-excursion
+      (let (no-killing-at-last)
+       ;; Save the avatar images for later re-inclusion into emchat-world
+       (setq emchat-world nil)
+       (set-buffer (find-file-noselect emchat-world-rc-filename))
+       ;; don't kill if rc file is buffer in current window
+       (setq no-killing-at-last
+             (or (buffer-modified-p)
+                 (eq (window-buffer) (current-buffer))))
+       (goto-char (point-min))
+       (while (search-forward-regexp emchat-world-rc-regexp nil t)
+         (let* ((uin (match-string 1))
+                (alias (replace-regexp-in-string
+                        emchat-world-ssi-id-regexp ""
+                        (match-string 2)))
+                (group (replace-regexp-in-string
+                        emchat-world-ssi-id-regexp ""
+                        (or (match-string 3) "")))
+                buddy)
+
+           ;; idea from Erik Arneson <erik@starseed.com>
+           (set-extent-properties
+            ;; We may consider moving to emchat-uin-alias or somewhere else, if
+            ;; we don't want to waste enourmous unused extents.
+            (make-extent 0 (length alias) alias)
+            `(highlight t duplicable t start-open t keymap ,emchat-alias-map))
+
+           (setq buddy (list alias uin 'rc-index (point)))
+
+           ;; group stuff not used yet
+           (if group
+               (setq buddy
+                     (append buddy (read (format "(group (%s))" group)))))
+           (push buddy emchat-world)))
+       (setq emchat-world (nreverse emchat-world))
+       (unless no-killing-at-last
+         (kill-buffer (current-buffer)))))
+
+    (setq emchat-all-aliases (mapcar 'first emchat-world))
+    (setq emchat-all-uin (mapcar 'second emchat-world))
+    ;; Add history files to emchat-world if enabled
+    (when emchat-history-enabled-flag
+      (mapcar
+       #'(lambda (alias)
+          (emchat-world-putf alias 'history
+                             (expand-file-name alias emchat-history-directory)))
+       emchat-all-aliases))
+    ;; Re-add avatars
     (mapcar
-     #'(lambda (alias)
-        (emchat-world-putf alias 'history
-                           (expand-file-name alias emchat-history-directory)))
+     #'(lambda (a)
+        (let ((cface (cdr (assoc (concat a "-c") avatars)))
+              (xface (cdr (assoc (concat a "-x") avatars))))
+          (and cface (emchat-world-putf a 'cface cface))
+          (and xface (emchat-world-putf a 'xface xface))))
      emchat-all-aliases)))
 
 (defun emchat-world-info (alias)