X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fshr.el;h=2dc85281ed473f99a00a668996df656af4f5b5e2;hp=8434d0b66b5ca9b9649ff2e75fa92a2ce8710833;hb=7231ea9d8f2c660dccf4e78bffa9b19eba3a8839;hpb=a994ad04381a8c1ff6e9b333e7f211fbbbbb4d3a diff --git a/lisp/shr.el b/lisp/shr.el index 8434d0b66..2dc85281e 100644 --- a/lisp/shr.el +++ b/lisp/shr.el @@ -202,12 +202,11 @@ redirects somewhere else." (if (fboundp function) (funcall function (cdr dom)) (shr-generic (cdr dom))) - (let ((color (cdr (assq 'color shr-stylesheet))) - (background (cdr (assq 'background-color shr-stylesheet)))) - (when (and style - shr-stylesheet - (or color background)) - (shr-colorize-region start (point) color background))))) + ;; If style is set, then this node has set the color. + (when style + (shr-colorize-region start (point) + (cdr (assq 'color shr-stylesheet)) + (cdr (assq 'background-color shr-stylesheet)))))) (defun shr-generic (cont) (dolist (sub cont) @@ -305,8 +304,8 @@ redirects somewhere else." (if (eq (preceding-char) ?') (not (memq (char-after (- (point) 2)) (list nil ?\n ? ))) - ;; There're some kinsoku CJK chars that aren't breakable. (and (shr-char-kinsoku-bol-p (preceding-char)) + (shr-char-breakable-p (following-char)) (not (shr-char-kinsoku-bol-p (following-char))))) (shr-char-kinsoku-eol-p (following-char)))) (backward-char 1)) @@ -525,7 +524,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." +START, and END. Note that START and END should be merkers." `(lambda (url start end) (when url (if (string-match "\\`cid:" url) @@ -535,9 +534,8 @@ START, and END." (when image (goto-char start) (shr-put-image image - (prog1 - (buffer-substring-no-properties start end) - (delete-region start end)))))) + (buffer-substring-no-properties start end)) + (delete-region (point) end)))) (url-retrieve url 'shr-image-fetched (list (current-buffer) start end) t))))) @@ -590,7 +588,8 @@ ones, in case fg and bg are nil." (when (or fg bg) (let ((new-colors (shr-color-check fg bg))) (when new-colors - (shr-put-color start end :foreground (cadr new-colors)) + (when fg + (shr-put-color start end :foreground (cadr new-colors))) (when bg (shr-put-color start end :background (car new-colors))))))) @@ -639,6 +638,12 @@ ones, in case fg and bg are nil." (shr-generic cont) (shr-colorize-region start (point) fgcolor bgcolor))) +(defun shr-tag-style (cont) + ) + +(defun shr-tag-script (cont) + ) + (defun shr-tag-p (cont) (shr-ensure-paragraph) (shr-indent) @@ -843,7 +848,9 @@ ones, in case fg and bg are nil." (shr-stylesheet (nconc (list (cons 'color color)) shr-stylesheet))) (shr-generic cont) - (shr-colorize-region start (point) color nil))) + (when color + (shr-colorize-region start (point) color + (cdr (assq 'background-color shr-stylesheet)))))) ;;; Table rendering algorithm. @@ -892,6 +899,9 @@ ones, in case fg and bg are nil." (body (or (cdr (assq 'tbody cont)) cont)) (footer (cdr (assq 'tfoot cont))) (bgcolor (cdr (assq :bgcolor cont))) + (start (point)) + (shr-stylesheet (nconc (list (cons 'background-color bgcolor)) + shr-stylesheet)) (nheader (if header (shr-max-columns header))) (nbody (if body (shr-max-columns body))) (nfooter (if footer (shr-max-columns footer)))) @@ -932,7 +942,10 @@ ones, in case fg and bg are nil." `((tr (td (table (tbody ,@footer)))))))) (if caption `((tr (td (table (tbody ,@body))))) - body))))))) + body))))) + (when bgcolor + (shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet)) + bgcolor)))) (defun shr-find-elements (cont type) (let (result) @@ -1038,43 +1051,73 @@ ones, in case fg and bg are nil." (defun shr-render-td (cont width fill) (with-temp-buffer - (let ((cache (cdr (assoc (cons width cont) shr-content-cache)))) - (if cache - (insert cache) - (let ((shr-width width) - (shr-indentation 0)) - (shr-descend (cons 'td cont))) - (delete-region - (point) - (+ (point) - (skip-chars-backward " \t\n"))) - (push (cons (cons width cont) (buffer-string)) - shr-content-cache))) - (goto-char (point-min)) - (let ((max 0)) - (while (not (eobp)) - (end-of-line) - (setq max (max max (current-column))) - (forward-line 1)) - (when fill - (goto-char (point-min)) - ;; If the buffer is totally empty, then put a single blank - ;; line here. - (if (zerop (buffer-size)) - (insert (make-string width ? )) - ;; Otherwise, fill the buffer. - (while (not (eobp)) - (end-of-line) - (when (> (- width (current-column)) 0) - (insert (make-string (- width (current-column)) ? ))) - (forward-line 1)))) - (if fill + (let ((bgcolor (cdr (assq :bgcolor cont))) + (fgcolor (cdr (assq :fgcolor cont))) + (style (cdr (assq :style cont))) + (shr-stylesheet shr-stylesheet) + overlays) + (when style + (setq style (and (string-match "color" style) + (shr-parse-style style)))) + (when bgcolor + (setq style (nconc (list (cons 'background-color bgcolor)) style))) + (when fgcolor + (setq style (nconc (list (cons 'color fgcolor)) style))) + (when style + (setq shr-stylesheet (append style shr-stylesheet))) + (let ((cache (cdr (assoc (cons width cont) shr-content-cache)))) + (if cache + (progn + (insert (car cache)) + (let ((end (length (car cache)))) + (dolist (overlay (cadr cache)) + (let ((new-overlay + (make-overlay (1+ (- end (nth 0 overlay))) + (1+ (- end (nth 1 overlay))))) + (properties (nth 2 overlay))) + (while properties + (overlay-put new-overlay + (pop properties) (pop properties))))))) + (let ((shr-width width) + (shr-indentation 0)) + (shr-descend (cons 'td cont))) + (delete-region + (point) + (+ (point) + (skip-chars-backward " \t\n"))) + (push (list (cons width cont) (buffer-string) + (shr-overlays-in-region (point-min) (point-max))) + shr-content-cache))) + (goto-char (point-min)) + (let ((max 0)) + (while (not (eobp)) + (end-of-line) + (setq max (max max (current-column))) + (forward-line 1)) + (when fill + (goto-char (point-min)) + ;; If the buffer is totally empty, then put a single blank + ;; line here. + (if (zerop (buffer-size)) + (insert (make-string width ? )) + ;; Otherwise, fill the buffer. + (while (not (eobp)) + (end-of-line) + (when (> (- width (current-column)) 0) + (insert (make-string (- width (current-column)) ? ))) + (forward-line 1)))) + (when style + (shr-colorize-region + (point-min) (point-max) + (cdr (assq 'color shr-stylesheet)) + (cdr (assq 'background-color shr-stylesheet)))) + (if fill + (list max + (count-lines (point-min) (point-max)) + (split-string (buffer-string) "\n") + (shr-collect-overlays)) (list max - (count-lines (point-min) (point-max)) - (split-string (buffer-string) "\n") - (shr-collect-overlays)) - (list max - (shr-natural-width)))))) + (shr-natural-width))))))) (defun shr-natural-width () (goto-char (point-min))