Function: rmail-mime-insert-bulk

rmail-mime-insert-bulk is a byte-compiled function defined in rmailmm.el.gz.

Signature

(rmail-mime-insert-bulk ENTITY)

Documentation

Presentation handler for an attachment MIME entity.

Source Code

;; Defined in /usr/src/emacs/lisp/mail/rmailmm.el.gz
(defun rmail-mime-insert-bulk (entity)
  "Presentation handler for an attachment MIME entity."
  (let* ((content-type (rmail-mime-entity-type entity))
	 (content-disposition (rmail-mime-entity-disposition entity))
	 (current (aref (rmail-mime-entity-display entity) 0))
	 (new (aref (rmail-mime-entity-display entity) 1))
	 (header (rmail-mime-entity-header entity))
	 (tagline (rmail-mime-entity-tagline entity))
	 (bulk-data (aref tagline 1))
	 (body (rmail-mime-entity-body entity))
	 ;; Find the default directory for this media type.
	 (directory (or (catch 'directory
			  (dolist (entry rmail-mime-attachment-dirs-alist)
			    (when (string-match (car entry) (car content-type))
			      (dolist (dir (cdr entry))
				(when (file-directory-p dir)
				  (throw 'directory dir))))))
			"~"))
	 (filename (or (cdr (assq 'name (cdr content-type)))
		       (cdr (assq 'filename (cdr content-disposition)))
		       "noname"))
	 (units '(B kB MB GB))
	 (segment (rmail-mime-entity-segment (point) entity))
	 beg data size)

    (if (or (integerp (aref body 0)) (markerp (aref body 0)))
	(setq data entity
	      size (car bulk-data))
      (if (stringp (aref body 0))
	  (setq data (aref body 0))
	(setq data (buffer-string))
        (cl-assert (not (multibyte-string-p data)))
	(aset body 0 data)
	(rmail-mime-set-bulk-data entity)
	(delete-region (point-min) (point-max)))
      (setq size (length data)))
    (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
		(cdr units))
      (setq size (/ size 1024.0)
	    units (cdr units)))

    (setq beg (point))

    ;; header
    (if (eq (rmail-mime-display-header current)
	    (rmail-mime-display-header new))
	(goto-char (aref segment 2))
      (if (rmail-mime-display-header current)
	  (delete-char (- (aref segment 2) (aref segment 1))))
      (if (rmail-mime-display-header new)
	  (rmail-mime-insert-header header)))

    ;; tagline
    (if (eq (rmail-mime-display-tagline current)
	    (rmail-mime-display-tagline new))
	(if (or (not (rmail-mime-display-tagline current))
		(eq (rmail-mime-display-body current)
		    (rmail-mime-display-body new)))
	    (forward-char (- (aref segment 3) (aref segment 2)))
	  (rmail-mime-update-tagline entity))
      (if (rmail-mime-display-tagline current)
	  (delete-char (- (aref segment 3) (aref segment 2))))
      (if (rmail-mime-display-tagline new)
	  (rmail-mime-insert-tagline
	   entity
	   " Save:"
	   (list filename
		 :type 'rmail-mime-save
		 'help-echo "mouse-2, RET: Save attachment"
		 'filename filename
		 'directory (file-name-as-directory directory)
		 'data data)
	   (format " (%.0f%s)" size (car units))
	   ;; We don't need this button because the "type" string of a
	   ;; tagline is the button to do this.
	   ;; (if (cdr bulk-data)
	   ;;     " ")
	   ;; (if (cdr bulk-data)
	   ;;     (list "Toggle show/hide"
	   ;;        :type 'rmail-mime-image
	   ;;        'help-echo "mouse-2, RET: Toggle show/hide"
	   ;;        'image-type (cdr bulk-data)
	   ;;        'image-data data))
	   )))
    ;; body
    (if (eq (rmail-mime-display-body current)
	    (rmail-mime-display-body new))
	(forward-char (- (aref segment 4) (aref segment 3)))
      (if (rmail-mime-display-body current)
	  (delete-char (- (aref segment 4) (aref segment 3))))
      (if (rmail-mime-display-body new)
	  (cond ((eq (cdr bulk-data) 'text)
		 (rmail-mime-insert-decoded-text entity))
		((eq (cdr bulk-data) 'html)
		 ;; Render HTML if display single message, but if searching
		 ;; don't render but just search HTML itself.
		 (if rmail-mime-searching
		     (rmail-mime-insert-decoded-text entity)
		   (rmail-mime-insert-html entity)))
		((cdr bulk-data)
		 (rmail-mime-insert-image entity))
		(t
		 ;; As we don't know how to display the body, just
		 ;; insert it as a text.
		 (rmail-mime-insert-decoded-text entity)))))
    (put-text-property beg (point) 'rmail-mime-entity entity)))