djavu-asus/emacs/elpa/jabber-20230715.456/jabber-vcard-avatars.el

   1 ;;; jabber-vcard-avatars.el --- Avatars by JEP-0153  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2006, 2007, 2008  Magnus Henoch
   4
   5 ;; Author: Magnus Henoch <mange@freemail.hu>
   6
   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)
  10 ;; any later version.
  11
  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.
  16
  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.
  21
  22 ;;; Commentary:
  23
  24 ;;
  25
  26 ;;; Code:
  27
  28 (require 'jabber-avatar)
  29
  30 (defcustom jabber-vcard-avatars-retrieve (and (fboundp 'display-images-p)
  31                                               (display-images-p))
  32   "Automatically download vCard avatars?"
  33   :group 'jabber-avatar
  34   :type 'boolean)
  35
  36 (defcustom jabber-vcard-avatars-publish t
  37   "Publish your vCard photo as avatar?"
  38   :group 'jabber-avatar
  39   :type 'boolean)
  40
  41 (defvar jabber-vcard-avatars-current-hash
  42   (make-hash-table :test 'equal)
  43   "For each connection, SHA1 hash of current avatar.
  44 Keys are full JIDs.")
  45
  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
  50 JC is the Jabber connection.
  51 XML-DATA is the parsed tree data from the stream (stanzas)
  52 obtained from `xml-parse-region'."
  53   ;; Only look at ordinary presence
  54   (when (and jabber-vcard-avatars-retrieve
  55              (null (jabber-xml-get-attribute xml-data 'type)))
  56     (let* ((from (jabber-jid-user (jabber-xml-get-attribute xml-data 'from)))
  57            (photo (jabber-xml-path xml-data '(("vcard-temp:x:update" . "x") photo)))
  58            (sha1-hash (car (jabber-xml-node-children photo))))
  59       (cond
  60        ((null sha1-hash)
  61         ;; User has removed avatar
  62         (jabber-avatar-set from nil))
  63        ((string= sha1-hash (get (jabber-jid-symbol from) 'avatar-hash))
  64         ;; Same avatar as before; do nothing
  65         )
  66        ((jabber-avatar-find-cached sha1-hash)
  67         ;; Avatar is cached
  68         (jabber-avatar-set from sha1-hash))
  69        (t
  70         ;; Avatar is not cached; retrieve it
  71         (jabber-vcard-avatars-fetch jc from sha1-hash))))))
  72
  73 (defun jabber-vcard-avatars-fetch (jc jid sha1-hash)
  74   "Fetch vCard for JID and extract the avatar.
  75
  76 JC is the Jabber connection."
  77   (interactive (list (jabber-read-account)
  78                      (jabber-read-jid-completing "Fetch whose vCard avatar: ")
  79                      nil))
  80   (jabber-send-iq jc jid "get" '(vCard ((xmlns . "vcard-temp")))
  81                   #'jabber-vcard-avatars-vcard (cons jid sha1-hash)
  82                   #'ignore nil))
  83
  84 (defun jabber-vcard-avatars-vcard (jc iq closure)
  85   "Get the photo from the vCard, and set the avatar."
  86   (let ((from (car closure))
  87         (sha1-hash (cdr closure))
  88         (photo (assq 'PHOTO (jabber-vcard-parse (jabber-iq-query iq)))))
  89     (if photo
  90         (let ((avatar (jabber-avatar-from-base64-string (nth 2 photo)
  91                                                         (nth 1 photo))))
  92           (unless (or (null sha1-hash)
  93                       (string= sha1-hash (avatar-sha1-sum avatar)))
  94             (when jabber-avatar-verbose
  95               (message "%s's avatar should have SHA1 sum %s, but has %s"
  96                        (jabber-jid-displayname from)
  97                        sha1-hash
  98                        (avatar-sha1-sum avatar))))
  99           (jabber-avatar-cache avatar)
 100           (jabber-avatar-set from avatar))
 101       (jabber-avatar-set from nil))))
 102
 103 (defun jabber-vcard-avatars-find-current (jc)
 104   "Request our own vCard, to find hash of avatar.
 105
 106 JC is the Jabber connection."
 107   (when jabber-vcard-avatars-publish
 108     (jabber-send-iq jc nil "get" '(vCard ((xmlns . "vcard-temp")))
 109                     #'jabber-vcard-avatars-find-current-1 t
 110                     #'jabber-vcard-avatars-find-current-1 nil)))
 111
 112 (defun jabber-vcard-avatars-find-current-1 (jc xml-data success)
 113   (jabber-vcard-avatars-update-current
 114    jc
 115    (and success
 116         (let ((photo (assq 'PHOTO (jabber-vcard-parse (jabber-iq-query xml-data)))))
 117           (when photo
 118             (let ((avatar (jabber-avatar-from-base64-string (nth 2 photo)
 119                                                             (nth 1 photo))))
 120               (avatar-sha1-sum avatar)))))))
 121
 122 (defun jabber-vcard-avatars-update-current (jc new-hash)
 123   (let ((old-hash (gethash
 124                    (jabber-connection-bare-jid jc)
 125                    jabber-vcard-avatars-current-hash)))
 126     (when (not (string= old-hash new-hash))
 127       (puthash (jabber-connection-bare-jid jc)
 128                new-hash jabber-vcard-avatars-current-hash)
 129       (jabber-send-current-presence jc))))
 130
 131 (add-to-list 'jabber-presence-element-functions 'jabber-vcard-avatars-presence-element)
 132 (defun jabber-vcard-avatars-presence-element (jc)
 133   (when jabber-vcard-avatars-publish
 134     (let ((hash (gethash
 135                  (jabber-connection-bare-jid jc)
 136                  jabber-vcard-avatars-current-hash)))
 137       (list
 138        `(x ((xmlns . "vcard-temp:x:update"))
 139            ;; if "not yet ready to advertise image", don't.
 140            ;; that is, we haven't yet checked what avatar we have.
 141            ,(when hash
 142               `(photo () ,hash)))))))
 143
 144 (provide 'jabber-vcard-avatars)
 145 ;; arch-tag: 3e50d460-8eae-11da-826c-000a95c2fcd0