- (let ((image (make-annotation (mm-get-image handle))))
- (and (< (glyph-width (annotation-glyph image))
- (window-pixel-width))
- (< (glyph-height (annotation-glyph image))
- (window-pixel-height)))))
-
-(defun url-cid (url)
- (set-buffer (get-buffer-create url-working-buffer))
- (let ((content-type nil)
- (encoding nil)
- (part nil)
- (data nil))
- (if (not (string-match "^cid:\\(.*\\)" url))
- (message "Malformed CID URL: %s" url)
- (setq url (url-unhex-string (match-string 1 url))
- part (mm-get-content-id url))
- (if (not part)
- (message "Unknown CID encounterred: %s" url)
- (setq data (buffer-string nil nil (mm-handle-buffer part))
- content-type (mm-handle-type part)
- encoding (symbol-name (mm-handle-encoding part)))
- (if (= 0 (length content-type)) (setq content-type "text/plain"))
- (if (= 0 (length encoding)) (setq encoding "8bit"))
- (setq url-current-content-length (length data)
- url-current-mime-type content-type
- url-current-mime-encoding encoding
- url-current-mime-headers (list (cons "content-type" content-type)
- (cons "content-encoding" encoding)))
- (and data (insert data))))))
+ (let ((image (mm-get-image handle)))
+ (if (fboundp 'glyph-width)
+ ;; XEmacs' glyphs can actually tell us about their width, so
+ ;; lets be nice and smart about them.
+ (or mm-inline-large-images
+ (and (< (glyph-width image) (window-pixel-width))
+ (< (glyph-height image) (window-pixel-height))))
+ (let* ((size (image-size image))
+ (w (car size))
+ (h (cdr size)))
+ (or mm-inline-large-images
+ (and (< h (1- (window-height))) ; Don't include mode line.
+ (< w (window-width))))))))
+
+(defun mm-valid-image-format-p (format)
+ "Say whether FORMAT can be displayed natively by Emacs."
+ (cond
+ ;; Handle XEmacs
+ ((fboundp 'valid-image-instantiator-format-p)
+ (valid-image-instantiator-format-p format))
+ ;; Handle Emacs 21
+ ((fboundp 'image-type-available-p)
+ (and (display-graphic-p)
+ (image-type-available-p format)))
+ ;; Nobody else can do images yet.
+ (t
+ nil)))
+
+(defun mm-valid-and-fit-image-p (format handle)
+ "Say whether FORMAT can be displayed natively and HANDLE fits the window."
+ (and (mm-valid-image-format-p format)
+ (mm-image-fit-p handle)))
+
+(defun mm-find-part-by-type (handles type &optional notp recursive)
+ "Search in HANDLES for part with TYPE.
+If NOTP, returns first non-matching part.
+If RECURSIVE, search recursively."
+ (let (handle)
+ (while handles
+ (if (and recursive (stringp (caar handles)))
+ (if (setq handle (mm-find-part-by-type (cdar handles) type
+ notp recursive))
+ (setq handles nil))
+ (if (if notp
+ (not (equal (mm-handle-media-type (car handles)) type))
+ (equal (mm-handle-media-type (car handles)) type))
+ (setq handle (car handles)
+ handles nil)))
+ (setq handles (cdr handles)))
+ handle))
+
+(defun mm-find-raw-part-by-type (ctl type &optional notp)
+ (goto-char (point-min))
+ (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl
+ 'boundary)))
+ (close-delimiter (concat "^" (regexp-quote boundary) "--[ \t]*$"))
+ start
+ (end (save-excursion
+ (goto-char (point-max))
+ (if (re-search-backward close-delimiter nil t)
+ (match-beginning 0)
+ (point-max))))
+ result)
+ (setq boundary (concat "^" (regexp-quote boundary) "[ \t]*$"))
+ (while (and (not result)
+ (re-search-forward boundary end t))
+ (goto-char (match-beginning 0))
+ (when start
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (1- (point)))
+ (when (let ((ctl (ignore-errors
+ (mail-header-parse-content-type
+ (mail-fetch-field "content-type")))))
+ (if notp
+ (not (equal (car ctl) type))
+ (equal (car ctl) type)))
+ (setq result (buffer-substring (point-min) (point-max)))))))
+ (forward-line 1)
+ (setq start (point)))
+ (when (and (not result) start)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (when (let ((ctl (ignore-errors
+ (mail-header-parse-content-type
+ (mail-fetch-field "content-type")))))
+ (if notp
+ (not (equal (car ctl) type))
+ (equal (car ctl) type)))
+ (setq result (buffer-substring (point-min) (point-max)))))))
+ result))
+
+(defvar mm-security-handle nil)
+
+(defsubst mm-set-handle-multipart-parameter (handle parameter value)
+ ;; HANDLE could be a CTL.
+ (if handle
+ (put-text-property 0 (length (car handle)) parameter value
+ (car handle))))
+
+(defun mm-possibly-verify-or-decrypt (parts ctl)
+ (let ((subtype (cadr (split-string (car ctl) "/")))
+ (mm-security-handle ctl) ;; (car CTL) is the type.
+ protocol func functest)
+ (cond
+ ((equal subtype "signed")
+ (unless (and (setq protocol
+ (mm-handle-multipart-ctl-parameter ctl 'protocol))
+ (not (equal protocol "multipart/mixed")))
+ ;; The message is broken or draft-ietf-openpgp-multsig-01.
+ (let ((protocols mm-verify-function-alist))
+ (while protocols
+ (if (and (or (not (setq functest (nth 3 (car protocols))))
+ (funcall functest parts ctl))
+ (mm-find-part-by-type parts (caar protocols) nil t))
+ (setq protocol (caar protocols)
+ protocols nil)
+ (setq protocols (cdr protocols))))))
+ (setq func (nth 1 (assoc protocol mm-verify-function-alist)))
+ (if (cond
+ ((eq mm-verify-option 'never) nil)
+ ((eq mm-verify-option 'always) t)
+ ((eq mm-verify-option 'known)
+ (and func
+ (or (not (setq functest
+ (nth 3 (assoc protocol
+ mm-verify-function-alist))))
+ (funcall functest parts ctl))))
+ (t (y-or-n-p
+ (format "Verify signed (%s) part? "
+ (or (nth 2 (assoc protocol mm-verify-function-alist))
+ (format "protocol=%s" protocol))))))
+ (save-excursion
+ (if func
+ (funcall func parts ctl)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (format "Unknown sign protocol (%s)" protocol))))))
+ ((equal subtype "encrypted")
+ (unless (setq protocol
+ (mm-handle-multipart-ctl-parameter ctl 'protocol))
+ ;; The message is broken.
+ (let ((parts parts))
+ (while parts
+ (if (assoc (mm-handle-media-type (car parts))
+ mm-decrypt-function-alist)
+ (setq protocol (mm-handle-media-type (car parts))
+ parts nil)
+ (setq parts (cdr parts))))))
+ (setq func (nth 1 (assoc protocol mm-decrypt-function-alist)))
+ (if (cond
+ ((eq mm-decrypt-option 'never) nil)
+ ((eq mm-decrypt-option 'always) t)
+ ((eq mm-decrypt-option 'known)
+ (and func
+ (or (not (setq functest
+ (nth 3 (assoc protocol
+ mm-decrypt-function-alist))))
+ (funcall functest parts ctl))))
+ (t (y-or-n-p
+ (format "Decrypt (%s) part? "
+ (or (nth 2 (assoc protocol mm-decrypt-function-alist))
+ (format "protocol=%s" protocol))))))
+ (save-excursion
+ (if func
+ (setq parts (funcall func parts ctl))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (format "Unknown encrypt protocol (%s)" protocol))))))
+ (t nil))
+ parts))
+
+(defun mm-multiple-handles (handles)
+ (and (listp (car handles))
+ (> (length handles) 1)))
+
+(defun mm-merge-handles (handles1 handles2)
+ (append
+ (if (listp (car handles1))
+ handles1
+ (list handles1))
+ (if (listp (car handles2))
+ handles2
+ (list handles2))))