emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] /srv/bzr/emacs/trunk r101818: Merge changes made in Gnus t


From: Katsumi Yamaoka
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r101818: Merge changes made in Gnus trunk.
Date: Wed, 06 Oct 2010 12:38:45 +0000
User-agent: Bazaar (2.0.3)

------------------------------------------------------------
revno: 101818
author: Gnus developers
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Wed 2010-10-06 12:38:45 +0000
message:
  Merge changes made in Gnus trunk.
  
  shr.el: Rearrange function order to be more logical.
  gnus-faq.texi: Remove reference to my.gnus.org
  message.el (message-change-subject): Remove 404 URL in a comment.
  nnir.el: Fix Swish-E URL.
  nnir.el: Fix Namazu URL.
  nnrss.el (nnrss-check-group): Remove 404 URL in comment.
  nnrss.el (nnrss-discover-feed): Remove 404 URL in docstring.
  gnus-faq.texi (FAQ 5-5): Fix Flyspell URL.
  gnus-faq.texi (FAQ 7-1): Fix getmail URL.
  gnus.texi (Comparing Mail Back Ends): Remove broken link and allusion to 
ReiserFS.
  nnimap.el (nnimap-open-connection): Prepare to support open-gnutls-stream.
  shr.el (shr-insert): Get 'space transition right.
  message.texi: Remove reference to gpg-2comp.
modified:
  doc/misc/ChangeLog
  doc/misc/gnus-faq.texi
  doc/misc/gnus.texi
  doc/misc/message.texi
  lisp/gnus/ChangeLog
  lisp/gnus/message.el
  lisp/gnus/nnimap.el
  lisp/gnus/nnir.el
  lisp/gnus/nnrss.el
  lisp/gnus/shr.el
=== modified file 'doc/misc/ChangeLog'
--- a/doc/misc/ChangeLog        2010-10-06 07:12:42 +0000
+++ b/doc/misc/ChangeLog        2010-10-06 12:38:45 +0000
@@ -1,3 +1,16 @@
+2010-10-06  Julien Danjou  <address@hidden>
+
+       * message.texi (PGP Compatibility): Remove reference to gpg-2comp,
+       broken link.
+
+       * gnus-faq.texi (FAQ 8-3): Remove references to my.gnus.org.
+
+       * gnus.texi (Comparing Mail Back Ends): Remove broken link and allusion
+       to ReiserFS.
+
+       * gnus-faq.texi (FAQ 5-5): Fix Flyspell URL.
+       (FAQ 7-1): Fix getmail URL.
+
 2010-10-06  Daiki Ueno  <address@hidden>
 
        * epa.texi (Caching Passphrases): New section.

=== modified file 'doc/misc/gnus-faq.texi'
--- a/doc/misc/gnus-faq.texi    2010-09-02 00:55:51 +0000
+++ b/doc/misc/gnus-faq.texi    2010-10-06 12:38:45 +0000
@@ -4,9 +4,6 @@
 @c Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
 @c   2009, 2010 Free Software Foundation, Inc.
 @c
address@hidden Do not modify this file, it was generated from gnus-faq.xml, 
available from
address@hidden <URL:http://my.gnus.org/FAQ/>.
address@hidden
 @setfilename gnus-faq.info
 @settitle Frequently Asked Questions
 @c %**end of header
@@ -40,20 +37,9 @@
 @subheading Abstract
 
 This is the new Gnus Frequently Asked Questions list.
-If you have a Web browser, the official hypertext version is at
address@hidden://my.gnus.org/FAQ/},
-the Docbook source is available from
address@hidden://sourceforge.net/projects/gnus/, http://sourceforge.net}.
 
 Please submit features and suggestions to the 
address@hidden@@my.gnus.org, FAQ discussion list}.
-The list is protected against junk mail with
address@hidden://smarden.org/qconfirm/index.html, qconfirm}. As
-a subscriber, your submissions will automatically pass.  You can
-also subscribe to the list by sending a blank email to
address@hidden@@my.gnus.org, faq-discuss-subscribe@@my.gnus.org}
-and 
@uref{http://mail1.kens.com/cgi-bin/ezmlm-browse?command=monthbythread%26list=faq-discuss,
 browse
-the archive (BROKEN)}.
address@hidden@@gnus.org, ding list}.
 
 @node FAQ - Changes
 @subheading Changes
@@ -98,8 +84,6 @@
 job with this FAQ before him. We would like to do the same - thanks,
 Justin!
 
-If you have a Web browser, the official hypertext version is at:
address@hidden://my.gnus.org/FAQ/}.
 This version is much nicer than the unofficial hypertext
 versions that are archived at Utrecht, Oxford, Smart Pages, Ohio
 State, and other FAQ archives. See the resources question below
@@ -107,7 +91,7 @@
 
 The information contained here was compiled with the assistance
 of the Gnus development mailing list, and any errors or
