From abb82ce90e16e2f41b166bdba0b1157e59635c11 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Wed, 6 Oct 2010 13:34:54 +0200 Subject: [PATCH] * shr.el: Rearrange function order to be more logical. --- lisp/ChangeLog | 4 + lisp/shr.el | 386 +++++++++++++++++++++++++------------------------ 2 files changed, 202 insertions(+), 188 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c99e46547..b98cef20f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2010-10-06 Lars Magne Ingebrigtsen + + * shr.el: Rearrange function order to be more logical. + 2010-10-06 Katsumi Yamaoka * gnus-art.el (gnus-mime-view-part-as-type): Make it work when being diff --git a/lisp/shr.el b/lisp/shr.el index c7f94ebc6..3b9709cc4 100644 --- a/lisp/shr.el +++ b/lisp/shr.el @@ -57,13 +57,17 @@ fit these criteria." 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) (defvar shr-state nil) (defvar shr-start nil) (defvar shr-indentation 0) (defvar shr-inhibit-images nil) - -(defvar shr-width 70) +(defvar shr-list-mode nil) (defvar shr-map (let ((map (make-sparse-keymap))) @@ -75,6 +79,64 @@ cid: URL as the argument.") (define-key map "\r" 'shr-browse-url) map)) +;; Public functions and commands. + +;;;###autoload +(defun shr-insert-document (dom) + (let ((shr-state nil) + (shr-start nil)) + (shr-descend (shr-transform-dom dom)))) + +(defun shr-copy-url () + "Copy the URL under point to the kill ring. +If called twice, then try to fetch the URL and see whether it +redirects somewhere else." + (interactive) + (let ((url (get-text-property (point) 'shr-url))) + (cond + ((not url) + (message "No URL under point")) + ;; Resolve redirected URLs. + ((equal url (car kill-ring)) + (url-retrieve + url + (lambda (a) + (when (and (consp a) + (eq (car a) :redirect)) + (with-temp-buffer + (insert (cadr a)) + (goto-char (point-min)) + ;; Remove common tracking junk from the URL. + (when (re-search-forward ".utm_.*" nil t) + (replace-match "" t t)) + (message "Copied %s" (buffer-string)) + (copy-region-as-kill (point-min) (point-max))))))) + ;; Copy the URL to the kill ring. + (t + (with-temp-buffer + (insert url) + (copy-region-as-kill (point-min) (point-max)) + (message "Copied %s" url)))))) + +(defun shr-show-alt-text () + "Show the ALT text of the image under point." + (interactive) + (let ((text (get-text-property (point) 'shr-alt))) + (if (not text) + (message "No image under point") + (message "%s" text)))) + +(defun shr-browse-image () + "Browse the image under point." + (interactive) + (let ((url (get-text-property (point) 'shr-image))) + (if (not url) + (message "No image under point") + (message "Browsing %s..." url) + (browse-url url)))) + +;;; Utility functions. + (defun shr-transform-dom (dom) (let ((result (list (pop dom)))) (dolist (arg (pop dom)) @@ -87,12 +149,6 @@ cid: URL as the argument.") (push (shr-transform-dom sub) result))) (nreverse result))) -;;;###autoload -(defun shr-insert-document (dom) - (let ((shr-state nil) - (shr-start nil)) - (shr-descend (shr-transform-dom dom)))) - (defun shr-descend (dom) (let ((function (intern (concat "shr-tag-" (symbol-name (car dom))) obarray))) (if (fboundp function) @@ -107,10 +163,48 @@ cid: URL as the argument.") ((listp (cdr sub)) (shr-descend sub))))) -(defun shr-tag-p (cont) - (shr-ensure-paragraph) - (shr-generic cont) - (shr-ensure-paragraph)) +(defun shr-insert (text) + (when (eq shr-state 'image) + (insert "\n") + (setq shr-state nil)) + (cond + ((eq shr-folding-mode 'none) + (insert text)) + (t + (let ((first t) + column) + (when (and (string-match "\\`[ \t\n]" text) + (not (bolp))) + (insert " ")) + (dolist (elem (split-string text)) + (setq column (current-column)) + (when (> column 0) + (cond + ((and (or (not first) + (eq shr-state 'space)) + (> (+ column (length elem) 1) shr-width)) + (insert "\n")) + ((not first) + (insert " ")))) + (setq first nil) + (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))) + (insert elem)) + (setq shr-state nil) + (when (and (string-match "[ \t\n]\\'" text) + (not (bolp))) + (insert " ") + (setq shr-state 'space)))))) + +(defun shr-ensure-newline () + (unless (zerop (current-column)) + (insert "\n"))) (defun shr-ensure-paragraph () (unless (bobp) @@ -125,20 +219,8 @@ cid: URL as the argument.") (insert "\n") (insert "\n\n"))))) -(defun shr-tag-b (cont) - (shr-fontize-cont cont 'bold)) - -(defun shr-tag-i (cont) - (shr-fontize-cont cont 'italic)) - -(defun shr-tag-em (cont) - (shr-fontize-cont cont 'bold)) - -(defun shr-tag-u (cont) - (shr-fontize-cont cont 'underline)) - -(defun shr-tag-s (cont) - (shr-fontize-cont cont 'strike-through)) +(defun shr-indent () + (insert (make-string shr-indentation ? ))) (defun shr-fontize-cont (cont &rest types) (let (shr-start) @@ -150,17 +232,6 @@ cid: URL as the argument.") (let ((overlay (make-overlay start end))) (overlay-put overlay 'face type))) -(defun shr-tag-a (cont) - (let ((url (cdr (assq :href cont))) - (start (point)) - 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) - (put-text-property (or shr-start start) (point) 'shr-url url))) - (defun shr-browse-url () "Browse the URL under point." (interactive) @@ -169,94 +240,6 @@ cid: URL as the argument.") (message "No link under point") (browse-url url)))) -(defun shr-copy-url () - "Copy the URL under point to the kill ring. -If called twice, then try to fetch the URL and see whether it -redirects somewhere else." - (interactive) - (let ((url (get-text-property (point) 'shr-url))) - (cond - ((not url) - (message "No URL under point")) - ;; Resolve redirected URLs. - ((equal url (car kill-ring)) - (url-retrieve - url - (lambda (a) - (when (and (consp a) - (eq (car a) :redirect)) - (with-temp-buffer - (insert (cadr a)) - (goto-char (point-min)) - ;; Remove common tracking junk from the URL. - (when (re-search-forward ".utm_.*" nil t) - (replace-match "" t t)) - (message "Copied %s" (buffer-string)) - (copy-region-as-kill (point-min) (point-max))))))) - ;; Copy the URL to the kill ring. - (t - (with-temp-buffer - (insert url) - (copy-region-as-kill (point-min) (point-max)) - (message "Copied %s" 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)))) - (when (zerop (length alt)) - (setq alt "[img]")) - (cond - ((and (not shr-inhibit-images) - (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)))) - (insert alt) - (shr-put-image image (point) alt)))) - ((or shr-inhibit-images - (and shr-blocked-images - (string-match shr-blocked-images url))) - (setq shr-start (point)) - (let ((shr-state 'space)) - (if (> (length alt) 8) - (shr-insert (substring alt 0 8)) - (shr-insert alt)))) - ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]")) - (shr-put-image (shr-get-image-data url) (point) alt)) - (t - (insert alt) - (ignore-errors - (url-retrieve url 'shr-image-fetched - (list (current-buffer) start (point-marker)) - t)))) - (insert " ") - (put-text-property start (point) 'keymap shr-map) - (put-text-property start (point) 'shr-alt alt) - (put-text-property start (point) 'shr-image url) - (setq shr-state 'image)))) - -(defun shr-show-alt-text () - "Show the ALT text of the image under point." - (interactive) - (let ((text (get-text-property (point) 'shr-alt))) - (if (not text) - (message "No image under point") - (message "%s" text)))) - -(defun shr-browse-image () - "Browse the image under point." - (interactive) - (let ((url (get-text-property (point) 'shr-image))) - (if (not url) - (message "No image under point") - (message "Browsing %s..." url) - (browse-url url)))) - (defun shr-image-fetched (status buffer start end) (when (and (buffer-name buffer) (not (plist-get status :error))) @@ -306,64 +289,6 @@ redirects somewhere else." image))) image))) -(defun shr-tag-pre (cont) - (let ((shr-folding-mode 'none)) - (shr-ensure-newline) - (shr-generic cont) - (shr-ensure-newline))) - -(defun shr-tag-blockquote (cont) - (shr-ensure-paragraph) - (let ((shr-indentation (+ shr-indentation 4))) - (shr-generic cont)) - (shr-ensure-paragraph)) - -(defun shr-ensure-newline () - (unless (zerop (current-column)) - (insert "\n"))) - -(defun shr-insert (text) - (when (eq shr-state 'image) - (insert "\n") - (setq shr-state nil)) - (cond - ((eq shr-folding-mode 'none) - (insert text)) - (t - (let ((first t) - column) - (when (and (string-match "\\`[ \t\n]" text) - (not (bolp))) - (insert " ")) - (dolist (elem (split-string text)) - (setq column (current-column)) - (when (> column 0) - (cond - ((and (or (not first) - (eq shr-state 'space)) - (> (+ column (length elem) 1) shr-width)) - (insert "\n")) - ((not first) - (insert " ")))) - (setq first nil) - (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))) - (insert elem)) - (setq shr-state nil) - (when (and (string-match "[ \t\n]\\'" text) - (not (bolp))) - (insert " ") - (setq shr-state 'space)))))) - -(defun shr-indent () - (insert (make-string shr-indentation ? ))) - (defun shr-get-image-data (url) "Get image data for URL. Return a string with image data." @@ -376,7 +301,95 @@ Return a string with image data." (search-forward "\r\n\r\n" nil t)) (buffer-substring (point) (point-max)))))) -(defvar shr-list-mode nil) +(defun shr-heading (cont &rest types) + (shr-ensure-paragraph) + (apply #'shr-fontize-cont cont types) + (shr-ensure-paragraph)) + +;;; Tag-specific rendering rules. + +(defun shr-tag-p (cont) + (shr-ensure-paragraph) + (shr-generic cont) + (shr-ensure-paragraph)) + +(defun shr-tag-b (cont) + (shr-fontize-cont cont 'bold)) + +(defun shr-tag-i (cont) + (shr-fontize-cont cont 'italic)) + +(defun shr-tag-em (cont) + (shr-fontize-cont cont 'bold)) + +(defun shr-tag-u (cont) + (shr-fontize-cont cont 'underline)) + +(defun shr-tag-s (cont) + (shr-fontize-cont cont 'strike-through)) + +(defun shr-tag-a (cont) + (let ((url (cdr (assq :href cont))) + (start (point)) + 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) + (put-text-property (or shr-start start) (point) 'shr-url 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)))) + (when (zerop (length alt)) + (setq alt "[img]")) + (cond + ((and (not shr-inhibit-images) + (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)))) + (insert alt) + (shr-put-image image (point) alt)))) + ((or shr-inhibit-images + (and shr-blocked-images + (string-match shr-blocked-images url))) + (setq shr-start (point)) + (let ((shr-state 'space)) + (if (> (length alt) 8) + (shr-insert (substring alt 0 8)) + (shr-insert alt)))) + ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]")) + (shr-put-image (shr-get-image-data url) (point) alt)) + (t + (insert alt) + (ignore-errors + (url-retrieve url 'shr-image-fetched + (list (current-buffer) start (point-marker)) + t)))) + (insert " ") + (put-text-property start (point) 'keymap shr-map) + (put-text-property start (point) 'shr-alt alt) + (put-text-property start (point) 'shr-image url) + (setq shr-state 'image)))) + +(defun shr-tag-pre (cont) + (let ((shr-folding-mode 'none)) + (shr-ensure-newline) + (shr-generic cont) + (shr-ensure-newline))) + +(defun shr-tag-blockquote (cont) + (shr-ensure-paragraph) + (let ((shr-indentation (+ shr-indentation 4))) + (shr-generic cont)) + (shr-ensure-paragraph)) (defun shr-tag-ul (cont) (shr-ensure-paragraph) @@ -422,10 +435,7 @@ Return a string with image data." (defun shr-tag-h6 (cont) (shr-heading cont)) -(defun shr-heading (cont &rest types) - (shr-ensure-paragraph) - (apply #'shr-fontize-cont cont types) - (shr-ensure-paragraph)) +;;; Table rendering algorithm. ;; Table rendering is the only complicated thing here. We do this by ;; first counting how many TDs there are in each TR, and registering -- 2.25.1