Function: mm-shr

mm-shr is a byte-compiled function defined in mm-decode.el.gz.

Signature

(mm-shr HANDLE)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/mm-decode.el.gz
(defun mm-shr (handle)
  ;; Require since we bind its variables.
  (require 'shr)
  (let ((shr-width (if shr-use-fonts
		       shr-width
		     fill-column))
	(shr-content-function (lambda (id)
				(let ((handle (mm-get-content-id id)))
				  (when handle
				    (mm-with-part handle
				      (buffer-string))))))
	(shr-inhibit-images mm-html-inhibit-images)
	(shr-blocked-images mm-html-blocked-images)
	charset coding char document)
    (mm-with-part (or handle (setq handle (mm-dissect-buffer t)))
      (setq case-fold-search t)
      (or (setq charset
		(mail-content-type-get (mm-handle-type handle) 'charset))
	  (progn
	    (goto-char (point-min))
	    (and (re-search-forward "\
<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']?\
text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t)
		 (setq coding (mm-charset-to-coding-system (match-string 1)
							   nil t))))
	  (setq charset mail-parse-charset))
      (when (and (or coding
		     (setq coding (mm-charset-to-coding-system charset nil t)))
		 (not (eq coding 'ascii)))
	(insert (prog1
		    (decode-coding-string (buffer-string) coding)
		  (erase-buffer)
		  (set-buffer-multibyte t))))
      (goto-char (point-min))
      (while (re-search-forward
	      "&#\\(?:x\\([89][0-9a-f]\\)\\|\\(1[2-5][0-9]\\)\\);" nil t)
	(when (setq char
		    (cdr (assq (if (match-beginning 1)
				   (string-to-number (match-string 1) 16)
				 (string-to-number (match-string 2)))
			       mm-extra-numeric-entities)))
	  (replace-match (char-to-string char))))
      ;; Remove "soft hyphens".
      (goto-char (point-min))
      (while (search-forward "­" nil t)
	(replace-match "" t t))
      (setq document (libxml-parse-html-region (point-min) (point-max))))
    (save-restriction
      (narrow-to-region (point) (point))
      (shr-insert-document document)
      (unless (bobp)
	(insert "\n"))
      (mm-handle-set-undisplayer
       handle
       (let ((min (point-min-marker))
             (max (point-max-marker)))
         (lambda ()
	   (let ((inhibit-read-only t))
	     (delete-region min max))))))))