X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fshr.el;h=e5bd5b0aeb7bbc1244380f4696397e81531bb916;hb=c8b66408c77cef31df1a874a2751d0a025d1c327;hp=9acb557ec6e0e58740c121f4af753310ea068267;hpb=bf9d34407b6ba1fdd35573efeb8f4de213273421;p=gnus diff --git a/lisp/shr.el b/lisp/shr.el index 9acb557ec..e5bd5b0ae 100644 --- a/lisp/shr.el +++ b/lisp/shr.el @@ -30,6 +30,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'browse-url) (defgroup shr nil @@ -52,14 +53,31 @@ fit these criteria." :group 'shr :type 'regexp) +(defcustom shr-table-line ?- + "Character used to draw table line." + :group 'shr + :type 'character) + +(defcustom shr-table-corner ?+ + "Character used to draw table corner." + :group 'shr + :type 'character) + +(defcustom shr-hr-line ?- + "Character used to draw hr line." + :group 'shr + :type 'character) + +(defcustom shr-width fill-column + "Frame width to use for rendering." + :type 'integer + :group 'shr) + (defvar shr-content-function nil "If bound, this should be a function that will return the content. This is used for cid: URLs, and the function is called with the cid: URL as the argument.") -(defvar shr-width 70 - "Frame width to use for rendering.") - ;;; Internal variables. (defvar shr-folding-mode nil) @@ -177,7 +195,8 @@ redirects somewhere else." (shr-descend sub))))) (defun shr-insert (text) - (when (eq shr-state 'image) + (when (and (eq shr-state 'image) + (not (string-match "\\`[ \t\n]+\\'" text))) (insert "\n") (setq shr-state nil)) (cond @@ -187,7 +206,8 @@ redirects somewhere else." (let ((first t) column) (when (and (string-match "\\`[ \t\n]" text) - (not (bolp))) + (not (bolp)) + (not (eq (char-after (1- (point))) ? ))) (insert " ")) (dolist (elem (split-string text)) (when (and (bolp) @@ -199,8 +219,8 @@ redirects somewhere else." (unless shr-start (setq shr-start (point))) (insert elem) - (when (> (current-column) shr-width) - (if (not (search-backward " " (line-beginning-position) t)) + (while (> (current-column) shr-width) + (if (not (shr-find-fill-point)) (insert "\n") (delete-char 1) (insert "\n") @@ -212,13 +232,26 @@ redirects somewhere else." (unless (string-match "[ \t\n]\\'" text) (delete-char -1)))))) +(defun shr-find-fill-point () + (let ((found nil)) + (while (and (not found) + (> (current-column) shr-indentation)) + (when (and (or (eq (preceding-char) ? ) + (aref fill-find-break-point-function-table + (preceding-char))) + (<= (current-column) shr-width)) + (setq found (point))) + (backward-char 1)) + (or found + (end-of-line)))) + (defun shr-ensure-newline () (unless (zerop (current-column)) (insert "\n"))) (defun shr-ensure-paragraph () (unless (bobp) - (if (bolp) + (if (<= (current-column) shr-indentation) (unless (save-excursion (forward-line -1) (looking-at " *$")) @@ -230,7 +263,8 @@ redirects somewhere else." (insert "\n\n"))))) (defun shr-indent () - (insert (make-string shr-indentation ? ))) + (when (> shr-indentation 0) + (insert (make-string shr-indentation ? )))) (defun shr-fontize-cont (cont &rest types) (let (shr-start) @@ -305,7 +339,7 @@ Return a string with image data." (with-temp-buffer (mm-disable-multibyte) (when (ignore-errors - (url-cache-extract (url-cache-create-filename url)) + (url-cache-extract (url-cache-create-filename (shr-encode-url url))) t) (when (or (search-forward "\n\n" nil t) (search-forward "\r\n\r\n" nil t)) @@ -320,6 +354,7 @@ Return a string with image data." (defun shr-tag-p (cont) (shr-ensure-paragraph) + (shr-indent) (shr-generic cont) (shr-ensure-paragraph)) @@ -344,24 +379,49 @@ Return a string with image data." shr-start) (shr-generic cont) (widget-convert-button - 'link (or shr-start start) (point) - :help-echo url) - (put-text-property (or shr-start start) (point) 'keymap shr-map) + 'url-link (or shr-start start) (point) + :help-echo url + :keymap shr-map + url) (put-text-property (or shr-start start) (point) 'shr-url url))) +(defun shr-encode-url (url) + "Encode URL." + (browse-url-url-encode-chars url "[)$ ]")) + (defun shr-tag-img (cont) (when (and (> (current-column) 0) (not (eq shr-state 'image))) (insert "\n")) - (let ((start (point-marker))) - (let ((alt (cdr (assq :alt cont))) - (url (cdr (assq :src cont)))) + (let ((alt (cdr (assq :alt cont))) + (url (cdr (assq :src cont))) + (width (cdr (assq :width cont)))) + ;; Only respect align if width specified. + (when width + ;; Check that width is not larger than max width, otherwise ignore + ;; align + (let ((max-width (* shr-width (frame-char-width))) + (width (string-to-number width))) + (when (< width max-width) + (let ((align (cdr (assq :align cont)))) + (cond + ((string= align "right") + (insert (propertize + " " 'display + `(space . (:align-to + ,(list (- max-width width))))))) + ((string= align "center") + (insert (propertize + " " 'display + `(space . (:balign-to + ,(list (- (/ max-width 2) width)))))))))))) + (let ((start (point-marker))) (when (zerop (length alt)) - (setq alt "[img]")) + (setq alt "[img]")) (cond ((and (not shr-inhibit-images) - (string-match "\\`cid:" url)) - (let ((url (substring url (match-end 0))) + (string-match "\\`cid:" url)) + (let ((url (substring url (match-end 0))) image) (if (or (not shr-content-function) (not (setq image (funcall shr-content-function url)))) @@ -375,12 +435,12 @@ Return a string with image data." (if (> (length alt) 8) (shr-insert (substring alt 0 8)) (shr-insert alt)))) - ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]")) + ((url-is-cached (shr-encode-url url)) (shr-put-image (shr-get-image-data url) (point) alt)) (t (insert alt) (ignore-errors - (url-retrieve url 'shr-image-fetched + (url-retrieve (shr-encode-url url) 'shr-image-fetched (list (current-buffer) start (point-marker)) t)))) (insert " ") @@ -392,11 +452,13 @@ Return a string with image data." (defun shr-tag-pre (cont) (let ((shr-folding-mode 'none)) (shr-ensure-newline) + (shr-indent) (shr-generic cont) (shr-ensure-newline))) (defun shr-tag-blockquote (cont) (shr-ensure-paragraph) + (shr-indent) (let ((shr-indentation (+ shr-indentation 4))) (shr-generic cont)) (shr-ensure-paragraph)) @@ -404,14 +466,18 @@ Return a string with image data." (defun shr-tag-ul (cont) (shr-ensure-paragraph) (let ((shr-list-mode 'ul)) - (shr-generic cont))) + (shr-generic cont)) + (shr-ensure-paragraph)) (defun shr-tag-ol (cont) + (shr-ensure-paragraph) (let ((shr-list-mode 1)) - (shr-generic cont))) + (shr-generic cont)) + (shr-ensure-paragraph)) (defun shr-tag-li (cont) - (shr-ensure-newline) + (shr-ensure-paragraph) + (shr-indent) (let* ((bullet (if (numberp shr-list-mode) (prog1 @@ -424,7 +490,8 @@ Return a string with image data." (defun shr-tag-br (cont) (unless (bobp) - (insert "\n")) + (insert "\n") + (shr-indent)) (shr-generic cont)) (defun shr-tag-h1 (cont) @@ -445,6 +512,10 @@ Return a string with image data." (defun shr-tag-h6 (cont) (shr-heading cont)) +(defun shr-tag-hr (cont) + (shr-ensure-newline) + (insert (make-string shr-width shr-hr-line) "\n")) + ;;; Table rendering algorithm. ;; Table rendering is the only complicated thing here. We do this by @@ -504,16 +575,15 @@ Return a string with image data." overlay overlay-line) (dolist (line lines) (setq overlay-line (pop overlay-lines)) - (when (> (length line) 0) - (end-of-line) - (insert line "|") - (dolist (overlay overlay-line) - (let ((o (make-overlay (- (point) (nth 0 overlay) 1) - (- (point) (nth 1 overlay) 1))) - (properties (nth 2 overlay))) - (while properties - (overlay-put o (pop properties) (pop properties))))) - (forward-line 1))) + (end-of-line) + (insert line "|") + (dolist (overlay overlay-line) + (let ((o (make-overlay (- (point) (nth 0 overlay) 1) + (- (point) (nth 1 overlay) 1))) + (properties (nth 2 overlay))) + (while properties + (overlay-put o (pop properties) (pop properties))))) + (forward-line 1)) ;; Add blank lines at padding at the bottom of the TD, ;; possibly. (dotimes (i (- height (length lines))) @@ -524,9 +594,9 @@ Return a string with image data." (defun shr-insert-table-ruler (widths) (shr-indent) - (insert "+") + (insert shr-table-corner) (dotimes (i (length widths)) - (insert (make-string (aref widths i) ?-) ?+)) + (insert (make-string (aref widths i) shr-table-line) shr-table-corner)) (insert "\n")) (defun shr-table-widths (table suggested-widths) @@ -541,8 +611,8 @@ Return a string with image data." (aset natural-widths i (max (aref natural-widths i) (cadr column))) (setq i (1+ i))))) - (let ((extra (- (reduce '+ suggested-widths) - (reduce '+ widths))) + (let ((extra (- (apply '+ (append suggested-widths nil)) + (apply '+ (append widths nil)))) (expanded-columns 0)) (when (> extra 0) (dotimes (i length)