shr.el: Improve kinsoku and table rendering.

This commit is contained in:
Katsumi Yamaoka 2010-10-19 07:57:50 +00:00
parent a04f9e264c
commit 83ffd5713d
2 changed files with 51 additions and 32 deletions

View file

@ -1,3 +1,15 @@
2010-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
* shr.el: Load kinsoku.
(shr-kinsoku-shorten): New internal variable.
(shr-find-fill-point): Make kinsoku shorten text line if
shr-kinsoku-shorten is bound to non-nil.
(shr-tag-table): Bild shr-kinsoku-shorten to t; refer to
shr-indentation too when testing if table is wider than frame width.
(shr-insert-table): Use `string-width' instead of `length' to measure
text width.
(shr-insert-table-ruler): Make sure indentation is done at bol.
2010-10-19 Stefan Monnier <monnier@iro.umontreal.ca> 2010-10-19 Stefan Monnier <monnier@iro.umontreal.ca>
* nnimap.el (nnimap-request-move-article, nnimap-parse-line) * nnimap.el (nnimap-request-move-article, nnimap-parse-line)

View file

@ -32,6 +32,7 @@
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
(require 'browse-url) (require 'browse-url)
(load "kinsoku" nil t)
(defgroup shr nil (defgroup shr nil
"Simple HTML Renderer" "Simple HTML Renderer"
@ -87,6 +88,7 @@ cid: URL as the argument.")
(defvar shr-inhibit-images nil) (defvar shr-inhibit-images nil)
(defvar shr-list-mode nil) (defvar shr-list-mode nil)
(defvar shr-content-cache nil) (defvar shr-content-cache nil)
(defvar shr-kinsoku-shorten nil)
(defvar shr-map (defvar shr-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
@ -247,36 +249,37 @@ redirects somewhere else."
(unless (string-match "[ \t\n]\\'" text) (unless (string-match "[ \t\n]\\'" text)
(delete-char -1))))) (delete-char -1)))))
(eval-and-compile (autoload 'kinsoku-longer "kinsoku"))
(defun shr-find-fill-point () (defun shr-find-fill-point ()
(let ((found nil)) (when (> (move-to-column shr-width) shr-width)
(while (and (not found) (backward-char 1))
(> (current-column) shr-indentation)) (let (failed)
(when (and (or (eq (preceding-char) ? ) (while (not
(aref fill-find-break-point-function-table (or (setq failed (= (current-column) shr-indentation))
(preceding-char))) (eq (preceding-char) ? )
(<= (current-column) shr-width)) (eq (following-char) ? )
(setq found t)) (aref fill-find-break-point-function-table (preceding-char))))
(backward-char 1) (backward-char 1))
(when (bolp) (if failed
;; There's no breakable point, so we give it up. ;; There's no breakable point, so we give it up.
(end-of-line) (progn
(while (aref fill-find-break-point-function-table (end-of-line)
(preceding-char)) (while (aref fill-find-break-point-function-table (preceding-char))
(backward-char 1)) (backward-char 1))
(setq found 'failed))) nil)
(cond ((eq found t) (or (eolp)
;; Don't put kinsoku-bol characters at the beginning of a line. ;; Don't put kinsoku-bol characters at the beginning of a line,
(or (eobp) ;; or kinsoku-eol characters at the end of a line,
(kinsoku-longer) (let ((count 4))
(not (aref fill-find-break-point-function-table (if shr-kinsoku-shorten
(following-char))) (while (and
(forward-char 1))) (> count 0)
(found t) (or (aref (char-category-set (preceding-char)) ?<)
(t (aref (char-category-set (following-char)) ?>)))
(end-of-line) (backward-char 1))
nil)))) (while (and (> count 0)
(aref (char-category-set (following-char)) ?>))
(forward-char 1)))
t)))))
(defun shr-ensure-newline () (defun shr-ensure-newline ()
(unless (zerop (current-column)) (unless (zerop (current-column))
@ -545,6 +548,7 @@ Return a string with image data."
(setq cont (or (cdr (assq 'tbody cont)) (setq cont (or (cdr (assq 'tbody cont))
cont)) cont))
(let* ((shr-inhibit-images t) (let* ((shr-inhibit-images t)
(shr-kinsoku-shorten t)
;; Find all suggested widths. ;; Find all suggested widths.
(columns (shr-column-specs cont)) (columns (shr-column-specs cont))
;; Compute how many characters wide each TD should be. ;; Compute how many characters wide each TD should be.
@ -555,8 +559,9 @@ Return a string with image data."
(sketch (shr-make-table cont suggested-widths)) (sketch (shr-make-table cont suggested-widths))
(sketch-widths (shr-table-widths sketch suggested-widths))) (sketch-widths (shr-table-widths sketch suggested-widths)))
;; This probably won't work very well. ;; This probably won't work very well.
(when (> (1+ (loop for width across sketch-widths (when (> (+ (loop for width across sketch-widths
summing (1+ width))) summing (1+ width))
shr-indentation 1)
(frame-width)) (frame-width))
(setq truncate-lines t)) (setq truncate-lines t))
;; Then render the table again with these new "hard" widths. ;; Then render the table again with these new "hard" widths.
@ -607,12 +612,14 @@ Return a string with image data."
;; possibly. ;; possibly.
(dotimes (i (- height (length lines))) (dotimes (i (- height (length lines)))
(end-of-line) (end-of-line)
(insert (make-string (length (car lines)) ? ) "|") (insert (make-string (string-width (car lines)) ? ) "|")
(forward-line 1))))) (forward-line 1)))))
(shr-insert-table-ruler widths))) (shr-insert-table-ruler widths)))
(defun shr-insert-table-ruler (widths) (defun shr-insert-table-ruler (widths)
(shr-indent) (when (and (bolp)
(> shr-indentation 0))
(shr-indent))
(insert shr-table-corner) (insert shr-table-corner)
(dotimes (i (length widths)) (dotimes (i (length widths))
(insert (make-string (aref widths i) shr-table-line) shr-table-corner)) (insert (make-string (aref widths i) shr-table-line) shr-table-corner))