Commit 7e7e8cfe authored by Kenichi Handa's avatar Kenichi Handa
Browse files

merge trunk

2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (HTML): Document gnus-max-image-proportion.
2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (HTML): Document gnus-blocked-images.
......
......@@ -721,7 +721,6 @@ Document Groups
Combined Groups
 
* Virtual Groups:: Combining articles from many groups.
* Kibozed Groups:: Looking through parts of the newsfeed for articles.
 
Email Based Diary
 
......@@ -2624,15 +2623,6 @@ default a group pointing to the most recent articles will be created
(@code{gnus-group-recent-archive-directory}), but given a prefix, a full
group will be created from @code{gnus-group-archive-directory}.
 
@item G k
@kindex G k (Group)
@findex gnus-group-make-kiboze-group
@cindex nnkiboze
Make a kiboze group. You will be prompted for a name, for a regexp to
match groups to be ``included'' in the kiboze group, and a series of
strings to match on headers (@code{gnus-group-make-kiboze-group}).
@xref{Kibozed Groups}.
@item G D
@kindex G D (Group)
@findex gnus-group-enter-directory
......@@ -4420,8 +4410,7 @@ which point to the ``real'' message files (if mbox is used, copies are
made). Since mairix already presents search results in such a virtual
mail folder, it is very well suited for using it as an external program
for creating @emph{smart} mail folders, which represent certain mail
searches. This is similar to a Kiboze group (@pxref{Kibozed Groups}),
but much faster.
searches.
 
@node nnmairix requirements
@subsubsection nnmairix requirements
......@@ -12515,6 +12504,14 @@ directory, the oldest files will be deleted. The default is 500MB.
@vindex gnus-html-frame-width
The width to use when rendering HTML. The default is 70.
 
@item gnus-max-image-proportion
@vindex gnus-max-image-proportion
How big pictures displayed are in relation to the window they're in.
A value of 0.7 (the default) means that they are allowed to take up
70% of the width and height of the window. If they are larger than
this, and Emacs supports it, then the images will be rescaled down to
fit these criteria.
@end table
 
To use this, make sure that you have @code{w3m} and @code{curl}
......@@ -18925,7 +18922,6 @@ groups.
 
@menu
* Virtual Groups:: Combining articles from many groups.
* Kibozed Groups:: Looking through parts of the newsfeed for articles.
@end menu
 
 
......@@ -19015,58 +19011,6 @@ from component groups---group parameters, for instance, are not
inherited.
 
 
@node Kibozed Groups
@subsection Kibozed Groups
@cindex nnkiboze
@cindex kibozing
@dfn{Kibozing} is defined by the @acronym{OED} as ``grepping through
(parts of) the news feed''. @code{nnkiboze} is a back end that will
do this for you. Oh joy! Now you can grind any @acronym{NNTP} server
down to a halt with useless requests! Oh happiness!
@kindex G k (Group)
To create a kibozed group, use the @kbd{G k} command in the group
buffer.
The address field of the @code{nnkiboze} method is, as with
@code{nnvirtual}, a regexp to match groups to be ``included'' in the
@code{nnkiboze} group. That's where most similarities between
@code{nnkiboze} and @code{nnvirtual} end.
In addition to this regexp detailing component groups, an
@code{nnkiboze} group must have a score file to say what articles are
to be included in the group (@pxref{Scoring}).
@kindex M-x nnkiboze-generate-groups
@findex nnkiboze-generate-groups
You must run @kbd{M-x nnkiboze-generate-groups} after creating the
@code{nnkiboze} groups you want to have. This command will take time.
Lots of time. Oodles and oodles of time. Gnus has to fetch the
headers from all the articles in all the component groups and run them
through the scoring process to determine if there are any articles in
the groups that are to be part of the @code{nnkiboze} groups.
Please limit the number of component groups by using restrictive
regexps. Otherwise your sysadmin may become annoyed with you, and the
@acronym{NNTP} site may throw you off and never let you back in again.
Stranger things have happened.
@code{nnkiboze} component groups do not have to be alive---they can be dead,
and they can be foreign. No restrictions.
@vindex nnkiboze-directory
The generation of an @code{nnkiboze} group means writing two files in
@code{nnkiboze-directory}, which is @file{~/News/kiboze/} by default.
One contains the @acronym{NOV} header lines for all the articles in
the group, and the other is an additional @file{.newsrc} file to store
information on what groups have been searched through to find
component articles.
Articles marked as read in the @code{nnkiboze} group will have
their @acronym{NOV} lines removed from the @acronym{NOV} file.
@node Email Based Diary
@section Email Based Diary
@cindex diary
......@@ -27414,10 +27358,6 @@ cluttering up the @file{.emacs} file.
You can set the process mark on both groups and articles and perform
operations on all the marked items (@pxref{Process/Prefix}).
 
