aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGnus developers2010-10-06 12:38:45 +0000
committerKatsumi Yamaoka2010-10-06 12:38:45 +0000
commit66627fa93ccb57773210dc8968f185140e008d30 (patch)
tree53027723ccc7a6cf0f34f93045bca148e169425c
parente44eccd7dba3e3a996f956fdf4305c39bb807dcc (diff)
downloademacs-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/ChangeLog13
-rw-r--r--doc/misc/gnus-faq.texi33
-rw-r--r--doc/misc/gnus.texi11
-rw-r--r--doc/misc/message.texi7
-rw-r--r--lisp/gnus/ChangeLog19
-rw-r--r--lisp/gnus/message.el1
-rw-r--r--lisp/gnus/nnimap.el17
-rw-r--r--lisp/gnus/nnir.el5
-rw-r--r--lisp/gnus/nnrss.el5
-rw-r--r--lisp/gnus/shr.el387
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 @@
12010-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
12010-10-06 Daiki Ueno <ueno@unixuser.org> 142010-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
42This is the new Gnus Frequently Asked Questions list. 39This is the new Gnus Frequently Asked Questions list.
43If you have a Web browser, the official hypertext version is at
44@uref{http://my.gnus.org/FAQ/},
45the Docbook source is available from
46@uref{http://sourceforge.net/projects/gnus/, http://sourceforge.net}.
47 40
48Please submit features and suggestions to the 41Please submit features and suggestions to the
49@email{faq-discuss@@my.gnus.org, FAQ discussion list}. 42@email{ding@@gnus.org, ding list}.
50The list is protected against junk mail with
51@uref{http://smarden.org/qconfirm/index.html, qconfirm}. As
52a subscriber, your submissions will automatically pass. You can
53also subscribe to the list by sending a blank email to
54@email{faq-discuss-subscribe@@my.gnus.org, faq-discuss-subscribe@@my.gnus.org}
55and @uref{http://mail1.kens.com/cgi-bin/ezmlm-browse?command=monthbythread%26list=faq-discuss, browse
56the 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
98job with this FAQ before him. We would like to do the same - thanks, 84job with this FAQ before him. We would like to do the same - thanks,
99Justin! 85Justin!
100 86
101If you have a Web browser, the official hypertext version is at:
102@uref{http://my.gnus.org/FAQ/}.
103This version is much nicer than the unofficial hypertext 87This version is much nicer than the unofficial hypertext
104versions that are archived at Utrecht, Oxford, Smart Pages, Ohio 88versions that are archived at Utrecht, Oxford, Smart Pages, Ohio
105State, and other FAQ archives. See the resources question below 89State, 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
108The information contained here was compiled with the assistance 92The information contained here was compiled with the assistance
109of the Gnus development mailing list, and any errors or 93of the Gnus development mailing list, and any errors or
110misprints are the my.gnus.org team's fault, sorry. 94misprints 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
1042make faces (specifications of how summary-line shall look 1026make faces (specifications of how summary-line shall look
1043like) for those postings, then we'll give them some 1027like) for those postings, then we'll give them some
1044special score and finally we'll tell Gnus to use the new 1028special score and finally we'll tell Gnus to use the new
1045faces. You can find detailed instructions on how to do it on 1029faces.
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}
1414installed and in your Path. Then you need 1397installed 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}
1416and for on-the-fly spell-checking 1399and 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}.
1418Ispell.el is shipped with Emacs and available through the XEmacs package system, 1401Ispell.el is shipped with Emacs and available through the XEmacs package system,
1419flyspell.el is shipped with Emacs and part of XEmacs text-modes package which is 1402flyspell.el is shipped with Emacs and part of XEmacs text-modes package which is
1420available through the package system, so there should be no need to install them 1403available 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}.
1988Then you want to fetch your Mail, popular choices 1971Then you want to fetch your Mail, popular choices
1989are @uref{http://www.catb.org/~esr/fetchmail/, fetchmail} 1972are @uref{http://www.catb.org/~esr/fetchmail/, fetchmail}
1990and @uref{http://www.qcc.ca/~charlesc/software/getmail-3.0/, getmail}. 1973and @uref{http://pyropus.ca/software/getmail/, getmail}.
1991You should tell those to write the mail to your disk and 1974You should tell those to write the mail to your disk and
1992Gnus to read it from there. Last but not least the mail 1975Gnus to read it from there. Last but not least the mail
1993sending part: This can be done with every MTA like 1976sending 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
2144The two most important ones are the 2127The most important one is the
2145@uref{http://www.gnus.org, official Gnus website}. 2128@uref{http://www.gnus.org, official Gnus website}.
2146and it's sister site
2147@uref{http://my.gnus.org, my.gnus.org (MGO)},
2148hosting an archive of lisp snippets, howtos, a (not
2149really finished) tutorial and this FAQ.
2150 2129
2151Tell me about other sites which are interesting. 2130Tell 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
17401mail back ends. 17401mail 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
17404differences. Each message is stored in a separate file, but the 17404differences. Each message is stored in a separate file, but the
17405filename is unrelated to the article number in Gnus. @code{nnmaildir} 17405filename is unrelated to the article number in Gnus. @code{nnmaildir}
17406also stores the equivalent of @code{nnml}'s overview files in one file 17406also stores the equivalent of @code{nnml}'s overview files in one file
17407per article, so it uses about twice as many inodes as @code{nnml}. (Use 17407per 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
17409you down or takes up very much space, consider switching to 17409slows you down or takes up very much space, a non-block-structured
17410@uref{http://www.namesys.com/, ReiserFS} or another non-block-structured
17411file system. 17410file system.
17412 17411
17413Since maildirs don't require locking for delivery, the maildirs you use 17412Since 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
1149signed and encrypted messages to your fellow PGP 2.x users, you'll 1149signed and encrypted messages to your fellow PGP 2.x users, you'll
1150discover that the receiver cannot understand what you send. One 1150discover that the receiver cannot understand what you send. One
1151solution is to use PGP 2.x instead (i.e., if you use @code{pgg}, set 1151solution 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
1153GnuPG, you can use a compatibility script called @code{gpg-2comp} 1153fellow PGP 2.x users to convert to GnuPG.
1154available from
1155@uref{http://muppet.faveve.uni-stuttgart.de/~gero/gpg-2comp/}. You
1156could also convince your fellow PGP 2.x users to convert to GnuPG.
1157@vindex mml-signencrypt-style-alist 1154@vindex mml-signencrypt-style-alist
1158As a final workaround, you can make the sign and encryption work in 1155As a final workaround, you can make the sign and encryption work in
1159two steps; separately sign, then encrypt a message. If you would like 1156two 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 @@
12010-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
102010-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
12010-10-06 Katsumi Yamaoka <yamaoka@jpl.org> 202010-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."
57This is used for cid: URLs, and the function is called with the 57This is used for cid: URLs, and the function is called with the
58cid: URL as the argument.") 58cid: 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.
92If called twice, then try to fetch the URL and see whether it
93redirects 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.
174If called twice, then try to fetch the URL and see whether it
175redirects 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.
369Return a string with image data." 295Return 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