-misprints are the my.gnus.org team's fault, sorry.
+misprints are the Gnus team's fault, sorry.
 
 @node FAQ 1 - Installation FAQ
 @subsection Installation FAQ
@@ -1042,8 +1026,7 @@
 make faces (specifications of how summary-line shall look
 like) for those postings, then we'll give them some
 special score and finally we'll tell Gnus to use the new
-faces. You can find detailed instructions on how to do it on
address@hidden://my.gnus.org/node/view/224, my.gnus.org}
+faces.
 
 @node FAQ 4-12
 @subsubheading Question 4.12
@@ -1414,7 +1397,7 @@
 installed and in your Path. Then you need 
 @uref{http://www.kdstevens.com/~stevens/ispell-page.html, ispell.el}
 and for on-the-fly spell-checking 
address@hidden://www-sop.inria.fr/mimosa/personnel/Manuel.Serrano/flyspell/flyspell.html,
 flyspell.el}.
address@hidden://www-sop.inria.fr/members/Manuel.Serrano/flyspell/flyspell.html,
 flyspell.el}.
 Ispell.el is shipped with Emacs and available through the XEmacs package 
system, 
 flyspell.el is shipped with Emacs and part of XEmacs text-modes package which 
is 
 available through the package system, so there should be no need to install 
