1 ;;; jabber-vcard-avatars.el --- Avatars by JEP-0153
3 ;; Copyright (C) 2006, 2007, 2008 Magnus Henoch
5 ;; Author: Magnus Henoch <mange@freemail.hu>
7 ;; This file is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; This file is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to
19 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 ;; Boston, MA 02110-1301, USA.
28 (require 'jabber-avatar
)
30 (defcustom jabber-vcard-avatars-retrieve
(and (fboundp 'display-images-p
)
32 "Automatically download vCard avatars?"
36 (defcustom jabber-vcard-avatars-publish t
37 "Publish your vCard photo as avatar?"
41 (defvar jabber-vcard-avatars-current-hash
42 (make-hash-table :test
'equal
)
43 "For each connection, SHA1 hash of current avatar.
46 (add-to-list 'jabber-presence-chain
'jabber-vcard-avatars-presence
)
47 (defun jabber-vcard-avatars-presence (jc xml-data
)
48 "Look for vCard avatar mark in <presence/> stanza."
49 ;; Only look at ordinary presence
50 (when (and jabber-vcard-avatars-retrieve
51 (null (jabber-xml-get-attribute xml-data
'type
)))
52 (let* ((from (jabber-jid-user (jabber-xml-get-attribute xml-data
'from
)))
53 (photo (jabber-xml-path xml-data
'(("vcard-temp:x:update" .
"x") photo
)))
54 (sha1-hash (car (jabber-xml-node-children photo
))))
57 ;; User has removed avatar
58 (jabber-avatar-set from nil
))
59 ((string= sha1-hash
(get (jabber-jid-symbol from
) 'avatar-hash
))
60 ;; Same avatar as before; do nothing
62 ((jabber-avatar-find-cached sha1-hash
)
64 (jabber-avatar-set from sha1-hash
))
66 ;; Avatar is not cached; retrieve it
67 (jabber-vcard-avatars-fetch jc from sha1-hash
))))))
69 (defun jabber-vcard-avatars-fetch (jc who sha1-hash
)
70 "Fetch WHO's vCard, and extract avatar."
71 (interactive (list (jabber-read-account)
72 (jabber-read-jid-completing "Fetch whose vCard avatar: ")
74 (jabber-send-iq jc who
"get" '(vCard ((xmlns .
"vcard-temp")))
75 #'jabber-vcard-avatars-vcard
(cons who sha1-hash
)
78 (defun jabber-vcard-avatars-vcard (jc iq closure
)
79 "Get the photo from the vCard, and set the avatar."
80 (let ((from (car closure
))
81 (sha1-hash (cdr closure
))
82 (photo (assq 'PHOTO
(jabber-vcard-parse (jabber-iq-query iq
)))))
84 (let ((avatar (jabber-avatar-from-base64-string (nth 2 photo
)
86 (unless (or (null sha1-hash
)
87 (string= sha1-hash
(avatar-sha1-sum avatar
)))
88 (when jabber-avatar-verbose
89 (message "%s's avatar should have SHA1 sum %s, but has %s"
90 (jabber-jid-displayname from
)
92 (avatar-sha1-sum avatar
))))
93 (jabber-avatar-cache avatar
)
94 (jabber-avatar-set from avatar
))
95 (jabber-avatar-set from nil
))))
97 (defun jabber-vcard-avatars-find-current (jc)
98 "Request our own vCard, to find hash of avatar."
99 (when jabber-vcard-avatars-publish
100 (jabber-send-iq jc nil
"get" '(vCard ((xmlns .
"vcard-temp")))
101 #'jabber-vcard-avatars-find-current-1 t
102 #'jabber-vcard-avatars-find-current-1 nil
)))
104 (defun jabber-vcard-avatars-find-current-1 (jc xml-data success
)
105 (jabber-vcard-avatars-update-current
108 (let ((photo (assq 'PHOTO
(jabber-vcard-parse (jabber-iq-query xml-data
)))))
110 (let ((avatar (jabber-avatar-from-base64-string (nth 2 photo
)
112 (avatar-sha1-sum avatar
)))))))
114 (defun jabber-vcard-avatars-update-current (jc new-hash
)
115 (let ((old-hash (gethash
116 (jabber-connection-bare-jid jc
)
117 jabber-vcard-avatars-current-hash
)))
118 (when (not (string= old-hash new-hash
))
119 (puthash (jabber-connection-bare-jid jc
)
120 new-hash jabber-vcard-avatars-current-hash
)
121 (jabber-send-current-presence jc
))))
123 (add-to-list 'jabber-presence-element-functions
'jabber-vcard-avatars-presence-element
)
124 (defun jabber-vcard-avatars-presence-element (jc)
125 (when jabber-vcard-avatars-publish
127 (jabber-connection-bare-jid jc
)
128 jabber-vcard-avatars-current-hash
)))
130 `(x ((xmlns .
"vcard-temp:x:update"))
131 ;; if "not yet ready to advertise image", don't.
132 ;; that is, we haven't yet checked what avatar we have.
134 `(photo () ,hash
)))))))
136 (provide 'jabber-vcard-avatars
)
137 ;; arch-tag: 3e50d460-8eae-11da-826c-000a95c2fcd0