Support #anchors

[gnus] / lisp / shr.el

diff --git a/lisp/shr.el b/lisp/shr.el
index 5173908..53f6e0c 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -83,6 +83,14 @@ used."
                 (const   :tag "Use the width of the window" nil))
   :group 'shr)
 
+(defcustom shr-bullet "* "
+  "Bullet used for unordered lists.
+Alternative suggestions are:
+- \"  \"
+- \"  \""
+  :type 'string
+  :group 'shr)
+
 (defvar shr-content-function nil
   "If bound, this should be a function that will return the content.
 This is used for cid: URLs, and the function is called with the
@@ -115,6 +123,7 @@ cid: URL as the argument.")
 (defvar shr-base nil)
 (defvar shr-ignore-cache nil)
 (defvar shr-external-rendering-functions nil)
+(defvar shr-target-id nil)
 
 (defvar shr-map
   (let ((map (make-sparse-keymap)))
@@ -303,18 +312,24 @@ size, and full-buffer size."
        (shr-stylesheet shr-stylesheet)
        (start (point)))
     (when style
-      (if (string-match "color" style)
+      (if (string-match "color\\|display" style)
          (setq shr-stylesheet (nconc (shr-parse-style style)
                                      shr-stylesheet))
        (setq style nil)))
-    (if (fboundp function)
-       (funcall function (cdr dom))
-      (shr-generic (cdr dom)))
-    ;; 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))))))
+    ;; If we have a display:none, then just ignore this part of the
+    ;; DOM.
+    (unless (equal (cdr (assq 'display shr-stylesheet)) "none")
+      (if (fboundp function)
+         (funcall function (cdr dom))
+       (shr-generic (cdr dom)))
+      (when (and shr-target-id
+                (equal (cdr (assq :id (cdr dom))) shr-target-id))
+       (put-text-property start (1+ start) 'shr-target-id shr-target-id))
+      ;; 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)
@@ -485,6 +500,9 @@ size, and full-buffer size."
     (not failed)))
 
 (defun shr-parse-base (url)
+  ;; Always chop off anchors.
+  (when (string-match "#.*" url)
+    (setq url (substring url 0 (match-beginning 0))))
   (let* ((parsed (url-generic-parse-url url))
         (local (url-filename parsed)))
     (setf (url-filename parsed) "")
@@ -497,7 +515,8 @@ size, and full-buffer size."
       (setq local (concat local "/")))
     (list (url-recreate-url parsed)
          local
-         (url-type parsed))))
+         (url-type parsed)
+         url)))
 
 (defun shr-expand-url (url &optional base)
   (setq base
@@ -505,6 +524,8 @@ size, and full-buffer size."
            (shr-parse-base base)
          ;; Bound by the parser.
          shr-base))
+  (when (zerop (length url))
+    (setq url nil))
   (cond ((or (not url)
             (not base)
             (string-match "\\`[a-z]*:" url))
@@ -517,6 +538,9 @@ size, and full-buffer size."
             (concat (nth 2 base) ":" url)
           ;; Just use the host name part.
           (concat (car base) url)))
+       ((eq (aref url 0) ?#)
+        ;; A link to an anchor.
+        (concat (nth 3 base) url))
        (t
         ;; Totally relative.
         (concat (car base) (cadr base) url))))
@@ -912,7 +936,7 @@ ones, in case fg and bg are nil."
     (dolist (sub (cdr dom))
       (cond
        ((listp (cdr sub))
-        (setq text (concat text (dom-to-text sub))))
+        (setq text (concat text (shr-dom-to-xml sub))))
        ((eq (car sub) 'text)
         (setq text (concat text (cdr sub))))
        (t
@@ -1121,14 +1145,14 @@ ones, in case fg and bg are nil."
   (shr-ensure-paragraph))
 
 (defun shr-tag-li (cont)
-  (shr-ensure-paragraph)
+  (shr-ensure-newline)
   (shr-indent)
   (let* ((bullet
          (if (numberp shr-list-mode)
              (prog1
                  (format "%d " shr-list-mode)
                (setq shr-list-mode (1+ shr-list-mode)))
-           "* "))
+           shr-bullet))
         (shr-indentation (+ shr-indentation (length bullet))))
     (insert bullet)
     (shr-generic cont)))