diff options
| author | Gnus developers | 2010-10-06 12:38:45 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2010-10-06 12:38:45 +0000 |
| commit | 66627fa93ccb57773210dc8968f185140e008d30 (patch) | |
| tree | 53027723ccc7a6cf0f34f93045bca148e169425c | |
| parent | e44eccd7dba3e3a996f956fdf4305c39bb807dcc (diff) | |
| download | emacs-66627fa93ccb57773210dc8968f185140e008d30.tar.gz emacs-66627fa93ccb57773210dc8968f185140e008d30.zip | |
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.
| -rw-r--r-- | doc/misc/ChangeLog | 13 | ||||
| -rw-r--r-- | doc/misc/gnus-faq.texi | 33 | ||||
| -rw-r--r-- | doc/misc/gnus.texi | 11 | ||||
| -rw-r--r-- | doc/misc/message.texi | 7 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 19 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 1 | ||||
| -rw-r--r-- | lisp/gnus/nnimap.el | 17 | ||||
| -rw-r--r-- | lisp/gnus/nnir.el | 5 | ||||
| -rw-r--r-- | lisp/gnus/nnrss.el | 5 | ||||
| -rw-r--r-- | lisp/gnus/shr.el | 387 |
10 files changed, 257 insertions, 241 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 6abb4be8a39..fb0b7a7851b 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog | |||
| @@ -1,3 +1,16 @@ | |||
| 1 | 2010-10-06 Julien Danjou <julien@danjou.info> | ||
| 2 | |||
| 3 | * message.texi (PGP Compatibility): Remove reference to gpg-2comp, | ||
| 4 | broken link. | ||
| 5 | |||
| 6 | * gnus-faq.texi (FAQ 8-3): Remove references to my.gnus.org. | ||
| 7 | |||
| 8 | * gnus.texi (Comparing Mail Back Ends): Remove broken link and allusion | ||
| 9 | to ReiserFS. | ||
| 10 | |||
| 11 | * gnus-faq.texi (FAQ 5-5): Fix Flyspell URL. | ||
| 12 | (FAQ 7-1): Fix getmail URL. | ||
| 13 | |||
| 1 | 2010-10-06 Daiki Ueno <ueno@unixuser.org> | 14 | 2010-10-06 Daiki Ueno <ueno@unixuser.org> |
| 2 | 15 | ||
| 3 | * epa.texi (Caching Passphrases): New section. | 16 | * epa.texi (Caching Passphrases): New section. |
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index ed74092eb0a..d9df9c8db18 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi | |||
| @@ -4,9 +4,6 @@ | |||
| 4 | @c Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, | 4 | @c Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, |
| 5 | @c 2009, 2010 Free Software Foundation, Inc. | 5 | @c 2009, 2010 Free Software Foundation, Inc. |
| 6 | @c | 6 | @c |
| 7 | @c Do not modify this file, it was generated from gnus-faq.xml, available from | ||
| 8 | @c <URL:http://my.gnus.org/FAQ/>. | ||
| 9 | @c | ||
| 10 | @setfilename gnus-faq.info | 7 | @setfilename gnus-faq.info |
| 11 | @settitle Frequently Asked Questions | 8 | @settitle Frequently Asked Questions |
| 12 | @c %**end of header | 9 | @c %**end of header |
| @@ -40,20 +37,9 @@ | |||
| 40 | @subheading Abstract | 37 | @subheading Abstract |
| 41 | 38 | ||
| 42 | This is the new Gnus Frequently Asked Questions list. | 39 | This is the new Gnus Frequently Asked Questions list. |
| 43 | If you have a Web browser, the official hypertext version is at | ||
| 44 | @uref{http://my.gnus.org/FAQ/}, | ||
| 45 | the Docbook source is available from | ||
| 46 | @uref{http://sourceforge.net/projects/gnus/, http://sourceforge.net}. | ||
| 47 | 40 | ||
| 48 | Please submit features and suggestions to the | 41 | Please submit features and suggestions to the |
| 49 | @email{faq-discuss@@my.gnus.org, FAQ discussion list}. | 42 | @email{ding@@gnus.org, ding list}. |
| 50 | The list is protected against junk mail with | ||
| 51 | @uref{http://smarden.org/qconfirm/index.html, qconfirm}. As | ||
| 52 | a subscriber, your submissions will automatically pass. You can | ||
| 53 | also subscribe to the list by sending a blank email to | ||
| 54 | @email{faq-discuss-subscribe@@my.gnus.org, faq-discuss-subscribe@@my.gnus.org} | ||
| 55 | and @uref{http://mail1.kens.com/cgi-bin/ezmlm-browse?command=monthbythread%26list=faq-discuss, browse | ||
| 56 | the archive (BROKEN)}. | ||
| 57 | 43 | ||
| 58 | @node FAQ - Changes | 44 | @node FAQ - Changes |
| 59 | @subheading Changes | 45 | @subheading Changes |
| @@ -98,8 +84,6 @@ would like to thank Steve Baur and Per Abrahamsen for doing a wonderful | |||
| 98 | job with this FAQ before him. We would like to do the same - thanks, | 84 | job with this FAQ before him. We would like to do the same - thanks, |
| 99 | Justin! | 85 | Justin! |
| 100 | 86 | ||
| 101 | If you have a Web browser, the official hypertext version is at: | ||
| 102 | @uref{http://my.gnus.org/FAQ/}. | ||
| 103 | This version is much nicer than the unofficial hypertext | 87 | This version is much nicer than the unofficial hypertext |
| 104 | versions that are archived at Utrecht, Oxford, Smart Pages, Ohio | 88 | versions that are archived at Utrecht, Oxford, Smart Pages, Ohio |
| 105 | State, and other FAQ archives. See the resources question below | 89 | State, and other FAQ archives. See the resources question below |
| @@ -107,7 +91,7 @@ if you want information on obtaining it in another format. | |||
| 107 | 91 | ||
| 108 | The information contained here was compiled with the assistance | 92 | The information contained here was compiled with the assistance |
| 109 | of the Gnus development mailing list, and any errors or | 93 | of the Gnus development mailing list, and any errors or |
| 110 | misprints are the my.gnus.org team's fault, sorry. | 94 | misprints are the Gnus team's fault, sorry. |
| 111 | 95 | ||
| 112 | @node FAQ 1 - Installation FAQ | 96 | @node FAQ 1 - Installation FAQ |
| 113 | @subsection Installation FAQ | 97 | @subsection Installation FAQ |
| @@ -1042,8 +1026,7 @@ in Gnus Country :-). It's a three step process: First we | |||
| 1042 | make faces (specifications of how summary-line shall look | 1026 | make faces (specifications of how summary-line shall look |
| 1043 | like) for those postings, then we'll give them some | 1027 | like) for those postings, then we'll give them some |
| 1044 | special score and finally we'll tell Gnus to use the new | 1028 | special score and finally we'll tell Gnus to use the new |
| 1045 | faces. You can find detailed instructions on how to do it on | 1029 | faces. |
| 1046 | @uref{http://my.gnus.org/node/view/224, my.gnus.org} | ||
| 1047 | 1030 | ||
| 1048 | @node FAQ 4-12 | 1031 | @node FAQ 4-12 |
| 1049 | @subsubheading Question 4.12 | 1032 | @subsubheading Question 4.12 |
| @@ -1414,7 +1397,7 @@ or @uref{http://aspell.sourceforge.net/, aspell} | |||
| 1414 | installed and in your Path. Then you need | 1397 | installed and in your Path. Then you need |
| 1415 | @uref{http://www.kdstevens.com/~stevens/ispell-page.html, ispell.el} | 1398 | @uref{http://www.kdstevens.com/~stevens/ispell-page.html, ispell.el} |
| 1416 | and for on-the-fly spell-checking | 1399 | and for on-the-fly spell-checking |
| 1417 | @uref{http://www-sop.inria.fr/mimosa/personnel/Manuel.Serrano/flyspell/flyspell.html, flyspell.el}. | 1400 | @uref{http://www-sop.inria.fr/members/Manuel.Serrano/flyspell/flyspell.html, flyspell.el}. |
| 1418 | Ispell.el is shipped with Emacs and available through the XEmacs package system, | 1401 | Ispell.el is shipped with Emacs and available through the XEmacs package system, |
| 1419 | flyspell.el is shipped with Emacs and part of XEmacs text-modes package which is | 1402 | flyspell.el is shipped with Emacs and part of XEmacs text-modes package which is |
| 1420 | available through the package system, so there should be no need to install them | 1403 | available through the package system, so there should be no need to install them |
| @@ -1987,7 +1970,7 @@ server like | |||
| 1987 | @uref{http://www.isc.org/products/INN/, inn}. | 1970 | @uref{http://www.isc.org/products/INN/, inn}. |
| 1988 | Then you want to fetch your Mail, popular choices | 1971 | Then you want to fetch your Mail, popular choices |
| 1989 | are @uref{http://www.catb.org/~esr/fetchmail/, fetchmail} | 1972 | are @uref{http://www.catb.org/~esr/fetchmail/, fetchmail} |
| 1990 | and @uref{http://www.qcc.ca/~charlesc/software/getmail-3.0/, getmail}. | 1973 | and @uref{http://pyropus.ca/software/getmail/, getmail}. |
| 1991 | You should tell those to write the mail to your disk and | 1974 | You should tell those to write the mail to your disk and |
| 1992 | Gnus to read it from there. Last but not least the mail | 1975 | Gnus to read it from there. Last but not least the mail |
| 1993 | sending part: This can be done with every MTA like | 1976 | sending part: This can be done with every MTA like |
| @@ -2141,12 +2124,8 @@ Which websites should I know? | |||
| 2141 | 2124 | ||
| 2142 | @subsubheading Answer | 2125 | @subsubheading Answer |
| 2143 | 2126 | ||
| 2144 | The two most important ones are the | 2127 | The most important one is the |
| 2145 | @uref{http://www.gnus.org, official Gnus website}. | 2128 | @uref{http://www.gnus.org, official Gnus website}. |
| 2146 | and it's sister site | ||
| 2147 | @uref{http://my.gnus.org, my.gnus.org (MGO)}, | ||
| 2148 | hosting an archive of lisp snippets, howtos, a (not | ||
| 2149 | really finished) tutorial and this FAQ. | ||
| 2150 | 2129 | ||
| 2151 | Tell me about other sites which are interesting. | 2130 | Tell me about other sites which are interesting. |
| 2152 | 2131 | ||
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 6c20e424f04..bc2adb87a35 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi | |||
| @@ -17401,13 +17401,12 @@ incompatible group parameters, slightly different from those of other | |||
| 17401 | mail back ends. | 17401 | mail back ends. |
| 17402 | 17402 | ||
| 17403 | @code{nnmaildir} is largely similar to @code{nnml}, with some notable | 17403 | @code{nnmaildir} is largely similar to @code{nnml}, with some notable |
| 17404 | differences. Each message is stored in a separate file, but the | 17404 | differences. Each message is stored in a separate file, but the |
| 17405 | filename is unrelated to the article number in Gnus. @code{nnmaildir} | 17405 | filename is unrelated to the article number in Gnus. @code{nnmaildir} |
| 17406 | also stores the equivalent of @code{nnml}'s overview files in one file | 17406 | also stores the equivalent of @code{nnml}'s overview files in one file |
| 17407 | per article, so it uses about twice as many inodes as @code{nnml}. (Use | 17407 | per article, so it uses about twice as many inodes as @code{nnml}. |
| 17408 | @code{df -i} to see how plentiful your inode supply is.) If this slows | 17408 | (Use @code{df -i} to see how plentiful your inode supply is.) If this |
| 17409 | you down or takes up very much space, consider switching to | 17409 | slows you down or takes up very much space, a non-block-structured |
| 17410 | @uref{http://www.namesys.com/, ReiserFS} or another non-block-structured | ||
| 17411 | file system. | 17410 | file system. |
| 17412 | 17411 | ||
| 17413 | Since maildirs don't require locking for delivery, the maildirs you use | 17412 | Since maildirs don't require locking for delivery, the maildirs you use |
diff --git a/doc/misc/message.texi b/doc/misc/message.texi index ad56520f892..8e9eca55177 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi | |||
| @@ -1149,11 +1149,8 @@ If you have imported your old PGP 2.x key into GnuPG, and want to send | |||
| 1149 | signed and encrypted messages to your fellow PGP 2.x users, you'll | 1149 | signed and encrypted messages to your fellow PGP 2.x users, you'll |
| 1150 | discover that the receiver cannot understand what you send. One | 1150 | discover that the receiver cannot understand what you send. One |
| 1151 | solution is to use PGP 2.x instead (i.e., if you use @code{pgg}, set | 1151 | solution is to use PGP 2.x instead (i.e., if you use @code{pgg}, set |
| 1152 | @code{pgg-default-scheme} to @code{pgp}). If you do want to use | 1152 | @code{pgg-default-scheme} to @code{pgp}). You could also convince your |
| 1153 | GnuPG, you can use a compatibility script called @code{gpg-2comp} | 1153 | fellow PGP 2.x users to convert to GnuPG. |
| 1154 | available from | ||
| 1155 | @uref{http://muppet.faveve.uni-stuttgart.de/~gero/gpg-2comp/}. You | ||
| 1156 | could also convince your fellow PGP 2.x users to convert to GnuPG. | ||
| 1157 | @vindex mml-signencrypt-style-alist | 1154 | @vindex mml-signencrypt-style-alist |
| 1158 | As a final workaround, you can make the sign and encryption work in | 1155 | As a final workaround, you can make the sign and encryption work in |
| 1159 | two steps; separately sign, then encrypt a message. If you would like | 1156 | two steps; separately sign, then encrypt a message. If you would like |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index b6c47cf3420..3ef57f26e86 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,22 @@ | |||
| 1 | 2010-10-06 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * shr.el (shr-insert): Get 'space transition right. | ||
| 4 | |||
| 5 | * nnimap.el (nnimap-open-connection): Prepare to support | ||
| 6 | open-gnutls-stream. | ||
| 7 | |||
| 8 | * shr.el: Rearrange function order to be more logical. | ||
| 9 | |||
| 10 | 2010-10-06 Julien Danjou <julien@danjou.info> | ||
| 11 | |||
| 12 | * nnrss.el (nnrss-check-group): Remove 404 URL in comment. | ||
| 13 | (nnrss-discover-feed): Remove 404 URL in docstring. | ||
| 14 | |||
| 15 | * nnir.el: Fix Swish-E URL. | ||
| 16 | Fix Namazu URL. | ||
| 17 | |||
| 18 | * message.el (message-change-subject): Remove 404 URL in a comment. | ||
| 19 | |||
| 1 | 2010-10-06 Katsumi Yamaoka <yamaoka@jpl.org> | 20 | 2010-10-06 Katsumi Yamaoka <yamaoka@jpl.org> |
| 2 | 21 | ||
| 3 | * gnus-art.el (gnus-mime-view-part-as-type): Make it work when being | 22 | * gnus-art.el (gnus-mime-view-part-as-type): Make it work when being |
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 546f13af815..d50e037ee00 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -2151,7 +2151,6 @@ Leading \"Re: \" is not stripped by this function. Use the function | |||
| 2151 | 2151 | ||
| 2152 | (defun message-change-subject (new-subject) | 2152 | (defun message-change-subject (new-subject) |
| 2153 | "Ask for NEW-SUBJECT header, append (was: <Old Subject>)." | 2153 | "Ask for NEW-SUBJECT header, append (was: <Old Subject>)." |
| 2154 | ;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged> | ||
| 2155 | (interactive | 2154 | (interactive |
| 2156 | (list | 2155 | (list |
| 2157 | (read-from-minibuffer "New subject: "))) | 2156 | (read-from-minibuffer "New subject: "))) |
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index d56e2f4b76e..7d935e4ecd1 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el | |||
| @@ -317,13 +317,16 @@ textual parts.") | |||
| 317 | 'starttls)) | 317 | 'starttls)) |
| 318 | '("imap")) | 318 | '("imap")) |
| 319 | ((memq nnimap-stream '(ssl tls)) | 319 | ((memq nnimap-stream '(ssl tls)) |
| 320 | (open-tls-stream | 320 | (funcall (if (and nil |
| 321 | "*nnimap*" (current-buffer) nnimap-address | 321 | (fboundp 'open-gnutls-stream)) |
| 322 | (setq port | 322 | 'open-gnutls-stream |
| 323 | (or nnimap-server-port | 323 | 'open-tls-stream) |
| 324 | (if (netrc-find-service-number "imaps") | 324 | "*nnimap*" (current-buffer) nnimap-address |
| 325 | "imaps" | 325 | (setq port |
| 326 | "993")))) | 326 | (or nnimap-server-port |
| 327 | (if (netrc-find-service-number "imaps") | ||
| 328 | "imaps" | ||
| 329 | "993")))) | ||
| 327 | '("143" "993" "imap" "imaps")) | 330 | '("143" "993" "imap" "imaps")) |
| 328 | (t | 331 | (t |
| 329 | (error "Unknown stream type: %s" nnimap-stream)))) | 332 | (error "Unknown stream type: %s" nnimap-stream)))) |
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 7a5380c52bb..3739cb8614f 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el | |||
| @@ -509,8 +509,7 @@ that it is for swish++, not Wais." | |||
| 509 | :group 'nnir) | 509 | :group 'nnir) |
| 510 | 510 | ||
| 511 | ;; Swish-E. | 511 | ;; Swish-E. |
| 512 | ;; URL: http://sunsite.berkeley.edu/SWISH-E/ | 512 | ;; URL: http://swish-e.org/ |
| 513 | ;; New version: http://www.boe.es/swish-e | ||
| 514 | ;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and | 513 | ;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and |
| 515 | ;; `nnir-swish-e-additional-switches' | 514 | ;; `nnir-swish-e-additional-switches' |
| 516 | 515 | ||
| @@ -596,7 +595,7 @@ arrive at the correct group name, \"mail.misc\"." | |||
| 596 | :type '(directory) | 595 | :type '(directory) |
| 597 | :group 'nnir) | 596 | :group 'nnir) |
| 598 | 597 | ||
| 599 | ;; Namazu engine, see <URL:http://ww.namazu.org/> | 598 | ;; Namazu engine, see <URL:http://www.namazu.org/> |
| 600 | 599 | ||
| 601 | (defcustom nnir-namazu-program "namazu" | 600 | (defcustom nnir-namazu-program "namazu" |
| 602 | "*Name of Namazu search executable." | 601 | "*Name of Namazu search executable." |
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 32b4f4f116f..743fba53e52 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el | |||
| @@ -703,9 +703,6 @@ which RSS 2.0 allows." | |||
| 703 | (push (list group nnrss-group-max url) nnrss-server-data))) | 703 | (push (list group nnrss-group-max url) nnrss-server-data))) |
| 704 | (setq changed t)) | 704 | (setq changed t)) |
| 705 | (setq xml (nnrss-fetch url))) | 705 | (setq xml (nnrss-fetch url))) |
| 706 | ;; See | ||
| 707 | ;; http://feeds.archive.org/validator/docs/howto/declare_namespaces.html | ||
| 708 | ;; for more RSS namespaces. | ||
| 709 | (setq dc-ns (nnrss-get-namespace-prefix xml "http://purl.org/dc/elements/1.1/") | 706 | (setq dc-ns (nnrss-get-namespace-prefix xml "http://purl.org/dc/elements/1.1/") |
| 710 | rdf-ns (nnrss-get-namespace-prefix xml "http://www.w3.org/1999/02/22-rdf-syntax-ns#") | 707 | rdf-ns (nnrss-get-namespace-prefix xml "http://www.w3.org/1999/02/22-rdf-syntax-ns#") |
| 711 | rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/") | 708 | rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/") |
| @@ -966,7 +963,7 @@ whether they are `offsite' or `onsite'." | |||
| 966 | 963 | ||
| 967 | (defun nnrss-discover-feed (url) | 964 | (defun nnrss-discover-feed (url) |
| 968 | "Given a page, find an RSS feed using Mark Pilgrim's | 965 | "Given a page, find an RSS feed using Mark Pilgrim's |
| 969 | `ultra-liberal rss locator' (URL `http://diveintomark.org/2002/08/15.html')." | 966 | `ultra-liberal rss locator'." |
| 970 | 967 | ||
| 971 | (let ((parsed-page (nnrss-fetch url))) | 968 | (let ((parsed-page (nnrss-fetch url))) |
| 972 | 969 | ||
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index c7f94ebc6b3..e0bb868f40e 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el | |||
| @@ -57,13 +57,17 @@ fit these criteria." | |||
| 57 | This is used for cid: URLs, and the function is called with the | 57 | This is used for cid: URLs, and the function is called with the |
| 58 | cid: URL as the argument.") | 58 | cid: URL as the argument.") |
| 59 | 59 | ||
| 60 | (defvar shr-width 70 | ||
| 61 | "Frame width to use for rendering.") | ||
| 62 | |||
| 63 | ;;; Internal variables. | ||
| 64 | |||
| 60 | (defvar shr-folding-mode nil) | 65 | (defvar shr-folding-mode nil) |
| 61 | (defvar shr-state nil) | 66 | (defvar shr-state nil) |
| 62 | (defvar shr-start nil) | 67 | (defvar shr-start nil) |
| 63 | (defvar shr-indentation 0) | 68 | (defvar shr-indentation 0) |
| 64 | (defvar shr-inhibit-images nil) | 69 | (defvar shr-inhibit-images nil) |
| 65 | 70 | (defvar shr-list-mode nil) | |
| 66 | (defvar shr-width 70) | ||
| 67 | 71 | ||
| 68 | (defvar shr-map | 72 | (defvar shr-map |
| 69 | (let ((map (make-sparse-keymap))) | 73 | (let ((map (make-sparse-keymap))) |
| @@ -75,6 +79,64 @@ cid: URL as the argument.") | |||
| 75 | (define-key map "\r" 'shr-browse-url) | 79 | (define-key map "\r" 'shr-browse-url) |
| 76 | map)) | 80 | map)) |
| 77 | 81 | ||
| 82 | ;; Public functions and commands. | ||
| 83 | |||
| 84 | ;;;###autoload | ||
| 85 | (defun shr-insert-document (dom) | ||
| 86 | (let ((shr-state nil) | ||
| 87 | (shr-start nil)) | ||
| 88 | (shr-descend (shr-transform-dom dom)))) | ||
| 89 | |||
| 90 | (defun shr-copy-url () | ||
| 91 | "Copy the URL under point to the kill ring. | ||
| 92 | If called twice, then try to fetch the URL and see whether it | ||
| 93 | redirects somewhere else." | ||
| 94 | (interactive) | ||
| 95 | (let ((url (get-text-property (point) 'shr-url))) | ||
| 96 | (cond | ||
| 97 | ((not url) | ||
| 98 | (message "No URL under point")) | ||
| 99 | ;; Resolve redirected URLs. | ||
| 100 | ((equal url (car kill-ring)) | ||
| 101 | (url-retrieve | ||
| 102 | url | ||
| 103 | (lambda (a) | ||
| 104 | (when (and (consp a) | ||
| 105 | (eq (car a) :redirect)) | ||
| 106 | (with-temp-buffer | ||
| 107 | (insert (cadr a)) | ||
| 108 | (goto-char (point-min)) | ||
| 109 | ;; Remove common tracking junk from the URL. | ||
| 110 | (when (re-search-forward ".utm_.*" nil t) | ||
| 111 | (replace-match "" t t)) | ||
| 112 | (message "Copied %s" (buffer-string)) | ||
| 113 | (copy-region-as-kill (point-min) (point-max))))))) | ||
| 114 | ;; Copy the URL to the kill ring. | ||
| 115 | (t | ||
| 116 | (with-temp-buffer | ||
| 117 | (insert url) | ||
| 118 | (copy-region-as-kill (point-min) (point-max)) | ||
| 119 | (message "Copied %s" url)))))) | ||
| 120 | |||
| 121 | (defun shr-show-alt-text () | ||
| 122 | "Show the ALT text of the image under point." | ||
| 123 | (interactive) | ||
| 124 | (let ((text (get-text-property (point) 'shr-alt))) | ||
| 125 | (if (not text) | ||
| 126 | (message "No image under point") | ||
| 127 | (message "%s" text)))) | ||
| 128 | |||
| 129 | (defun shr-browse-image () | ||
| 130 | "Browse the image under point." | ||
| 131 | (interactive) | ||
| 132 | (let ((url (get-text-property (point) 'shr-image))) | ||
| 133 | (if (not url) | ||
| 134 | (message "No image under point") | ||
| 135 | (message "Browsing %s..." url) | ||
| 136 | (browse-url url)))) | ||
| 137 | |||
| 138 | ;;; Utility functions. | ||
| 139 | |||
| 78 | (defun shr-transform-dom (dom) | 140 | (defun shr-transform-dom (dom) |
| 79 | (let ((result (list (pop dom)))) | 141 | (let ((result (list (pop dom)))) |
| 80 | (dolist (arg (pop dom)) | 142 | (dolist (arg (pop dom)) |
| @@ -87,12 +149,6 @@ cid: URL as the argument.") | |||
| 87 | (push (shr-transform-dom sub) result))) | 149 | (push (shr-transform-dom sub) result))) |
| 88 | (nreverse result))) | 150 | (nreverse result))) |
| 89 | 151 | ||
| 90 | ;;;###autoload | ||
| 91 | (defun shr-insert-document (dom) | ||
| 92 | (let ((shr-state nil) | ||
| 93 | (shr-start nil)) | ||
| 94 | (shr-descend (shr-transform-dom dom)))) | ||
| 95 | |||
| 96 | (defun shr-descend (dom) | 152 | (defun shr-descend (dom) |
| 97 | (let ((function (intern (concat "shr-tag-" (symbol-name (car dom))) obarray))) | 153 | (let ((function (intern (concat "shr-tag-" (symbol-name (car dom))) obarray))) |
| 98 | (if (fboundp function) | 154 | (if (fboundp function) |
| @@ -107,10 +163,49 @@ cid: URL as the argument.") | |||
| 107 | ((listp (cdr sub)) | 163 | ((listp (cdr sub)) |
| 108 | (shr-descend sub))))) | 164 | (shr-descend sub))))) |
| 109 | 165 | ||
| 110 | (defun shr-tag-p (cont) | 166 | (defun shr-insert (text) |
| 111 | (shr-ensure-paragraph) | 167 | (when (eq shr-state 'image) |
| 112 | (shr-generic cont) | 168 | (insert "\n") |
| 113 | (shr-ensure-paragraph)) | 169 | (setq shr-state nil)) |
| 170 | (cond | ||
| 171 | ((eq shr-folding-mode 'none) | ||
| 172 | (insert text)) | ||
| 173 | (t | ||
| 174 | (let ((first t) | ||
| 175 | column) | ||
| 176 | (when (and (string-match "\\`[ \t\n]" text) | ||
| 177 | (not (bolp))) | ||
| 178 | (insert " ") | ||
| 179 | (setq shr-state 'space)) | ||
| 180 | (dolist (elem (split-string text)) | ||
| 181 | (setq column (current-column)) | ||
| 182 | (when (> column 0) | ||
| 183 | (cond | ||
| 184 | ((and (or (not first) | ||
| 185 | (eq shr-state 'space)) | ||
| 186 | (> (+ column (length elem) 1) shr-width)) | ||
| 187 | (insert "\n")) | ||
| 188 | ((not first) | ||
| 189 | (insert " ")))) | ||
| 190 | (setq first nil) | ||
| 191 | (when (and (bolp) | ||
| 192 | (> shr-indentation 0)) | ||
| 193 | (shr-indent)) | ||
| 194 | ;; The shr-start is a special variable that is used to pass | ||
| 195 | ;; upwards the first point in the buffer where the text really | ||
| 196 | ;; starts. | ||
| 197 | (unless shr-start | ||
| 198 | (setq shr-start (point))) | ||
| 199 | (insert elem)) | ||
| 200 | (setq shr-state nil) | ||
| 201 | (when (and (string-match "[ \t\n]\\'" text) | ||
| 202 | (not (bolp))) | ||
| 203 | (insert " ") | ||
| 204 | (setq shr-state 'space)))))) | ||
| 205 | |||
| 206 | (defun shr-ensure-newline () | ||
| 207 | (unless (zerop (current-column)) | ||
| 208 | (insert "\n"))) | ||
| 114 | 209 | ||
| 115 | (defun shr-ensure-paragraph () | 210 | (defun shr-ensure-paragraph () |
| 116 | (unless (bobp) | 211 | (unless (bobp) |
| @@ -125,20 +220,8 @@ cid: URL as the argument.") | |||
| 125 | (insert "\n") | 220 | (insert "\n") |
| 126 | (insert "\n\n"))))) | 221 | (insert "\n\n"))))) |
| 127 | 222 | ||
| 128 | (defun shr-tag-b (cont) | 223 | (defun shr-indent () |
| 129 | (shr-fontize-cont cont 'bold)) | 224 | (insert (make-string shr-indentation ? ))) |
| 130 | |||
| 131 | (defun shr-tag-i (cont) | ||
| 132 | (shr-fontize-cont cont 'italic)) | ||
| 133 | |||
| 134 | (defun shr-tag-em (cont) | ||
| 135 | (shr-fontize-cont cont 'bold)) | ||
| 136 | |||
| 137 | (defun shr-tag-u (cont) | ||
| 138 | (shr-fontize-cont cont 'underline)) | ||
| 139 | |||
| 140 | (defun shr-tag-s (cont) | ||
| 141 | (shr-fontize-cont cont 'strike-through)) | ||
| 142 | 225 | ||
| 143 | (defun shr-fontize-cont (cont &rest types) | 226 | (defun shr-fontize-cont (cont &rest types) |
| 144 | (let (shr-start) | 227 | (let (shr-start) |
| @@ -150,17 +233,6 @@ cid: URL as the argument.") | |||
| 150 | (let ((overlay (make-overlay start end))) | 233 | (let ((overlay (make-overlay start end))) |
| 151 | (overlay-put overlay 'face type))) | 234 | (overlay-put overlay 'face type))) |
| 152 | 235 | ||
| 153 | (defun shr-tag-a (cont) | ||
| 154 | (let ((url (cdr (assq :href cont))) | ||
| 155 | (start (point)) | ||
| 156 | shr-start) | ||
| 157 | (shr-generic cont) | ||
| 158 | (widget-convert-button | ||
| 159 | 'link (or shr-start start) (point) | ||
| 160 | :help-echo url) | ||
| 161 | (put-text-property (or shr-start start) (point) 'keymap shr-map) | ||
| 162 | (put-text-property (or shr-start start) (point) 'shr-url url))) | ||
| 163 | |||
| 164 | (defun shr-browse-url () | 236 | (defun shr-browse-url () |
| 165 | "Browse the URL under point." | 237 | "Browse the URL under point." |
| 166 | (interactive) | 238 | (interactive) |
| @@ -169,94 +241,6 @@ cid: URL as the argument.") | |||
| 169 | (message "No link under point") | 241 | (message "No link under point") |
| 170 | (browse-url url)))) | 242 | (browse-url url)))) |
| 171 | 243 | ||
| 172 | (defun shr-copy-url () | ||
| 173 | "Copy the URL under point to the kill ring. | ||
| 174 | If called twice, then try to fetch the URL and see whether it | ||
| 175 | redirects somewhere else." | ||
| 176 | (interactive) | ||
| 177 | (let ((url (get-text-property (point) 'shr-url))) | ||
| 178 | (cond | ||
| 179 | ((not url) | ||
| 180 | (message "No URL under point")) | ||
| 181 | ;; Resolve redirected URLs. | ||
| 182 | ((equal url (car kill-ring)) | ||
| 183 | (url-retrieve | ||
| 184 | url | ||
| 185 | (lambda (a) | ||
| 186 | (when (and (consp a) | ||
| 187 | (eq (car a) :redirect)) | ||
| 188 | (with-temp-buffer | ||
| 189 | (insert (cadr a)) | ||
| 190 | (goto-char (point-min)) | ||
| 191 | ;; Remove common tracking junk from the URL. | ||
| 192 | (when (re-search-forward ".utm_.*" nil t) | ||
| 193 | (replace-match "" t t)) | ||
| 194 | (message "Copied %s" (buffer-string)) | ||
| 195 | (copy-region-as-kill (point-min) (point-max))))))) | ||
| 196 | ;; Copy the URL to the kill ring. | ||
| 197 | (t | ||
| 198 | (with-temp-buffer | ||
| 199 | (insert url) | ||
| 200 | (copy-region-as-kill (point-min) (point-max)) | ||
| 201 | (message "Copied %s" url)))))) | ||
| 202 | |||
| 203 | (defun shr-tag-img (cont) | ||
| 204 | (when (and (> (current-column) 0) | ||
| 205 | (not (eq shr-state 'image))) | ||
| 206 | (insert "\n")) | ||
| 207 | (let ((start (point-marker))) | ||
| 208 | (let ((alt (cdr (assq :alt cont))) | ||
| 209 | (url (cdr (assq :src cont)))) | ||
| 210 | (when (zerop (length alt)) | ||
| 211 | (setq alt "[img]")) | ||
| 212 | (cond | ||
| 213 | ((and (not shr-inhibit-images) | ||
| 214 | (string-match "\\`cid:" url)) | ||
| 215 | (let ((url (substring url (match-end 0))) | ||
| 216 | image) | ||
| 217 | (if (or (not shr-content-function) | ||
| 218 | (not (setq image (funcall shr-content-function url)))) | ||
| 219 | (insert alt) | ||
| 220 | (shr-put-image image (point) alt)))) | ||
| 221 | ((or shr-inhibit-images | ||
| 222 | (and shr-blocked-images | ||
| 223 | (string-match shr-blocked-images url))) | ||
| 224 | (setq shr-start (point)) | ||
| 225 | (let ((shr-state 'space)) | ||
| 226 | (if (> (length alt) 8) | ||
| 227 | (shr-insert (substring alt 0 8)) | ||
| 228 | (shr-insert alt)))) | ||
| 229 | ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]")) | ||
| 230 | (shr-put-image (shr-get-image-data url) (point) alt)) | ||
| 231 | (t | ||
| 232 | (insert alt) | ||
| 233 | (ignore-errors | ||
| 234 | (url-retrieve url 'shr-image-fetched | ||
| 235 | (list (current-buffer) start (point-marker)) | ||
| 236 | t)))) | ||
| 237 | (insert " ") | ||
| 238 | (put-text-property start (point) 'keymap shr-map) | ||
| 239 | (put-text-property start (point) 'shr-alt alt) | ||
| 240 | (put-text-property start (point) 'shr-image url) | ||
| 241 | (setq shr-state 'image)))) | ||
| 242 | |||
| 243 | (defun shr-show-alt-text () | ||
| 244 | "Show the ALT text of the image under point." | ||
| 245 | (interactive) | ||
| 246 | (let ((text (get-text-property (point) 'shr-alt))) | ||
| 247 | (if (not text) | ||
| 248 | (message "No image under point") | ||
| 249 | (message "%s" text)))) | ||
| 250 | |||
| 251 | (defun shr-browse-image () | ||
| 252 | "Browse the image under point." | ||
| 253 | (interactive) | ||
| 254 | (let ((url (get-text-property (point) 'shr-image))) | ||
| 255 | (if (not url) | ||
| 256 | (message "No image under point") | ||
| 257 | (message "Browsing %s..." url) | ||
| 258 | (browse-url url)))) | ||
| 259 | |||
| 260 | (defun shr-image-fetched (status buffer start end) | 244 | (defun shr-image-fetched (status buffer start end) |
| 261 | (when (and (buffer-name buffer) | 245 | (when (and (buffer-name buffer) |
| 262 | (not (plist-get status :error))) | 246 | (not (plist-get status :error))) |
| @@ -306,64 +290,6 @@ redirects somewhere else." | |||
| 306 | image))) | 290 | image))) |
| 307 | image))) | 291 | image))) |
| 308 | 292 | ||
| 309 | (defun shr-tag-pre (cont) | ||
| 310 | (let ((shr-folding-mode 'none)) | ||
| 311 | (shr-ensure-newline) | ||
| 312 | (shr-generic cont) | ||
| 313 | (shr-ensure-newline))) | ||
| 314 | |||
| 315 | (defun shr-tag-blockquote (cont) | ||
| 316 | (shr-ensure-paragraph) | ||
| 317 | (let ((shr-indentation (+ shr-indentation 4))) | ||
| 318 | (shr-generic cont)) | ||
| 319 | (shr-ensure-paragraph)) | ||
| 320 | |||
| 321 | (defun shr-ensure-newline () | ||
| 322 | (unless (zerop (current-column)) | ||
| 323 | (insert "\n"))) | ||
| 324 | |||
| 325 | (defun shr-insert (text) | ||
| 326 | (when (eq shr-state 'image) | ||
| 327 | (insert "\n") | ||
| 328 | (setq shr-state nil)) | ||
| 329 | (cond | ||
| 330 | ((eq shr-folding-mode 'none) | ||
| 331 | (insert text)) | ||
| 332 | (t | ||
| 333 | (let ((first t) | ||
| 334 | column) | ||
| 335 | (when (and (string-match "\\`[ \t\n]" text) | ||
| 336 | (not (bolp))) | ||
| 337 | (insert " ")) | ||
| 338 | (dolist (elem (split-string text)) | ||
| 339 | (setq column (current-column)) | ||
| 340 | (when (> column 0) | ||
| 341 | (cond | ||
| 342 | ((and (or (not first) | ||
| 343 | (eq shr-state 'space)) | ||
| 344 | (> (+ column (length elem) 1) shr-width)) | ||
| 345 | (insert "\n")) | ||
| 346 | ((not first) | ||
| 347 | (insert " ")))) | ||
| 348 | (setq first nil) | ||
| 349 | (when (and (bolp) | ||
| 350 | (> shr-indentation 0)) | ||
| 351 | (shr-indent)) | ||
| 352 | ;; The shr-start is a special variable that is used to pass | ||
| 353 | ;; upwards the first point in the buffer where the text really | ||
| 354 | ;; starts. | ||
| 355 | (unless shr-start | ||
| 356 | (setq shr-start (point))) | ||
| 357 | (insert elem)) | ||
| 358 | (setq shr-state nil) | ||
| 359 | (when (and (string-match "[ \t\n]\\'" text) | ||
| 360 | (not (bolp))) | ||
| 361 | (insert " ") | ||
| 362 | (setq shr-state 'space)))))) | ||
| 363 | |||
| 364 | (defun shr-indent () | ||
| 365 | (insert (make-string shr-indentation ? ))) | ||
| 366 | |||
| 367 | (defun shr-get-image-data (url) | 293 | (defun shr-get-image-data (url) |
| 368 | "Get image data for URL. | 294 | "Get image data for URL. |
| 369 | Return a string with image data." | 295 | Return a string with image data." |
| @@ -376,7 +302,95 @@ Return a string with image data." | |||
| 376 | (search-forward "\r\n\r\n" nil t)) | 302 | (search-forward "\r\n\r\n" nil t)) |
| 377 | (buffer-substring (point) (point-max)))))) | 303 | (buffer-substring (point) (point-max)))))) |
| 378 | 304 | ||
| 379 | (defvar shr-list-mode nil) | 305 | (defun shr-heading (cont &rest types) |
| 306 | (shr-ensure-paragraph) | ||
| 307 | (apply #'shr-fontize-cont cont types) | ||
| 308 | (shr-ensure-paragraph)) | ||
| 309 | |||
| 310 | ;;; Tag-specific rendering rules. | ||
| 311 | |||
| 312 | (defun shr-tag-p (cont) | ||
| 313 | (shr-ensure-paragraph) | ||
| 314 | (shr-generic cont) | ||
| 315 | (shr-ensure-paragraph)) | ||
| 316 | |||
| 317 | (defun shr-tag-b (cont) | ||
| 318 | (shr-fontize-cont cont 'bold)) | ||
| 319 | |||
| 320 | (defun shr-tag-i (cont) | ||
| 321 | (shr-fontize-cont cont 'italic)) | ||
| 322 | |||
| 323 | (defun shr-tag-em (cont) | ||
| 324 | (shr-fontize-cont cont 'bold)) | ||
| 325 | |||
| 326 | (defun shr-tag-u (cont) | ||
| 327 | (shr-fontize-cont cont 'underline)) | ||
| 328 | |||
| 329 | (defun shr-tag-s (cont) | ||
| 330 | (shr-fontize-cont cont 'strike-through)) | ||
| 331 | |||
| 332 | (defun shr-tag-a (cont) | ||
| 333 | (let ((url (cdr (assq :href cont))) | ||
| 334 | (start (point)) | ||
| 335 | shr-start) | ||
| 336 | (shr-generic cont) | ||
| 337 | (widget-convert-button | ||
| 338 | 'link (or shr-start start) (point) | ||
| 339 | :help-echo url) | ||
| 340 | (put-text-property (or shr-start start) (point) 'keymap shr-map) | ||
| 341 | (put-text-property (or shr-start start) (point) 'shr-url url))) | ||
| 342 | |||
| 343 | (defun shr-tag-img (cont) | ||
| 344 | (when (and (> (current-column) 0) | ||
| 345 | (not (eq shr-state 'image))) | ||
| 346 | (insert "\n")) | ||
| 347 | (let ((start (point-marker))) | ||
| 348 | (let ((alt (cdr (assq :alt cont))) | ||
| 349 | (url (cdr (assq :src cont)))) | ||
| 350 | (when (zerop (length alt)) | ||
| 351 | (setq alt "[img]")) | ||
| 352 | (cond | ||
| 353 | ((and (not shr-inhibit-images) | ||
| 354 | (string-match "\\`cid:" url)) | ||
| 355 | (let ((url (substring url (match-end 0))) | ||
| 356 | image) | ||
| 357 | (if (or (not shr-content-function) | ||
| 358 | (not (setq image (funcall shr-content-function url)))) | ||
| 359 | (insert alt) | ||
| 360 | (shr-put-image image (point) alt)))) | ||
| 361 | ((or shr-inhibit-images | ||
| 362 | (and shr-blocked-images | ||
| 363 | (string-match shr-blocked-images url))) | ||
| 364 | (setq shr-start (point)) | ||
| 365 | (let ((shr-state 'space)) | ||
| 366 | (if (> (length alt) 8) | ||
| 367 | (shr-insert (substring alt 0 8)) | ||
| 368 | (shr-insert alt)))) | ||
| 369 | ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]")) | ||
| 370 | (shr-put-image (shr-get-image-data url) (point) alt)) | ||
| 371 | (t | ||
| 372 | (insert alt) | ||
| 373 | (ignore-errors | ||
| 374 | (url-retrieve url 'shr-image-fetched | ||
| 375 | (list (current-buffer) start (point-marker)) | ||
| 376 | t)))) | ||
| 377 | (insert " ") | ||
| 378 | (put-text-property start (point) 'keymap shr-map) | ||
| 379 | (put-text-property start (point) 'shr-alt alt) | ||
| 380 | (put-text-property start (point) 'shr-image url) | ||
| 381 | (setq shr-state 'image)))) | ||
| 382 | |||
| 383 | (defun shr-tag-pre (cont) | ||
| 384 | (let ((shr-folding-mode 'none)) | ||
| 385 | (shr-ensure-newline) | ||
| 386 | (shr-generic cont) | ||
| 387 | (shr-ensure-newline))) | ||
| 388 | |||
| 389 | (defun shr-tag-blockquote (cont) | ||
| 390 | (shr-ensure-paragraph) | ||
| 391 | (let ((shr-indentation (+ shr-indentation 4))) | ||
| 392 | (shr-generic cont)) | ||
| 393 | (shr-ensure-paragraph)) | ||
| 380 | 394 | ||
| 381 | (defun shr-tag-ul (cont) | 395 | (defun shr-tag-ul (cont) |
| 382 | (shr-ensure-paragraph) | 396 | (shr-ensure-paragraph) |
| @@ -422,10 +436,7 @@ Return a string with image data." | |||
| 422 | (defun shr-tag-h6 (cont) | 436 | (defun shr-tag-h6 (cont) |
| 423 | (shr-heading cont)) | 437 | (shr-heading cont)) |
| 424 | 438 | ||
| 425 | (defun shr-heading (cont &rest types) | 439 | ;;; Table rendering algorithm. |
| 426 | (shr-ensure-paragraph) | ||
| 427 | (apply #'shr-fontize-cont cont types) | ||
| 428 | (shr-ensure-paragraph)) | ||
| 429 | 440 | ||
| 430 | ;; Table rendering is the only complicated thing here. We do this by | 441 | ;; Table rendering is the only complicated thing here. We do this by |
| 431 | ;; first counting how many TDs there are in each TR, and registering | 442 | ;; first counting how many TDs there are in each TR, and registering |