(eval-when-compile (require 'cl))
(require 'browse-url)
+(unless (aref (char-category-set (make-char 'japanese-jisx0208 33 35)) ?>)
+ (load "kinsoku" nil t))
(defgroup shr nil
"Simple HTML Renderer"
(defvar shr-inhibit-images nil)
(defvar shr-list-mode nil)
(defvar shr-content-cache nil)
+(defvar shr-kinsoku-shorten nil)
(defvar shr-map
(let ((map (make-sparse-keymap)))
((eq shr-folding-mode 'none)
(insert text))
(t
- (let ((first t)
- column)
- (when (and (string-match "\\`[ \t\n]" text)
- (not (bolp))
- (not (eq (char-after (1- (point))) ? )))
- (insert " "))
- (dolist (elem (split-string text))
- (when (and (bolp)
- (> shr-indentation 0))
- (shr-indent))
- ;; The shr-start is a special variable that is used to pass
- ;; upwards the first point in the buffer where the text really
- ;; starts.
- (unless shr-start
- (setq shr-start (point)))
- ;; No space is needed before or after a breakable character or
- ;; at the beginning of a line.
+ (when (and (string-match "\\`[ \t\n]" text)
+ (not (bolp))
+ (not (eq (char-after (1- (point))) ? )))
+ (insert " "))
+ (dolist (elem (split-string text))
+ (when (and (bolp)
+ (> shr-indentation 0))
+ (shr-indent))
+ ;; The shr-start is a special variable that is used to pass
+ ;; upwards the first point in the buffer where the text really
+ ;; starts.
+ (unless shr-start
+ (setq shr-start (point)))
+ ;; No space is needed behind a wide character categorized as
+ ;; kinsoku-bol, between characters both categorized as nospace,
+ ;; or at the beginning of a line.
+ (let (prev)
(when (and (eq (preceding-char) ? )
(or (= (line-beginning-position) (1- (point)))
- (aref fill-find-break-point-function-table
- (char-after (- (point) 2)))
- (aref fill-find-break-point-function-table
- (aref elem 0))))
- (delete-char -1))
- (insert elem)
- (while (> (current-column) shr-width)
- (unless (prog1
- (shr-find-fill-point)
- (when (eq (preceding-char) ? )
- (delete-char -1))
- (insert "\n"))
- (put-text-property (1- (point)) (point) 'shr-break t)
- ;; No space is needed at the beginning of a line.
- (if (eq (following-char) ? )
- (delete-char 1)))
- (when (> shr-indentation 0)
- (shr-indent))
- (end-of-line))
- (insert " "))
- (unless (string-match "[ \t\n]\\'" text)
- (delete-char -1))))))
-
-(eval-and-compile (autoload 'kinsoku-longer "kinsoku"))
+ (and (aref fill-find-break-point-function-table
+ (setq prev (char-after (- (point) 2))))
+ (aref (char-category-set prev) ?>))
+ (and (aref fill-nospace-between-words-table prev)
+ (aref fill-nospace-between-words-table
+ (aref elem 0)))))
+ (delete-char -1)))
+ (insert elem)
+ (while (> (current-column) shr-width)
+ (unless (prog1
+ (shr-find-fill-point)
+ (when (eq (preceding-char) ? )
+ (delete-char -1))
+ (insert "\n"))
+ (put-text-property (1- (point)) (point) 'shr-break t)
+ ;; No space is needed at the beginning of a line.
+ (when (eq (following-char) ? )
+ (delete-char 1)))
+ (when (> shr-indentation 0)
+ (shr-indent))
+ (end-of-line))
+ (insert " "))
+ (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 t))
- (backward-char 1)
- (when (bolp)
+ (when (> (move-to-column shr-width) shr-width)
+ (backward-char 1))
+ (let (failed)
+ (while (not
+ (or (setq failed (= (current-column) shr-indentation))
+ (eq (preceding-char) ? )
+ (eq (following-char) ? )
+ (aref fill-find-break-point-function-table (preceding-char))))
+ (backward-char 1))
+ (if failed
;; There's no breakable point, so we give it up.
- (end-of-line)
- (while (aref fill-find-break-point-function-table
- (preceding-char))
- (backward-char 1))
- (setq found 'failed)))
- (cond ((eq found t)
- ;; Don't put kinsoku-bol characters at the beginning of a line.
- (or (eobp)
- (kinsoku-longer)
- (not (aref fill-find-break-point-function-table
- (following-char)))
- (forward-char 1)))
- (found t)
- (t
- (end-of-line)
- nil))))
+ (progn
+ (end-of-line)
+ (while (aref fill-find-break-point-function-table (preceding-char))
+ (backward-char 1))
+ nil)
+ (or (eolp)
+ ;; Don't put kinsoku-bol characters at the beginning of a line,
+ ;; or kinsoku-eol characters at the end of a line,
+ (let ((count 4))
+ (if shr-kinsoku-shorten
+ (while (and
+ (> count 0)
+ (or (aref (char-category-set (preceding-char)) ?<)
+ (aref (char-category-set (following-char)) ?>)))
+ (backward-char 1))
+ (while (and (> count 0)
+ (aref (char-category-set (following-char)) ?>))
+ (forward-char 1)))
+ (when (eq (following-char) ? )
+ (forward-char 1))
+ t)))))
(defun shr-ensure-newline ()
(unless (zerop (current-column))
(defun shr-tag-s (cont)
(shr-fontize-cont cont 'strike-through))
+(defun shr-tag-span (cont)
+ (let ((start (point))
+ (color (cdr (assq 'color (shr-parse-style (cdr (assq :style cont)))))))
+ (shr-generic cont)
+ (when color
+ (let ((overlay (make-overlay start (point))))
+ (overlay-put overlay 'face (cons 'foreground-color color))))))
+
+(defun shr-parse-style (style)
+ (when style
+ (let ((plist nil))
+ (dolist (elem (split-string style ";"))
+ (when elem
+ (setq elem (split-string elem ":"))
+ (when (and (car elem)
+ (cadr elem))
+ (let ((name (replace-regexp-in-string "^ +\\| +$" "" (car elem)))
+ (value (replace-regexp-in-string "^ +\\| +$" "" (cadr elem))))
+ (push (cons (intern name obarray)
+ value)
+ plist)))))
+ plist)))
+
(defun shr-tag-a (cont)
(let ((url (cdr (assq :href cont)))
(start (point))
(not (eq shr-state 'image)))
(insert "\n"))
(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))))))))))))
+ (url (cdr (assq :src cont))))
(let ((start (point-marker)))
(when (zerop (length alt))
(setq alt "[img]"))
(setq cont (or (cdr (assq 'tbody cont))
cont))
(let* ((shr-inhibit-images t)
+ (shr-kinsoku-shorten t)
;; Find all suggested widths.
(columns (shr-column-specs cont))
;; Compute how many characters wide each TD should be.
(sketch (shr-make-table cont suggested-widths))
(sketch-widths (shr-table-widths sketch suggested-widths)))
;; This probably won't work very well.
- (when (> (1+ (loop for width across sketch-widths
- summing (1+ width)))
+ (when (> (+ (loop for width across sketch-widths
+ summing (1+ width))
+ shr-indentation 1)
(frame-width))
(setq truncate-lines t))
;; Then render the table again with these new "hard" widths.
;; possibly.
(dotimes (i (- height (length lines)))
(end-of-line)
- (insert (make-string (length (car lines)) ? ) "|")
+ (insert (make-string (string-width (car lines)) ? ) "|")
(forward-line 1)))))
(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)
(dotimes (i (length widths))
(insert (make-string (aref widths i) shr-table-line) shr-table-corner))
projects / gnus / blobdiff