@item
You can grep through a subset of groups and create a group from the
results (@pxref{Kibozed Groups}).
@item
You can list subsets of groups according to, well, anything
(@pxref{Listing Groups}).
......@@ -29126,8 +29066,7 @@ As the variables for the other back ends, there are
@code{nnfolder-nov-is-evil}, @code{nnimap-nov-is-evil},
@code{nnml-nov-is-evil}, and @code{nnspool-nov-is-evil}. Note that a
non-@code{nil} value for @code{gnus-nov-is-evil} overrides all those
variables.@footnote{Although the back ends @code{nnkiboze}, and
@code{nnwfm} don't have their own nn*-nov-is-evil.}
variables.
@end table
 
 
2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca>
* simple.el (blink-paren-function): Move from C to here.
(blink-paren-post-self-insert-function): New function.
(post-self-insert-hook): Use it.
* emacs-lisp/pcase.el (pcase-split-memq):
Fix overenthusiastic optimisation.
(pcase-u1): Handle the case of a lambda pred.
2010-08-31 Kenichi Handa <handa@m17n.org>
 
* international/mule-cmds.el (standard-display-european-internal):
......
......@@ -290,9 +290,13 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase-split-memq (elems pat)
;; Based on pcase-split-eq.
(cond
;; The same match will give the same result.
;; The same match will give the same result, but we don't know how
;; to check it.
;; (???
;; (cons :pcase-succeed nil))
;; A match for one of the elements may succeed or fail.
((and (eq (car-safe pat) '\`) (member (cadr pat) elems))
(cons :pcase-succeed nil))
nil)
;; A different match will fail if this one succeeds.
((and (eq (car-safe pat) '\`)
;; (or (integerp (cadr pat)) (symbolp (cadr pat))
......@@ -383,18 +387,20 @@ and otherwise defers to REST which is a list of branches of the form
`(,(cadr upat) ,sym)
(let* ((exp (cadr upat))
;; `vs' is an upper bound on the vars we need.
(vs (pcase-fgrep (mapcar #'car vars) exp)))
(if vs
;; Let's not replace `vars' in `exp' since it's
;; too difficult to do it right, instead just
;; let-bind `vars' around `exp'.
`(let ,(mapcar (lambda (var)
(list var (cdr (assq var vars))))
vs)
;; FIXME: `vars' can capture `sym'. E.g.
;; (pcase x ((and `(,x . ,y) (pred (fun x)))))
(,@exp ,sym))
`(,@exp ,sym))))
(vs (pcase-fgrep (mapcar #'car vars) exp))
(call (if (functionp exp)
`(,exp ,sym) `(,@exp ,sym))))
(if (null vs)
call
;; Let's not replace `vars' in `exp' since it's
;; too difficult to do it right, instead just
;; let-bind `vars' around `exp'.
`(let ,(mapcar (lambda (var)
(list var (cdr (assq var vars))))
vs)
;; FIXME: `vars' can capture `sym'. E.g.
;; (pcase x ((and `(,x . ,y) (pred (fun x)))))
,call))))
(pcase-u1 matches code vars then-rest)
(pcase-u else-rest))))
((symbolp upat)
......
2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnwfm.el: Removed.
* nnlistserv.el: Removed.
2010-09-01 Teodor Zlatanov <tzz@lifelogs.com>
* gnus-html.el (gnus-html-image-url-blocked-p): New function.
(gnus-html-prefetch-images, gnus-html-wash-tags): Use it.
2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnkiboze.el: Removed.
* nndb.el: Removed.
* gnus-html.el (gnus-html-put-image): Use the deleted text as the image
alt text.
(gnus-html-rescale-image): Try to get the rescaling logic right for
images that are just wide and not tall.
* gnus.el (gnus-string-or): Fix the syntax to not use eval or
overshadow variable bindings.
2010-09-01 Teodor Zlatanov <tzz@lifelogs.com>
* gnus-html.el (gnus-html-wash-tags)
(gnus-html-schedule-image-fetching, gnus-html-prefetch-images): Add
extra logging.
2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-html.el (gnus-html-wash-tags): Delete the IMG_ALT region.
(gnus-max-image-proportion): New variable.
(gnus-html-rescale-image): New function.
(gnus-html-put-image): Rescale images.
2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca>
Fix up some byte-compiler warnings.
* gnus.el (gnus-group-find-parameter, gnus-kill-save-kill-buffer):
* gnus-cite.el (gnus-article-highlight-citation, gnus-dissect-cited-text)
(gnus-article-fill-cited-article, gnus-article-hide-citation)
(gnus-article-hide-citation-in-followups, gnus-cite-toggle):
* gnus-group.el (gnus-group-set-mode-line, gnus-group-quit)
(gnus-group-set-info, gnus-add-mark): Use with-current-buffer.
(gnus-group-update-group): Use save-excursion and with-current-buffer.
2010-09-01 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-html.el (gnus-article-html): Decode contents by charset.
2010-09-01 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-html.el (gnus-html-cache-directory, gnus-html-cache-size)
(gnus-html-frame-width, gnus-blocked-images)
* message.el (message-prune-recipient-rules): Add custom version.
* gnus-sum.el (gnus-auto-expirable-marks): Bump custom version.
* gnus-ems.el (gnus-process-get, gnus-process-put): New compatibility
functions.
* gnus-html.el (gnus-html-curl-sentinel): Replace process-get with
gnus-process-get.
2010-08-31 Julien Danjou <julien@danjou.info> (tiny change)
* nnimap.el (nnimap-request-newgroups): Use nnimap-request-list-method
......
......@@ -407,9 +407,7 @@ lines matches `message-cite-prefix-regexp' with the same prefix.
Lines matching `gnus-cite-attribution-suffix' and perhaps
`gnus-cite-attribution-prefix' are considered attribution lines."
(interactive (list 'force))
(save-excursion
(unless same-buffer
(set-buffer gnus-article-buffer))
(with-current-buffer (if same-buffer (current-buffer) gnus-article-buffer)
(gnus-cite-parse-maybe force)
(let ((buffer-read-only nil)
(alist gnus-cite-prefix-alist)
......@@ -462,8 +460,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
(defun gnus-dissect-cited-text ()
"Dissect the article buffer looking for cited text."
(save-excursion
(set-buffer gnus-article-buffer)
(with-current-buffer gnus-article-buffer
(gnus-cite-parse-maybe nil t)
(let ((alist gnus-cite-prefix-alist)
prefix numbers number marks m)
......@@ -523,8 +520,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
"Do word wrapping in the current article.
If WIDTH (the numerical prefix), use that text width when filling."
(interactive (list t current-prefix-arg))
(save-excursion
(set-buffer gnus-article-buffer)
(with-current-buffer gnus-article-buffer
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
(marks (gnus-dissect-cited-text))
......@@ -578,67 +574,66 @@ always hide."
(interactive (append (gnus-article-hidden-arg) (list 'force)))
(gnus-set-format 'cited-opened-text-button t)
(gnus-set-format 'cited-closed-text-button t)
(save-excursion
(set-buffer gnus-article-buffer)
(let ((buffer-read-only nil)
marks
(inhibit-point-motion-hooks t)
(props (nconc (list 'article-type 'cite)
gnus-hidden-properties))
(point (point-min))
found beg end start)
(while (setq point
(text-property-any point (point-max)
'gnus-callback
'gnus-article-toggle-cited-text))
(setq found t)
(goto-char point)
(gnus-article-toggle-cited-text
(get-text-property point 'gnus-data) arg)
(forward-line 1)
(setq point (point)))
(unless found
(setq marks (gnus-dissect-cited-text))
(while marks
(setq beg nil
end nil)
(while (and marks (string= (cdar marks) ""))
(setq marks (cdr marks)))
(when marks
(setq beg (caar marks)))
(while (and marks (not (string= (cdar marks) "")))
(setq marks (cdr marks)))
(when marks
(with-current-buffer gnus-article-buffer
(let ((buffer-read-only nil)
marks
(inhibit-point-motion-hooks t)
(props (nconc (list 'article-type 'cite)
gnus-hidden-properties))
(point (point-min))
found beg end start)
(while (setq point
(text-property-any point (point-max)
'gnus-callback
'gnus-article-toggle-cited-text))
(setq found t)
(goto-char point)
(gnus-article-toggle-cited-text
(get-text-property point 'gnus-data) arg)
(forward-line 1)
(setq point (point)))
(unless found
(setq marks (gnus-dissect-cited-text))
(while marks
(setq beg nil
end nil)
(while (and marks (string= (cdar marks) ""))
(setq marks (cdr marks)))
(when marks
(setq beg (caar marks)))
(while (and marks (not (string= (cdar marks) "")))
(setq marks (cdr marks)))
(when marks
(setq end (caar marks)))
;; Skip past lines we want to leave visible.
(when (and beg end gnus-cited-lines-visible)
(goto-char beg)
(forward-line (if (consp gnus-cited-lines-visible)
(car gnus-cited-lines-visible)
gnus-cited-lines-visible))
(if (>= (point) end)
(setq beg nil)
(setq beg (point-marker))
(when (consp gnus-cited-lines-visible)
(goto-char end)
(forward-line (- (cdr gnus-cited-lines-visible)))
(if (<= (point) beg)
(setq beg nil)
;; Skip past lines we want to leave visible.
(when (and beg end gnus-cited-lines-visible)
(goto-char beg)
(forward-line (if (consp gnus-cited-lines-visible)
(car gnus-cited-lines-visible)
gnus-cited-lines-visible))
(if (>= (point) end)
(setq beg nil)
(setq beg (point-marker))
(when (consp gnus-cited-lines-visible)
(goto-char end)
(forward-line (- (cdr gnus-cited-lines-visible)))
(if (<= (point) beg)
(setq beg nil)
(setq end (point-marker))))))
(when (and beg end)
(gnus-add-wash-type 'cite)
;; We use markers for the end-points to facilitate later
;; wrapping and mangling of text.
(setq beg (set-marker (make-marker) beg)
end (set-marker (make-marker) end))
(gnus-add-text-properties-when 'article-type nil beg end props)
(goto-char beg)
(when (and gnus-cite-blank-line-after-header
(not (save-excursion (search-backward "\n\n" nil t))))
(insert "\n"))
(put-text-property
(setq start (point-marker))
(progn
(when (and beg end)
(gnus-add-wash-type 'cite)
;; We use markers for the end-points to facilitate later
;; wrapping and mangling of text.
(setq beg (set-marker (make-marker) beg)
end (set-marker (make-marker) end))
(gnus-add-text-properties-when 'article-type nil beg end props)
(goto-char beg)
(when (and gnus-cite-blank-line-after-header
(not (save-excursion (search-backward "\n\n" nil t))))
(insert "\n"))
(put-text-property
(setq start (point-marker))
(progn
(gnus-article-add-button
(point)
(progn (eval gnus-cited-closed-text-button-line-format-spec)
......@@ -646,8 +641,8 @@ always hide."
`gnus-article-toggle-cited-text
(list (cons beg end) start))
(point))
'article-type 'annotation)
(set-marker beg (point))))))))
'article-type 'annotation)
(set-marker beg (point))))))))
(defun gnus-article-toggle-cited-text (args &optional arg)
"Toggle hiding the text in REGION.
......@@ -750,11 +745,9 @@ See also the documentation for `gnus-article-highlight-citation'."
(defun gnus-article-hide-citation-in-followups ()
"Hide cited text in non-root articles."
(interactive)
(save-excursion
(set-buffer gnus-article-buffer)
(with-current-buffer gnus-article-buffer
(let ((article (cdr gnus-article-current)))
(unless (save-excursion
(set-buffer gnus-summary-buffer)
(unless (with-current-buffer gnus-summary-buffer
(gnus-article-displayed-root-p article))
(gnus-article-hide-citation)))))
......@@ -1097,8 +1090,7 @@ See also the documentation for `gnus-article-highlight-citation'."
(gnus-overlay-put overlay 'face face))))))
(defun gnus-cite-toggle (prefix)
(save-excursion
(set-buffer gnus-article-buffer)
(with-current-buffer gnus-article-buffer
(gnus-cite-parse-maybe nil t)
(let ((buffer-read-only nil)
(numbers (cdr (assoc prefix gnus-cite-prefix-alist)))
......
......@@ -305,26 +305,39 @@
(setq start end
end nil))))))
(if (fboundp 'set-process-plist)
(progn
(defalias 'gnus-set-process-plist 'set-process-plist)
(defalias 'gnus-process-plist 'process-plist))
(defun gnus-set-process-plist (process plist)
"Replace the plist of PROCESS with PLIST. Returns PLIST."
(put 'gnus-process-plist process plist))
(defun gnus-process-plist (process)
"Return the plist of PROCESS."
;; Remove those of dead processes from `gnus-process-plist'
;; to prevent it from growing.
(let ((plist (symbol-plist 'gnus-process-plist))
proc)
(while (setq proc (car plist))
(if (and (processp proc)
(memq (process-status proc) '(open run)))
(setq plist (cddr plist))
(setcar plist (caddr plist))
(setcdr plist (or (cdddr plist) '(nil))))))
(get 'gnus-process-plist process)))
(eval-and-compile
(if (fboundp 'set-process-plist)
(progn
(defalias 'gnus-set-process-plist 'set-process-plist)
(defalias 'gnus-process-plist 'process-plist)
(defalias 'gnus-process-get 'process-get)
(defalias 'gnus-process-put 'process-put))
(defun gnus-set-process-plist (process plist)
"Replace the plist of PROCESS with PLIST. Returns PLIST."
(put 'gnus-process-plist process plist))
(defun gnus-process-plist (process)
"Return the plist of PROCESS."
;; Remove those of dead processes from `gnus-process-plist'
;; to prevent it from growing.
(let ((plist (symbol-plist 'gnus-process-plist))
proc)
(while (setq proc (car plist))
(if (and (processp proc)
(memq (process-status proc) '(open run)))
(setq plist (cddr plist))
(setcar plist (caddr plist))
(setcdr plist (or (cdddr plist) '(nil))))))
(get 'gnus-process-plist process))
(defun gnus-process-get (process propname)
"Return the value of PROCESS' PROPNAME property.
This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'."
(plist-get (gnus-process-plist process) propname))
(defun gnus-process-put (process propname value)
"Change PROCESS' PROPNAME property to VALUE.
It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'."
(gnus-set-process-plist process
(plist-put (gnus-process-plist process)
propname value)))))
(provide 'gnus-ems)
......
......@@ -660,7 +660,6 @@ simple manner.")
"h" gnus-group-make-help-group
"u" gnus-group-make-useful-group
"a" gnus-group-make-archive-group
"k" gnus-group-make-kiboze-group
"l" gnus-group-nnimap-edit-acl
"m" gnus-group-make-group
"E" gnus-group-edit-group
......@@ -931,7 +930,6 @@ simple manner.")
["Add the archive group" gnus-group-make-archive-group t]
["Make a doc group..." gnus-group-make-doc-group t]
["Make a web group..." gnus-group-make-web-group t]
["Make a kiboze group..." gnus-group-make-kiboze-group t]
["Make a virtual group..." gnus-group-make-empty-virtual t]
["Add a group to a virtual..." gnus-group-add-to-virtual t]
["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
......@@ -982,7 +980,6 @@ simple manner.")
["Browse foreign server..." gnus-group-browse-foreign-server t]
["Enter server buffer" gnus-group-enter-server-mode t]
["Expire all expirable articles" gnus-group-expire-all-groups t]
["Generate any kiboze groups" nnkiboze-generate-groups t]
["Gnus version" gnus-version t]
["Save .newsrc files" gnus-group-save-newsrc t]
["Suspend Gnus" gnus-group-suspend t]
......@@ -1691,72 +1688,66 @@ if it is a string, only list groups matching REGEXP."
"Update all lines where GROUP appear.
If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
already."
;; Can't use `save-excursion' here, so we do it manually.
(let ((buf (current-buffer))
mark)
(set-buffer gnus-group-buffer)
(setq mark (point-marker))
;; The buffer may be narrowed.
(save-restriction
(widen)
(let ((ident (gnus-intern-safe group gnus-active-hashtb))
(loc (point-min))
found buffer-read-only)
;; Enter the current status into the dribble buffer.
(let ((entry (gnus-group-entry group)))
(when (and entry
(not (gnus-ephemeral-group-p group)))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(gnus-prin1-to-string (nth 2 entry))
")"))))
;; Find all group instances. If topics are in use, each group
;; may be listed in more than once.
(while (setq loc (text-property-any
loc (point-max) 'gnus-group ident))
(setq found t)
(goto-char loc)
(let ((gnus-group-indentation (gnus-group-group-indentation)))
(gnus-delete-line)
(gnus-group-insert-group-line-info group)
(save-excursion
(forward-line -1)
(gnus-run-hooks 'gnus-group-update-group-hook)))
(setq loc (1+ loc)))
(unless (or found visible-only)
;; No such line in the buffer, find out where it's supposed to
;; go, and insert it there (or at the end of the buffer).
(if gnus-goto-missing-group-function
(funcall gnus-goto-missing-group-function group)
(let ((entry (cddr (gnus-group-entry group))))
(while (and entry (car entry)
(not
(gnus-goto-char
(text-property-any
(point-min) (point-max)
'gnus-group (gnus-intern-safe
(caar entry) gnus-active-hashtb)))))
(setq entry (cdr entry)))
(or entry (goto-char (point-max)))))
;; Finally insert the line.
(let ((gnus-group-indentation (gnus-group-group-indentation)))
(gnus-group-insert-group-line-info group)
(save-excursion
(forward-line -1)
(gnus-run-hooks 'gnus-group-update-group-hook))))
(when gnus-group-update-group-function
(funcall gnus-group-update-group-function group))
(gnus-group-set-mode-line)))
(goto-char mark)
(set-marker mark nil)
(set-buffer buf)))
(with-current-buffer gnus-group-buffer
(save-excursion
;; The buffer may be narrowed.
(save-restriction
(widen)
(let ((ident (gnus-intern-safe group gnus-active-hashtb))
(loc (point-min))
found buffer-read-only)
;; Enter the current status into the dribble buffer.
(let ((entry (gnus-group-entry group)))
(when (and entry
(not (gnus-ephemeral-group-p group)))