Function: mh-picon-get-image

mh-picon-get-image is a byte-compiled function defined in mh-xface.el.gz.

Signature

(mh-picon-get-image)

Documentation

Find the best possible match and return contents.

Source Code

;; Defined in /usr/src/emacs/lisp/mh-e/mh-xface.el.gz
(defun mh-picon-get-image ()
  "Find the best possible match and return contents."
  (mh-picon-set-directory-list)
  (save-restriction
    (let* ((from-field (ignore-errors (car (message-tokenize-header
                                            (mh-get-header-field "from:")))))
           (from (car (ignore-errors
                        (mail-header-parse-address from-field))))
           (host (and from
                      (string-match "\\([^+]*\\)\\(\\+.*\\)?@\\(.*\\)" from)
                      (downcase (match-string 3 from))))
           (user (and host (downcase (match-string 1 from))))
           (canonical-address (format "%s@%s" user host))
           (cached-value (gethash canonical-address mh-picon-cache))
           (host-list (and host (delete "" (split-string host "\\.")))))
      (cond
       (cached-value cached-value)
       ((not host-list) nil)
       (t
        (let ((match
               (cl-block loop
                 ;; u@h search
                 (dolist (dir mh-picon-existing-directory-list)
                   (cl-loop for type in mh-picon-image-types
                            ;; [path]user@host
                            for file1 = (format "%s/%s.%s"
                                                dir canonical-address type)
                            when (file-exists-p file1)
                            do (cl-return-from loop file1)
                            ;; [path]user
                            for file2 = (format "%s/%s.%s" dir user type)
                            when (file-exists-p file2)
                            do (cl-return-from loop file2)
                            ;; [path]host
                            for file3 = (format "%s/%s.%s" dir host type)
                            when (file-exists-p file3)
                            do (cl-return-from loop file3)))
                 ;; facedb search
                 ;; Search order for user@foo.net:
                 ;;   [path]net/foo/user
                 ;;   [path]net/foo/user/face
                 ;;   [path]net/user
                 ;;   [path]net/user/face
                 ;;   [path]net/foo/unknown
                 ;;   [path]net/foo/unknown/face
                 ;;   [path]net/unknown
                 ;;   [path]net/unknown/face
                 (dolist (u (list user "unknown"))
                   (dolist (dir mh-picon-existing-directory-list)
                     (cl-loop for x on host-list by #'cdr
                              for y = (mh-picon-generate-path x u dir)
                              do (cl-loop for type in mh-picon-image-types
                                          for z1 = (format "%s.%s" y type)
                                          when (file-exists-p z1)
                                          do (cl-return-from loop z1)
                                          for z2 = (format "%s/face.%s"
                                                           y type)
                                          when (file-exists-p z2)
                                          do (cl-return-from loop z2))))))))
          (setf (gethash canonical-address mh-picon-cache)
                (mh-picon-file-contents match))))))))