Commit 2526f423 authored by Gnus developers's avatar Gnus developers Committed by Katsumi Yamaoka

Merge changes made in Gnus trunk.

nnimap.el (nnimap-insert-partial-structure): Fix boundary detection.
spam.el (spam-list-of-processors): Mark as obsolete.
gnus-art.el (gnus-blocked-images): New function.  Allow the `gnus-blocked-images' to be a function.
gnus-art.el (gnus-article-wash-function): Remove it, and use `mm-text-html-renderer' instead.
mm-decode.el (mm-inline-text-html-renderer): Removed.
mm-decode.el (mm-inline-media-tests): Removed use.
mm-view.el (mm-inline-text-html): Removed use.
mm-view.el (mm-text-html-renderer-alist): Add the `shr' and `gnus-w3m' symbols.
gnus.texi (Article Washing): shr and gnus-w3m, not the direct function names.
gnus-art.el (article-wash-html): Simplify and remove the charset stuff.  Use the normal html rendering code instead of the special html washing code.
mm-view.el (mm-text-html-washer-alist): Removed.
gnus-news.texi: Mention that mm-text-html-renderer is the only HTML variable now.
shr.el (shr-tag-table): Remove useless nconc.
parent 4bfb8dec
2010-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (HTML): Document the function value of
gnus-blocked-images.
(Article Washing): shr and gnus-w3m, not the direct function names.
2010-10-20 Julien Danjou <julien@danjou.info>
* emacs-mime.texi (Flowed text): Add a note about mml-enable-flowed
......
......@@ -124,6 +124,9 @@ Customization}.
@itemize @bullet
@item There's now only one variable that determines how @acronym{HTML}
is rendered: @code{mm-text-html-renderer}.
@item Gnus now supports sticky article buffers. Those are article buffers
that are not reused when you select another article. @xref{Sticky
Articles}.
......
......@@ -9803,19 +9803,16 @@ If a prefix is given, a charset will be asked for. If it is a number,
the charset defined in @code{gnus-summary-show-article-charset-alist}
(@pxref{Paging the Article}) will be used.
@vindex gnus-article-wash-function
The default is to use the function specified by
@code{mm-text-html-renderer} (@pxref{Display Customization, ,Display
Customization, emacs-mime, The Emacs MIME Manual}) to convert the
@acronym{HTML}, but this is controlled by the
@code{gnus-article-wash-function} variable. Pre-defined functions you
can use include:
@acronym{HTML}. Pre-defined functions you can use include:
@table @code
@item mm-shr
@item shr
Use Gnus simple html renderer.
@item gnus-article-html
@item gnus-w3m
Use Gnus rendered based on w3m.
@item w3
......@@ -12462,15 +12459,20 @@ that's based on @code{w3m}.
@item gnus-blocked-images
@vindex gnus-blocked-images
Images that have @acronym{URL}s that match this regexp won't be
fetched and displayed. For instance, do block all @acronym{URL}s that
have the string ``ads'' in them, do the following:
External images that have @acronym{URL}s that match this regexp won't
be fetched and displayed. For instance, do block all @acronym{URL}s
that have the string ``ads'' in them, do the following:
@lisp
(setq gnus-blocked-images "ads")
@end lisp
The default is to block all external images.
This can also be a function to be evaluated. If so, it will be
called with the group name as the parameter. The default value is
@code{gnus-block-private-groups}, which will return @samp{"."} for
anything that isn't a newsgroup. This means that no external images
will be fetched as a result of reading mail, so that nobody can use
web bugs (and the like) to track whether you've read email.
@item gnus-html-cache-directory
@vindex gnus-html-cache-directory
2010-10-20 Katsumi Yamaoka <yamaoka@jpl.org>
* shr.el (shr-tag-table): Remove useless nconc.
2010-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-art.el (article-wash-html): Simplify and remove the charset
stuff. Use the normal html rendering code instead of the special html
washing code.
* mm-view.el (mm-text-html-renderer-alist): Add the `shr' and
`gnus-w3m' symbols.
(mm-text-html-washer-alist): Removed.
* mm-decode.el (mm-inline-text-html-renderer): Removed.
(mm-inline-media-tests): Removed use.
(mm-text-html-renderer): Change default to the `shr' symbol.
* mm-view.el (mm-inline-text-html): Removed use.
* gnus-art.el (gnus-blocked-images): New function. Allow the
`gnus-blocked-images' to be a function.
(gnus-article-wash-function): Removed.
2010-10-20 Julien Danjou <julien@danjou.info>
* spam.el (spam-list-of-processors): Mark as obsolete.
* nnimap.el (nnimap-request-article): Fix BODYSTRUCTURE retrieval.
(nnimap-insert-partial-structure): Fix boundary detection.
2010-10-20 Andreas Seltenreich <seltenreich@gmx.de>
......
......@@ -1621,9 +1621,6 @@ It is a string, such as \"PGP\". If nil, ask user."
:type 'string
:group 'mime-security)
(defvar gnus-article-wash-function nil
"Function used for converting HTML into text.")
(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
(mm-coding-system-p 'utf-8)
(executable-find idna-program))
......@@ -1639,8 +1636,11 @@ This requires GNU Libidn, and by default only enabled if it is found."
:group 'gnus-article
:type 'boolean)
(defcustom gnus-blocked-images "."
"Images that have URLs matching this regexp will be blocked."
(defcustom gnus-blocked-images 'gnus-block-private-groups
"Images that have URLs matching this regexp will be blocked.
This can also be a function to be evaluated. If so, it will be
called with the group name as the parameter, and should return a
regexp."
:version "24.1"
:group 'gnus-art
:type 'regexp)
......@@ -2694,118 +2694,16 @@ If READ-CHARSET, ask for a coding system."
(when (interactive-p)
(gnus-treat-article nil))))
(defun article-wash-html (&optional read-charset)
"Format an HTML article.
If READ-CHARSET, ask for a coding system. If it is a number, the
charset defined in `gnus-summary-show-article-charset-alist' is used."
(interactive "P")
(save-excursion
(let ((inhibit-read-only t)
charset)
(if read-charset
(if (or (and (numberp read-charset)
(setq charset
(cdr
(assq read-charset
gnus-summary-show-article-charset-alist))))
(setq charset (mm-read-coding-system "Charset: ")))
(let ((gnus-summary-show-article-charset-alist
(list (cons 1 charset))))
(with-current-buffer gnus-summary-buffer
(gnus-summary-show-article 1)))
(error "No charset is given"))
(when (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer
(let* ((ct (gnus-fetch-field "content-type"))
(ctl (and ct (mail-header-parse-content-type ct))))
(setq charset (and ctl
(mail-content-type-get ctl 'charset)))
(when (stringp charset)
(setq charset (intern (downcase charset)))))))
(unless charset
(setq charset gnus-newsgroup-charset)))
(article-goto-body)
(save-window-excursion
(save-restriction
(narrow-to-region (point) (point-max))
(let* ((func (or gnus-article-wash-function mm-text-html-renderer))
(entry (assq func mm-text-html-washer-alist)))
(when entry
(setq func (cdr entry)))
(cond
((functionp func)
(funcall func))
(t
(apply (car func) (cdr func))))))))))
;; External.
(declare-function w3-region "ext:w3-display" (st nd))
(defun gnus-article-wash-html-with-w3 ()
"Wash the current buffer with w3."
(mm-setup-w3)
(let ((w3-strict-width (window-width))
(url-standalone-mode t)
(url-gateway-unplugged t)
(w3-honor-stylesheets nil))
(condition-case ()
(w3-region (point-min) (point-max))
(error))))
;; External.
(declare-function w3m-region "ext:w3m" (start end &optional url charset))
(defun gnus-article-wash-html-with-w3m ()
"Wash the current buffer with emacs-w3m."
(mm-setup-w3m)
(let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
w3m-force-redisplay)
(w3m-region (point-min) (point-max)))
;; Put the mark meaning this part was rendered by emacs-w3m.
(put-text-property (point-min) (point-max) 'mm-inline-text-html-with-w3m t)
(when (and mm-inline-text-html-with-w3m-keymap
(boundp 'w3m-minor-mode-map)
w3m-minor-mode-map)
(if (and (boundp 'w3m-link-map)
w3m-link-map)
(let* ((start (point-min))
(end (point-max))
(on (get-text-property start 'w3m-href-anchor))
(map (copy-keymap w3m-link-map))
next)
(set-keymap-parent map w3m-minor-mode-map)
(while (< start end)
(if on
(progn
(setq next (or (text-property-any start end
'w3m-href-anchor nil)
end))
(put-text-property start next 'keymap map))
(setq next (or (text-property-not-all start end
'w3m-href-anchor nil)
end))
(put-text-property start next 'keymap w3m-minor-mode-map))
(setq start next
on (not on))))
(put-text-property (point-min) (point-max) 'keymap w3m-minor-mode-map))))
(defvar charset) ;; Bound by `article-wash-html'.
(defun gnus-article-wash-html-with-w3m-standalone ()
"Wash the current buffer with w3m."
(if (mm-w3m-standalone-supports-m17n-p)
(progn
(unless (mm-coding-system-p charset) ;; Bound by `article-wash-html'.
;; The default.
(setq charset 'iso-8859-1))
(let ((coding-system-for-write charset)
(coding-system-for-read charset))
(call-process-region
(point-min) (point-max)
"w3m" t t nil "-dump" "-T" "text/html"
"-I" (symbol-name charset) "-O" (symbol-name charset))))
(mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html")))
(defun article-wash-html ()
"Format an HTML article."
(interactive)
(let ((handles nil)
(buffer-read-only nil))
(when (gnus-buffer-live-p gnus-original-article-buffer)
(setq handles (mm-dissect-buffer t t)))
(article-goto-body)
(delete-region (point) (point-max))
(mm-inline-text-html handles)))
(defvar gnus-article-browse-html-temp-list nil
"List of temporary files created by `gnus-article-browse-html-parts'.
......@@ -6896,6 +6794,18 @@ If given a prefix, show the hidden text instead."
(point))
(set-buffer buf))))))
(defun gnus-block-private-groups (group)
(if (gnus-news-group-p group)
;; Block nothing in news groups.
nil
;; Block everything anywhere else.
"."))
(defun gnus-blocked-images ()
(if (functionp gnus-blocked-images)
(funcall gnus-blocked-images gnus-newsgroup-name)
gnus-blocked-images))
;;;
;;; Article editing
;;;
......
......@@ -205,8 +205,8 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
url
(if (buffer-live-p gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
gnus-blocked-images)
gnus-blocked-images))
(gnus-blocked-images))
(gnus-blocked-images)))
(progn
(widget-convert-button
'link start end
......@@ -491,7 +491,7 @@ This only works if the article in question is HTML."
(defun gnus-html-prefetch-images (summary)
(when (buffer-live-p summary)
(let ((blocked-images (with-current-buffer summary
gnus-blocked-images)))
(gnus-blocked-images))))
(save-match-data
(while (re-search-forward "<img[^>]+src=[\"']\\([^\"']+\\)" nil t)
(let ((url (gnus-html-encode-url (match-string 1))))
......
......@@ -105,8 +105,8 @@
,disposition ,description ,cache ,id))
(defcustom mm-text-html-renderer
(cond ((fboundp 'libxml-parse-html-region) 'mm-shr)
((executable-find "w3m") 'gnus-article-html)
(cond ((fboundp 'libxml-parse-html-region) 'shr)
((executable-find "w3m") 'gnus-w3m)
((executable-find "links") 'links)
((executable-find "lynx") 'lynx)
((locate-library "w3") 'w3)
......@@ -115,8 +115,8 @@
"Render of HTML contents.
It is one of defined renderer types, or a rendering function.
The defined renderer types are:
`mm-shr': use Gnus simple HTML renderer;
`gnus-article-html' : use Gnus renderer based on w3m;
`shr': use Gnus simple HTML renderer;
`gnus-w3m' : use Gnus renderer based on w3m;
`w3m' : use emacs-w3m;
`w3m-standalone': use w3m;
`links': use links;
......@@ -125,8 +125,8 @@ The defined renderer types are:
`html2text' : use html2text;
nil : use external viewer (default web browser)."
:version "24.1"
:type '(choice (const mm-shr)
(const gnus-article-html)
:type '(choice (const shr)
(const gnus-w3m)
(const w3)
(const w3m :tag "emacs-w3m")
(const w3m-standalone :tag "standalone w3m" )
......@@ -137,10 +137,6 @@ nil : use external viewer (default web browser)."
(function))
:group 'mime-display)
(defvar mm-inline-text-html-renderer nil
"Function used for rendering inline HTML contents.
It is suggested to customize `mm-text-html-renderer' instead.")
(defcustom mm-inline-text-html-with-images nil
"If non-nil, Gnus will allow retrieving images in HTML contents with
the <img> tags. It has no effect on Emacs/w3. See also the
......@@ -245,8 +241,7 @@ before the external MIME handler is invoked."
("text/html"
mm-inline-text-html
(lambda (handle)
(or mm-inline-text-html-renderer
mm-text-html-renderer)))
mm-text-html-renderer))
("text/x-vcard"
mm-inline-text-vcard
(lambda (handle)
......
......@@ -50,29 +50,19 @@
(defvar w3m-minor-mode-map)
(defvar mm-text-html-renderer-alist
'((w3 . mm-inline-text-html-render-with-w3)
'((shr . mm-shr)
(w3 . mm-inline-text-html-render-with-w3)
(w3m . mm-inline-text-html-render-with-w3m)
(w3m-standalone . mm-inline-text-html-render-with-w3m-standalone)
(gnus-w3m . gnus-article-html)
(links mm-inline-render-with-file
mm-links-remove-leading-blank
"links" "-dump" file)
(lynx mm-inline-render-with-stdin nil
"lynx" "-dump" "-force_html" "-stdin" "-nolist")
(html2text mm-inline-render-with-function html2text))
(lynx mm-inline-render-with-stdin nil
"lynx" "-dump" "-force_html" "-stdin" "-nolist")
(html2text mm-inline-render-with-function html2text))
"The attributes of renderer types for text/html.")
(defvar mm-text-html-washer-alist
'((w3 . gnus-article-wash-html-with-w3)
(w3m . gnus-article-wash-html-with-w3m)
(w3m-standalone . gnus-article-wash-html-with-w3m-standalone)
(links mm-inline-wash-with-file
mm-links-remove-leading-blank
"links" "-dump" file)
(lynx mm-inline-wash-with-stdin nil
"lynx" "-dump" "-force_html" "-stdin" "-nolist")
(html2text html2text))
"The attributes of washer types for text/html.")
(defcustom mm-fill-flowed t
"If non-nil a format=flowed article will be displayed flowed."
:type 'boolean
......@@ -426,7 +416,7 @@
(buffer-string)))))
(defun mm-inline-text-html (handle)
(let* ((func (or mm-inline-text-html-renderer mm-text-html-renderer))
(let* ((func mm-text-html-renderer)
(entry (assq func mm-text-html-renderer-alist))
(inhibit-read-only t))
(if entry
......
......@@ -565,9 +565,9 @@ textual parts.")
(pop bstruc))
(setq type (car bstruc))
(setq bstruc (car (cdr bstruc)))
(when (and (stringp (car bstruc))
(string= (downcase (car bstruc)) "boundary"))
(setq boundary (cadr bstruc))))
(let ((has-boundary (member "boundary" bstruc)))
(when has-boundary
(setq boundary (cadr has-boundary)))))
(when subp
(insert (format "Content-type: multipart/%s; boundary=%S\n\n"
(downcase type) boundary)))
......
......@@ -198,7 +198,6 @@ used to render text. If it is nil, text will simply be folded.")
t)
(defvar mm-text-html-renderer)
(defvar mm-text-html-washer-alist)
(deffoo nnrss-request-article (article &optional group server buffer)
(setq group (nnrss-decode-group-name group))
......
......@@ -631,93 +631,92 @@ Return a string with image data."
(nbody (if body (shr-max-columns body)))
(nfooter (if footer (shr-max-columns footer))))
(shr-tag-table-1
(nconc
(if caption
(if header
(if footer
;; caption + hader + body + footer
(if (= nheader nbody)
(if (= nbody nfooter)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header ,@body))))
,@footer)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header ,@body))))
(tr (td (table (tbody ,@footer)))))))
(if (= nbody nfooter)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))
,@footer)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))
(tr (td (table (tbody ,@footer))))))))
;; caption + header + body
(if (= nheader nbody)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header ,@body)))))
(if (= nheader 1)
`((tr (td ,@caption))
,@header (tr (td (table (tbody ,@body)))))
`((tr (td ,@caption))
(tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))))))
(if footer
;; caption + body + footer
(if (= nbody nfooter)
`((tr (td (table (tbody ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td (table (tbody ,@body)))) ,@footer)
`((tr (td (table (tbody ,@body))))
(tr (td (table (tbody ,@footer)))))))
;; caption + body
`((tr (td ,@caption))
(tr (td (table (tbody ,@body)))))))
(if header
(if footer
;; header + body + footer
(if (= nheader nbody)
(if (= nbody nfooter)
`((tr (td (table (tbody ,@header ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td (table (tbody ,@header ,@body))))
,@footer)
`((tr (td (table (tbody ,@header ,@body))))
(tr (td (table (tbody ,@footer)))))))
(if (= nbody nfooter)
`((tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))
,@footer)
`((tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))
(tr (td (table (tbody ,@footer))))))))
;; header + body
(if (= nheader nbody)
`((tr (td (table (tbody ,@header ,@body)))))
(if (= nheader 1)
`(,@header (tr (td (table (tbody ,@body)))))
`((tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))))))
(if footer
;; body + footer
(if (= nbody nfooter)
`((tr (td (table (tbody ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td (table (tbody ,@body)))) ,@footer)
`((tr (td (table (tbody ,@body))))
(tr (td (table (tbody ,@footer)))))))
body)))))))
(if caption
(if header
(if footer
;; caption + hader + body + footer
(if (= nheader nbody)
(if (= nbody nfooter)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header ,@body))))
,@footer)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header ,@body))))
(tr (td (table (tbody ,@footer)))))))
(if (= nbody nfooter)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))
,@footer)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))
(tr (td (table (tbody ,@footer))))))))
;; caption + header + body
(if (= nheader nbody)
`((tr (td ,@caption))
(tr (td (table (tbody ,@header ,@body)))))
(if (= nheader 1)
`((tr (td ,@caption))
,@header (tr (td (table (tbody ,@body)))))
`((tr (td ,@caption))
(tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))))))
(if footer
;; caption + body + footer
(if (= nbody nfooter)
`((tr (td (table (tbody ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td (table (tbody ,@body)))) ,@footer)
`((tr (td (table (tbody ,@body))))
(tr (td (table (tbody ,@footer)))))))
;; caption + body
`((tr (td ,@caption))
(tr (td (table (tbody ,@body)))))))
(if header
(if footer
;; header + body + footer
(if (= nheader nbody)
(if (= nbody nfooter)
`((tr (td (table (tbody ,@header ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td (table (tbody ,@header ,@body))))
,@footer)
`((tr (td (table (tbody ,@header ,@body))))
(tr (td (table (tbody ,@footer)))))))
(if (= nbody nfooter)
`((tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))
,@footer)
`((tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))
(tr (td (table (tbody ,@footer))))))))
;; header + body
(if (= nheader nbody)
`((tr (td (table (tbody ,@header ,@body)))))
(if (= nheader 1)
`(,@header (tr (td (table (tbody ,@body)))))
`((tr (td (table (tbody ,@header))))
(tr (td (table (tbody ,@body))))))))
(if footer
;; body + footer
(if (= nbody nfooter)
`((tr (td (table (tbody ,@body ,@footer)))))
(if (= nfooter 1)
`((tr (td (table (tbody ,@body)))) ,@footer)
`((tr (td (table (tbody ,@body))))
(tr (td (table (tbody ,@footer)))))))
body))))))
(defun shr-find-elements (cont type)
(let (result)
......
......@@ -1287,6 +1287,7 @@ variable. When the processor variable is nil, just the
classification and spam-use-* check variable are used. This is
superseded by the new spam backend code, so it's only consulted
for backwards compatibility.")
(make-obsolete-variable 'spam-list-of-processors nil "22.1")
(defun spam-group-processor-p (group backend &optional classification)
"Checks if GROUP has a BACKEND with CLASSIFICATION registered.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment