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.
This commit is contained in:
Gnus developers
Katsumi Yamaoka
parent
e44eccd7db
commit
66627fa93c
10 changed files with 261 additions and 245 deletions
|
|
@ -1,3 +1,16 @@
|
|||
2010-10-06 Julien Danjou <julien@danjou.info>
|
||||
|
||||
* 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 <ueno@unixuser.org>
|
||||
|
||||
* epa.texi (Caching Passphrases): New section.
|
||||
|
|
|
|||
|
|
@ -4,9 +4,6 @@
|
|||
@c Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
|
||||
@c 2009, 2010 Free Software Foundation, Inc.
|
||||
@c
|
||||
@c Do not modify this file, it was generated from gnus-faq.xml, available from
|
||||
@c <URL:http://my.gnus.org/FAQ/>.
|
||||
@c
|
||||
@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
|
||||
@uref{http://my.gnus.org/FAQ/},
|
||||
the Docbook source is available from
|
||||
@uref{http://sourceforge.net/projects/gnus/, http://sourceforge.net}.
|
||||
|
||||
Please submit features and suggestions to the
|
||||
@email{faq-discuss@@my.gnus.org, FAQ discussion list}.
|
||||
The list is protected against junk mail with
|
||||
@uref{http://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
|
||||
@email{faq-discuss-subscribe@@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)}.
|
||||
@email{ding@@gnus.org, ding list}.
|
||||
|
||||
@node FAQ - Changes
|
||||
@subheading Changes
|
||||
|
|
@ -98,8 +84,6 @@ would like to thank Steve Baur and Per Abrahamsen for doing a wonderful
|
|||
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:
|
||||
@uref{http://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 @@ if you want information on obtaining it in another format.
|
|||
|
||||
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 @@ in Gnus Country :-). It's a three step process: First we
|
|||
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
|
||||
@uref{http://my.gnus.org/node/view/224, my.gnus.org}
|
||||
faces.
|
||||
|
||||
@node FAQ 4-12
|
||||
@subsubheading Question 4.12
|
||||
|
|
@ -1414,7 +1397,7 @@ or @uref{http://aspell.sourceforge.net/, aspell}
|
|||
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
|
||||
@uref{http://www-sop.inria.fr/mimosa/personnel/Manuel.Serrano/flyspell/flyspell.html, flyspell.el}.
|
||||
@uref{http://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 @@ server like
|
|||
@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 @@ Which websites should I know?
|
|||
|
||||
@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
|
||||
@uref{http://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.
|
||||
|
||||
|
|
|
|||
|
|
@ -17401,13 +17401,12 @@ incompatible group parameters, slightly different from those of other
|
|||
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
|
||||
@code{df -i} to see how plentiful your inode supply is.) If this slows
|
||||
you down or takes up very much space, consider switching to
|
||||
@uref{http://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
|
||||
|
|
|
|||
|
|
@ -1149,11 +1149,8 @@ If you have imported your old PGP 2.x key into GnuPG, and want to send
|
|||
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
|
||||
@code{pgg-default-scheme} to @code{pgp}). If you do want to use
|
||||
GnuPG, you can use a compatibility script called @code{gpg-2comp}
|
||||
available from
|
||||
@uref{http://muppet.faveve.uni-stuttgart.de/~gero/gpg-2comp/}. You
|
||||
could also convince your fellow PGP 2.x users to convert to GnuPG.
|
||||
@code{pgg-default-scheme} 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
|
||||
|
|
|
|||
|
|
@ -1,3 +1,22 @@
|
|||
2010-10-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* 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 <julien@danjou.info>
|
||||
|
||||
* 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 <yamaoka@jpl.org>
|
||||
|
||||
* gnus-art.el (gnus-mime-view-part-as-type): Make it work when being
|
||||
|
|
|
|||
|
|
@ -2151,7 +2151,6 @@ Leading \"Re: \" is not stripped by this function. Use the function
|
|||
|
||||
(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: ")))
|
||||
|
|
|
|||
|
|
@ -317,13 +317,16 @@ textual parts.")
|
|||
'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))))
|
||||
|
|
|
|||
|
|
@ -509,8 +509,7 @@ that it is for swish++, not Wais."
|
|||
: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 @@ arrive at the correct group name, \"mail.misc\"."
|
|||
: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."
|
||||
|
|
|
|||
|
|
@ -703,9 +703,6 @@ which RSS 2.0 allows."
|
|||
(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 @@ whether they are `offsite' or `onsite'."
|
|||
|
||||
(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)))
|
||||
|
||||
|
|
|
|||
395
lisp/gnus/shr.el
395
lisp/gnus/shr.el
|
|
@ -57,13 +57,17 @@ fit these criteria."
|
|||
This is used for cid: URLs, and the function is called with the
|
||||
cid: URL as the argument.")
|
||||
|
||||
(defvar shr-width 70
|
||||
"Frame width to use for rendering.")
|
||||
|
||||
;;; Internal variables.
|
||||
|
||||
(defvar shr-folding-mode nil)
|
||||
(defvar shr-state nil)
|
||||
(defvar shr-start nil)
|
||||
(defvar shr-indentation 0)
|
||||
(defvar shr-inhibit-images nil)
|
||||
|
||||
(defvar shr-width 70)
|
||||
(defvar shr-list-mode nil)
|
||||
|
||||
(defvar shr-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
|
|
@ -75,17 +79,7 @@ cid: URL as the argument.")
|
|||
(define-key map "\r" 'shr-browse-url)
|
||||
map))
|
||||
|
||||
(defun shr-transform-dom (dom)
|
||||
(let ((result (list (pop dom))))
|
||||
(dolist (arg (pop dom))
|
||||
(push (cons (intern (concat ":" (symbol-name (car arg))) obarray)
|
||||
(cdr arg))
|
||||
result))
|
||||
(dolist (sub dom)
|
||||
(if (stringp sub)
|
||||
(push (cons :text sub) result)
|
||||
(push (shr-transform-dom sub) result)))
|
||||
(nreverse result)))
|
||||
;; Public functions and commands.
|
||||
|
||||
;;;###autoload
|
||||
(defun shr-insert-document (dom)
|
||||
|
|
@ -93,82 +87,6 @@ cid: URL as the argument.")
|
|||
(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)
|
||||
(funcall function (cdr dom))
|
||||
(shr-generic (cdr dom)))))
|
||||
|
||||
(defun shr-generic (cont)
|
||||
(dolist (sub cont)
|
||||
(cond
|
||||
((eq (car sub) :text)
|
||||
(shr-insert (cdr sub)))
|
||||
((listp (cdr sub))
|
||||
(shr-descend sub)))))
|
||||
|
||||
(defun shr-tag-p (cont)
|
||||
(shr-ensure-paragraph)
|
||||
(shr-generic cont)
|
||||
(shr-ensure-paragraph))
|
||||
|
||||
(defun shr-ensure-paragraph ()
|
||||
(unless (bobp)
|
||||
(if (bolp)
|
||||
(unless (save-excursion
|
||||
(forward-line -1)
|
||||
(looking-at " *$"))
|
||||
(insert "\n"))
|
||||
(if (save-excursion
|
||||
(beginning-of-line)
|
||||
(looking-at " *$"))
|
||||
(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-fontize-cont (cont &rest types)
|
||||
(let (shr-start)
|
||||
(shr-generic cont)
|
||||
(dolist (type types)
|
||||
(shr-add-font (or shr-start (point)) (point) type))))
|
||||
|
||||
(defun shr-add-font (start end type)
|
||||
(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)
|
||||
(let ((url (get-text-property (point) 'shr-url)))
|
||||
(if (not url)
|
||||
(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
|
||||
|
|
@ -200,46 +118,6 @@ redirects somewhere else."
|
|||
(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)
|
||||
|
|
@ -257,6 +135,112 @@ redirects somewhere else."
|
|||
(message "Browsing %s..." url)
|
||||
(browse-url url))))
|
||||
|
||||
;;; Utility functions.
|
||||
|
||||
(defun shr-transform-dom (dom)
|
||||
(let ((result (list (pop dom))))
|
||||
(dolist (arg (pop dom))
|
||||
(push (cons (intern (concat ":" (symbol-name (car arg))) obarray)
|
||||
(cdr arg))
|
||||
result))
|
||||
(dolist (sub dom)
|
||||
(if (stringp sub)
|
||||
(push (cons :text sub) result)
|
||||
(push (shr-transform-dom sub) result)))
|
||||
(nreverse result)))
|
||||
|
||||
(defun shr-descend (dom)
|
||||
(let ((function (intern (concat "shr-tag-" (symbol-name (car dom))) obarray)))
|
||||
(if (fboundp function)
|
||||
(funcall function (cdr dom))
|
||||
(shr-generic (cdr dom)))))
|
||||
|
||||
(defun shr-generic (cont)
|
||||
(dolist (sub cont)
|
||||
(cond
|
||||
((eq (car sub) :text)
|
||||
(shr-insert (cdr sub)))
|
||||
((listp (cdr sub))
|
||||
(shr-descend sub)))))
|
||||
|
||||
(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)
|
||||
(if (bolp)
|
||||
(unless (save-excursion
|
||||
(forward-line -1)
|
||||
(looking-at " *$"))
|
||||
(insert "\n"))
|
||||
(if (save-excursion
|
||||
(beginning-of-line)
|
||||
(looking-at " *$"))
|
||||
(insert "\n")
|
||||
(insert "\n\n")))))
|
||||
|
||||
(defun shr-indent ()
|
||||
(insert (make-string shr-indentation ? )))
|
||||
|
||||
(defun shr-fontize-cont (cont &rest types)
|
||||
(let (shr-start)
|
||||
(shr-generic cont)
|
||||
(dolist (type types)
|
||||
(shr-add-font (or shr-start (point)) (point) type))))
|
||||
|
||||
(defun shr-add-font (start end type)
|
||||
(let ((overlay (make-overlay start end)))
|
||||
(overlay-put overlay 'face type)))
|
||||
|
||||
(defun shr-browse-url ()
|
||||
"Browse the URL under point."
|
||||
(interactive)
|
||||
(let ((url (get-text-property (point) 'shr-url)))
|
||||
(if (not url)
|
||||
(message "No link under point")
|
||||
(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 @@ redirects somewhere else."
|
|||
image)))
|
||||
image)))
|
||||
|
||||
(defun shr-tag-pre (cont)
|
||||
(let ((shr-folding-mode 'none))
|
||||
(shr-ensure-newline)
|
||||
(shr-generic cont)
|
||||
(shr-ensure-newline)))
|
||||
|
||||
(defun shr-tag-blockquote (cont)
|
||||
(shr-ensure-paragraph)
|
||||
(let ((shr-indentation (+ shr-indentation 4)))
|
||||
(shr-generic cont))
|
||||
(shr-ensure-paragraph))
|
||||
|
||||
(defun shr-ensure-newline ()
|
||||
(unless (zerop (current-column))
|
||||
(insert "\n")))
|
||||
|
||||
(defun shr-insert (text)
|
||||
(when (eq shr-state 'image)
|
||||
(insert "\n")
|
||||
(setq shr-state nil))
|
||||
(cond
|
||||
((eq shr-folding-mode 'none)
|
||||
(insert text))
|
||||
(t
|
||||
(let ((first t)
|
||||
column)
|
||||
(when (and (string-match "\\`[ \t\n]" text)
|
||||
(not (bolp)))
|
||||
(insert " "))
|
||||
(dolist (elem (split-string text))
|
||||
(setq column (current-column))
|
||||
(when (> column 0)
|
||||
(cond
|
||||
((and (or (not first)
|
||||
(eq shr-state 'space))
|
||||
(> (+ column (length elem) 1) shr-width))
|
||||
(insert "\n"))
|
||||
((not first)
|
||||
(insert " "))))
|
||||
(setq first nil)
|
||||
(when (and (bolp)
|
||||
(> shr-indentation 0))
|
||||
(shr-indent))
|
||||
;; The shr-start is a special variable that is used to pass
|
||||
;; upwards the first point in the buffer where the text really
|
||||
;; starts.
|
||||
(unless shr-start
|
||||
(setq shr-start (point)))
|
||||
(insert elem))
|
||||
(setq shr-state nil)
|
||||
(when (and (string-match "[ \t\n]\\'" text)
|
||||
(not (bolp)))
|
||||
(insert " ")
|
||||
(setq shr-state 'space))))))
|
||||
|
||||
(defun shr-indent ()
|
||||
(insert (make-string shr-indentation ? )))
|
||||
|
||||
(defun shr-get-image-data (url)
|
||||
"Get image data for URL.
|
||||
Return a string with image data."
|
||||
|
|
@ -376,7 +302,95 @@ Return a string with image data."
|
|||
(search-forward "\r\n\r\n" nil t))
|
||||
(buffer-substring (point) (point-max))))))
|
||||
|
||||
(defvar shr-list-mode nil)
|
||||
(defun shr-heading (cont &rest types)
|
||||
(shr-ensure-paragraph)
|
||||
(apply #'shr-fontize-cont cont types)
|
||||
(shr-ensure-paragraph))
|
||||
|
||||
;;; Tag-specific rendering rules.
|
||||
|
||||
(defun shr-tag-p (cont)
|
||||
(shr-ensure-paragraph)
|
||||
(shr-generic cont)
|
||||
(shr-ensure-paragraph))
|
||||
|
||||
(defun shr-tag-b (cont)
|
||||
(shr-fontize-cont cont 'bold))
|
||||
|
||||
(defun shr-tag-i (cont)
|
||||
(shr-fontize-cont cont 'italic))
|
||||
|
||||
(defun shr-tag-em (cont)
|
||||
(shr-fontize-cont cont 'bold))
|
||||
|
||||
(defun shr-tag-u (cont)
|
||||
(shr-fontize-cont cont 'underline))
|
||||
|
||||
(defun shr-tag-s (cont)
|
||||
(shr-fontize-cont cont 'strike-through))
|
||||
|
||||
(defun shr-tag-a (cont)
|
||||
(let ((url (cdr (assq :href cont)))
|
||||
(start (point))
|
||||
shr-start)
|
||||
(shr-generic cont)
|
||||
(widget-convert-button
|
||||
'link (or shr-start start) (point)
|
||||
:help-echo url)
|
||||
(put-text-property (or shr-start start) (point) 'keymap shr-map)
|
||||
(put-text-property (or shr-start start) (point) 'shr-url url)))
|
||||
|
||||
(defun shr-tag-img (cont)
|
||||
(when (and (> (current-column) 0)
|
||||
(not (eq shr-state 'image)))
|
||||
(insert "\n"))
|
||||
(let ((start (point-marker)))
|
||||
(let ((alt (cdr (assq :alt cont)))
|
||||
(url (cdr (assq :src cont))))
|
||||
(when (zerop (length alt))
|
||||
(setq alt "[img]"))
|
||||
(cond
|
||||
((and (not shr-inhibit-images)
|
||||
(string-match "\\`cid:" url))
|
||||
(let ((url (substring url (match-end 0)))
|
||||
image)
|
||||
(if (or (not shr-content-function)
|
||||
(not (setq image (funcall shr-content-function url))))
|
||||
(insert alt)
|
||||
(shr-put-image image (point) alt))))
|
||||
((or shr-inhibit-images
|
||||
(and shr-blocked-images
|
||||
(string-match shr-blocked-images url)))
|
||||
(setq shr-start (point))
|
||||
(let ((shr-state 'space))
|
||||
(if (> (length alt) 8)
|
||||
(shr-insert (substring alt 0 8))
|
||||
(shr-insert alt))))
|
||||
((url-is-cached (browse-url-url-encode-chars url "[&)$ ]"))
|
||||
(shr-put-image (shr-get-image-data url) (point) alt))
|
||||
(t
|
||||
(insert alt)
|
||||
(ignore-errors
|
||||
(url-retrieve url 'shr-image-fetched
|
||||
(list (current-buffer) start (point-marker))
|
||||
t))))
|
||||
(insert " ")
|
||||
(put-text-property start (point) 'keymap shr-map)
|
||||
(put-text-property start (point) 'shr-alt alt)
|
||||
(put-text-property start (point) 'shr-image url)
|
||||
(setq shr-state 'image))))
|
||||
|
||||
(defun shr-tag-pre (cont)
|
||||
(let ((shr-folding-mode 'none))
|
||||
(shr-ensure-newline)
|
||||
(shr-generic cont)
|
||||
(shr-ensure-newline)))
|
||||
|
||||
(defun shr-tag-blockquote (cont)
|
||||
(shr-ensure-paragraph)
|
||||
(let ((shr-indentation (+ shr-indentation 4)))
|
||||
(shr-generic cont))
|
||||
(shr-ensure-paragraph))
|
||||
|
||||
(defun shr-tag-ul (cont)
|
||||
(shr-ensure-paragraph)
|
||||
|
|
@ -422,10 +436,7 @@ Return a string with image data."
|
|||
(defun shr-tag-h6 (cont)
|
||||
(shr-heading cont))
|
||||
|
||||
(defun shr-heading (cont &rest types)
|
||||
(shr-ensure-paragraph)
|
||||
(apply #'shr-fontize-cont cont types)
|
||||
(shr-ensure-paragraph))
|
||||
;;; Table rendering algorithm.
|
||||
|
||||
;; Table rendering is the only complicated thing here. We do this by
|
||||
;; first counting how many TDs there are in each TR, and registering
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue