X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fshr.el;h=deaef1d3f252f2f5f8e70bfa8329c930b7603462;hb=e73012620ed0ef460469ccbf54c3a982f10504ef;hp=ddf47f4ed1416c162d6300f5e0d0fa2afb093dd2;hpb=13c8334616707c9071c4617e67f255902ee80ce9;p=gnus diff --git a/lisp/shr.el b/lisp/shr.el index ddf47f4ed..deaef1d3f 100644 --- a/lisp/shr.el +++ b/lisp/shr.el @@ -1,6 +1,6 @@ ;;; shr.el --- Simple HTML Renderer -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010-2012 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: html @@ -53,17 +53,17 @@ fit these criteria." :group 'shr :type 'regexp) -(defcustom shr-table-horizontal-line ? +(defcustom shr-table-horizontal-line ?\s "Character used to draw horizontal table lines." :group 'shr :type 'character) -(defcustom shr-table-vertical-line ? +(defcustom shr-table-vertical-line ?\s "Character used to draw vertical table lines." :group 'shr :type 'character) -(defcustom shr-table-corner ? +(defcustom shr-table-corner ?\s "Character used to draw table corners." :group 'shr :type 'character) @@ -128,22 +128,41 @@ cid: URL as the argument.") ;; Public functions and commands. (defun shr-visit-file (file) + "Parse FILE as an HTML document, and render it in a new buffer." (interactive "fHTML file name: ") (pop-to-buffer "*html*") (erase-buffer) (shr-insert-document (with-temp-buffer (insert-file-contents file) - (libxml-parse-html-region (point-min) (point-max))))) + (libxml-parse-html-region (point-min) (point-max)))) + (goto-char (point-min))) ;;;###autoload (defun shr-insert-document (dom) + "Render the parsed document DOM into the current buffer. +DOM should be a parse tree as generated by +`libxml-parse-html-region' or similar." (setq shr-content-cache nil) - (let ((shr-state nil) + (let ((start (point)) + (shr-state nil) (shr-start nil) (shr-base nil) (shr-width (or shr-width (window-width)))) - (shr-descend (shr-transform-dom dom)))) + (shr-descend (shr-transform-dom dom)) + (shr-remove-trailing-whitespace start (point)))) + +(defun shr-remove-trailing-whitespace (start end) + (save-restriction + (narrow-to-region start end) + (delete-trailing-whitespace) + (goto-char start) + (while (not (eobp)) + (end-of-line) + (dolist (overlay (overlays-at (point))) + (when (overlay-get overlay 'before-string) + (overlay-put overlay 'before-string nil))) + (forward-line 1)))) (defun shr-copy-url () "Copy the URL under point to the kill ring. @@ -479,7 +498,7 @@ the URL of the image to the kill buffer instead." ((not url) (message "No link under point")) ((string-match "^mailto:" url) - (browse-url-mailto url)) + (browse-url-mail url)) (t (browse-url url))))) @@ -534,38 +553,38 @@ the URL of the image to the kill buffer instead." (insert alt))) (defun shr-rescale-image (data) - (if (or (not (fboundp 'imagemagick-types)) - (not (get-buffer-window (current-buffer)))) - (create-image data nil t - :ascent 100) - (let* ((image (create-image data nil t :ascent 100)) - (size (image-size image t)) - (width (car size)) - (height (cdr size)) - (edges (window-inside-pixel-edges - (get-buffer-window (current-buffer)))) - (window-width (truncate (* shr-max-image-proportion - (- (nth 2 edges) (nth 0 edges))))) - (window-height (truncate (* shr-max-image-proportion - (- (nth 3 edges) (nth 1 edges))))) - scaled-image) - (when (> height window-height) - (setq image (or (create-image data 'imagemagick t - :height window-height) - image)) - (setq size (image-size image t))) - (when (> (car size) window-width) - (setq image (or - (create-image data 'imagemagick t - :width window-width - :ascent 100) - image))) - image))) + (let ((image (create-image data nil t :ascent 100))) + (if (or (not (fboundp 'imagemagick-types)) + (not (get-buffer-window (current-buffer)))) + image + (let* ((size (image-size image t)) + (width (car size)) + (height (cdr size)) + (edges (window-inside-pixel-edges + (get-buffer-window (current-buffer)))) + (window-width (truncate (* shr-max-image-proportion + (- (nth 2 edges) (nth 0 edges))))) + (window-height (truncate (* shr-max-image-proportion + (- (nth 3 edges) (nth 1 edges))))) + scaled-image) + (when (> height window-height) + (setq image (or (create-image data 'imagemagick t + :height window-height + :ascent 100) + image)) + (setq size (image-size image t))) + (when (> (car size) window-width) + (setq image (or + (create-image data 'imagemagick t + :width window-width + :ascent 100) + image))) + image)))) ;; url-cache-extract autoloads url-cache. (declare-function url-cache-create-filename "url-cache" (url)) (autoload 'mm-disable-multibyte "mm-util") -(autoload 'browse-url-mailto "browse-url") +(autoload 'browse-url-mail "browse-url") (defun shr-get-image-data (url) "Get image data for URL. @@ -583,7 +602,7 @@ Return a string with image data." "Return a function to display an image. CONTENT-FUNCTION is a function to retrieve an image for a cid url that is an argument. The function to be returned takes three arguments URL, -START, and END. Note that START and END should be merkers." +START, and END. Note that START and END should be markers." `(lambda (url start end) (when url (if (string-match "\\`cid:" url) @@ -914,12 +933,13 @@ ones, in case fg and bg are nil." (shr-encode-url url) 'shr-image-fetched (list (current-buffer) start (set-marker (make-marker) (1- (point)))) t))) - (put-text-property start (point) 'keymap shr-map) - (put-text-property start (point) 'shr-alt alt) - (put-text-property start (point) 'image-url url) - (put-text-property start (point) 'image-displayer - (shr-image-displayer shr-content-function)) - (put-text-property start (point) 'help-echo alt) + (when (zerop shr-table-depth) ;; We are not in a table. + (put-text-property start (point) 'keymap shr-map) + (put-text-property start (point) 'shr-alt alt) + (put-text-property start (point) 'image-url url) + (put-text-property start (point) 'image-displayer + (shr-image-displayer shr-content-function)) + (put-text-property start (point) 'help-echo alt)) (setq shr-state 'image))))) (defun shr-tag-pre (cont)