them 
@@ -1987,7 +1970,7 @@
 @uref{http://www.isc.org/products/INN/, inn}. 
 Then you want to fetch your Mail, popular choices
 are @uref{http://www.catb.org/~esr/fetchmail/, fetchmail}
-and @uref{http://www.qcc.ca/~charlesc/software/getmail-3.0/, getmail}.
+and @uref{http://pyropus.ca/software/getmail/, getmail}.
 You should tell those to write the mail to your disk and
 Gnus to read it from there. Last but not least the mail
 sending part: This can be done with every MTA like
@@ -2141,12 +2124,8 @@
 
 @subsubheading Answer
 
-The two most important ones are the
+The most important one is the
 @uref{http://www.gnus.org, official Gnus website}.
-and it's sister site 
address@hidden://my.gnus.org, my.gnus.org (MGO)},
-hosting an archive of lisp snippets, howtos, a (not
-really finished) tutorial and this FAQ.
 
 Tell me about other sites which are interesting.
 

=== modified file 'doc/misc/gnus.texi'
--- a/doc/misc/gnus.texi        2010-10-04 22:26:51 +0000
+++ b/doc/misc/gnus.texi        2010-10-06 12:38:45 +0000
@@ -17401,13 +17401,12 @@
 mail back ends.
 
 @code{nnmaildir} is largely similar to @code{nnml}, with some notable
-differences.  Each message is stored in a separate file, but the
-filename is unrelated to the article number in Gnus.  @code{nnmaildir}
+differences. Each message is stored in a separate file, but the
+filename is unrelated to the article number in Gnus. @code{nnmaildir}
 also stores the equivalent of @code{nnml}'s overview files in one file
-per article, so it uses about twice as many inodes as @code{nnml}.  (Use
address@hidden -i} to see how plentiful your inode supply is.)  If this slows
-you down or takes up very much space, consider switching to
address@hidden://www.namesys.com/, ReiserFS} or another non-block-structured
+per article, so it uses about twice as many inodes as @code{nnml}.
+(Use @code{df -i} to see how plentiful your inode supply is.) If this
+slows you down or takes up very much space, a non-block-structured
 file system.
 
 Since maildirs don't require locking for delivery, the maildirs you use

=== modified file 'doc/misc/message.texi'
--- a/doc/misc/message.texi     2010-09-26 14:35:50 +0000
+++ b/doc/misc/message.texi     2010-10-06 12:38:45 +0000
@@ -1149,11 +1149,8 @@
 signed and encrypted messages to your fellow PGP 2.x users, you'll
 discover that the receiver cannot understand what you send. One
 solution is to use PGP 2.x instead (i.e., if you use @code{pgg}, set
address@hidden to @code{pgp}).  If you do want to use
-GnuPG, you can use a compatibility script called @code{gpg-2comp}
-available from
address@hidden://muppet.faveve.uni-stuttgart.de/~gero/gpg-2comp/}.  You
-could also convince your fellow PGP 2.x users to convert to GnuPG.
address@hidden to @code{pgp}). You could also convince your
+fellow PGP 2.x users to convert to GnuPG.
 @vindex mml-signencrypt-style-alist
 As a final workaround, you can make the sign and encryption work in
 two steps; separately sign, then encrypt a message.  If you would like

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2010-10-06 02:41:59 +0000
+++ b/lisp/gnus/ChangeLog       2010-10-06 12:38:45 +0000
@@ -1,3 +1,22 @@
+2010-10-06  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * shr.el (shr-insert): Get 'space transition right.
+
+       * nnimap.el (nnimap-open-connection): Prepare to support
+       open-gnutls-stream.
+
+       * shr.el: Rearrange function order to be more logical.
+
+2010-10-06  Julien Danjou  <address@hidden>
+
+       * nnrss.el (nnrss-check-group): Remove 404 URL in comment.
+       (nnrss-discover-feed): Remove 404 URL in docstring.
+
+       * nnir.el: Fix Swish-E URL.
+       Fix Namazu URL.
+
+       * message.el (message-change-subject): Remove 404 URL in a comment.
+
 2010-10-06  Katsumi Yamaoka  <address@hidden>
 
        * gnus-art.el (gnus-mime-view-part-as-type): Make it work when being

=== modified file 'lisp/gnus/message.el'
--- a/lisp/gnus/message.el      2010-10-04 22:26:51 +0000
+++ b/lisp/gnus/message.el      2010-10-06 12:38:45 +0000
@@ -2151,7 +2151,6 @@
 
 (defun message-change-subject (new-subject)
   "Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
-  ;; 
<URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged>
   (interactive
    (list
     (read-from-minibuffer "New subject: ")))

=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el       2010-10-05 22:43:06 +0000
+++ b/lisp/gnus/nnimap.el       2010-10-06 12:38:45 +0000
@@ -317,13 +317,16 @@
                   'starttls))
                '("imap"))
               ((memq nnimap-stream '(ssl tls))
-               (open-tls-stream
-                "*nnimap*" (current-buffer) nnimap-address
-                (setq port
-                      (or nnimap-server-port
-                          (if (netrc-find-service-number "imaps")
-                              "imaps"
-                            "993"))))
+               (funcall (if (and nil
+                                 (fboundp 'open-gnutls-stream))
+                            'open-gnutls-stream
+                          'open-tls-stream)
+                        "*nnimap*" (current-buffer) nnimap-address
+                        (setq port
+                              (or nnimap-server-port
+                                  (if (netrc-find-service-number "imaps")
+                                      "imaps"
+                                    "993"))))
                '("143" "993" "imap" "imaps"))
               (t
                (error "Unknown stream type: %s" nnimap-stream))))

=== modified file 'lisp/gnus/nnir.el'
--- a/lisp/gnus/nnir.el 2010-10-05 22:43:06 +0000
+++ b/lisp/gnus/nnir.el 2010-10-06 12:38:45 +0000
@@ -509,8 +509,7 @@
   :group 'nnir)
 
 ;; Swish-E.
-;; URL: http://sunsite.berkeley.edu/SWISH-E/
-;; New version: http://www.boe.es/swish-e
+;; URL: http://swish-e.org/
 ;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and
 ;; `nnir-swish-e-additional-switches'
 
@@ -596,7 +595,7 @@
   :type '(directory)
   :group 'nnir)
 
-;; Namazu engine, see <URL:http://ww.namazu.org/>
+;; Namazu engine, see <URL:http://www.namazu.org/>
 
 (defcustom nnir-namazu-program "namazu"
   "*Name of Namazu search executable."

=== modified file 'lisp/gnus/nnrss.el'
--- a/lisp/gnus/nnrss.el        2010-10-01 00:25:50 +0000
+++ b/lisp/gnus/nnrss.el        2010-10-06 12:38:45 +0000
@@ -703,9 +703,6 @@
            (push (list group nnrss-group-max url) nnrss-server-data)))
        (setq changed t))
       (setq xml (nnrss-fetch url)))
-    ;; See
-    ;; http://feeds.archive.org/validator/docs/howto/declare_namespaces.html
-    ;; for more RSS namespaces.
     (setq dc-ns (nnrss-get-namespace-prefix xml 
"http://purl.org/dc/elements/1.1/";)
          rdf-ns (nnrss-get-namespace-prefix xml 
"http://www.w3.org/1999/02/22-rdf-syntax-ns#";)
          rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/";)
@@ -966,7 +963,7 @@
 
 (defun nnrss-discover-feed (url)
   "Given a page, find an RSS feed using Mark Pilgrim's
-`ultra-liberal rss locator' (URL `http://diveintomark.org/2002/08/15.html')."
+`ultra-liberal rss locator'."
 
   (let ((parsed-page (nnrss-fetch url)))
 

=== modified file 'lisp/gnus/shr.el'
--- a/lisp/gnus/shr.el  2010-10-05 23:42:01 +0000
+++ b/lisp/gnus/shr.el  2010-10-06 12:38:45 +0000
@@ -57,13 +57,17 @@
 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 @@
     (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 @@
        (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,49 @@
      ((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 " ")
+       (setq shr-state 'space))
+      (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 +220,8 @@
          (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 +233,6 @@
   (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 +241,6 @@
        (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 +290,6 @@
                     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 +302,95 @@
                (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 +436,7 @@
 (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


reply via email to

[Prev in Thread] Current Thread [Next in Thread]