X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fshr.el;h=324bbee2acd42e446f9bee9aaf87ce95ac366871;hp=acf47aa254ad667a057a755640c868cccd8db7d6;hb=2675e547c07719f3e144f5b964e26d582665da0f;hpb=899c7c58fd014e0d54245eba35120d8b181b17f4 diff --git a/lisp/shr.el b/lisp/shr.el index acf47aa25..324bbee2a 100644 --- a/lisp/shr.el +++ b/lisp/shr.el @@ -90,6 +90,7 @@ cid: URL as the argument.") (defvar shr-list-mode nil) (defvar shr-content-cache nil) (defvar shr-kinsoku-shorten nil) +(defvar shr-table-depth 0) (defvar shr-map (let ((map (make-sparse-keymap))) @@ -318,9 +319,20 @@ redirects somewhere else." (dolist (type types) (shr-add-font (or shr-start (point)) (point) type)))) +;; Add an overlay in the region, but avoid putting the font properties +;; on blank text at the start of the line, and the newline at the end, +;; to avoid ugliness. (defun shr-add-font (start end type) - (let ((overlay (make-overlay start end))) - (overlay-put overlay 'face type))) + (save-excursion + (goto-char start) + (while (< (point) end) + (when (bolp) + (skip-chars-forward " ")) + (let ((overlay (make-overlay (point) (min (line-end-position) end)))) + (overlay-put overlay 'face type)) + (if (< (line-end-position) end) + (forward-line 1) + (goto-char end))))) (defun shr-browse-url () "Browse the URL under point." @@ -362,12 +374,14 @@ redirects somewhere else." (kill-buffer (current-buffer))) (defun shr-put-image (data point alt) - (if (not (display-graphic-p)) - (insert alt) - (let ((image (ignore-errors - (shr-rescale-image data)))) - (when image - (put-image image point alt))))) + (if (display-graphic-p) + (let ((image (ignore-errors + (shr-rescale-image data)))) + (when image + (put-image image point alt))) + (save-excursion + (goto-char point) + (insert alt)))) (defun shr-rescale-image (data) (if (or (not (fboundp 'imagemagick-types)) @@ -413,6 +427,18 @@ Return a string with image data." (apply #'shr-fontize-cont cont types) (shr-ensure-paragraph)) +(defun shr-urlify (start url) + (widget-convert-button + 'url-link start (point) + :help-echo url + :keymap shr-map + url) + (put-text-property start (point) 'shr-url url)) + +(defun shr-encode-url (url) + "Encode URL." + (browse-url-url-encode-chars url "[)$ ]")) + ;;; Tag-specific rendering rules. (defun shr-tag-p (cont) @@ -421,6 +447,12 @@ Return a string with image data." (shr-generic cont) (shr-ensure-paragraph)) +(defun shr-tag-div (cont) + (shr-ensure-newline) + (shr-indent) + (shr-generic cont) + (shr-ensure-newline)) + (defun shr-tag-b (cont) (shr-fontize-cont cont 'bold)) @@ -430,6 +462,9 @@ Return a string with image data." (defun shr-tag-em (cont) (shr-fontize-cont cont 'bold)) +(defun shr-tag-strong (cont) + (shr-fontize-cont cont 'bold)) + (defun shr-tag-u (cont) (shr-fontize-cont cont 'underline)) @@ -464,19 +499,18 @@ Return a string with image data." (start (point)) shr-start) (shr-generic cont) - (widget-convert-button - '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))) + (shr-urlify (or shr-start start) url))) -(defun shr-encode-url (url) - "Encode URL." - (browse-url-url-encode-chars url "[)$ ]")) +(defun shr-tag-object (cont) + (let ((url (cdr (assq :src (cdr (assq 'embed cont))))) + (start (point))) + (when url + (shr-insert " [multimedia] ") + (shr-urlify start url)))) (defun shr-tag-img (cont) - (when cont + (when (and cont + (cdr (assq :src cont))) (when (and (> (current-column) 0) (not (eq shr-state 'image))) (insert "\n")) @@ -597,6 +631,7 @@ Return a string with image data." (setq cont (or (cdr (assq 'tbody cont)) cont)) (let* ((shr-inhibit-images t) + (shr-table-depth (1+ shr-table-depth)) (shr-kinsoku-shorten t) ;; Find all suggested widths. (columns (shr-column-specs cont)) @@ -618,8 +653,9 @@ Return a string with image data." ;; Finally, insert all the images after the table. The Emacs buffer ;; model isn't strong enough to allow us to put the images actually ;; into the tables. - (dolist (elem (shr-find-elements cont 'img)) - (shr-tag-img (cdr elem)))) + (when (zerop shr-table-depth) + (dolist (elem (shr-find-elements cont 'img)) + (shr-tag-img (cdr elem))))) (defun shr-tag-table (cont) (shr-ensure-paragraph) @@ -631,92 +667,43 @@ Return a string with image data." (nbody (if body (shr-max-columns body))) (nfooter (if footer (shr-max-columns footer)))) (shr-tag-table-1 - (if caption - (if header - (if footer - ;; caption + hader + body + footer - (if (= nheader nbody) - (if (= nbody nfooter) - `((tr (td ,@caption)) - (tr (td (table (tbody ,@header ,@body ,@footer))))) - (if (= nfooter 1) - `((tr (td ,@caption)) - (tr (td (table (tbody ,@header ,@body)))) - ,@footer) - `((tr (td ,@caption)) - (tr (td (table (tbody ,@header ,@body)))) - (tr (td (table (tbody ,@footer))))))) - (if (= nbody nfooter) - `((tr (td ,@caption)) - (tr (td (table (tbody ,@header)))) - (tr (td (table (tbody ,@body ,@footer))))) - (if (= nfooter 1) - `((tr (td ,@caption)) - (tr (td (table (tbody ,@header)))) - (tr (td (table (tbody ,@body)))) - ,@footer) - `((tr (td ,@caption)) - (tr (td (table (tbody ,@header)))) - (tr (td (table (tbody ,@body)))) - (tr (td (table (tbody ,@footer)))))))) - ;; caption + header + body - (if (= nheader nbody) - `((tr (td ,@caption)) - (tr (td (table (tbody ,@header ,@body))))) - (if (= nheader 1) - `((tr (td ,@caption)) - ,@header (tr (td (table (tbody ,@body))))) - `((tr (td ,@caption)) - (tr (td (table (tbody ,@header)))) - (tr (td (table (tbody ,@body)))))))) - (if footer - ;; caption + body + footer - (if (= nbody nfooter) - `((tr (td (table (tbody ,@body ,@footer))))) - (if (= nfooter 1) - `((tr (td (table (tbody ,@body)))) ,@footer) - `((tr (td (table (tbody ,@body)))) - (tr (td (table (tbody ,@footer))))))) - ;; caption + body - `((tr (td ,@caption)) - (tr (td (table (tbody ,@body))))))) - (if header - (if footer - ;; header + body + footer - (if (= nheader nbody) - (if (= nbody nfooter) - `((tr (td (table (tbody ,@header ,@body ,@footer))))) + (nconc + (if caption `((tr (td ,@caption)))) + (if header + (if footer + ;; hader + body + footer + (if (= nheader nbody) + (if (= nbody nfooter) + `((tr (td (table (tbody ,@header ,@body ,@footer))))) + (nconc `((tr (td (table (tbody ,@header ,@body))))) + (if (= nfooter 1) + footer + `((tr (td (table (tbody ,@footer)))))))) + (nconc `((tr (td (table (tbody ,@header))))) + (if (= nbody nfooter) + `((tr (td (table (tbody ,@body ,@footer))))) + (nconc `((tr (td (table (tbody ,@body))))) + (if (= nfooter 1) + footer + `((tr (td (table (tbody ,@footer)))))))))) + ;; header + body + (if (= nheader nbody) + `((tr (td (table (tbody ,@header ,@body))))) + (if (= nheader 1) + `(,@header (tr (td (table (tbody ,@body))))) + `((tr (td (table (tbody ,@header)))) + (tr (td (table (tbody ,@body)))))))) + (if footer + ;; body + footer + (if (= nbody nfooter) + `((tr (td (table (tbody ,@body ,@footer))))) + (nconc `((tr (td (table (tbody ,@body))))) (if (= nfooter 1) - `((tr (td (table (tbody ,@header ,@body)))) - ,@footer) - `((tr (td (table (tbody ,@header ,@body)))) - (tr (td (table (tbody ,@footer))))))) - (if (= nbody nfooter) - `((tr (td (table (tbody ,@header)))) - (tr (td (table (tbody ,@body ,@footer))))) - (if (= nfooter 1) - `((tr (td (table (tbody ,@header)))) - (tr (td (table (tbody ,@body)))) - ,@footer) - `((tr (td (table (tbody ,@header)))) - (tr (td (table (tbody ,@body)))) - (tr (td (table (tbody ,@footer)))))))) - ;; header + body - (if (= nheader nbody) - `((tr (td (table (tbody ,@header ,@body))))) - (if (= nheader 1) - `(,@header (tr (td (table (tbody ,@body))))) - `((tr (td (table (tbody ,@header)))) - (tr (td (table (tbody ,@body)))))))) - (if footer - ;; body + footer - (if (= nbody nfooter) - `((tr (td (table (tbody ,@body ,@footer))))) - (if (= nfooter 1) - `((tr (td (table (tbody ,@body)))) ,@footer) - `((tr (td (table (tbody ,@body)))) - (tr (td (table (tbody ,@footer))))))) - body)))))) + footer + `((tr (td (table (tbody ,@footer)))))))) + (if caption + `((tr (td (table (tbody ,@body))))) + body))))))) (defun shr-find-elements (cont type) (let (result)