Mercurial > emacs
changeset 110242:2d39cc9376df
Merge from mainline.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Thu, 02 Sep 2010 02:12:28 +0000 |
| parents | 033d5544b038 (current diff) 99544439ab8f (diff) |
| children | d0ac153f6acf |
| files | lisp/gnus/nndb.el lisp/gnus/nnkiboze.el lisp/gnus/nnlistserv.el lisp/gnus/nnwfm.el |
| diffstat | 189 files changed, 899 insertions(+), 2068 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/man/ChangeLog Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/man/ChangeLog Thu Sep 02 02:12:28 2010 +0000 @@ -1,3 +1,7 @@ +2010-08-26 Sven Joachim <svenjoac@gmx.de> + + * emacs.1: Mention "maximized" value for the "fullscreen" X resource. + 2010-05-07 Chong Yidong <cyd@stupidchicken.com> * Version 23.2 released.
--- a/doc/man/emacs.1 Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/man/emacs.1 Thu Sep 02 02:12:28 2010 +0000 @@ -403,11 +403,12 @@ The desired fullscreen size. The value can be one of .IR fullboth , +.IR maximized , .IR fullwidth , or .IR fullheight , -which correspond to the command-line options `\-fs', `\-fw', and -`\-fh', respectively. +which correspond to the command-line options `\-fs', `-mm', `\-fw', +and `\-fh', respectively. Note that this applies to the initial frame only. .TP .BR geometry " (class " Geometry )
--- a/doc/misc/ChangeLog Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/ChangeLog Thu Sep 02 02:12:28 2010 +0000 @@ -1,3 +1,7 @@ +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. @@ -30,6 +34,19 @@ Sync with Tramp 2.1.19. + * tramp.texi (Inline methods, Default Method): Mention + `tramp-inline-compress-start-size'. Remove "kludgy" phrase. Remove + remark about doubled "-t" argument. + (Auto-save and Backup): Remove reference to Emacs 21. + (Filename Syntax): Describe port numbers. + (Frequently Asked Questions): Adapt supported (X)Emacs versions. Adapt + supported MS Windows versions. Remove obsolete URL. Recommend "sshx" + and "scpx" for echoing shells. Use the $() syntax, texi2dvi reports + errors with the backquotes. + (External packages): File attributes cache flushing for asynchronous + processes. + (Traces and Profiles): Describe verbose level 9. + * trampver.texi: Update release number. 2010-08-23 Michael Albinus <michael.albinus@gmx.de>
--- a/doc/misc/auth.texi Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/auth.texi Thu Sep 02 02:12:28 2010 +0000 @@ -286,7 +286,3 @@ @bye @c End: - -@ignore - arch-tag: 7b835fd3-473f-40fc-9776-1c4e49d26c94 -@end ignore
--- a/doc/misc/doclicense.texi Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/doclicense.texi Thu Sep 02 02:12:28 2010 +0000 @@ -505,7 +505,3 @@ @c Local Variables: @c ispell-local-pdict: "ispell-dict" @c End: - -@ignore - arch-tag: c1679162-1d8a-4f02-bc52-2e71765f0165 -@end ignore
--- a/doc/misc/emacs-mime.texi Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/emacs-mime.texi Thu Sep 02 02:12:28 2010 +0000 @@ -1889,7 +1889,3 @@ @c mode: texinfo @c coding: iso-8859-1 @c End: - -@ignore - arch-tag: c7ef2fd0-a91c-4e10-aa52-c1a2b11b1a8d -@end ignore
--- a/doc/misc/gnus-coding.texi Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/gnus-coding.texi Thu Sep 02 02:12:28 2010 +0000 @@ -387,7 +387,3 @@ @c mode: texinfo @c coding: iso-8859-1 @c End: - -@ignore - arch-tag: ab15234c-2c8a-4cbd-8111-1811bcc6f931 -@end ignore
--- a/doc/misc/gnus-faq.texi Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/gnus-faq.texi Thu Sep 02 02:12:28 2010 +0000 @@ -2331,7 +2331,3 @@ use to read and write Usenet news. @end table - -@ignore -arch-tag: 64dc5692-edb4-4848-a965-7aa0181acbb8 -@end ignore
--- a/doc/misc/gnus-news.el Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/gnus-news.el Thu Sep 02 02:12:28 2010 +0000 @@ -113,5 +113,4 @@ (insert gnus-news-trailer) (write-region (point-min) (point-max) outfile)))) -;; arch-tag: e23cdd27-eafd-4ba0-816f-98f5edb0dc29 ;;; gnus-news.el ends here
--- a/doc/misc/gnus-news.texi Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/gnus-news.texi Thu Sep 02 02:12:28 2010 +0000 @@ -325,7 +325,3 @@ @end itemize @c gnus-news.texi ends here. - -@ignore - arch-tag: 872c7569-4340-4d73-9d1d-7826d9f94a51 -@end ignore
--- a/doc/misc/gnus.texi Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/gnus.texi Thu Sep 02 02:12:28 2010 +0000 @@ -721,7 +721,6 @@ 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 @@ (@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 @@ 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 @@ @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 @@ @menu * Virtual Groups:: Combining articles from many groups. -* Kibozed Groups:: Looking through parts of the newsfeed for articles. @end menu @@ -19015,58 +19011,6 @@ 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 @@ -27415,10 +27359,6 @@ 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 @@ @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 @@ -30958,7 +30897,3 @@ @c mode: texinfo @c coding: iso-8859-1 @c End: - -@ignore - arch-tag: c9fa47e7-78ca-4681-bda9-9fef45d1c819 -@end ignore
--- a/doc/misc/message.texi Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/message.texi Thu Sep 02 02:12:28 2010 +0000 @@ -2473,7 +2473,3 @@ @bye @c End: - -@ignore - arch-tag: 16ab76af-a281-4e34-aed6-5624569f7601 -@end ignore
--- a/doc/misc/pgg.texi Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/pgg.texi Thu Sep 02 02:12:28 2010 +0000 @@ -497,7 +497,3 @@ @bye @c End: - -@ignore - arch-tag: 0c205838-34b9-41a5-b9d7-49ae57ccac85 -@end ignore
--- a/doc/misc/sasl.texi Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/sasl.texi Thu Sep 02 02:12:28 2010 +0000 @@ -267,7 +267,3 @@ @bye @c End: - -@ignore - arch-tag: dc9650be-a953-40bf-bc55-24fe5f19d875 -@end ignore
--- a/doc/misc/sieve.texi Wed Sep 01 22:54:47 2010 +0000 +++ b/doc/misc/sieve.texi Thu Sep 02 02:12:28 2010 +0000 @@ -356,7 +356,3 @@ @bye @c End: - -@ignore - arch-tag: 6e3ad0af-2eaf-4f35-a081-d40f4a683ec3 -@end ignore
--- a/etc/ChangeLog Wed Sep 01 22:54:47 2010 +0000 +++ b/etc/ChangeLog Thu Sep 02 02:12:28 2010 +0000 @@ -6,6 +6,10 @@ * NEWS: dbus.el supports alternative buses. +2010-08-22 Alex Harsanyi <harsanyi@mac.com> (tiny change) + + * emacs3.py: Import imp module and use it (Bug#5756). + 2010-08-14 Eli Zaretskii <eliz@gnu.org> * tutorials/TUTORIAL.he: Use MAQAF instead of hyphen where appropriate.
--- a/etc/emacs3.py Wed Sep 01 22:54:47 2010 +0000 +++ b/etc/emacs3.py Thu Sep 02 02:12:28 2010 +0000 @@ -1,10 +1,3 @@ -""" -Warning: This file is automatically generated from emacs2.py with the -2to3 script. Do not hand edit. -""" - -"""Definitions used by commands sent to inferior Python in python.el.""" - # Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. # Author: Dave Love <fx@gnu.org> @@ -23,7 +16,7 @@ # You should have received a copy of the GNU General Public License # along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -import os, sys, traceback, inspect, __main__ +import os, sys, traceback, inspect, imp, __main__ try: set @@ -216,7 +209,7 @@ try: try: if mod in __dict__ and inspect.ismodule (__dict__[mod]): - reload (__dict__[mod]) + imp.reload (__dict__[mod]) else: __dict__[mod] = __import__ (mod) except:
--- a/etc/gnus/gnus-setup.ast Wed Sep 01 22:54:47 2010 +0000 +++ b/etc/gnus/gnus-setup.ast Thu Sep 02 02:12:28 2010 +0000 @@ -48,8 +48,3 @@ @c Local variables: @c mode: texinfo @c End: - -@ignore - arch-tag: 6b7b200b-9169-4b44-8b32-b73773fa71af -@end ignore -
--- a/etc/refcards/gnus-refcard.tex Wed Sep 01 22:54:47 2010 +0000 +++ b/etc/refcards/gnus-refcard.tex Thu Sep 02 02:12:28 2010 +0000 @@ -1425,5 +1425,3 @@ %%% mode: latex %%% TeX-master: t %%% End: - -% arch-tag: be438b0e-6832-4afb-8c56-5f84743e5cd1
--- a/leim/ChangeLog Wed Sep 01 22:54:47 2010 +0000 +++ b/leim/ChangeLog Thu Sep 02 02:12:28 2010 +0000 @@ -1,3 +1,8 @@ +2010-08-28 Kenichi Handa <handa@m17n.org> + + * quail/japanese.el (quail-japanese-update-translation): Fix + handling of invalid key. + 2010-08-15 Andreas Schwab <schwab@linux-m68k.org> * quail/vntelex.el ("vietnamese-telex"): Doc fix.
--- a/leim/quail/japanese.el Wed Sep 01 22:54:47 2010 +0000 +++ b/leim/quail/japanese.el Thu Sep 02 02:12:28 2010 +0000 @@ -43,20 +43,25 @@ (or quail-current-str quail-current-key) "")) (if (integerp control-flag) - (if (= control-flag 0) - (setq quail-current-str (aref quail-current-key 0)) - (cond ((= (aref quail-current-key 0) ?n) + (let ((keylen (length quail-current-key))) + (cond ((= control-flag 0) + (setq quail-current-str (aref quail-current-key 0) + control-flag t)) + ((= (aref quail-current-key 0) ?n) (setq quail-current-str ?$B$s(B) (if (and quail-japanese-use-double-n + (> keylen 0) (= (aref quail-current-key 1) ?n)) (setq control-flag t))) - ((= (aref quail-current-key 0) (aref quail-current-key 1)) + ((and (> keylen 1) + (= (aref quail-current-key 0) (aref quail-current-key 1))) (setq quail-current-str ?$B$C(B)) (t (setq quail-current-str (aref quail-current-key 0)))) (if (integerp control-flag) (setq unread-command-events - (list (aref quail-current-key control-flag))))))) + (string-to-list + (substring quail-current-key control-flag))))))) control-flag) ;; Convert Hiragana <-> Katakana in the current translation region.
--- a/lisp/ChangeLog Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/ChangeLog Thu Sep 02 02:12:28 2010 +0000 @@ -8,6 +8,17 @@ 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): + Setup standard-display-table for 8-bit characters by storing 8-bit + characters in the element vector. + + * disp-table.el (standard-display-8bit): Setup + standard-display-table for 8-bit characters by storing 8-bit + characters in the element vector. + (standard-display-european): Likewise. + 2010-08-31 Masatake YAMATO <yamato@redhat.com> * textmodes/nroff-mode.el (nroff-view): New command. @@ -167,6 +178,57 @@ * whitespace.el (whitespace-style): Adjust type declaration. +2010-08-26 Magnus Henoch <magnus.henoch@gmail.com> + + * net/tramp-gvfs.el (tramp-gvfs-handle-copy-file): Do not pass + empty argument to gvfs-copy. + +2010-08-26 Chong Yidong <cyd@stupidchicken.com> + + * net/tramp-compat.el (tramp-compat-delete-file): Rewrite to + handle new TRASH arg of `delete-file'. + +2010-08-26 Christian Lynbech <christian.lynbech@tieto.com> (tiny change) + + * net/tramp.el (tramp-handle-insert-directory): Don't use + `forward-word', its default syntax could be changed. + +2010-08-26 Toru TSUNEYOSHI <t_tuneyosi@hotmail.com> + Michael Albinus <michael.albinus@gmx.de> + + Implement compression for inline methods. + + * net/tramp.el (tramp-inline-compress-start-size): New defcustom. + (tramp-copy-size-limit): Allow also nil. + (tramp-inline-compress-commands): New defconst. + (tramp-find-inline-compress, tramp-get-inline-compress) + (tramp-get-inline-coding): New defuns. + (tramp-get-remote-coding, tramp-get-local-coding): Remove, + replaced by `tramp-get-inline-coding'. + (tramp-handle-file-local-copy, tramp-handle-write-region) + (tramp-method-out-of-band-p): Use `tramp-get-inline-coding'. + +2010-08-26 Noah Lavine <noah549@gmail.com> (tiny change) + + Detect ssh 'ControlMaster' argument automatically in some cases. + + * net/tramp.el (tramp-detect-ssh-controlmaster): New defun. + (tramp-default-method): Use it. + +2010-08-26 Karel Klíč <kklic@redhat.com> + + * net/tramp.el (tramp-file-name-for-operation): + Add file-selinux-context. + +2010-08-26 Łukasz Stelmach <lukasz.stelmach@iem.pw.edu.pl> (tiny change) + + * play/cookie1.el (read-cookie): Fix off-by-one error (bug#6921). + +2010-08-26 Chong Yidong <cyd@stupidchicken.com> + + * simple.el (beginning-of-buffer, end-of-buffer): Doc fix + (Bug#6907). + 2010-08-26 Nathan Weizenbaum <nweiz@cressida.sea.corp.google.com> (tiny change) * progmodes/js.el: Make indentation more customizable (Bug#6914). @@ -190,6 +252,211 @@ Sync with Tramp 2.1.19. + * net/tramp-cmds.el (tramp-cleanup-all-connections) + (tramp-reporter-dump-variable, tramp-load-report-modules) + (tramp-append-tramp-buffers): Use `tramp-compat-funcall'. + (tramp-bug): Recommend setting of `tramp-verbose' to 9. + + * net/tramp-compat.el (top): Do not autoload + `tramp-handle-file-remote-p'. Load tramp-util.el and tramp-vc.el + only when `start-file-process' is not bound. + (byte-compile-not-obsolete-vars): Define if not bound. + (tramp-compat-funcall): New defmacro. + (tramp-compat-line-beginning-position) + (tramp-compat-line-end-position) + (tramp-compat-temporary-file-directory) + (tramp-compat-make-temp-file, tramp-compat-file-attributes) + (tramp-compat-copy-file, tramp-compat-copy-directory) + (tramp-compat-delete-file, tramp-compat-delete-directory) + (tramp-compat-number-sequence, tramp-compat-process-running-p): + Use it. + (tramp-advice-file-expand-wildcards): Do not use + `tramp-handle-file-remote-p'. + (tramp-compat-make-temp-file): Simplify fallback implementation. + (tramp-compat-copy-file): Add PRESERVE-SELINUX-CONTEXT. + (tramp-compat-copy-tree): Remove function. + (tramp-compat-delete-file): New defun. + (tramp-compat-delete-directory): Provide implementation for older + Emacsen. + (tramp-compat-file-attributes): Handle only + `wrong-number-of-arguments' error. + + * net/tramp-fish.el (tramp-fish-handle-copy-file): Add + PRESERVE_SELINUX_CONTEXT. + (tramp-fish-handle-delete-file): Add TRASH arg. + (tramp-fish-handle-directory-files-and-attributes): + Do not use `tramp-fish-handle-file-attributes. + (tramp-fish-handle-file-local-copy) + (tramp-fish-handle-insert-file-contents) + (tramp-fish-maybe-open-connection): Use `with-progress-reporter'. + + * net/tramp-gvfs.el (top): Require url-util. + (tramp-gvfs-mount-point): Remove. + (tramp-gvfs-file-name-handler-alist): Add `file-selinux-context' + and `set-file-selinux-context'. + (tramp-gvfs-stringify-dbus-message, tramp-gvfs-send-command) + (tramp-gvfs-handle-file-selinux-context) + (tramp-gvfs-handle-set-file-selinux-context): New defuns. + (with-tramp-dbus-call-method): Format trace message. + (tramp-gvfs-handle-copy-file): Handle PRESERVE-SELINUX-CONTEXT. + (tramp-gvfs-handle-copy-file, tramp-gvfs-handle-rename-file): + Implement backup call, when operation on local files fails. Use + progress reporter. Flush properties of changed files. + (tramp-gvfs-handle-delete-file): Add TRASH arg. Use + `tramp-compat-delete-file'. + (tramp-gvfs-handle-expand-file-name): Expand "~/". + (tramp-gvfs-handle-make-directory): Make more traces. + (tramp-gvfs-handle-write-region): Protect deleting tmpfile. + (tramp-gvfs-url-file-name): Hexify file name in url. + (tramp-gvfs-fuse-file-name): Take also prefix (like dav shares) + into account for the resulting file name. + (tramp-gvfs-handler-askquestion): Preserve current message, in + order to let progress reporter continue afterwards. (Bug#6257) + Return dummy mountpoint, when the answer is "no". See + `tramp-gvfs-maybe-open-connection'. + (tramp-gvfs-handler-mounted-unmounted) + (tramp-gvfs-connection-mounted-p): Test also for new mountspec + attribute "default_location". Set "prefix" property. Handle + default-location. + (tramp-gvfs-mount-spec): Return both prefix and mountspec. + (tramp-gvfs-maybe-open-connection): Test, whether mountpoint + exists. Raise an error, if not (due to a corresponding answer + "no" in interactive questions, for example). Use + `tramp-compat-funcall'. + + * net/tramp-imap.el (top): Autoload `epg-make-context'. + (tramp-imap-handle-copy-file): Add PRESERVE-SELINUX-CONTEXT. + (tramp-imap-do-copy-or-rename-file) + (tramp-imap-handle-insert-file-contents) + (tramp-imap-handle-file-local-copy): Use `with-progress-reporter'. + (tramp-imap-handle-delete-file): Add TRASH arg. + + * net/tramp-smb.el (tramp-smb-handle-copy-file): Add + PRESERVE-SELINUX-CONTEXT. + (tramp-smb-handle-copy-file) + (tramp-smb-handle-file-local-copy, tramp-smb-handle-rename-file) + (tramp-smb-handle-write-region, tramp-smb-maybe-open-connection): + Use `with-progress-reporter'. + (tramp-smb-handle-delete-file): Add TRASH arg. + + * net/tramp.el (tramp-methods): Move hostname to the end in all + ssh `tramp-login-args'. Add `tramp-async-args' attribute where + appropriate. + (tramp-verbose): Describe verbose level 9. + (tramp-completion-function-alist) + (tramp-file-name-regexp, tramp-chunksize) + (tramp-local-coding-commands, tramp-remote-coding-commands) + (with-connection-property, tramp-completion-mode-p) + (tramp-action-process-alive, tramp-action-out-of-band) + (tramp-check-for-regexp, tramp-file-name-p, tramp-equal-remote) + (tramp-exists-file-name-handler): Fix docstring. + (tramp-remote-process-environment): Use `format' instead of + `concat'. Protect version string by apostroph. + (tramp-shell-prompt-pattern): Do not use a shy group in case of + XEmacs. + (tramp-file-name-regexp-unified) + (tramp-completion-file-name-regexp-unified): On W32 systems, do + not regard the volume letter as remote filename. (Bug#5447) + (tramp-perl-file-attributes) + (tramp-perl-directory-files-and-attributes): Don't pass "$3". + (tramp-vc-registered-read-file-names): Read input as + here-document, otherwise the command could exceed maximum length + of command line. + (tramp-file-name-handler-alist): Add `file-selinux-context' and + `set-file-selinux-context'. + (tramp-debug-message): Add `tramp-compat-funcall' to ignored + backtrace functions. + (tramp-error-with-buffer): Don't show the connection buffer when + we are in completion mode. + (tramp-progress-reporter-update, tramp-remote-selinux-p) + (tramp-handle-file-selinux-context) + (tramp-handle-set-file-selinux-context, tramp-process-sentinel) + (tramp-connectable-p, tramp-open-shell, tramp-get-remote-trash): + New defuns. + (with-progress-reporter): New defmacro. + (tramp-debug-outline-regexp): New defconst. + (top, tramp-rfn-eshadow-setup-minibuffer) + (tramp-rfn-eshadow-update-overlay, tramp-handle-set-file-times) + (tramp-handle-dired-compress-file, tramp-handle-shell-command) + (tramp-completion-mode-p, tramp-check-for-regexp) + (tramp-open-connection-setup-interactive-shell) + (tramp-compute-multi-hops, tramp-read-passwd, tramp-clear-passwd) + (tramp-time-diff, tramp-coding-system-change-eol-conversion) + (tramp-set-process-query-on-exit-flag, tramp-unload-tramp): + Use `tramp-compat-funcall'. + (tramp-handle-make-symbolic-link): Flush file properties. + (tramp-handle-load, tramp-handle-file-local-copy) + (tramp-handle-insert-file-contents, tramp-handle-write-region) + (tramp-handle-vc-registered, tramp-maybe-send-script) + (tramp-find-shell): Use `with-progress-reporter'. + (tramp-do-file-attributes-with-stat): Add space in format string, + in order to work around a bug in pdksh. Reported by Gilles Pion + <gpion@lfdj.com>. + (tramp-handle-verify-visited-file-modtime): Do not send a command + when the connection is not established. + (tramp-handle-set-file-times): Simplify the check for utc. + (tramp-handle-directory-files-and-attributes) + (tramp-get-remote-path): Use `copy-tree'. + (tramp-completion-handle-file-name-all-completions): Ensure, that + non remote files are still checked. Oops. + (tramp-handle-copy-file, tramp-do-copy-or-rename-file): Handle + PRESERVE-SELINUX-CONTEXT. + (tramp-do-copy-or-rename-file): Add progress reporter. + (tramp-do-copy-or-rename-file-directly): Do not use + `tramp-handle-file-remote-p'. + (tramp-do-copy-or-rename-file-out-of-band): + Use `tramp-compat-delete-directory'. + (tramp-do-copy-or-rename-file-out-of-band) + (tramp-compute-multi-hops, tramp-maybe-open-connection): + Use `format-spec-make'. + (tramp-handle-delete-file): Add TRASH arg. + (tramp-handle-dired-uncache): Flush directory cache, not only file + cache. + (tramp-handle-expand-file-name) + (tramp-completion-handle-file-name-all-completions) + (tramp-completion-handle-file-name-completion): Use + `tramp-connectable-p'. + (tramp-handle-start-file-process): Set connection property "vec". + Use it, in order to invalidate file caches. Check only for + `remote-tty' process property. + Implement tty setting. (Bug#4604, Bug#6360) + (tramp-file-name-for-operation): Add `call-process-region' and + `set-file-selinux-context'. + (tramp-find-foreign-file-name-handler) + (tramp-advice-make-auto-save-file-name) + (tramp-set-auto-save-file-modes): Remove superfluous check for + `stringp'. This is done inside `tramp-tramp-file-p'. + (tramp-file-name-handler): Trace 'quit. Catch the error for some + operations when we are in completion mode. This gives the user + the chance to correct the file name in the minibuffer. + (tramp-completion-mode-p): Use `non-essential'. + (tramp-handle-file-name-all-completions): Backward/ XEmacs + compatibility: Use `completion-ignore-case' if + `read-file-name-completion-ignore-case' does not exist. + (tramp-get-debug-buffer): Use `tramp-debug-outline-regexp'. + (tramp-find-shell, tramp-open-connection-setup-interactive-shell): + `tramp-open-shell'. + (tramp-action-password): Hide password prompt before next run. + (tramp-process-actions): Widen connection buffer for the trace. + (tramp-open-connection-setup-interactive-shell): Set `remote-tty' + process property. Trace stty settings if `tramp-verbose' >= 9. + Apply workaround for IRIX64 bug. Move argument of last + `tramp-send-command' where it belongs to. + (tramp-maybe-open-connection): Use `async-args' and `gw-args' in + front of `login-args'. + (tramp-get-ls-command, tramp-get-ls-command-with-dired): Run tests + on "/dev/null" instead of "/". + (tramp-get-ls-command-with-dired): Make test for "--dired" + stronger. + (tramp-set-auto-save-file-modes): Adapt version check. + (tramp-set-process-query-on-exit-flag): Fix wrong parentheses. + (tramp-handle-process-file): Call the program in a subshell, in + order to preserve working directory. + (tramp-handle-shell-command): Don't use hard-wired "/bin/sh" but + `tramp-remote-sh' from `tramp-methods'. + (tramp-get-ls-command): Make test for "--color=never" stronger. + (tramp-check-for-regexp): Use (forward-line 1). + * net/trampver.el: Update release number. 2010-08-26 Chong Yidong <cyd@stupidchicken.com> @@ -275,6 +542,11 @@ * mouse.el (mouse-yank-primary): Avoid setting primary when deactivating the mark (Bug#6872). +2010-08-23 Chris Foote <chris@foote.com.au> (tiny change) + + * progmodes/python.el (python-block-pairs): Allow use of "finally" + with "else" (Bug#3991). + 2010-08-23 Michael Albinus <michael.albinus@gmx.de> * net/dbus.el: Accept UNIX domain sockets as bus address. @@ -301,13 +573,19 @@ * startup.el (command-line-1): Issue warning for ignored arguments --unibyte, etc (Bug#6886). +2010-08-22 Leo <sdl.web@gmail.com> + + * net/rcirc.el (rcirc-add-or-remove): Accept a list of elements. + (ignore, bright, dim, keyword): Split list of nicknames before + passing to rcirc-add-or-remove (Bug#6894). + 2010-08-22 Chong Yidong <cyd@stupidchicken.com> * emacs-lisp/easy-mmode.el (define-minor-mode): Doc fix (Bug#6880). 2010-08-22 Leo <sdl.web@gmail.com> - Fix buffer-list rename&refresh after after killing a buffer in ido. + Fix buffer-list rename&refresh after killing a buffer in ido. * lisp/ido.el: Revert Óscar's. (ido-kill-buffer-at-head): Exit the minibuffer with ido-exit=refresh. Remember the buffers at head, rather than their name.
--- a/lisp/calendar/parse-time.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/calendar/parse-time.el Thu Sep 02 02:12:28 2010 +0000 @@ -220,5 +220,4 @@ (provide 'parse-time) -;; arch-tag: 07066094-45a8-4c68-b307-86195e2c1103 ;;; parse-time.el ends here
--- a/lisp/calendar/time-date.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/calendar/time-date.el Thu Sep 02 02:12:28 2010 +0000 @@ -364,5 +364,4 @@ (provide 'time-date) -;; arch-tag: addcf07b-b20a-465b-af72-550b8ac5190f ;;; time-date.el ends here
--- a/lisp/disp-table.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/disp-table.el Thu Sep 02 02:12:28 2010 +0000 @@ -110,11 +110,27 @@ ;;;###autoload (defun standard-display-8bit (l h) - "Display characters in the range L to H literally." + "Display characters representing raw bytes in the range L to H literally. + +On a terminal display, each character in the range is displayed +by sending the corresponding byte directly to the terminal. + +On a graphic display, each character in the range is displayed +using the default font by a glyph whose code is the corresponding +byte. + +Note that ASCII printable characters (SPC to TILDA) are displayed +in the default way after this call." (or standard-display-table (setq standard-display-table (make-display-table))) + (if (> h 255) + (setq h 255)) (while (<= l h) - (aset standard-display-table l (if (or (< l ?\s) (>= l 127)) (vector l))) + (if (< l 128) + (aset standard-display-table l + (if (or (< l ?\s) (= l 127)) (vector l))) + (let ((c (unibyte-char-to-multibyte l))) + (aset standard-display-table c (vector c)))) (setq l (1+ l)))) ;;;###autoload @@ -236,9 +252,12 @@ (and (null arg) (char-table-p standard-display-table) ;; Test 161, because 160 displays as a space. - (equal (aref standard-display-table 161) [161]))) + (equal (aref standard-display-table + (unibyte-char-to-multibyte 161)) + (vector (unibyte-char-to-multibyte 161))))) (progn - (standard-display-default 160 255) + (standard-display-default + (unibyte-char-to-multibyte 160) (unibyte-char-to-multibyte 255)) (unless (or (memq window-system '(x w32 ns))) (and (terminal-coding-system) (set-terminal-coding-system nil))))
--- a/lisp/format-spec.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/format-spec.el Thu Sep 02 02:12:28 2010 +0000 @@ -76,5 +76,4 @@ (provide 'format-spec) -;; arch-tag: c22d49cf-d167-445d-b7f1-2504d4173f53 ;;; format-spec.el ends here
--- a/lisp/gnus/ChangeLog Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/ChangeLog Thu Sep 02 02:12:28 2010 +0000 @@ -1,3 +1,74 @@ +2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-wash-tags): Don't show images that are really + small. They're probably tracking images. + (gnus-html-wash-tags): Remove all <pre_int> place holders. + (gnus-html-rescale-image): Yet another try at getting the image sizing + right. + + * nntp.el (nntp-request-set-mark): Refuse to do marks if + nntp-marks-file-name is nil. + +2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-html.el (gnus-html-wash-tags) + (gnus-html-schedule-image-fetching, gnus-html-image-url-blocked-p): + Better logging. + +2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nndoc.el (nndoc-type-alist): Added a new type for Google digests. + + * gnus-html.el (gnus-html-wash-tags): Check the value of + gnus-blocked-images in the summary buffer. + +2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-html.el (gnus-html-image-url-blocked-p): Doc fix. + +2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-wash-tags): "A" is also used for links, just + like "a", it seems like. + (gnus-html-image-url-blocked-p): Take a parameter for blocked-images + since it needs to be picked from the correct buffer. + + * 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. @@ -14722,5 +14793,3 @@ ;; fill-column: 79 ;; add-log-time-zone-rule: t ;; End: - -;;; arch-tag: 3f33a3e7-090d-492b-bedd-02a1417d32b4
--- a/lisp/gnus/auth-source.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/auth-source.el Thu Sep 02 02:12:28 2010 +0000 @@ -465,5 +465,4 @@ (provide 'auth-source) -;; arch-tag: ff1afe78-06e9-42c2-b693-e9f922cbe4ab ;;; auth-source.el ends here
--- a/lisp/gnus/canlock.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/canlock.el Thu Sep 02 02:12:28 2010 +0000 @@ -247,5 +247,4 @@ (provide 'canlock) -;; arch-tag: 033c4f09-b9f1-459d-bd0d-254430283f78 ;;; canlock.el ends here
--- a/lisp/gnus/compface.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/compface.el Thu Sep 02 02:12:28 2010 +0000 @@ -58,5 +58,4 @@ (provide 'compface) -;; arch-tag: f9c78e84-98c0-4142-9682-8ba4cf4c3441 ;;; compface.el ends here
--- a/lisp/gnus/deuglify.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/deuglify.el Thu Sep 02 02:12:28 2010 +0000 @@ -476,5 +476,4 @@ ;; coding: iso-8859-1 ;; End: -;; arch-tag: 5f895cc9-51a9-487c-b42e-28844d79eb73 ;;; deuglify.el ends here
--- a/lisp/gnus/earcon.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/earcon.el Thu Sep 02 02:12:28 2010 +0000 @@ -229,5 +229,4 @@ (run-hooks 'earcon-load-hook) -;; arch-tag: 844dfeea-980c-4ed0-907f-a30bf139691c ;;; earcon.el ends here
--- a/lisp/gnus/ecomplete.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/ecomplete.el Thu Sep 02 02:12:28 2010 +0000 @@ -95,7 +95,7 @@ (let* ((elems (cdr (assq type ecomplete-database))) (match (regexp-quote match)) (candidates - (sort + (sort (loop for (key count time text) in elems when (string-match match text) collect (list count time text)) @@ -156,5 +156,4 @@ (provide 'ecomplete) -;; arch-tag: 34622935-bb81-4711-a600-57b89c2ece72 ;;; ecomplete.el ends here
--- a/lisp/gnus/flow-fill.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/flow-fill.el Thu Sep 02 02:12:28 2010 +0000 @@ -221,5 +221,4 @@ (provide 'flow-fill) -;; arch-tag: addc0040-bc53-4f17-b4bc-1eb44eed6f0b ;;; flow-fill.el ends here
--- a/lisp/gnus/gmm-utils.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gmm-utils.el Thu Sep 02 02:12:28 2010 +0000 @@ -433,5 +433,4 @@ (provide 'gmm-utils) -;; arch-tag: e0b60920-2ce6-40c1-bfc0-cadbbe26b602 ;;; gmm-utils.el ends here
--- a/lisp/gnus/gnus-agent.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-agent.el Thu Sep 02 02:12:28 2010 +0000 @@ -1788,7 +1788,7 @@ (while alist (let ((entry (pop alist))) (when (gnus-methods-equal-p gnus-command-method (gnus-info-method entry)) - (gnus-agent-flush-group (gnus-info-group entry))))))) + (gnus-agent-flush-group (gnus-info-group entry))))))) (defun gnus-agent-flush-group (group) "Flush the agent's index files such that the GROUP no longer @@ -2162,13 +2162,13 @@ (gnus-agent-save-alist gnus-agent-read-agentview))) alist)) ((end-of-file file-error) - ;; The agentview file is missing. + ;; The agentview file is missing. (condition-case nil ;; If the agent directory exists, attempt to perform a brute-force ;; reconstruction of its contents. (let* (alist (file-name-coding-system nnmail-pathname-coding-system) - (file-attributes (directory-files-and-attributes + (file-attributes (directory-files-and-attributes (gnus-agent-article-name "" gnus-agent-read-agentview) nil "^[0-9]+$" t))) (while file-attributes @@ -3258,7 +3258,7 @@ (gnus-message 7 "gnus-agent-expire: Loading overview...") (nnheader-insert-file-contents nov-file) (goto-char (point-min)) - + (let (p) (while (< (setq p (point)) (point-max)) (condition-case nil @@ -4227,5 +4227,4 @@ (provide 'gnus-agent) -;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e ;;; gnus-agent.el ends here
--- a/lisp/gnus/gnus-art.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-art.el Thu Sep 02 02:12:28 2010 +0000 @@ -8732,5 +8732,4 @@ (run-hooks 'gnus-art-load-hook) -;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33 ;;; gnus-art.el ends here
--- a/lisp/gnus/gnus-async.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-async.el Thu Sep 02 02:12:28 2010 +0000 @@ -384,5 +384,4 @@ (provide 'gnus-async) -;; arch-tag: fee61de5-3ea2-4de6-8578-2f90ce89391d ;;; gnus-async.el ends here
--- a/lisp/gnus/gnus-audio.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-audio.el Thu Sep 02 02:12:28 2010 +0000 @@ -146,5 +146,4 @@ (run-hooks 'gnus-audio-load-hook) -;; arch-tag: 6f129e78-3416-4fc9-973f-6cf5ac8d654b ;;; gnus-audio.el ends here
--- a/lisp/gnus/gnus-bcklg.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-bcklg.el Thu Sep 02 02:12:28 2010 +0000 @@ -159,5 +159,4 @@ (provide 'gnus-bcklg) -;; arch-tag: 66259e56-505a-4bba-8a0d-3552c5b94e39 ;;; gnus-bcklg.el ends here
--- a/lisp/gnus/gnus-bookmark.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-bookmark.el Thu Sep 02 02:12:28 2010 +0000 @@ -828,5 +828,4 @@ (provide 'gnus-bookmark) -;; arch-tag: 779df694-366f-46e8-84b2-1d0340e6f525 ;;; gnus-bookmark.el ends here
--- a/lisp/gnus/gnus-cache.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-cache.el Thu Sep 02 02:12:28 2010 +0000 @@ -868,7 +868,7 @@ (while (setq file (pop files)) (setq attrs (file-attributes file)) (unless (nth 0 attrs) - (incf size (float (nth 7 attrs))))))) + (incf size (float (nth 7 attrs))))))) (setq gnus-cache-need-update-total-fetched-for t) @@ -879,10 +879,10 @@ (gnus-cache-with-refreshed-group group (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb) - (gnus-sethash group (make-list 2 0) + (gnus-sethash group (make-list 2 0) gnus-cache-total-fetched-hashtb))) (file-name-coding-system nnmail-pathname-coding-system) - (size (or (nth 7 (file-attributes + (size (or (nth 7 (file-attributes (or file (gnus-cache-file-name group ".overview")))) 0))) @@ -911,11 +911,10 @@ (if entry (apply '+ entry) (let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit))) - (+ + (+ (gnus-cache-update-overview-total-fetched-for group nil) (gnus-cache-update-file-total-fetched-for group nil))))))) (provide 'gnus-cache) -;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a ;;; gnus-cache.el ends here
--- a/lisp/gnus/gnus-cite.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-cite.el Thu Sep 02 02:12:28 2010 +0000 @@ -1258,5 +1258,4 @@ ;; coding: iso-8859-1 ;; End: -;; arch-tag: 1997b044-6067-471e-8c8f-dc903093098a ;;; gnus-cite.el ends here
--- a/lisp/gnus/gnus-cus.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-cus.el Thu Sep 02 02:12:28 2010 +0000 @@ -1118,5 +1118,4 @@ (provide 'gnus-cus) -;; arch-tag: a37c285a-49bc-4235-8244-804536effeaf ;;; gnus-cus.el ends here
--- a/lisp/gnus/gnus-delay.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-delay.el Thu Sep 02 02:12:28 2010 +0000 @@ -192,5 +192,4 @@ ;; coding: iso-8859-1 ;; End: -;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d ;;; gnus-delay.el ends here
--- a/lisp/gnus/gnus-demon.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-demon.el Thu Sep 02 02:12:28 2010 +0000 @@ -319,5 +319,4 @@ (provide 'gnus-demon) -;; arch-tag: 8dd5cd3d-6ae4-46b4-9b15-f5fca09fd392 ;;; gnus-demon.el ends here
--- a/lisp/gnus/gnus-diary.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-diary.el Thu Sep 02 02:12:28 2010 +0000 @@ -401,5 +401,4 @@ (provide 'gnus-diary) -;; arch-tag: 98467e70-337e-4ddc-b92d-45d403ff1b4b ;;; gnus-diary.el ends here
--- a/lisp/gnus/gnus-dired.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-dired.el Thu Sep 02 02:12:28 2010 +0000 @@ -204,7 +204,7 @@ (setq method (cdr (assoc 'viewer (car (mailcap-mime-info mime-type - 'all + 'all 'no-decode))))))) (let ((view-command (mm-mailcap-command method file-name nil))) (message "viewing via %s" view-command) @@ -261,5 +261,4 @@ (provide 'gnus-dired) -;; arch-tag: 44737731-e445-4638-a31e-713c7590ec76 ;;; gnus-dired.el ends here
--- a/lisp/gnus/gnus-draft.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-draft.el Thu Sep 02 02:12:28 2010 +0000 @@ -325,5 +325,4 @@ (provide 'gnus-draft) -;; arch-tag: 3d92af58-8c97-4a5c-9db4-a98e85198022 ;;; gnus-draft.el ends here
--- a/lisp/gnus/gnus-dup.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-dup.el Thu Sep 02 02:12:28 2010 +0000 @@ -159,5 +159,4 @@ (provide 'gnus-dup) -;; arch-tag: 903e94db-7b00-4d19-83ee-cf34a81fa5fb ;;; gnus-dup.el ends here
--- a/lisp/gnus/gnus-eform.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-eform.el Thu Sep 02 02:12:28 2010 +0000 @@ -130,5 +130,4 @@ (provide 'gnus-eform) -;; arch-tag: ef50678c-2c28-49ef-affc-e53b3b2c0bf6 ;;; gnus-eform.el ends here
--- a/lisp/gnus/gnus-ems.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-ems.el Thu Sep 02 02:12:28 2010 +0000 @@ -341,5 +341,4 @@ (provide 'gnus-ems) -;; arch-tag: e7360b45-14b5-4171-aa39-69a44aed3cdb ;;; gnus-ems.el ends here
--- a/lisp/gnus/gnus-fun.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-fun.el Thu Sep 02 02:12:28 2010 +0000 @@ -290,5 +290,4 @@ (provide 'gnus-fun) -;; arch-tag: 9d000a69-15cc-4491-9dc0-4627484f50c1 ;;; gnus-fun.el ends here
--- a/lisp/gnus/gnus-group.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-group.el Thu Sep 02 02:12:28 2010 +0000 @@ -660,7 +660,6 @@ "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 @@ ["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 @@ ["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] @@ -3116,41 +3113,6 @@ (gnus-group-real-name group) (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) -(defvar nnkiboze-score-file) -(declare-function nnkiboze-score-file "nnkiboze" (group)) - -(defun gnus-group-make-kiboze-group (group address scores) - "Create an nnkiboze group. -The user will be prompted for a name, a regexp to match groups, and -score file entries for articles to include in the group." - (interactive - (list - (read-string "nnkiboze group name: ") - (read-string "Source groups (regexp): ") - (let ((headers (mapcar 'list - '("subject" "from" "number" "date" "message-id" - "references" "chars" "lines" "xref" - "followup" "all" "body" "head"))) - scores header regexp regexps) - (while (not (equal "" (setq header (completing-read - "Match on header: " headers nil t)))) - (setq regexps nil) - (while (not (equal "" (setq regexp (read-string - (format "Match on %s (regexp): " - header))))) - (push (list regexp nil nil 'r) regexps)) - (push (cons header regexps) scores)) - scores))) - (gnus-group-make-group group "nnkiboze" address) - (let* ((nnkiboze-current-group group) - (score-file (car (nnkiboze-score-file ""))) - (score-dir (file-name-directory score-file))) - (unless (file-exists-p score-dir) - (make-directory score-dir)) - (with-temp-file score-file - (let (emacs-lisp-mode-hook) - (gnus-pp scores))))) - (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." (interactive @@ -4755,5 +4717,4 @@ (provide 'gnus-group) -;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6 ;;; gnus-group.el ends here
--- a/lisp/gnus/gnus-html.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-html.el Thu Sep 02 02:12:28 2010 +0000 @@ -56,6 +56,16 @@ :group 'gnus-art :type 'regexp) +(defcustom gnus-max-image-proportion 0.7 + "How big pictures displayed are in relation to the window they're in. +A value of 0.7 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." + :version "24.1" + :group 'gnus-art + :type 'float) + ;;;###autoload (defun gnus-article-html (handle) (let ((article-buffer (current-buffer))) @@ -74,7 +84,7 @@ (not (eq charset 'ascii))) (mm-decode-coding-region (point-min) (point-max) charset)) (call-process-region (point-min) (point-max) - "w3m" + "w3m" nil article-buffer nil "-halfdump" "-no-cookie" @@ -84,7 +94,7 @@ "-o" "pre_conv=1" "-t" (format "%s" tab-width) "-cols" (format "%s" gnus-html-frame-width) - "-o" "display_image=off" + "-o" "display_image=on" "-T" "text/html")))) (gnus-html-wash-tags)))) @@ -94,6 +104,9 @@ (let (tag parameters string start end images url) (mm-url-decode-entities) (goto-char (point-min)) + (while (re-search-forward "<pre_int> *</pre_int>\n" nil t) + (replace-match "" t t)) + (goto-char (point-min)) (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t) (setq tag (match-string 1) parameters (match-string 2) @@ -107,8 +120,9 @@ (cond ;; Fetch and insert a picture. ((equal tag "img_alt") - (when (string-match "src=\"\\([^\"]+\\)" parameters) + (when (string-match "src=\"\\([^\"]+\\)" parameters) (setq url (match-string 1 parameters)) + (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url) (if (string-match "^cid:\\(.*\\)" url) ;; URLs with cid: have their content stashed in other ;; parts of the MIME structure, so just insert them @@ -121,27 +135,46 @@ (setq image (gnus-create-image (buffer-string) nil t)))) (when image - (delete-region start end) - (gnus-put-image image))) + (let ((string (buffer-substring start end))) + (delete-region start end) + (gnus-put-image image (gnus-string-or string "*"))))) ;; Normal, external URL. - (when (or (null gnus-blocked-images) - (not (string-match gnus-blocked-images url))) - (let ((file (gnus-html-image-id url))) - (if (file-exists-p file) - ;; It's already cached, so just insert it. - (when (gnus-html-put-image file (point)) - ;; Delete the ALT text. - (delete-region start end)) - ;; We don't have it, so schedule it for fetching - ;; asynchronously. - (push (list url - (set-marker (make-marker) start) - (point-marker)) - images))))))) + (unless (gnus-html-image-url-blocked-p + url + (if (buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-blocked-images) + gnus-blocked-images)) + (let ((file (gnus-html-image-id url)) + width height) + (when (string-match "height=\"?\\([0-9]+\\)" parameters) + (setq height (string-to-number (match-string 1 parameters)))) + (when (string-match "width=\"?\\([0-9]+\\)" parameters) + (setq width (string-to-number (match-string 1 parameters)))) + ;; Don't fetch images that are really small. They're + ;; probably tracking pictures. + (when (and (or (null height) + (> height 4)) + (or (null width) + (> width 4))) + (if (file-exists-p file) + ;; It's already cached, so just insert it. + (let ((string (buffer-substring start end))) + ;; Delete the ALT text. + (delete-region start end) + (gnus-html-put-image file (point) string)) + ;; We don't have it, so schedule it for fetching + ;; asynchronously. + (push (list url + (set-marker (make-marker) start) + (point-marker)) + images)))))))) ;; Add a link. - ((equal tag "a") + ((or (equal tag "a") + (equal tag "A")) (when (string-match "href=\"\\([^\"]+\\)" parameters) (setq url (match-string 1 parameters)) + (gnus-message 8 "gnus-html-wash-tags: fetching link URL %s" url) (gnus-article-add-button start end 'browse-url url url) @@ -150,6 +183,10 @@ (gnus-overlay-put overlay 'gnus-button-url url) (when gnus-article-mouse-face (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))))) + ;; The upper-case IMG_ALT is apparently just an artifact that + ;; should be deleted. + ((equal tag "IMG_ALT") + (delete-region start end)) ;; Whatever. Just ignore the tag. (t )) @@ -163,6 +200,8 @@ (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))))) (defun gnus-html-schedule-image-fetching (buffer images) + (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s" + buffer images) (let* ((url (caar images)) (process (start-process "images" nil "curl" @@ -192,13 +231,14 @@ ;; article before the image arrived. (not (= (marker-position (cadr spec)) (point-min)))) (with-current-buffer buffer - (let ((inhibit-read-only t)) - (when (gnus-html-put-image file (cadr spec)) - (delete-region (1+ (cadr spec)) (caddr spec)))))) + (let ((inhibit-read-only t) + (string (buffer-substring (cadr spec) (caddr spec)))) + (delete-region (cadr spec) (caddr spec)) + (gnus-html-put-image file (cadr spec) string)))) (when images (gnus-html-schedule-image-fetching buffer images))))) -(defun gnus-html-put-image (file point) +(defun gnus-html-put-image (file point string) (when (display-graphic-p) (let ((image (ignore-errors (gnus-create-image file)))) @@ -212,13 +252,39 @@ (= (car (image-size image t)) 30) (= (cdr (image-size image t)) 30)))) (progn - (gnus-put-image image) + (gnus-put-image (gnus-html-rescale-image image) + (gnus-string-or string "*")) t) + (insert string) (when (fboundp 'find-image) (gnus-put-image (find-image - '((:type xpm :file "lock-broken.xpm"))))) + '((:type xpm :file "lock-broken.xpm"))) + (gnus-string-or string "*"))) nil))))) +(defun gnus-html-rescale-image (image) + (if (or (not (fboundp 'imagemagick-types)) + (not (get-buffer-window (current-buffer)))) + image + (let* ((width (car (image-size image t))) + (height (cdr (image-size image t))) + (edges (window-pixel-edges (get-buffer-window (current-buffer)))) + (window-width (truncate (* gnus-max-image-proportion + (- (nth 2 edges) (nth 0 edges))))) + (window-height (truncate (* gnus-max-image-proportion + (- (nth 3 edges) (nth 1 edges))))) + scaled-image) + (when (> height window-height) + (setq image (or (create-image file 'imagemagick nil + :height window-height) + image)) + (when (> (car (image-size image t)) window-width) + (setq image (or + (create-image file 'imagemagick nil + :width window-width) + image)))) + image))) + (defun gnus-html-prune-cache () (let ((total-size 0) files) @@ -237,6 +303,17 @@ (decf total-size (cadr file)) (delete-file (nth 2 file))))))) +(defun gnus-html-image-url-blocked-p (url blocked-images) +"Find out if URL is blocked by BLOCKED-IMAGES." + (let ((ret (and blocked-images + (string-match blocked-images url)))) + (if ret + (gnus-message 8 "gnus-html-image-url-blocked-p: %s blocked by regex %s" + url blocked-images) + (gnus-message 9 "gnus-html-image-url-blocked-p: %s passes regex %s" + url blocked-images)) + ret)) + ;;;###autoload (defun gnus-html-prefetch-images (summary) (let (blocked-images urls) @@ -246,14 +323,13 @@ (save-match-data (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t) (let ((url (match-string 1))) - (when (or (null blocked-images) - (not (string-match blocked-images url))) - (unless (file-exists-p (gnus-html-image-id url)) - (push url urls) - (push (gnus-html-image-id url) urls) - (push "-o" urls))))) + (unless (gnus-html-image-url-blocked-p url blocked-images) + (unless (file-exists-p (gnus-html-image-id url)) + (push url urls) + (push (gnus-html-image-id url) urls) + (push "-o" urls))))) (let ((process - (apply 'start-process + (apply 'start-process "images" nil "curl" "-s" "--create-dirs" "--location"
--- a/lisp/gnus/gnus-int.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-int.el Thu Sep 02 02:12:28 2010 +0000 @@ -716,5 +716,4 @@ (provide 'gnus-int) -;; arch-tag: bbc90087-9b7f-4017-a92c-3abf180ac86d ;;; gnus-int.el ends here
--- a/lisp/gnus/gnus-kill.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-kill.el Thu Sep 02 02:12:28 2010 +0000 @@ -715,5 +715,4 @@ (provide 'gnus-kill) -;; arch-tag: b30c0f53-df1a-490b-b81e-17b13474f395 ;;; gnus-kill.el ends here
--- a/lisp/gnus/gnus-logic.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-logic.el Thu Sep 02 02:12:28 2010 +0000 @@ -225,5 +225,4 @@ (provide 'gnus-logic) -;; arch-tag: 9651a100-4a59-4b69-a55b-e511e67c0f8d ;;; gnus-logic.el ends here
--- a/lisp/gnus/gnus-mh.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-mh.el Thu Sep 02 02:12:28 2010 +0000 @@ -109,5 +109,4 @@ (provide 'gnus-mh) -;; arch-tag: 2d5696d3-b363-48e5-8749-c256be56acca ;;; gnus-mh.el ends here
--- a/lisp/gnus/gnus-ml.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-ml.el Thu Sep 02 02:12:28 2010 +0000 @@ -180,5 +180,4 @@ (provide 'gnus-ml) -;; arch-tag: 936c0fe6-acce-4c16-87d0-eded88078896 ;;; gnus-ml.el ends here
--- a/lisp/gnus/gnus-mlspl.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-mlspl.el Thu Sep 02 02:12:28 2010 +0000 @@ -227,5 +227,4 @@ (provide 'gnus-mlspl) -;; arch-tag: 62b3381f-1e45-4b61-be1a-29fb27703322 ;;; gnus-mlspl.el ends here
--- a/lisp/gnus/gnus-msg.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-msg.el Thu Sep 02 02:12:28 2010 +0000 @@ -1989,5 +1989,4 @@ (provide 'gnus-msg) -;; arch-tag: 9f22b2f5-1c0a-49de-916e-4c88e984852b ;;; gnus-msg.el ends here
--- a/lisp/gnus/gnus-nocem.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-nocem.el Thu Sep 02 02:12:28 2010 +0000 @@ -449,5 +449,4 @@ (provide 'gnus-nocem) -;; arch-tag: 0e0c74ea-2f8e-4f3e-8fff-09f767c1adef ;;; gnus-nocem.el ends here
--- a/lisp/gnus/gnus-picon.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-picon.el Thu Sep 02 02:12:28 2010 +0000 @@ -319,5 +319,4 @@ (provide 'gnus-picon) -;; arch-tag: fe9aede0-1b1b-463a-b4ab-807f98bcb31f ;;; gnus-picon.el ends here
--- a/lisp/gnus/gnus-range.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-range.el Thu Sep 02 02:12:28 2010 +0000 @@ -187,7 +187,7 @@ RANGE1 and RANGE2 have to be sorted over <." (let* (out (min1 (car range1)) - (max1 (if (numberp min1) + (max1 (if (numberp min1) (if (numberp (cdr range1)) (prog1 (cdr range1) (setq range1 nil)) min1) @@ -196,8 +196,8 @@ (min2 (car range2)) (max2 (if (numberp min2) (if (numberp (cdr range2)) - (prog1 (cdr range2) - (setq range2 nil)) min2) + (prog1 (cdr range2) + (setq range2 nil)) min2) (prog1 (cdr min2) (setq min2 (car min2)))))) (setq range1 (cdr range1) @@ -654,5 +654,4 @@ (provide 'gnus-range) -;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad ;;; gnus-range.el ends here
--- a/lisp/gnus/gnus-registry.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-registry.el Thu Sep 02 02:12:28 2010 +0000 @@ -1,6 +1,6 @@ ;;; gnus-registry.el --- article registry for Gnus -;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;;; Free Software Foundation, Inc. ;; Author: Ted Zlatanov <tzz@lifelogs.com> @@ -72,7 +72,7 @@ :version "22.1" :group 'gnus) -(defvar gnus-registry-hashtb (make-hash-table +(defvar gnus-registry-hashtb (make-hash-table :size 256 :test 'equal) "*The article registry by Message ID.") @@ -97,7 +97,7 @@ "List of registry marks and their options. `gnus-registry-mark-article' will offer symbols from this list -for completion. +for completion. Each entry must have a character to be useful for summary mode line display and for keyboard shortcuts. @@ -121,7 +121,7 @@ :group 'gnus-registry :type 'symbol) -(defcustom gnus-registry-unfollowed-groups +(defcustom gnus-registry-unfollowed-groups '("delayed$" "drafts$" "queue$" "INBOX$") "List of groups that gnus-registry-split-fancy-with-parent won't return. The group names are matched, they don't have to be fully @@ -206,9 +206,9 @@ :group 'gnus-registry :type '(repeat symbol)) -(defcustom gnus-registry-cache-file - (nnheader-concat - (or gnus-dribble-directory gnus-home-directory "~/") +(defcustom gnus-registry-cache-file + (nnheader-concat + (or gnus-dribble-directory gnus-home-directory "~/") ".gnus.registry.eld") "File where the Gnus registry will be stored." :group 'gnus-registry @@ -253,7 +253,7 @@ (if gnus-save-startup-file-via-temp-buffer (let ((coding-system-for-write gnus-ding-file-coding-system) (standard-output (current-buffer))) - (gnus-gnus-to-quick-newsrc-format + (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist) (gnus-registry-cache-whitespace file) (save-buffer)) @@ -276,7 +276,7 @@ (unwind-protect (progn (gnus-with-output-to-file working-file - (gnus-gnus-to-quick-newsrc-format + (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist)) ;; These bindings will mislead the current buffer @@ -326,7 +326,7 @@ (when gnus-registry-clean-empty (gnus-registry-clean-empty-function)) ;; now trim and clean text properties from the registry appropriately - (setq gnus-registry-alist + (setq gnus-registry-alist (gnus-registry-remove-alist-text-properties (gnus-registry-trim (gnus-hashtable-to-alist @@ -346,7 +346,7 @@ (dolist (group (gnus-registry-fetch-groups key)) (when (gnus-parameter-registry-ignore group) (gnus-message - 10 + 10 "gnus-registry: deleted ignored group %s from key %s" group key) (gnus-registry-delete-group key group))) @@ -361,14 +361,14 @@ (gnus-registry-fetch-extra key 'label)) (incf count) (gnus-registry-delete-id key)) - + (unless (stringp key) - (gnus-message - 10 - "gnus-registry key %s was not a string, removing" + (gnus-message + 10 + "gnus-registry key %s was not a string, removing" key) (gnus-registry-delete-id key)))) - + gnus-registry-hashtb) count)) @@ -391,7 +391,7 @@ (defun gnus-registry-trim (alist) "Trim alist to size, using gnus-registry-max-entries. Any entries with extra data (marks, currently) are left alone." - (if (null gnus-registry-max-entries) + (if (null gnus-registry-max-entries) alist ; just return the alist ;; else, when given max-entries, trim the alist (let* ((timehash (make-hash-table @@ -420,25 +420,25 @@ (push item precious-list) (push item junk-list)))) - (sort + (sort junk-list (lambda (a b) - (let ((t1 (or (cdr (gethash (car a) timehash)) + (let ((t1 (or (cdr (gethash (car a) timehash)) '(0 0 0))) - (t2 (or (cdr (gethash (car b) timehash)) + (t2 (or (cdr (gethash (car b) timehash)) '(0 0 0)))) (time-less-p t1 t2)))) ;; we use the return value of this setq, which is the trimmed alist (setq alist (append precious-list (nthcdr trim-length junk-list)))))) - + (defun gnus-registry-action (action data-header from &optional to method) (let* ((id (mail-header-id data-header)) (subject (gnus-string-remove-all-properties (gnus-registry-simplify-subject (mail-header-subject data-header)))) - (sender (gnus-string-remove-all-properties + (sender (gnus-string-remove-all-properties (mail-header-from data-header))) (from (gnus-group-guess-full-name-from-command-method from)) (to (if to (gnus-group-guess-full-name-from-command-method to) nil)) @@ -489,7 +489,7 @@ (let* ((refstr (or (message-fetch-field "references") "")) ; guaranteed (reply-to (message-fetch-field "in-reply-to")) ; may be nil ;; now, if reply-to is valid, append it to the References - (refstr (if reply-to + (refstr (if reply-to (concat refstr " " reply-to) refstr)) ;; these may not be used, but the code is cleaner having them up here @@ -517,8 +517,8 @@ 9 "%s is looking for matches for reference %s from [%s]" log-agent reference refstr) - (dolist (group (gnus-registry-fetch-groups - reference + (dolist (group (gnus-registry-fetch-groups + reference gnus-registry-max-track-groups)) (when (and group (gnus-registry-follow-group-p group)) (gnus-message @@ -528,9 +528,9 @@ (push group found)))) ;; filter the found groups and return them ;; the found groups are the full groups - (setq found (gnus-registry-post-process-groups + (setq found (gnus-registry-post-process-groups "references" refstr found found))) - + ;; else: there were no matches, now try the extra tracking by sender ((and (gnus-registry-track-sender-p) sender @@ -543,7 +543,7 @@ matches) (when (and this-sender (equal sender this-sender)) - (let ((groups (gnus-registry-fetch-groups + (let ((groups (gnus-registry-fetch-groups key gnus-registry-max-track-groups))) (dolist (group groups) @@ -558,9 +558,9 @@ gnus-registry-hashtb) ;; filter the found groups and return them ;; the found groups are NOT the full groups - (setq found (gnus-registry-post-process-groups + (setq found (gnus-registry-post-process-groups "sender" sender found found-full))) - + ;; else: there were no matches, now try the extra tracking by subject ((and (gnus-registry-track-subject-p) subject @@ -572,7 +572,7 @@ matches) (when (and this-subject (equal subject this-subject)) - (let ((groups (gnus-registry-fetch-groups + (let ((groups (gnus-registry-fetch-groups key gnus-registry-max-track-groups))) (dolist (group groups) @@ -587,7 +587,7 @@ gnus-registry-hashtb) ;; filter the found groups and return them ;; the found groups are NOT the full groups - (setq found (gnus-registry-post-process-groups + (setq found (gnus-registry-post-process-groups "subject" subject found found-full)))) ;; after the (cond) we extract the actual value safely (car-safe found))) @@ -627,7 +627,7 @@ (lambda (a b) (> (gethash a freq 0) (gethash b freq 0))))))))) - + (if gnus-registry-use-long-group-names (dolist (group groups) (let ((m1 (gnus-find-method-for-group group)) @@ -708,8 +708,8 @@ (unless (member gnus-newsgroup-name (gnus-registry-fetch-groups id)) (gnus-message 9 "Registry: Registering article %d with group %s" article gnus-newsgroup-name) - (gnus-registry-add-group - id + (gnus-registry-add-group + id gnus-newsgroup-name (gnus-registry-fetch-simplified-message-subject-fast article) (gnus-registry-fetch-sender-fast article))))))) @@ -785,18 +785,18 @@ (shortcut (if remove (upcase shortcut) shortcut))) (unintern function-name) (eval - `(defun + `(defun ;; function name - ,(intern function-name) + ,(intern function-name) ;; parameter definition (&rest articles) ;; documentation - ,(format + ,(format "%s the %s mark over process-marked ARTICLES." (upcase-initials variant-name) mark) ;; interactive definition - (interactive + (interactive (gnus-summary-work-articles current-prefix-arg)) ;; actual code @@ -807,49 +807,49 @@ ;; now the user is asked if gnus-registry-install is 'ask (when (gnus-registry-install-p) - (gnus-registry-set-article-mark-internal + (gnus-registry-set-article-mark-internal ;; all this just to get the mark, I must be doing it wrong (intern ,(symbol-name mark)) articles ,remove t) (gnus-message - 9 + 9 "Applying mark %s to %d articles" ,(symbol-name mark) (length articles)) (dolist (article articles) - (gnus-summary-update-article + (gnus-summary-update-article article (assoc article (gnus-data-list nil))))))) (push (intern function-name) keys-plist) - (push shortcut keys-plist) + (push shortcut keys-plist) (push (vector (format "%s %s" (upcase-initials variant-name) (symbol-name mark)) (intern function-name) t) gnus-registry-misc-menus) (gnus-message - 9 - "Defined mark handling function %s" + 9 + "Defined mark handling function %s" function-name)))))) (gnus-define-keys-1 '(gnus-registry-mark-map "M" gnus-summary-mark-map) keys-plist) (add-hook 'gnus-summary-menu-hook (lambda () - (easy-menu-add-item + (easy-menu-add-item gnus-summary-misc-menu - nil + nil (cons "Registry Marks" gnus-registry-misc-menus)))))) ;;; use like this: -;;; (defalias 'gnus-user-format-function-M +;;; (defalias 'gnus-user-format-function-M ;;; 'gnus-registry-user-format-function-M) (defun gnus-registry-user-format-function-M (headers) (let* ((id (mail-header-message-id headers)) (marks (when id (gnus-registry-fetch-extra-marks id)))) (apply 'concat (mapcar (lambda(mark) - (let ((c + (let ((c (plist-get - (cdr-safe + (cdr-safe (assoc mark gnus-registry-marks)) :char))) (if c @@ -859,9 +859,9 @@ (defun gnus-registry-read-mark () "Read a mark name from the user with completion." - (let ((mark (gnus-completing-read-with-default + (let ((mark (gnus-completing-read-with-default (symbol-name gnus-registry-default-mark) - "Label" + "Label" (mapcar (lambda (x) ; completion list (cons (symbol-name (car-safe x)) (car-safe x))) gnus-registry-marks)))) @@ -896,7 +896,7 @@ (gnus-message 1 "%s mark %s with message ID %s, resulting in %S" (if remove "Removing" "Adding") mark id new-marks)) - + (apply 'gnus-registry-store-extra-marks ; set the extra marks id ; for the message ID new-marks))))) @@ -1007,7 +1007,7 @@ "Put a specific entry in the extras field of the registry entry for id." (let* ((extra (gnus-registry-fetch-extra id)) ;; all the entries except the one for `key' - (the-rest (gnus-assq-delete-all key (gnus-registry-fetch-extra id))) + (the-rest (gnus-assq-delete-all key (gnus-registry-fetch-extra id))) (alist (if value (gnus-registry-remove-alist-text-properties (cons (cons key value) @@ -1034,7 +1034,7 @@ (dolist (crumb trail) (when (stringp crumb) ;; push the group name into the list - (setq + (setq groups (cons (if (or (not (stringp crumb)) gnus-registry-use-long-group-names) @@ -1183,5 +1183,4 @@ (provide 'gnus-registry) -;; arch-tag: 5cba0a32-718a-4a97-8c91-0a15af21da94 ;;; gnus-registry.el ends here
--- a/lisp/gnus/gnus-salt.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-salt.el Thu Sep 02 02:12:28 2010 +0000 @@ -1045,5 +1045,4 @@ (provide 'gnus-salt) -;; arch-tag: 35449164-77b3-4398-bcbd-a2e3e998f810 ;;; gnus-salt.el ends here
--- a/lisp/gnus/gnus-score.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-score.el Thu Sep 02 02:12:28 2010 +0000 @@ -3122,5 +3122,4 @@ (provide 'gnus-score) -;; arch-tag: d3922589-764d-46ae-9954-9330fd192634 ;;; gnus-score.el ends here
--- a/lisp/gnus/gnus-setup.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-setup.el Thu Sep 02 02:12:28 2010 +0000 @@ -189,5 +189,4 @@ (run-hooks 'gnus-setup-load-hook) -;; arch-tag: 08e4af93-8565-46bf-905c-36229400609d ;;; gnus-setup.el ends here
--- a/lisp/gnus/gnus-sieve.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-sieve.el Thu Sep 02 02:12:28 2010 +0000 @@ -235,5 +235,4 @@ (provide 'gnus-sieve) -;; arch-tag: 3b906527-c7f3-4c86-9e82-62e2697998a3 ;;; gnus-sieve.el ends here
--- a/lisp/gnus/gnus-spec.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-spec.el Thu Sep 02 02:12:28 2010 +0000 @@ -767,5 +767,4 @@ ;; coding: iso-8859-1 ;; End: -;; arch-tag: a4328fa1-1f84-4b09-97ad-4b5767cfd50f ;;; gnus-spec.el ends here
--- a/lisp/gnus/gnus-srvr.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-srvr.el Thu Sep 02 02:12:28 2010 +0000 @@ -1033,5 +1033,4 @@ (provide 'gnus-srvr) -;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25 ;;; gnus-srvr.el ends here
--- a/lisp/gnus/gnus-start.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-start.el Thu Sep 02 02:12:28 2010 +0000 @@ -765,7 +765,7 @@ (when gnus-select-method (push (cons "native" gnus-select-method) gnus-predefined-server-alist)) - + (if gnus-agent (gnus-agentize)) @@ -3195,7 +3195,6 @@ (provide 'gnus-start) -;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2 ;;; gnus-start.el ends here
--- a/lisp/gnus/gnus-sum.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-sum.el Thu Sep 02 02:12:28 2010 +0000 @@ -12691,5 +12691,4 @@ ;; coding: iso-8859-1 ;; End: -;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235 ;;; gnus-sum.el ends here
--- a/lisp/gnus/gnus-topic.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-topic.el Thu Sep 02 02:12:28 2010 +0000 @@ -1779,5 +1779,4 @@ (provide 'gnus-topic) -;; arch-tag: bf176856-f30c-40f0-ae77-e41529a1134c ;;; gnus-topic.el ends here
--- a/lisp/gnus/gnus-undo.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-undo.el Thu Sep 02 02:12:28 2010 +0000 @@ -188,5 +188,4 @@ (provide 'gnus-undo) -;; arch-tag: 0d787bc7-787d-499a-837f-211d2cb07f2e ;;; gnus-undo.el ends here
--- a/lisp/gnus/gnus-util.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-util.el Thu Sep 02 02:12:28 2010 +0000 @@ -1899,5 +1899,4 @@ (provide 'gnus-util) -;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49 ;;; gnus-util.el ends here
--- a/lisp/gnus/gnus-uu.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-uu.el Thu Sep 02 02:12:28 2010 +0000 @@ -2170,5 +2170,4 @@ (provide 'gnus-uu) -;; arch-tag: 05312384-0a83-4720-9a58-b3160b888853 ;;; gnus-uu.el ends here
--- a/lisp/gnus/gnus-vm.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-vm.el Thu Sep 02 02:12:28 2010 +0000 @@ -103,5 +103,4 @@ (provide 'gnus-vm) -;; arch-tag: 42ca7f88-a12f-461d-be3e-cac7efb44866 ;;; gnus-vm.el ends here
--- a/lisp/gnus/gnus-win.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus-win.el Thu Sep 02 02:12:28 2010 +0000 @@ -590,5 +590,4 @@ (provide 'gnus-win) -;; arch-tag: ccd5a394-2ddf-4397-b8f8-6d80d3e46e2b ;;; gnus-win.el ends here
--- a/lisp/gnus/gnus.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/gnus.el Thu Sep 02 02:12:28 2010 +0000 @@ -1740,14 +1740,11 @@ ("nneething" none address prompt-address physical-address) ("nndoc" none address prompt-address) ("nnbabyl" mail address respool) - ("nnkiboze" post virtual) ("nndraft" post-mail) ("nnfolder" mail respool address) ("nngateway" post-mail address prompt-address physical-address) ("nnweb" none) ("nnrss" none) - ("nnwfm" none) - ("nnlistserv" none) ("nnagent" post-mail) ("nnimap" post-mail address prompt-address physical-address) ("nnmaildir" mail respool address) @@ -3289,12 +3286,12 @@ (defmacro gnus-string-or (&rest strings) "Return the first element of STRINGS that is a non-blank string. STRINGS will be evaluated in normal `or' order." - `(gnus-string-or-1 ',strings)) + `(gnus-string-or-1 (list ,@strings))) (defun gnus-string-or-1 (strings) (let (string) (while strings - (setq string (eval (pop strings))) + (setq string (pop strings)) (if (string-match "^[ \t]*$" string) (setq string nil) (setq strings nil))) @@ -4409,5 +4406,4 @@ (provide 'gnus) -;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636 ;;; gnus.el ends here
--- a/lisp/gnus/html2text.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/html2text.el Thu Sep 02 02:12:28 2010 +0000 @@ -508,5 +508,5 @@ ;; </Interactive functions> ;; (provide 'html2text) -;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e + ;;; html2text.el ends here
--- a/lisp/gnus/ietf-drums.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/ietf-drums.el Thu Sep 02 02:12:28 2010 +0000 @@ -295,5 +295,4 @@ (provide 'ietf-drums) -;; arch-tag: 379a0191-dbae-4ca6-a0f5-d4202c209ef9 ;;; ietf-drums.el ends here
--- a/lisp/gnus/legacy-gnus-agent.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/legacy-gnus-agent.el Thu Sep 02 02:12:28 2010 +0000 @@ -250,5 +250,4 @@ (provide 'legacy-gnus-agent) -;; arch-tag: 845c7b8a-88f7-4468-b8d7-94e8fc72cf1a ;;; legacy-gnus-agent.el ends here
--- a/lisp/gnus/mail-parse.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mail-parse.el Thu Sep 02 02:12:28 2010 +0000 @@ -74,5 +74,4 @@ (provide 'mail-parse) -;; arch-tag: 3e63d75c-c962-4784-ab01-7ba07ca9d2d4 ;;; mail-parse.el ends here
--- a/lisp/gnus/mail-prsvr.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mail-prsvr.el Thu Sep 02 02:12:28 2010 +0000 @@ -41,5 +41,4 @@ (provide 'mail-prsvr) -;; arch-tag: 9ba878cc-8b43-4f7a-85b1-69b1a9a5d9f5 ;;; mail-prsvr.el ends here
--- a/lisp/gnus/mail-source.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mail-source.el Thu Sep 02 02:12:28 2010 +0000 @@ -466,10 +466,10 @@ ;; 1) the auth-sources user and password override everything ;; 2) it avoids macros, so it's cleaner ;; 3) it falls through to the mail-sources and then default values - (cond + (cond ((and (eq keyword :user) - (setq user-auth + (setq user-auth (nth 0 (auth-source-user-or-password '("login" "password") ;; this is "host" in auth-sources @@ -1145,5 +1145,4 @@ (provide 'mail-source) -;; arch-tag: 72948025-1d17-4d6c-bb12-ef1aa2c490fd ;;; mail-source.el ends here
--- a/lisp/gnus/mailcap.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mailcap.el Thu Sep 02 02:12:28 2010 +0000 @@ -1069,5 +1069,4 @@ (provide 'mailcap) -;; arch-tag: 1fd4f9c9-c305-4d2e-9747-3a4d45baa0bd ;;; mailcap.el ends here
--- a/lisp/gnus/message.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/message.el Thu Sep 02 02:12:28 2010 +0000 @@ -6687,7 +6687,7 @@ (setq recipients (delq recip recipients)))))))) (setq recipients (message-prune-recipients recipients)) - + ;; Build the header alist. Allow the user to be asked whether ;; or not to reply to all recipients in a wide reply. (setq follow-to (list (cons 'To (cdr (pop recipients))))) @@ -6704,7 +6704,7 @@ (defun message-prune-recipients (recipients) (dolist (rule message-prune-recipient-rules) (let ((match (car rule)) - dup-match + dup-match address) (dolist (recipient recipients) (setq address (car recipient)) @@ -8258,5 +8258,4 @@ ;; coding: iso-8859-1 ;; End: -;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0 ;;; message.el ends here
--- a/lisp/gnus/messcompat.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/messcompat.el Thu Sep 02 02:12:28 2010 +0000 @@ -89,5 +89,4 @@ (provide 'messcompat) -;; arch-tag: a76673be-905e-4bbd-8966-615370494a7b ;;; messcompat.el ends here
--- a/lisp/gnus/mm-bodies.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mm-bodies.el Thu Sep 02 02:12:28 2010 +0000 @@ -302,5 +302,4 @@ (provide 'mm-bodies) -;; arch-tag: 41104bb6-4443-4ca9-8d5c-ff87ecf27d8d ;;; mm-bodies.el ends here
--- a/lisp/gnus/mm-decode.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mm-decode.el Thu Sep 02 02:12:28 2010 +0000 @@ -1670,5 +1670,4 @@ (provide 'mm-decode) -;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b ;;; mm-decode.el ends here
--- a/lisp/gnus/mm-encode.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mm-encode.el Thu Sep 02 02:12:28 2010 +0000 @@ -223,5 +223,4 @@ (provide 'mm-encode) -;; arch-tag: 7d01bba4-d469-4851-952b-dc863f84ed66 ;;; mm-encode.el ends here
--- a/lisp/gnus/mm-extern.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mm-extern.el Thu Sep 02 02:12:28 2010 +0000 @@ -167,5 +167,4 @@ (provide 'mm-extern) -;; arch-tag: 9653808e-14d9-4172-86e6-adceaa05378e ;;; mm-extern.el ends here
--- a/lisp/gnus/mm-partial.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mm-partial.el Thu Sep 02 02:12:28 2010 +0000 @@ -150,5 +150,4 @@ (provide 'mm-partial) -;; arch-tag: 460e7424-05f2-4a1d-a0f2-70ec081eff7d ;;; mm-partial.el ends here
--- a/lisp/gnus/mm-url.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mm-url.el Thu Sep 02 02:12:28 2010 +0000 @@ -501,5 +501,4 @@ (provide 'mm-url) -;; arch-tag: 0594f9b3-417c-48b0-adc2-5082e1e7917f ;;; mm-url.el ends here
--- a/lisp/gnus/mm-util.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mm-util.el Thu Sep 02 02:12:28 2010 +0000 @@ -1653,5 +1653,4 @@ (provide 'mm-util) -;; arch-tag: 94dc5388-825d-4fd1-bfa5-2100aa351238 ;;; mm-util.el ends here
--- a/lisp/gnus/mm-uu.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mm-uu.el Thu Sep 02 02:12:28 2010 +0000 @@ -441,7 +441,7 @@ (defun mm-uu-yenc-extract () ;; This might not be exactly correct, but we sure can't get the ;; binary data from the article buffer, since that's already in a - ;; non-binary charset. So get it from the original article buffer. + ;; non-binary charset. So get it from the original article buffer. (mm-make-handle (with-current-buffer gnus-original-article-buffer (mm-uu-copy-to-buffer start-point end-point)) (list (or (and file-name @@ -729,5 +729,4 @@ (provide 'mm-uu) -;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c ;;; mm-uu.el ends here
--- a/lisp/gnus/mm-view.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mm-view.el Thu Sep 02 02:12:28 2010 +0000 @@ -688,5 +688,4 @@ (provide 'mm-view) -;; arch-tag: b60e749a-d05c-47f2-bccd-bdaa59327cb2 ;;; mm-view.el ends here
--- a/lisp/gnus/mml-sec.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mml-sec.el Thu Sep 02 02:12:28 2010 +0000 @@ -380,5 +380,4 @@ (provide 'mml-sec) -;; arch-tag: 111c56e7-df5e-4287-87d7-93ed2911ec6c ;;; mml-sec.el ends here
--- a/lisp/gnus/mml-smime.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mml-smime.el Thu Sep 02 02:12:28 2010 +0000 @@ -554,5 +554,4 @@ (provide 'mml-smime) -;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2 ;;; mml-smime.el ends here
--- a/lisp/gnus/mml.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mml.el Thu Sep 02 02:12:28 2010 +0000 @@ -1570,5 +1570,4 @@ (provide 'mml) -;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12 ;;; mml.el ends here
--- a/lisp/gnus/mml1991.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mml1991.el Thu Sep 02 02:12:28 2010 +0000 @@ -521,5 +521,4 @@ ;; coding: iso-8859-1 ;; End: -;; arch-tag: e542be18-ab28-4393-9b33-97fe9cf30706 ;;; mml1991.el ends here
--- a/lisp/gnus/mml2015.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/mml2015.el Thu Sep 02 02:12:28 2010 +0000 @@ -1420,5 +1420,4 @@ (provide 'mml2015) -;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2 ;;; mml2015.el ends here
--- a/lisp/gnus/nnagent.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnagent.el Thu Sep 02 02:12:28 2010 +0000 @@ -121,7 +121,7 @@ (deffoo nnagent-request-set-mark (group action server) (mm-with-unibyte-buffer (insert "(gnus-agent-synchronize-group-flags \"" - group + group "\" '") (gnus-pp action) (insert " \"" @@ -151,7 +151,7 @@ ;; Assume that articles with smaller numbers than the first one ;; Agent knows are gone. (setq first (caar gnus-agent-article-alist)) - (when first + (when first (while (and arts (< (car arts) first)) (pop arts))) (set-buffer nntp-server-buffer) @@ -261,5 +261,4 @@ (provide 'nnagent) -;; arch-tag: af710b77-f816-4969-af31-6fd94fb42245 ;;; nnagent.el ends here
--- a/lisp/gnus/nnbabyl.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnbabyl.el Thu Sep 02 02:12:28 2010 +0000 @@ -344,7 +344,7 @@ (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") + (nnmail-cache-insert (nnmail-fetch-field "message-id") group (nnmail-fetch-field "subject") (nnmail-fetch-field "from"))) @@ -363,7 +363,7 @@ (insert-buffer-substring buf) (when last (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") + (nnmail-cache-insert (nnmail-fetch-field "message-id") group (nnmail-fetch-field "subject") (nnmail-fetch-field "from"))) @@ -663,5 +663,4 @@ (provide 'nnbabyl) -;; arch-tag: aa7ddedb-8c07-4c0e-beb0-58e795c2b81b ;;; nnbabyl.el ends here
--- a/lisp/gnus/nndb.el Wed Sep 01 22:54:47 2010 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,325 +0,0 @@ -;;; nndb.el --- nndb access for Gnus - -;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> -;; Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de> -;; Joe Hildebrand <joe.hildebrand@ilg.com> -;; David Blacka <davidb@rwhois.net> -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; This was based upon Kai Grossjohan's shamessly snarfed code and -;;; further modified by Joe Hildebrand. It has been updated for Red -;;; Gnus. - -;; TODO: -;; -;; * Fix bug where server connection can be lost and impossible to regain -;; This hasn't happened to me in a while; think it was fixed in Rgnus -;; -;; * make it handle different nndb servers seemlessly -;; -;; * Optimize expire if FORCE -;; -;; * Optimize move (only expire once) -;; -;; * Deal with add/deletion of groups -;; -;; * make the backend TOUCH an article when marked as expireable (will -;; make article expire 'expiry' days after that moment). - -;;; Code: - -;; For Emacs < 22.2. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - -;;- -;; Register nndb with known select methods. - -(require 'gnus-start) -(unless (assoc "nndb" gnus-valid-select-methods) - (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)) - -(require 'nnmail) -(require 'nnheader) -(require 'nntp) -(eval-when-compile (require 'cl)) - -;; Declare nndb as derived from nntp - -(nnoo-declare nndb nntp) - -;; Variables specific to nndb - -;;- currently not used but just in case... -(defvoo nndb-deliver-program "nndel" - "*The program used to put a message in an NNDB group.") - -(defvoo nndb-server-side-expiry nil - "If t, expiry calculation will occur on the server side.") - -(defvoo nndb-set-expire-date-on-mark nil - "If t, the expiry date for a given article will be set to the time -it was marked as expireable; otherwise the date will be the time the -article was posted to nndb") - -;; Variables copied from nntp - -(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file) - "Like nntp-server-opened-hook." - nntp-server-opened-hook) - -(defvoo nndb-address "localhost" - "*The name of the NNDB server." - nntp-address) - -(defvoo nndb-port-number 9000 - "*Port number to connect to." - nntp-port-number) - -;; change to 'news if you are actually using nndb for news -(defvoo nndb-article-type 'mail) - -(defvoo nndb-status-string nil "" nntp-status-string) - - - -(defconst nndb-version "nndb 0.7" - "Version numbers of this version of NNDB.") - - -;;; Interface functions. - -(nnoo-define-basics nndb) - -;;------------------------------------------------------------------ - -;; this function turns the lisp list into a string list. There is -;; probably a more efficient way to do this. -(defun nndb-build-article-string (articles) - (let (art-string art) - (while articles - (setq art (pop articles)) - (setq art-string (concat art-string art " "))) - art-string)) - -(defun nndb-build-expire-rest-list (total expire) - (let (art rest) - (while total - (setq art (pop total)) - (if (memq art expire) - () - (push art rest))) - rest)) - - -;; -(deffoo nndb-request-type (group &optional article) - nndb-article-type) - -;; nndb-request-update-info does not exist and is not needed - -;; nndb-request-update-mark does not exist; it should be used to TOUCH -;; articles as they are marked exipirable -(defun nndb-touch-article (group article) - (nntp-send-command nil "X-TOUCH" article)) - -(deffoo nndb-request-update-mark - (group article mark) - "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'" - (if (and nndb-set-expire-date-on-mark (string-equal mark "E")) - (nndb-touch-article group article)) - mark) - -;; nndb-request-create-group -- currently this isn't necessary; nndb -;; creates groups on demand. - -;; todo -- use some other time than the creation time of the article -;; best is time since article has been marked as expirable - -(defun nndb-request-expire-articles-local - (articles &optional group server force) - "Let gnus do the date check and issue the delete commands." - (let (msg art delete-list (num-delete 0) rest) - (nntp-possibly-change-group group server) - (while articles - (setq art (pop articles)) - (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art) - (setq msg (nndb-status-message)) - (if (string-match "^423" msg) - () - (or (string-match "'\\(.+\\)'" msg) - (error "Not a valid response for X-DATE command: %s" - msg)) - (if (nnmail-expired-article-p - group - (date-to-time (substring msg (match-beginning 1) (match-end 1))) - force) - (progn - (setq delete-list (concat delete-list " " (int-to-string art))) - (setq num-delete (1+ num-delete))) - (push art rest)))) - (if (> (length delete-list) 0) - (progn - (nnheader-message 5 "Deleting %s article(s) from %s" - (int-to-string num-delete) group) - (nntp-send-command "^[23].*\n" "X-DELETE" delete-list)) - ) - - (nnheader-message 5 "") - (nconc rest articles))) - -(defun nndb-get-remote-expire-response () - (let (list) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (if (looking-at "^[34]") - ;; x-expire returned error--presume no articles were expirable) - (setq list nil) - ;; otherwise, pull all of the following numbers into the list - (re-search-forward "follows\r?\n?" nil t) - (while (re-search-forward "^[0-9]+$" nil t) - (push (string-to-number (match-string 0)) list))) - list)) - -(defun nndb-request-expire-articles-remote - (articles &optional group server force) - "Let the nndb backend expire articles" - (let (days art-string delete-list (num-delete 0)) - (nntp-possibly-change-group group server) - - ;; first calculate the wait period in days - (setq days (or (and nnmail-expiry-wait-function - (funcall nnmail-expiry-wait-function group)) - nnmail-expiry-wait)) - ;; now handle the special cases - (cond (force - (setq days 0)) - ((eq days 'never) - ;; This isn't an expirable group. - (setq days -1)) - ((eq days 'immediate) - (setq days 0))) - - - ;; build article string - (setq art-string (concat days " " (nndb-build-article-string articles))) - (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string) - - (setq delete-list (nndb-get-remote-expire-response)) - (setq num-delete (length delete-list)) - (if (> num-delete 0) - (nnheader-message 5 "Deleting %s article(s) from %s" - (int-to-string num-delete) group)) - - (nndb-build-expire-rest-list articles delete-list))) - -(deffoo nndb-request-expire-articles - (articles &optional group server force) - "Expires ARTICLES from GROUP on SERVER. -If FORCE, delete regardless of exiration date, otherwise use normal -expiry mechanism." - (if nndb-server-side-expiry - (nndb-request-expire-articles-remote articles group server force) - (nndb-request-expire-articles-local articles group server force))) - -;; _Something_ defines it... -(declare-function nndb-request-article "nndb" t t) - -(deffoo nndb-request-move-article - (article group server accept-form &optional last move-is-internal) - "Move ARTICLE (a number) from GROUP on SERVER. -Evals ACCEPT-FORM in current buffer, where the article is. -Optional LAST is ignored." - ;; we guess that the second arg in accept-form is the new group, - ;; which it will be for nndb, which is all that matters anyway - (let ((new-group (nth 1 accept-form)) result) - (nntp-possibly-change-group group server) - - ;; use the move command for nndb-to-nndb moves - (if (string-match "^nndb" new-group) - (let ((new-group-name (gnus-group-real-name new-group))) - (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name) - (cons new-group article)) - ;; else move normally - (let ((artbuf (get-buffer-create " *nndb move*"))) - (and - (nndb-request-article article group server artbuf) - (save-excursion - (set-buffer artbuf) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (nndb-request-expire-articles (list article) - group - server - t)) - result) - ))) - -(deffoo nndb-request-accept-article (group server &optional last) - "The article in the current buffer is put into GROUP." - (nntp-possibly-change-group group server) - (let (art msg) - (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) - (nnheader-insert "") - (nntp-send-buffer "^[23].*\n")) - - (set-buffer nntp-server-buffer) - (setq msg (buffer-string)) - (or (string-match "^\\([0-9]+\\)" msg) - (error "nndb: %s" msg)) - (setq art (substring msg (match-beginning 1) (match-end 1))) - (nnheader-message 5 "nndb: accepted %s" art) - (list art))) - -(deffoo nndb-request-replace-article (article group buffer) - "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER." - (set-buffer buffer) - (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article)) - (nnheader-insert "") - (nntp-send-buffer "^[23.*\n") - (list (int-to-string article)))) - - ; nndb-request-delete-group does not exist - ; todo -- maybe later - - ; nndb-request-rename-group does not exist - ; todo -- maybe later - -;; -- standard compatibility functions - -(deffoo nndb-status-message (&optional server) - "Return server status as a string." - (set-buffer nntp-server-buffer) - (buffer-string)) - -;; Import stuff from nntp - -(nnoo-import nndb - (nntp)) - -(provide 'nndb) - -;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a -;;; nndb.el ends here
--- a/lisp/gnus/nndiary.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nndiary.el Thu Sep 02 02:12:28 2010 +0000 @@ -1584,6 +1584,4 @@ (provide 'nndiary) - -;; arch-tag: 9c542b95-92e7-4ace-a038-330ab296e203 ;;; nndiary.el ends here
--- a/lisp/gnus/nndir.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nndir.el Thu Sep 02 02:12:28 2010 +0000 @@ -96,5 +96,4 @@ (provide 'nndir) -;; arch-tag: 56f09f68-0e4e-4816-818a-df80b4a394c8 ;;; nndir.el ends here
--- a/lisp/gnus/nndoc.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nndoc.el Thu Sep 02 02:12:28 2010 +0000 @@ -100,7 +100,7 @@ (head-end . "^\t") (generate-head-function . nndoc-generate-clari-briefs-head) (article-transform-function . nndoc-transform-clari-briefs)) - + (standard-digest (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+")) (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+")) @@ -118,6 +118,16 @@ (file-end . "^End of") (prepare-body-function . nndoc-unquote-dashes) (subtype digest guess)) + (google + (pre-dissection-function . nndoc-decode-content-transfer-encoding) + (article-begin . "^== [0-9]+ of [0-9]+ ==$") + (head-begin . "^Date:") + (head-end . "^$") + (body-end-function . nndoc-digest-body-end) + (body-begin . "^$") + (file-end . "^==============================================================================$") + (prepare-body-function . nndoc-unquote-dashes) + (subtype digest guess)) (lanl-gov-announce (article-begin . "^\\\\\\\\\n") (head-begin . "^\\(Paper.*:\\|arXiv:\\)") @@ -186,6 +196,7 @@ (defvoo nndoc-article-begin-function nil) (defvoo nndoc-generate-article-function nil) (defvoo nndoc-dissection-function nil) +(defvoo nndoc-pre-dissection-function nil) (defvoo nndoc-status-string "") (defvoo nndoc-group-alist nil) @@ -363,7 +374,8 @@ nndoc-generate-head-function nndoc-body-begin-function nndoc-head-begin-function nndoc-generate-article-function - nndoc-dissection-function))) + nndoc-dissection-function + nndoc-pre-dissection-function))) (while vars (set (pop vars) nil))) (let (defs) @@ -445,6 +457,22 @@ (forward-line 1) (goto-char (+ (point) (string-to-number (match-string 1)))))) +(defun nndoc-google-type-p () + (when (re-search-forward "^=3D=3D 1 of [0-9]+ =3D=3D$" nil t) + t)) + +(defun nndoc-decode-content-transfer-encoding () + (let ((encoding + (save-restriction + (message-narrow-to-head) + (message-fetch-field "content-transfer-encoding")))) + (when (and encoding + (search-forward "\n\n" nil t)) + (save-restriction + (narrow-to-region (point) (point-max)) + (mm-decode-content-transfer-encoding + (intern (downcase (mail-header-strip encoding)))))))) + (defun nndoc-babyl-type-p () (when (re-search-forward "\^_\^L *\n" nil t) t)) @@ -807,6 +835,9 @@ ;; Remove blank lines. (while (eq (following-char) ?\n) (delete-char 1)) + (when nndoc-pre-dissection-function + (save-excursion + (funcall nndoc-pre-dissection-function))) (if nndoc-dissection-function (funcall nndoc-dissection-function) ;; Find the beginning of the file. @@ -1025,5 +1056,4 @@ (provide 'nndoc) -;; arch-tag: f5c2970e-0387-47ac-a0b3-6cc317dffabe ;;; nndoc.el ends here
--- a/lisp/gnus/nndraft.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nndraft.el Thu Sep 02 02:12:28 2010 +0000 @@ -202,7 +202,7 @@ 'nnmh-request-group (list group server dont-check))) -(deffoo nndraft-request-move-article (article group server accept-form +(deffoo nndraft-request-move-article (article group server accept-form &optional last move-is-internal) (nndraft-possibly-change-group group) (let ((buf (get-buffer-create " *nndraft move*")) @@ -313,5 +313,4 @@ (provide 'nndraft) -;; arch-tag: 3ce26ca0-41cb-48b1-8703-4dad35e188aa ;;; nndraft.el ends here
--- a/lisp/gnus/nneething.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nneething.el Thu Sep 02 02:12:28 2010 +0000 @@ -427,5 +427,4 @@ (provide 'nneething) -;; arch-tag: 1277f386-88f2-4459-bb24-f3f45962a6c5 ;;; nneething.el ends here
--- a/lisp/gnus/nnfolder.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnfolder.el Thu Sep 02 02:12:28 2010 +0000 @@ -494,7 +494,7 @@ (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) (gnus-sorted-difference articles (nreverse deleted-articles))))) -(deffoo nnfolder-request-move-article (article group server accept-form +(deffoo nnfolder-request-move-article (article group server accept-form &optional last move-is-internal) (save-excursion (let ((buf (get-buffer-create " *nnfolder move*")) @@ -552,7 +552,7 @@ (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") + (nnmail-cache-insert (nnmail-fetch-field "message-id") group (nnmail-fetch-field "subject") (nnmail-fetch-field "from"))) @@ -1301,5 +1301,4 @@ (provide 'nnfolder) -;; arch-tag: a040d0f4-4f4e-445f-8972-839575c5f7e6 ;;; nnfolder.el ends here
--- a/lisp/gnus/nngateway.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nngateway.el Thu Sep 02 02:12:28 2010 +0000 @@ -89,5 +89,4 @@ (provide 'nngateway) -;; arch-tag: f7ecb92e-b10c-43d5-9a9b-1314233341fc ;;; nngateway.el ends here
--- a/lisp/gnus/nnheader.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnheader.el Thu Sep 02 02:12:28 2010 +0000 @@ -1085,5 +1085,4 @@ (provide 'nnheader) -;; arch-tag: a9c4b7d9-52ae-4ec9-b196-dfd93124d202 ;;; nnheader.el ends here
--- a/lisp/gnus/nnimap.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnimap.el Thu Sep 02 02:12:28 2010 +0000 @@ -1871,5 +1871,4 @@ (provide 'nnimap) -;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b ;;; nnimap.el ends here
--- a/lisp/gnus/nnir.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnir.el Thu Sep 02 02:12:28 2010 +0000 @@ -263,10 +263,10 @@ ;; I have tried to make the code expandable. Basically, it is divided ;; into two layers. The upper layer is somewhat like the `nnvirtual' -;; or `nnkiboze' backends: given a specification of what articles to -;; show from another backend, it creates a group containing exactly -;; those articles. The lower layer issues a query to a search engine -;; and produces such a specification of what articles to show from the +;; backend: given a specification of what articles to show from +;; another backend, it creates a group containing exactly those +;; articles. The lower layer issues a query to a search engine and +;; produces such a specification of what articles to show from the ;; other backend. ;; The interface between the two layers consists of the single @@ -792,7 +792,7 @@ (setq novitem (funcall nnir-get-article-nov-override-function artitem)) ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head - (case (setq foo (gnus-retrieve-headers (list artno) + (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil)) (nov (goto-char (point-min)) @@ -1697,5 +1697,4 @@ ;; The end. (provide 'nnir) -;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664 ;;; nnir.el ends here
--- a/lisp/gnus/nnkiboze.el Wed Sep 01 22:54:47 2010 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,391 +0,0 @@ -;;; nnkiboze.el --- select virtual news access for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; The other access methods (nntp, nnspool, etc) are general news -;; access methods. This module relies on Gnus and can't be used -;; separately. - -;;; Code: - -(require 'nntp) -(require 'nnheader) -(require 'gnus) -(require 'gnus-score) -(require 'nnoo) -(require 'mm-util) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnkiboze) -(defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/") - "nnkiboze will put its files in this directory.") - -(defvoo nnkiboze-level 9 - "The maximum level to be searched for articles.") - -(defvoo nnkiboze-remove-read-articles t - "If non-nil, nnkiboze will remove read articles from the kiboze group.") - -(defvoo nnkiboze-ephemeral nil - "If non-nil, don't store any data anywhere.") - -(defvoo nnkiboze-scores nil - "Score rules for generating the nnkiboze group.") - -(defvoo nnkiboze-regexp nil - "Regexp for matching component groups.") - -(defvoo nnkiboze-file-coding-system mm-text-coding-system - "Coding system for nnkiboze files.") - - - -(defconst nnkiboze-version "nnkiboze 1.0") - -(defvoo nnkiboze-current-group nil) -(defvoo nnkiboze-status-string "") - -(defvoo nnkiboze-headers nil) - - - -;;; Interface functions. - -(nnoo-define-basics nnkiboze) - -(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old) - (nnkiboze-possibly-change-group group) - (unless gnus-nov-is-evil - (if (stringp (car articles)) - 'headers - (let ((nov (nnkiboze-nov-file-name))) - (when (file-exists-p nov) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) - (nnheader-insert-file-contents nov)) - (nnheader-nov-delete-outside-range - (car articles) (car (last articles))) - 'nov)))))) - -(deffoo nnkiboze-request-article (article &optional newsgroup server buffer) - (nnkiboze-possibly-change-group newsgroup) - (if (not (numberp article)) - ;; This is a real kludge. It might not work at times, but it - ;; does no harm I think. The only alternative is to offer no - ;; article fetching by message-id at all. - (nntp-request-article article newsgroup gnus-nntp-server buffer) - (let* ((header (gnus-summary-article-header article)) - (xref (mail-header-xref header)) - num group) - (unless xref - (error "nnkiboze: No xref")) - (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) - (error "nnkiboze: Malformed xref")) - (setq num (string-to-number (match-string 2 xref)) - group (match-string 1 xref)) - (or (with-current-buffer buffer - (or (and gnus-use-cache (gnus-cache-request-article num group)) - (gnus-agent-request-article num group))) - (gnus-request-article num group buffer))))) - -(deffoo nnkiboze-request-scan (&optional group server) - (nnkiboze-possibly-change-group group) - (nnkiboze-generate-group (concat "nnkiboze:" group))) - -(deffoo nnkiboze-request-group (group &optional server dont-check) - "Make GROUP the current newsgroup." - (nnkiboze-possibly-change-group group) - (if dont-check - t - (let ((nov-file (nnkiboze-nov-file-name)) - beg end total) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (unless (file-exists-p nov-file) - (nnkiboze-request-scan group)) - (if (not (file-exists-p nov-file)) - (nnheader-report 'nnkiboze "Can't select group %s" group) - (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) - (nnheader-insert-file-contents nov-file)) - (if (zerop (buffer-size)) - (nnheader-insert "211 0 0 0 %s\n" group) - (goto-char (point-min)) - (when (looking-at "[0-9]+") - (setq beg (read (current-buffer)))) - (goto-char (point-max)) - (when (re-search-backward "^[0-9]" nil t) - (setq end (read (current-buffer)))) - (setq total (count-lines (point-min) (point-max))) - (nnheader-insert "211 %d %d %d %s\n" total beg end group))))))) - -(deffoo nnkiboze-close-group (group &optional server) - (nnkiboze-possibly-change-group group) - ;; Remove NOV lines of articles that are marked as read. - (when (and (file-exists-p (nnkiboze-nov-file-name)) - nnkiboze-remove-read-articles) - (let ((coding-system-for-write nnkiboze-file-coding-system)) - (with-temp-file (nnkiboze-nov-file-name) - (let ((cur (current-buffer)) - (nnheader-file-coding-system nnkiboze-file-coding-system)) - (nnheader-insert-file-contents (nnkiboze-nov-file-name)) - (goto-char (point-min)) - (while (not (eobp)) - (if (not (gnus-article-read-p (read cur))) - (forward-line 1) - (gnus-delete-line)))))) - (setq nnkiboze-current-group nil))) - -(deffoo nnkiboze-open-server (server &optional defs) - (unless (assq 'nnkiboze-regexp defs) - (push `(nnkiboze-regexp ,server) - defs)) - (nnoo-change-server 'nnkiboze server defs)) - -(deffoo nnkiboze-request-delete-group (group &optional force server) - (nnkiboze-possibly-change-group group) - (when force - (let ((files (nconc - (nnkiboze-score-file group) - (list (nnkiboze-nov-file-name) - (nnkiboze-nov-file-name ".newsrc"))))) - (while files - (and (file-exists-p (car files)) - (file-writable-p (car files)) - (delete-file (car files))) - (setq files (cdr files))))) - (setq nnkiboze-current-group nil) - t) - -(nnoo-define-skeleton nnkiboze) - - -;;; Internal functions. - -(defun nnkiboze-possibly-change-group (group) - (setq nnkiboze-current-group group)) - -(defun nnkiboze-prefixed-name (group) - (gnus-group-prefixed-name group '(nnkiboze ""))) - -;;;###autoload -(defun nnkiboze-generate-groups () - "\"Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups\". -Finds out what articles are to be part of the nnkiboze groups." - (interactive) - (let ((mail-sources nil) - (gnus-use-dribble-file nil) - (gnus-read-active-file t) - (gnus-expert-user t)) - (gnus)) - (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) - (newsrc (cdr gnus-newsrc-alist)) - gnus-newsrc-hashtb info) - (gnus-make-hashtable-from-newsrc-alist) - ;; We have copied all the newsrc alist info over to local copies - ;; so that we can mess all we want with these lists. - (while (setq info (pop newsrc)) - (when (string-match "nnkiboze" (gnus-info-group info)) - ;; For each kiboze group, we call this function to generate - ;; it. - (nnkiboze-generate-group (gnus-info-group info) t)))) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups))) - -(defun nnkiboze-score-file (group) - (list (expand-file-name - (concat (file-name-as-directory gnus-kill-files-directory) - (nnheader-translate-file-chars - (concat (nnkiboze-prefixed-name nnkiboze-current-group) - "." gnus-score-file-suffix)))))) - -(defun nnkiboze-generate-group (group &optional inhibit-list-groups) - (let* ((info (gnus-get-info group)) - (newsrc-file (concat nnkiboze-directory - (nnheader-translate-file-chars - (concat group ".newsrc")))) - (nov-file (concat nnkiboze-directory - (nnheader-translate-file-chars - (concat group ".nov")))) - method nnkiboze-newsrc gname newsrc active - ginfo lowest glevel orig-info nov-buffer - ;; Bind various things to nil to make group entry faster. - (gnus-expert-user t) - (gnus-large-newsgroup nil) - (gnus-score-find-score-files-function 'nnkiboze-score-file) - ;; Use only nnkiboze-score-file! - (gnus-score-use-all-scores nil) - (gnus-use-scoring t) - (gnus-verbose (min gnus-verbose 3)) - gnus-select-group-hook gnus-summary-prepare-hook - gnus-thread-sort-functions gnus-show-threads - gnus-visual gnus-suppress-duplicates num-unread) - (unless info - (error "No such group: %s" group)) - ;; Load the kiboze newsrc file for this group. - (when (file-exists-p newsrc-file) - (load newsrc-file)) - (let ((coding-system-for-write nnkiboze-file-coding-system)) - (gnus-make-directory (file-name-directory nov-file)) - (with-temp-file nov-file - (mm-disable-multibyte) - (when (file-exists-p nov-file) - (insert-file-contents nov-file)) - (setq nov-buffer (current-buffer)) - ;; Go through the active hashtb and add new all groups that match the - ;; kiboze regexp. - (mapatoms - (lambda (group) - (and (string-match nnkiboze-regexp - (setq gname (symbol-name group))) ; Match - (not (assoc gname nnkiboze-newsrc)) ; It isn't registered - (numberp (car (symbol-value group))) ; It is active - (or (> nnkiboze-level 7) - (and (setq glevel - (gnus-info-level (gnus-get-info gname))) - (>= nnkiboze-level glevel))) - (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes - (push (cons gname (1- (car (symbol-value group)))) - nnkiboze-newsrc))) - gnus-active-hashtb) - ;; `newsrc' is set to the list of groups that possibly are - ;; component groups to this kiboze group. This list has elements - ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest - ;; number that has been kibozed in GROUP in this kiboze group. - (setq newsrc nnkiboze-newsrc) - (while newsrc - (if (not (setq active (gnus-active (caar newsrc)))) - ;; This group isn't active after all, so we remove it from - ;; the list of component groups. - (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) - (setq lowest (cdar newsrc)) - ;; Ok, we have a valid component group, so we jump to it. - (switch-to-buffer gnus-group-buffer) - (gnus-group-jump-to-group (caar newsrc)) - (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) - (setq ginfo (gnus-get-info (gnus-group-group-name)) - orig-info (gnus-copy-sequence ginfo) - num-unread (gnus-group-unread (caar newsrc))) - (unwind-protect - (progn - ;; We set all list of article marks to nil. Since we operate - ;; on copies of the real lists, we can destroy anything we - ;; want here. - (when (nth 3 ginfo) - (setcar (nthcdr 3 ginfo) nil)) - ;; We set the list of read articles to be what we expect for - ;; this kiboze group -- either nil or `(1 . LOWEST)'. - (when ginfo - (setcar (nthcdr 2 ginfo) - (and (not (= lowest 1)) (cons 1 lowest)))) - (when (and (or (not ginfo) - (> (length (gnus-list-of-unread-articles - (car ginfo))) - 0)) - (progn - (ignore-errors - (gnus-group-select-group nil)) - (eq major-mode 'gnus-summary-mode))) - ;; We are now in the group where we want to be. - (setq method (gnus-find-method-for-group - gnus-newsgroup-name)) - (when (eq method gnus-select-method) - (setq method nil)) - ;; We go through the list of scored articles. - (while gnus-newsgroup-scored - (when (> (caar gnus-newsgroup-scored) lowest) - ;; If it has a good score, then we enter this article - ;; into the kiboze group. - (nnkiboze-enter-nov - nov-buffer - (gnus-summary-article-header - (caar gnus-newsgroup-scored)) - gnus-newsgroup-name)) - (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) - ;; That's it. We exit this group. - (when (eq major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))))) - ;; Restore the proper info. - (when ginfo - (setcdr ginfo (cdr orig-info))) - (setcar (gnus-group-entry (caar newsrc)) num-unread))) - (setcdr (car newsrc) (cdr active)) - (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) - (setq newsrc (cdr newsrc))))) - ;; We save the kiboze newsrc for this group. - (gnus-make-directory (file-name-directory newsrc-file)) - (with-temp-file newsrc-file - (mm-disable-multibyte) - (insert "(setq nnkiboze-newsrc '") - (gnus-prin1 nnkiboze-newsrc) - (insert ")\n")) - (unless inhibit-list-groups - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups))) - t)) - -(defun nnkiboze-enter-nov (buffer header group) - (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (let ((prefix (gnus-group-real-prefix group)) - (oheader (copy-sequence header)) - article) - (if (zerop (forward-line -1)) - (progn - (setq article (1+ (read (current-buffer)))) - (forward-line 1)) - (setq article 1)) - (mail-header-set-number oheader article) - (with-temp-buffer - (insert (or (mail-header-xref oheader) "")) - (goto-char (point-min)) - (if (re-search-forward " [^ ]+:[0-9]+" nil t) - (goto-char (match-beginning 0)) - (or (eobp) (forward-char 1))) - ;; The first Xref has to be the group this article - ;; really came for - this is the article nnkiboze - ;; will request when it is asked for the article. - (insert " " group ":" - (int-to-string (mail-header-number header)) " ") - (while (re-search-forward " [^ ]+:[0-9]+" nil t) - (goto-char (1+ (match-beginning 0))) - (insert prefix)) - (mail-header-set-xref oheader (buffer-string))) - (nnheader-insert-nov oheader)))) - -(defun nnkiboze-nov-file-name (&optional suffix) - (concat (file-name-as-directory nnkiboze-directory) - (nnheader-translate-file-chars - (concat (nnkiboze-prefixed-name nnkiboze-current-group) - (or suffix ".nov"))))) - -(provide 'nnkiboze) - -;; arch-tag: 66068271-bdc9-4801-bcde-779702e73a05 -;;; nnkiboze.el ends here
--- a/lisp/gnus/nnlistserv.el Wed Sep 01 22:54:47 2010 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,152 +0,0 @@ -;;; nnlistserv.el --- retrieving articles via web mailing list archives - -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'mm-url) -(require 'nnweb) - -(nnoo-declare nnlistserv - nnweb) - -(defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/") - "Where nnlistserv will save its files." - nnweb-directory) - -(defvoo nnlistserv-name 'kk - "What search engine type is being used." - nnweb-type) - -(defvoo nnlistserv-type-definition - '((kk - (article . nnlistserv-kk-wash-article) - (map . nnlistserv-kk-create-mapping) - (search . nnlistserv-kk-search) - (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/") - (pages "fra160396" "fra160796" "fra061196" "fra160197" - "fra090997" "fra040797" "fra130397" "nye") - (index . "date.html") - (identifier . nnlistserv-kk-identity))) - "Type-definition alist." - nnweb-type-definition) - -(defvoo nnlistserv-search nil - "Search string to feed to DejaNews." - nnweb-search) - -(defvoo nnlistserv-ephemeral-p nil - "Whether this nnlistserv server is ephemeral." - nnweb-ephemeral-p) - -;;; Internal variables - -;;; Interface functions - -(nnoo-define-basics nnlistserv) - -(nnoo-import nnlistserv - (nnweb)) - -;;; Internal functions - -;;; -;;; KK functions. -;;; - -(defun nnlistserv-kk-create-mapping () - "Perform the search and create a number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (let ((case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - (pages (nnweb-definition 'pages)) - map url page subject from ) - (while (setq page (pop pages)) - (erase-buffer) - (when (funcall (nnweb-definition 'search) page) - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (mm-url-decode-entities) - (goto-char (point-min)) - (while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t) - (setq url (match-string 1) - subject (match-string 2) - from (match-string 3)) - (setq url (concat (format (nnweb-definition 'address) page) url)) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) subject from "" - (concat "<" (nnweb-identifier url) "@kk>") - nil 0 0 url)) - map) - (nnweb-set-hashtb (cadar map) (car map)) - (nnheader-message 5 "%s %s %s" (cdr active) (point) pages))))) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car))))) - -(defun nnlistserv-kk-wash-article () - (let ((case-fold-search t) - (headers '(sent name email subject id)) - sent name email subject id) - (mm-url-decode-entities) - (while headers - (goto-char (point-min)) - (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t) - (set (pop headers) (match-string 1))) - (goto-char (point-min)) - (search-forward "<!-- body" nil t) - (delete-region (point-min) (progn (forward-line 1) (point))) - (goto-char (point-max)) - (search-backward "<!-- body" nil t) - (delete-region (point-max) (progn (beginning-of-line) (point))) - (mm-url-remove-markup) - (goto-char (point-min)) - (insert (format "From: %s <%s>\n" name email) - (format "Subject: %s\n" subject) - (format "Message-ID: %s\n" id) - (format "Date: %s\n\n" sent)))) - -(defun nnlistserv-kk-search (search) - (mm-url-insert - (concat (format (nnweb-definition 'address) search) - (nnweb-definition 'index))) - t) - -(defun nnlistserv-kk-identity (url) - "Return an unique identifier based on URL." - url) - -(provide 'nnlistserv) - -;; arch-tag: 7705176f-d332-4a5e-a520-d0d319445617 -;;; nnlistserv.el ends here
--- a/lisp/gnus/nnmail.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnmail.el Thu Sep 02 02:12:28 2010 +0000 @@ -2052,5 +2052,4 @@ (provide 'nnmail) -;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7 ;;; nnmail.el ends here
--- a/lisp/gnus/nnmaildir.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnmaildir.el Thu Sep 02 02:12:28 2010 +0000 @@ -1667,5 +1667,4 @@ ;; fill-column: 77 ;; End: -;; arch-tag: 0c4e44cd-dfde-4040-888e-5597ec771849 ;;; nnmaildir.el ends here
--- a/lisp/gnus/nnmairix.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnmairix.el Thu Sep 02 02:12:28 2010 +0000 @@ -556,7 +556,7 @@ (mapcar (lambda (arg) (- arg numcorr)) articles))) - (setq rval + (setq rval (if (eq nnmairix-backend 'nnimap) (let ((gnus-nov-is-evil t)) (nnmairix-call-backend @@ -2044,5 +2044,4 @@ (provide 'nnmairix) -;; arch-tag: bb187498-b229-4a55-8c07-6d3f80713e94 ;;; nnmairix.el ends here
--- a/lisp/gnus/nnmbox.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnmbox.el Thu Sep 02 02:12:28 2010 +0000 @@ -718,5 +718,4 @@ (provide 'nnmbox) -;; arch-tag: 611dd95f-be37-413a-b3ae-8b059ba93659 ;;; nnmbox.el ends here
--- a/lisp/gnus/nnmh.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnmh.el Thu Sep 02 02:12:28 2010 +0000 @@ -287,7 +287,7 @@ (deffoo nnmh-close-group (group &optional server) t) -(deffoo nnmh-request-move-article (article group server accept-form +(deffoo nnmh-request-move-article (article group server accept-form &optional last move-is-internal) (let ((buf (get-buffer-create " *nnmh move*")) result) @@ -312,7 +312,7 @@ (nnmh-possibly-change-directory group server) (nnmail-check-syntax) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") + (nnmail-cache-insert (nnmail-fetch-field "message-id") group (nnmail-fetch-field "subject") (nnmail-fetch-field "from"))) @@ -574,5 +574,4 @@ (provide 'nnmh) -;; arch-tag: 36c12a98-3bad-44b3-9953-628078ef0e04 ;;; nnmh.el ends here
--- a/lisp/gnus/nnml.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnml.el Thu Sep 02 02:12:28 2010 +0000 @@ -1306,5 +1306,4 @@ (provide 'nnml) -;; arch-tag: 52c97dc3-9735-45de-b439-9e4d23b52004 ;;; nnml.el ends here
--- a/lisp/gnus/nnnil.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnnil.el Thu Sep 02 02:12:28 2010 +0000 @@ -79,4 +79,4 @@ (provide 'nnnil) -;; arch-tag: a982a1a3-bc5e-4fb1-a233-d7657a3e3257 +;;; nnnil.el ends here
--- a/lisp/gnus/nnoo.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnoo.el Thu Sep 02 02:12:28 2010 +0000 @@ -322,5 +322,4 @@ (provide 'nnoo) -;; arch-tag: 0196b5ed-6f34-4778-a455-73a971f837e7 ;;; nnoo.el ends here
--- a/lisp/gnus/nnrss.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnrss.el Thu Sep 02 02:12:28 2010 +0000 @@ -1134,5 +1134,4 @@ (provide 'nnrss) -;; arch-tag: 12910c07-0cdf-44fb-8d2c-416ded64c267 ;;; nnrss.el ends here
--- a/lisp/gnus/nnspool.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnspool.el Thu Sep 02 02:12:28 2010 +0000 @@ -458,5 +458,4 @@ (provide 'nnspool) -;; arch-tag: bdac8d27-2934-4eee-bad0-49e6b90c0d05 ;;; nnspool.el ends here
--- a/lisp/gnus/nntp.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nntp.el Thu Sep 02 02:12:28 2010 +0000 @@ -309,8 +309,8 @@ stdin and return responses to stdout.") (defvar nntp-authinfo-rejected nil -"A custom error condition used to report 'Authentication Rejected' errors. -Condition handlers that match just this condition ensure that the nntp +"A custom error condition used to report 'Authentication Rejected' errors. +Condition handlers that match just this condition ensure that the nntp backend doesn't catch this error.") (put 'nntp-authinfo-rejected 'error-conditions '(error nntp-authinfo-rejected)) (put 'nntp-authinfo-rejected 'error-message "Authorization Rejected") @@ -1109,7 +1109,8 @@ t) (deffoo nntp-request-set-mark (group actions &optional server) - (unless nntp-marks-is-evil + (when (and (not nntp-marks-is-evil) + nntp-marks-file-name) (nntp-possibly-create-directory group server) (nntp-open-marks group server) (dolist (action actions) @@ -1129,7 +1130,8 @@ nil) (deffoo nntp-request-update-info (group info &optional server) - (unless nntp-marks-is-evil + (when (and (not nntp-marks-is-evil) + nntp-marks-file-name) (nntp-possibly-create-directory group server) (when (nntp-marks-changed-p group server) (nnheader-message 8 "Updating marks for %s..." group) @@ -2011,7 +2013,7 @@ (and nntp-pre-command (push nntp-pre-command command)) (let ((process-connection-type nil)) ;See `nntp-open-via-rlogin-and-netcat'. (apply 'start-process "nntpd" buffer command)))) - + (defun nntp-open-via-telnet-and-telnet (buffer) "Open a connection to an nntp server through an intermediate host. @@ -2178,5 +2180,4 @@ (provide 'nntp) -;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271 ;;; nntp.el ends here
--- a/lisp/gnus/nnvirtual.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnvirtual.el Thu Sep 02 02:12:28 2010 +0000 @@ -809,5 +809,4 @@ (provide 'nnvirtual) -;; arch-tag: ca8c8ad9-1bd8-4b0f-9722-90dc645a45f5 ;;; nnvirtual.el ends here
--- a/lisp/gnus/nnweb.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/nnweb.el Thu Sep 02 02:12:28 2010 +0000 @@ -612,5 +612,4 @@ (provide 'nnweb) -;; arch-tag: f59307eb-c90f-479f-b7d2-dbd8bf51b697 ;;; nnweb.el ends here
--- a/lisp/gnus/nnwfm.el Wed Sep 01 22:54:47 2010 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,432 +0,0 @@ -;;; nnwfm.el --- interfacing with a web forum - -;; Copyright (C) 2000, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Note: You need to have `url' and `w3' installed for this -;; backend to work. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'message) -(require 'gnus-util) -(require 'gnus) -(require 'nnmail) -(require 'mm-util) -(require 'mm-url) -(require 'nnweb) -(autoload 'w3-parse-buffer "w3-parse") - -(nnoo-declare nnwfm) - -(defvoo nnwfm-directory (nnheader-concat gnus-directory "wfm/") - "Where nnwfm will save its files.") - -(defvoo nnwfm-address "" - "The address of the Ultimate bulletin board.") - -;;; Internal variables - -(defvar nnwfm-groups-alist nil) -(defvoo nnwfm-groups nil) -(defvoo nnwfm-headers nil) -(defvoo nnwfm-articles nil) -(defvar nnwfm-table-regexp - "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") - -;;; Interface functions - -(nnoo-define-basics nnwfm) - -(deffoo nnwfm-retrieve-headers (articles &optional group server fetch-old) - (nnwfm-possibly-change-server group server) - (unless gnus-nov-is-evil - (let* ((last (car (last articles))) - (did nil) - (start 1) - (entry (assoc group nnwfm-groups)) - (sid (nth 2 entry)) - (topics (nth 4 entry)) - (mapping (nth 5 entry)) - (old-total (or (nth 6 entry) 1)) - (nnwfm-table-regexp "Thread.asp") - headers article subject score from date lines parent point - contents tinfo fetchers map elem a href garticles topic old-max - inc datel table string current-page total-contents pages - farticles forum-contents parse furl-fetched mmap farticle - thread-id tables hstuff bstuff time) - (setq map mapping) - (while (and (setq article (car articles)) - map) - (while (and map - (or (> article (caar map)) - (< (cadar map) (caar map)))) - (pop map)) - (when (setq mmap (car map)) - (setq farticle -1) - (while (and article - (<= article (nth 1 mmap))) - ;; Do we already have a fetcher for this topic? - (if (setq elem (assq (nth 2 mmap) fetchers)) - ;; Yes, so we just add the spec to the end. - (nconc elem (list (cons article - (+ (nth 3 mmap) (incf farticle))))) - ;; No, so we add a new one. - (push (list (nth 2 mmap) - (cons article - (+ (nth 3 mmap) (incf farticle)))) - fetchers)) - (pop articles) - (setq article (car articles))))) - ;; Now we have the mapping from/to Gnus/nnwfm article numbers, - ;; so we start fetching the topics that we need to satisfy the - ;; request. - (if (not fetchers) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer)) - (setq nnwfm-articles nil) - (mm-with-unibyte-buffer - (dolist (elem fetchers) - (erase-buffer) - (setq subject (nth 2 (assq (car elem) topics)) - thread-id (nth 0 (assq (car elem) topics))) - (mm-url-insert - (concat nnwfm-address - (format "Item.asp?GroupID=%d&ThreadID=%d" sid - thread-id))) - (goto-char (point-min)) - (setq tables (caddar - (caddar - (cdr (caddar - (caddar - (ignore-errors - (w3-parse-buffer (current-buffer))))))))) - (setq tables (cdr (caddar (memq (assq 'div tables) tables)))) - (setq contents nil) - (dolist (table tables) - (when (eq (car table) 'table) - (setq table (caddar (caddar (caddr table))) - hstuff (delete ":link" (nnweb-text (car table))) - bstuff (car (caddar (cdr table))) - from (car hstuff)) - (when (nth 2 hstuff) - (setq time (nnwfm-date-to-time (nth 2 hstuff))) - (push (list from time bstuff) contents)))) - (setq contents (nreverse contents)) - (dolist (art (cdr elem)) - (push (list (car art) - (nth (1- (cdr art)) contents) - subject) - nnwfm-articles)))) - (setq nnwfm-articles - (sort nnwfm-articles 'car-less-than-car)) - ;; Now we have all the articles, conveniently in an alist - ;; where the key is the Gnus article number. - (dolist (articlef nnwfm-articles) - (setq article (nth 0 articlef) - contents (nth 1 articlef) - subject (nth 2 articlef)) - (setq from (nth 0 contents) - date (message-make-date (nth 1 contents))) - (push - (cons - article - (make-full-mail-header - article subject - from (or date "") - (concat "<" (number-to-string sid) "%" - (number-to-string article) - "@wfm>") - "" 0 - (/ (length (mapconcat 'identity (nnweb-text (nth 2 contents)) "")) - 70) - nil nil)) - headers)) - (setq nnwfm-headers (sort headers 'car-less-than-car)) - (save-excursion - (set-buffer nntp-server-buffer) - (mm-with-unibyte-current-buffer - (erase-buffer) - (dolist (header nnwfm-headers) - (nnheader-insert-nov (cdr header)))))) - 'nov))) - -(deffoo nnwfm-request-group (group &optional server dont-check) - (nnwfm-possibly-change-server nil server) - (when (not nnwfm-groups) - (nnwfm-request-list)) - (unless dont-check - (nnwfm-create-mapping group)) - (let ((elem (assoc group nnwfm-groups))) - (cond - ((not elem) - (nnheader-report 'nnwfm "Group does not exist")) - (t - (nnheader-report 'nnwfm "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) - (prin1-to-string group)))))) - -(deffoo nnwfm-request-close () - (setq nnwfm-groups-alist nil - nnwfm-groups nil)) - -(deffoo nnwfm-request-article (article &optional group server buffer) - (nnwfm-possibly-change-server group server) - (let ((contents (cdr (assq article nnwfm-articles)))) - (when (setq contents (nth 2 (car contents))) - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (nnweb-insert-html contents) - (goto-char (point-min)) - (insert "Content-Type: text/html\nMIME-Version: 1.0\n") - (let ((header (cdr (assq article nnwfm-headers)))) - (mm-with-unibyte-current-buffer - (nnheader-insert-header header))) - (nnheader-report 'nnwfm "Fetched article %s" article) - (cons group article))))) - -(deffoo nnwfm-request-list (&optional server) - (nnwfm-possibly-change-server nil server) - (mm-with-unibyte-buffer - (mm-url-insert - (if (string-match "/$" nnwfm-address) - (concat nnwfm-address "Group.asp") - nnwfm-address)) - (let* ((nnwfm-table-regexp "Thread.asp") - (contents (w3-parse-buffer (current-buffer))) - sid elem description articles a href group forum - a1 a2) - (dolist (row (cdr (nth 2 (car (nth 2 (nnwfm-find-forum-table - contents)))))) - (setq row (nth 2 row)) - (when (setq a (nnweb-parse-find 'a row)) - (setq group (car (last (nnweb-text a))) - href (cdr (assq 'href (nth 1 a)))) - (setq description (car (last (nnweb-text (nth 1 row))))) - (setq articles - (string-to-number - (gnus-replace-in-string - (car (last (nnweb-text (nth 3 row)))) "," ""))) - (when (and href - (string-match "GroupId=\\([0-9]+\\)" href)) - (setq forum (string-to-number (match-string 1 href))) - (if (setq elem (assoc group nnwfm-groups)) - (setcar (cdr elem) articles) - (push (list group articles forum description nil nil nil nil) - nnwfm-groups)))))) - (nnwfm-write-groups) - (nnwfm-generate-active) - t)) - -(deffoo nnwfm-request-newgroups (date &optional server) - (nnwfm-possibly-change-server nil server) - (nnwfm-generate-active) - t) - -(nnoo-define-skeleton nnwfm) - -;;; Internal functions - -(defun nnwfm-new-threads-p (group time) - "See whether we want to fetch the threads for GROUP written before TIME." - (let ((old-time (nth 7 (assoc group nnwfm-groups)))) - (or (null old-time) - (time-less-p old-time time)))) - -(defun nnwfm-create-mapping (group) - (let* ((entry (assoc group nnwfm-groups)) - (sid (nth 2 entry)) - (topics (nth 4 entry)) - (mapping (nth 5 entry)) - (old-total (or (nth 6 entry) 1)) - (current-time (current-time)) - (nnwfm-table-regexp "Thread.asp") - (furls (list (concat nnwfm-address - (format "Thread.asp?GroupId=%d" sid)))) - fetched-urls - contents forum-contents a subject href - garticles topic tinfo old-max inc parse elem date - url time) - (mm-with-unibyte-buffer - (while furls - (erase-buffer) - (push (car furls) fetched-urls) - (mm-url-insert (pop furls)) - (goto-char (point-min)) - (while (re-search-forward " wr(" nil t) - (forward-char -1) - (setq elem (message-tokenize-header - (gnus-replace-in-string - (buffer-substring - (1+ (point)) - (progn - (forward-sexp 1) - (1- (point)))) - "\\\\[\"\\\\]" ""))) - (push (list - (string-to-number (nth 1 elem)) - (gnus-replace-in-string (nth 2 elem) "\"" "") - (string-to-number (nth 5 elem))) - forum-contents)) - (when (re-search-forward "href=\"\\(Thread.*DateLast=\\([^\"]+\\)\\)" - nil t) - (setq url (match-string 1) - time (nnwfm-date-to-time (gnus-url-unhex-string - (match-string 2)))) - (when (and (nnwfm-new-threads-p group time) - (not (member - (setq url (concat - nnwfm-address - (mm-url-decode-entities-string url))) - fetched-urls))) - (push url furls)))) - ;; The main idea here is to map Gnus article numbers to - ;; nnwfm article numbers. Say there are three topics in - ;; this forum, the first with 4 articles, the seconds with 2, - ;; and the third with 1. Then this will translate into 7 Gnus - ;; article numbers, where 1-4 comes from the first topic, 5-6 - ;; from the second and 7 from the third. Now, then next time - ;; the group is entered, there's 2 new articles in topic one - ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6 - ;; in topic one and 10 will be the 2 in topic three. - (dolist (elem (nreverse forum-contents)) - (setq subject (nth 1 elem) - topic (nth 0 elem) - garticles (nth 2 elem)) - (if (setq tinfo (assq topic topics)) - (progn - (setq old-max (cadr tinfo)) - (setcar (cdr tinfo) garticles)) - (setq old-max 0) - (push (list topic garticles subject) topics) - (setcar (nthcdr 4 entry) topics)) - (when (not (= old-max garticles)) - (setq inc (- garticles old-max)) - (setq mapping (nconc mapping - (list - (list - old-total (1- (incf old-total inc)) - topic (1+ old-max))))) - (incf old-max inc) - (setcar (nthcdr 5 entry) mapping) - (setcar (nthcdr 6 entry) old-total)))) - (setcar (nthcdr 7 entry) current-time) - (setcar (nthcdr 1 entry) (1- old-total)) - (nnwfm-write-groups) - mapping)) - -(defun nnwfm-possibly-change-server (&optional group server) - (nnwfm-init server) - (when (and server - (not (nnwfm-server-opened server))) - (nnwfm-open-server server)) - (unless nnwfm-groups-alist - (nnwfm-read-groups) - (setq nnwfm-groups (cdr (assoc nnwfm-address - nnwfm-groups-alist))))) - -(deffoo nnwfm-open-server (server &optional defs connectionless) - (nnheader-init-server-buffer) - (if (nnwfm-server-opened server) - t - (unless (assq 'nnwfm-address defs) - (setq defs (append defs (list (list 'nnwfm-address server))))) - (nnoo-change-server 'nnwfm server defs))) - -(defun nnwfm-read-groups () - (setq nnwfm-groups-alist nil) - (let ((file (expand-file-name "groups" nnwfm-directory))) - (when (file-exists-p file) - (mm-with-unibyte-buffer - (insert-file-contents file) - (goto-char (point-min)) - (setq nnwfm-groups-alist (read (current-buffer))))))) - -(defun nnwfm-write-groups () - (setq nnwfm-groups-alist - (delq (assoc nnwfm-address nnwfm-groups-alist) - nnwfm-groups-alist)) - (push (cons nnwfm-address nnwfm-groups) - nnwfm-groups-alist) - (with-temp-file (expand-file-name "groups" nnwfm-directory) - (prin1 nnwfm-groups-alist (current-buffer)))) - -(defun nnwfm-init (server) - "Initialize buffers and such." - (unless (file-exists-p nnwfm-directory) - (gnus-make-directory nnwfm-directory))) - -(defun nnwfm-generate-active () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (elem nnwfm-groups) - (insert (prin1-to-string (car elem)) - " " (number-to-string (cadr elem)) " 1 y\n")))) - -(defun nnwfm-find-forum-table (contents) - (catch 'found - (nnwfm-find-forum-table-1 contents))) - -(defun nnwfm-find-forum-table-1 (contents) - (dolist (element contents) - (unless (stringp element) - (when (and (eq (car element) 'table) - (nnwfm-forum-table-p element)) - (throw 'found element)) - (when (nth 2 element) - (nnwfm-find-forum-table-1 (nth 2 element)))))) - -(defun nnwfm-forum-table-p (parse) - (when (not (apply 'gnus-or - (mapcar - (lambda (p) - (nnweb-parse-find 'table p)) - (nth 2 parse)))) - (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20))))) - case-fold-search) - (when (and href (string-match nnwfm-table-regexp href)) - t)))) - -(defun nnwfm-date-to-time (date) - (let ((time (mapcar #'string-to-number (split-string date "[\\.\\+ :]")))) - (encode-time 0 (nth 4 time) (nth 3 time) - (nth 0 time) (nth 1 time) - (if (< (nth 2 time) 70) - (+ 2000 (nth 2 time)) - (+ 1900 (nth 2 time)))))) - -(provide 'nnwfm) - -;; Local Variables: -;; coding: iso-8859-1 -;; End: - -;; arch-tag: d813966a-4211-4557-ad11-d1ac2bc86536 -;;; nnwfm.el ends here
--- a/lisp/gnus/pop3.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/pop3.el Thu Sep 02 02:12:28 2010 +0000 @@ -102,7 +102,7 @@ "*If non-nil, display the size of the message that is being fetched." :version "22.1" ;; Oort Gnus :type 'boolean - :group 'pop3) + :group 'pop3) (defvar pop3-timestamp nil "Timestamp returned when initially connected to the POP server. @@ -167,7 +167,7 @@ (/ (cdr (assoc n message-sizes)) 1024.0)) (message "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost)) + n message-count pop3-mailhost)) (pop3-retr process n crashbuf) (save-excursion (set-buffer crashbuf) @@ -283,7 +283,7 @@ (pop3-quit process) (error "POP server doesn't support starttls"))) process)) - (t + (t (open-network-stream "POP" (current-buffer) mailhost port)))) (let ((response (pop3-read-response process t))) (setq pop3-timestamp @@ -468,7 +468,7 @@ (defun pop3-list (process &optional msg) "If MSG is nil, return an alist of (MESSAGE-ID . SIZE) pairs. Otherwise, return the size of the message-id MSG" - (pop3-send-command process (if msg + (pop3-send-command process (if msg (format "LIST %d" msg) "LIST")) (let ((response (pop3-read-response process t))) @@ -643,5 +643,4 @@ (provide 'pop3) -;; arch-tag: 2facc142-1d74-498e-82af-4659b64cac12 ;;; pop3.el ends here
--- a/lisp/gnus/qp.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/qp.el Thu Sep 02 02:12:28 2010 +0000 @@ -164,5 +164,4 @@ (provide 'qp) -;; arch-tag: db89e52a-e4a1-4b69-926f-f434f04216ba ;;; qp.el ends here
--- a/lisp/gnus/rfc1843.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/rfc1843.el Thu Sep 02 02:12:28 2010 +0000 @@ -192,5 +192,4 @@ (provide 'rfc1843) -;; arch-tag: 5149c301-a6ca-4731-9c9d-ba616e2cb687 ;;; rfc1843.el ends here
--- a/lisp/gnus/rfc2045.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/rfc2045.el Thu Sep 02 02:12:28 2010 +0000 @@ -39,5 +39,4 @@ (provide 'rfc2045) -;; arch-tag: 9ca54127-97bc-432c-b6e2-8c59cadba306 ;;; rfc2045.el ends here
--- a/lisp/gnus/rfc2047.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/rfc2047.el Thu Sep 02 02:12:28 2010 +0000 @@ -1175,5 +1175,4 @@ (provide 'rfc2047) -;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6 ;;; rfc2047.el ends here
--- a/lisp/gnus/rfc2104.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/rfc2104.el Thu Sep 02 02:12:28 2010 +0000 @@ -122,5 +122,4 @@ (provide 'rfc2104) -;; arch-tag: cf671d5c-a45f-4a09-815e-704e59e43950 ;;; rfc2104.el ends here
--- a/lisp/gnus/rfc2231.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/rfc2231.el Thu Sep 02 02:12:28 2010 +0000 @@ -296,5 +296,4 @@ (provide 'rfc2231) -;; arch-tag: c3ab751d-d108-406a-b301-68882ad8cd63 ;;; rfc2231.el ends here
--- a/lisp/gnus/score-mode.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/score-mode.el Thu Sep 02 02:12:28 2010 +0000 @@ -116,5 +116,4 @@ (provide 'score-mode) -;; arch-tag: a74a416b-2505-4ad4-bc4e-a418c96b8845 ;;; score-mode.el ends here
--- a/lisp/gnus/sieve-manage.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/sieve-manage.el Thu Sep 02 02:12:28 2010 +0000 @@ -335,7 +335,7 @@ (defun sieve-sasl-auth (buffer mech) "Login to server using the SASL MECH method." (message "sieve: Authenticating using %s..." mech) - (if (sieve-manage-interactive-login + (if (sieve-manage-interactive-login buffer (lambda (user passwd) (let (client step tag data rsp) @@ -701,5 +701,4 @@ (provide 'sieve-manage) -;; arch-tag: 321c4640-1371-4495-9baf-8ccb71dd5bd1 ;; sieve-manage.el ends here
--- a/lisp/gnus/sieve-mode.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/sieve-mode.el Thu Sep 02 02:12:28 2010 +0000 @@ -216,5 +216,4 @@ (provide 'sieve-mode) -;; arch-tag: 3b8ab76d-065d-4c52-b1e8-ab2ec21f2ace ;; sieve-mode.el ends here
--- a/lisp/gnus/sieve.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/sieve.el Thu Sep 02 02:12:28 2010 +0000 @@ -380,5 +380,4 @@ (provide 'sieve) -;; arch-tag: 7f6a6d94-94e1-4654-ab9a-aee21b9b8a94 ;; sieve.el ends here
--- a/lisp/gnus/smiley.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/smiley.el Thu Sep 02 02:12:28 2010 +0000 @@ -228,5 +228,4 @@ (provide 'smiley) -;; arch-tag: 5beb161b-4321-40af-8ac9-876afb8ee818 ;;; smiley.el ends here
--- a/lisp/gnus/smime.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/smime.el Thu Sep 02 02:12:28 2010 +0000 @@ -729,5 +729,4 @@ (provide 'smime) -;; arch-tag: e3f9b938-5085-4510-8a11-6625269c9a9e ;;; smime.el ends here
--- a/lisp/gnus/spam-report.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/spam-report.el Thu Sep 02 02:12:28 2010 +0000 @@ -95,12 +95,12 @@ "Report an article as spam by resending via email. Reports is as ham when HAM is set." (dolist (article articles) - (gnus-message 6 + (gnus-message 6 "Reporting %s article %d to <%s>..." (if ham "ham" "spam") article spam-report-resend-to) (unless spam-report-resend-to - (customize-set-variable + (customize-set-variable spam-report-resend-to (read-from-minibuffer "email address to resend SPAM/HAM to? "))) ;; This is ganked from the `gnus-summary-resend-message' function. @@ -385,5 +385,4 @@ (provide 'spam-report) -;; arch-tag: f6683295-ec89-4ab5-8803-8cc842293022 ;;; spam-report.el ends here.
--- a/lisp/gnus/spam-stat.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/spam-stat.el Thu Sep 02 02:12:28 2010 +0000 @@ -674,5 +674,4 @@ (provide 'spam-stat) -;; arch-tag: ff1d2200-8ddb-42fb-bb7b-1b5e20448554 ;;; spam-stat.el ends here
--- a/lisp/gnus/spam-wash.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/spam-wash.el Thu Sep 02 02:12:28 2010 +0000 @@ -69,5 +69,4 @@ (provide 'spam-wash) -;; arch-tag: 3c7f94a7-c96d-4c77-bb59-950df12bc85f ;;; spam-wash.el ends here
--- a/lisp/gnus/spam.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/spam.el Thu Sep 02 02:12:28 2010 +0000 @@ -2941,5 +2941,4 @@ (provide 'spam) -;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f ;;; spam.el ends here
--- a/lisp/gnus/starttls.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/starttls.el Thu Sep 02 02:12:28 2010 +0000 @@ -311,5 +311,4 @@ (provide 'starttls) -;; arch-tag: 648b3bd8-63bd-47f5-904c-7c819aea2297 ;;; starttls.el ends here
--- a/lisp/gnus/utf7.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/utf7.el Thu Sep 02 02:12:28 2010 +0000 @@ -228,5 +228,4 @@ (provide 'utf7) -;; arch-tag: 96078b55-85c7-4161-aed2-932c24b282c7 ;;; utf7.el ends here
--- a/lisp/gnus/webmail.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/webmail.el Thu Sep 02 02:12:28 2010 +0000 @@ -1148,5 +1148,4 @@ (provide 'webmail) -;; arch-tag: f75a4558-a8f6-46ec-b1c3-7a6434b3dd71 ;;; webmail.el ends here
--- a/lisp/gnus/yenc.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/gnus/yenc.el Thu Sep 02 02:12:28 2010 +0000 @@ -136,5 +136,4 @@ (provide 'yenc) -;; arch-tag: 74df17e8-6fa8-4071-9f7d-54d548d79d9a ;;; yenc.el ends here
--- a/lisp/hex-util.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/hex-util.el Thu Sep 02 02:12:28 2010 +0000 @@ -69,5 +69,4 @@ (provide 'hex-util) -;; arch-tag: fe8aaa79-6c86-400e-813f-5a8cc4cb3859 ;;; hex-util.el ends here
--- a/lisp/international/mule-cmds.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/international/mule-cmds.el Thu Sep 02 02:12:28 2010 +0000 @@ -1952,7 +1952,7 @@ (> (aref (number-to-string (nth 2 (x-server-version))) 0) ?3)) ;; Make non-line-break space display as a plain space. - (aset standard-display-table 160 [32])) + (aset standard-display-table (unibyte-char-to-multibyte 160) [32])) ;; Most Windows programs send out apostrophes as \222. Most X fonts ;; don't contain a character at that position. Map it to the ASCII ;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK, @@ -1960,7 +1960,7 @@ ;; fonts probably have the appropriate glyph at this position, ;; so they could use standard-display-8bit. It's better to use a ;; proper windows-1252 coding system. --fx] - (aset standard-display-table 146 [39])))) + (aset standard-display-table (unibyte-char-to-multibyte 146) [39])))) (defun set-language-environment-coding-systems (language-name) "Do various coding system setups for language environment LANGUAGE-NAME."
--- a/lisp/mail/binhex.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/mail/binhex.el Thu Sep 02 02:12:28 2010 +0000 @@ -328,5 +328,4 @@ (provide 'binhex) -;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8 ;;; binhex.el ends here
--- a/lisp/mail/hashcash.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/mail/hashcash.el Thu Sep 02 02:12:28 2010 +0000 @@ -375,4 +375,4 @@ (provide 'hashcash) -;; arch-tag: 0e7fe983-a124-4392-9788-0dbcbd2c4d62 +;;; hashcash.el ends here
--- a/lisp/mail/uudecode.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/mail/uudecode.el Thu Sep 02 02:12:28 2010 +0000 @@ -236,5 +236,4 @@ (provide 'uudecode) -;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3 ;;; uudecode.el ends here
--- a/lisp/md4.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/md4.el Thu Sep 02 02:12:28 2010 +0000 @@ -225,5 +225,4 @@ (provide 'md4) -;; arch-tag: 99d706fe-089b-42ea-9507-67ae41091e6e ;;; md4.el ends here
--- a/lisp/net/dig.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/dig.el Thu Sep 02 02:12:28 2010 +0000 @@ -184,5 +184,4 @@ (provide 'dig) -;; arch-tag: 1d61726e-9400-4013-9ae7-4035e0c7f7d6 ;;; dig.el ends here
--- a/lisp/net/dns.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/dns.el Thu Sep 02 02:12:28 2010 +0000 @@ -151,7 +151,7 @@ (lsh (if (dns-get 'truncated-p spec) 1 0) -1) (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0))) (dns-write-bytes - (cond + (cond ((eq (dns-get 'response-code spec) 'no-error) 0) ((eq (dns-get 'response-code spec) 'format-error) 1) ((eq (dns-get 'response-code spec) 'server-failure) 2) @@ -438,5 +438,4 @@ (provide 'dns) -;; arch-tag: d0edd0c4-4cce-4538-ae92-06c3356ee80a ;;; dns.el ends here
--- a/lisp/net/hmac-def.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/hmac-def.el Thu Sep 02 02:12:28 2010 +0000 @@ -80,5 +80,4 @@ (provide 'hmac-def) -;; arch-tag: 645adcef-b835-4900-a10a-11f636c982b9 ;;; hmac-def.el ends here
--- a/lisp/net/hmac-md5.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/hmac-md5.el Thu Sep 02 02:12:28 2010 +0000 @@ -79,5 +79,4 @@ (provide 'hmac-md5) -;; arch-tag: 0ab3f4f6-3d4b-4167-a9fa-635b7fed7f27 ;;; hmac-md5.el ends here
--- a/lisp/net/imap.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/imap.el Thu Sep 02 02:12:28 2010 +0000 @@ -1227,7 +1227,7 @@ (when user (setq imap-username user)) (when passwd (setq imap-password passwd)) (if imap-auth - (and (setq imap-last-authenticator + (and (setq imap-last-authenticator (assq imap-auth imap-authenticator-alist)) (funcall (nth 2 imap-last-authenticator) (current-buffer)) (setq imap-state 'auth)) @@ -3093,5 +3093,4 @@ (provide 'imap) -;; arch-tag: 27369ed6-33e4-482f-96f1-8bb906ba70f7 ;;; imap.el ends here
--- a/lisp/net/netrc.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/netrc.el Thu Sep 02 02:12:28 2010 +0000 @@ -160,9 +160,9 @@ (defaults (or defaults '(nil))) info) (if (listp mode) - (setq info - (mapcar - (lambda (mode-element) + (setq info + (mapcar + (lambda (mode-element) (netrc-machine-user-or-password mode-element authinfo-list @@ -223,5 +223,4 @@ (provide 'netrc) -;; arch-tag: af9929cc-2d12-482f-936e-eb4366f9fa55 ;;; netrc.el ends here
--- a/lisp/net/ntlm.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/ntlm.el Thu Sep 02 02:12:28 2010 +0000 @@ -27,9 +27,9 @@ ;; This library is a direct translation of the Samba release 2.2.0 ;; implementation of Windows NT and LanManager compatible password ;; encryption. -;; +;; ;; Interface functions: -;; +;; ;; ntlm-build-auth-request ;; This will return a binary string, which should be used in the ;; base64 encoded form and it is the caller's responsibility to encode @@ -40,7 +40,7 @@ ;; (which will be a binary string) as the first argument and to ;; encode the returned string with base64. The second argument user ;; should be given in user@domain format. -;; +;; ;; ntlm-get-password-hashes ;; ;; @@ -534,5 +534,4 @@ (provide 'ntlm) -;; arch-tag: 348ace18-f8e2-4176-8fe9-d9ab4e96f296 ;;; ntlm.el ends here
--- a/lisp/net/rcirc.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/rcirc.el Thu Sep 02 02:12:28 2010 +0000 @@ -1085,7 +1085,7 @@ (goto-char (point-max)) (when (not (equal 0 (- (point) rcirc-prompt-end-marker))) ;; delete a trailing newline - (when (bolp) + (when (eq (point) (point-at-bol)) (delete-char -1)) (let ((input (buffer-substring-no-properties rcirc-prompt-end-marker (point)))) @@ -2151,12 +2151,13 @@ (rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a" target args))) -(defun rcirc-add-or-remove (set &optional elt) - (if (and elt (not (string= "" elt))) - (if (member-ignore-case elt set) - (delete elt set) - (cons elt set)) - set)) +(defun rcirc-add-or-remove (set &rest elements) + (dolist (elt elements) + (if (and elt (not (string= "" elt))) + (setq set (if (member-ignore-case elt set) + (delete elt set) + (cons elt set))))) + set) (defun-rcirc-command ignore (nick) "Manage the ignore list. @@ -2164,7 +2165,9 @@ nicks when no NICK is given. When listing ignored nicks, the ones added to the list automatically are marked with an asterisk." (interactive "sToggle ignoring of nick: ") - (setq rcirc-ignore-list (rcirc-add-or-remove rcirc-ignore-list nick)) + (setq rcirc-ignore-list + (apply #'rcirc-add-or-remove rcirc-ignore-list + (split-string nick nil t))) (rcirc-print process nil "IGNORE" target (mapconcat (lambda (nick) @@ -2176,14 +2179,18 @@ (defun-rcirc-command bright (nick) "Manage the bright nick list." (interactive "sToggle emphasis of nick: ") - (setq rcirc-bright-nicks (rcirc-add-or-remove rcirc-bright-nicks nick)) + (setq rcirc-bright-nicks + (apply #'rcirc-add-or-remove rcirc-bright-nicks + (split-string nick nil t))) (rcirc-print process nil "BRIGHT" target (mapconcat 'identity rcirc-bright-nicks " "))) (defun-rcirc-command dim (nick) "Manage the dim nick list." (interactive "sToggle deemphasis of nick: ") - (setq rcirc-dim-nicks (rcirc-add-or-remove rcirc-dim-nicks nick)) + (setq rcirc-dim-nicks + (apply #'rcirc-add-or-remove rcirc-dim-nicks + (split-string nick nil t))) (rcirc-print process nil "DIM" target (mapconcat 'identity rcirc-dim-nicks " "))) @@ -2192,7 +2199,9 @@ Mark KEYWORD, unmark KEYWORD if already marked, or list marked keywords when no KEYWORD is given." (interactive "sToggle highlighting of keyword: ") - (setq rcirc-keywords (rcirc-add-or-remove rcirc-keywords keyword)) + (setq rcirc-keywords + (apply #'rcirc-add-or-remove rcirc-keywords + (split-string keyword nil t))) (rcirc-print process nil "KEYWORD" target (mapconcat 'identity rcirc-keywords " ")))
--- a/lisp/net/sasl-cram.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/sasl-cram.el Thu Sep 02 02:12:28 2010 +0000 @@ -47,5 +47,4 @@ (provide 'sasl-cram) -;; arch-tag: 46cb281b-975a-4fe0-a39f-3018691b1b05 ;;; sasl-cram.el ends here
--- a/lisp/net/sasl-digest.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/sasl-digest.el Thu Sep 02 02:12:28 2010 +0000 @@ -95,10 +95,10 @@ (md5-binary (concat (encode-hex-string - (md5-binary (concat (md5-binary + (md5-binary (concat (md5-binary (concat username ":" realm ":" passphrase)) ":" nonce ":" cnonce - (if authzid + (if authzid (concat ":" authzid))))) ":" nonce ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":" @@ -154,5 +154,4 @@ (provide 'sasl-digest) -;; arch-tag: 786e02ed-1bc4-4b3c-bf34-96c27e31084d ;;; sasl-digest.el ends here
--- a/lisp/net/sasl-ntlm.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/sasl-ntlm.el Thu Sep 02 02:12:28 2010 +0000 @@ -63,5 +63,4 @@ (provide 'sasl-ntlm) -;; arch-tag: 1d9164c1-1df0-418f-b7ab-360157fd05dc ;;; sasl-ntlm.el ends here
--- a/lisp/net/sasl.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/sasl.el Thu Sep 02 02:12:28 2010 +0000 @@ -267,5 +267,4 @@ (provide 'sasl) -;; arch-tag: 8b3326fa-4978-4fda-93e2-cb2c6255f887 ;;; sasl.el ends here
--- a/lisp/net/tls.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/net/tls.el Thu Sep 02 02:12:28 2010 +0000 @@ -298,5 +298,4 @@ (provide 'tls) -;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac ;;; tls.el ends here
--- a/lisp/password-cache.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/password-cache.el Thu Sep 02 02:12:28 2010 +0000 @@ -134,5 +134,4 @@ (provide 'password-cache) -;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5 ;;; password-cache.el ends here
--- a/lisp/pgg-def.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/pgg-def.el Thu Sep 02 02:12:28 2010 +0000 @@ -95,5 +95,4 @@ (provide 'pgg-def) -;; arch-tag: c425f3ab-ed75-4055-bb46-431a418c94b7 ;;; pgg-def.el ends here
--- a/lisp/pgg-gpg.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/pgg-gpg.el Thu Sep 02 02:12:28 2010 +0000 @@ -407,5 +407,4 @@ (provide 'pgg-gpg) -;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000 ;;; pgg-gpg.el ends here
--- a/lisp/pgg-parse.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/pgg-parse.el Thu Sep 02 02:12:28 2010 +0000 @@ -519,5 +519,4 @@ (provide 'pgg-parse) -;; arch-tag: 16c2eb82-1313-4a7c-a70f-420709b5b43e ;;; pgg-parse.el ends here
--- a/lisp/pgg-pgp.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/pgg-pgp.el Thu Sep 02 02:12:28 2010 +0000 @@ -254,5 +254,4 @@ (provide 'pgg-pgp) -;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c ;;; pgg-pgp.el ends here
--- a/lisp/pgg-pgp5.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/pgg-pgp5.el Thu Sep 02 02:12:28 2010 +0000 @@ -255,5 +255,4 @@ (provide 'pgg-pgp5) -;; arch-tag: 3dbd1073-6b3a-466c-9f55-5c587ffa6d7b ;;; pgg-pgp5.el ends here
--- a/lisp/pgg.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/pgg.el Thu Sep 02 02:12:28 2010 +0000 @@ -602,5 +602,4 @@ (provide 'pgg) -;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4 ;;; pgg.el ends here
--- a/lisp/play/cookie1.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/play/cookie1.el Thu Sep 02 02:12:28 2010 +0000 @@ -138,7 +138,7 @@ (vec (cookie-snarf phrase-file startmsg endmsg)) (i (length vec))) - (while (> (setq i (1- i)) 0) + (while (>= (setq i (1- i)) 0) (setq alist (cons (list (aref vec i)) alist))) (put sym 'completion-alist alist)))) nil require-match nil nil))
--- a/lisp/progmodes/python.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/progmodes/python.el Thu Sep 02 02:12:28 2010 +0000 @@ -782,7 +782,7 @@ '(("else" "if" "elif" "while" "for" "try" "except") ("elif" "if" "elif") ("except" "try" "except") - ("finally" "try" "except")) + ("finally" "else" "try" "except")) "Alist of keyword matches. The car of an element is a keyword introducing a statement which can close a block opened by a keyword in the cdr.")
--- a/lisp/sha1.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/sha1.el Thu Sep 02 02:12:28 2010 +0000 @@ -439,5 +439,4 @@ (provide 'sha1) -;; arch-tag: c0f9abd0-ffc1-4557-aac6-ece7f2d4c901 ;;; sha1.el ends here
--- a/lisp/simple.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/simple.el Thu Sep 02 02:12:28 2010 +0000 @@ -804,15 +804,16 @@ (constrain-to-field nil orig-pos t))))) (defun beginning-of-buffer (&optional arg) - "Move point to the beginning of the buffer; leave mark at previous position. -With \\[universal-argument] prefix, do not set mark at previous position. + "Move point to the beginning of the buffer. With numeric arg N, put point N/10 of the way from the beginning. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. +If the buffer is narrowed, this command uses the beginning of the +accessible part of the buffer. + +If Transient Mark mode is disabled, leave mark at previous +position, unless a \\[universal-argument] prefix is supplied. Don't use this command in Lisp programs! -\(goto-char (point-min)) is faster and avoids clobbering the mark." +\(goto-char (point-min)) is faster." (interactive "^P") (or (consp arg) (region-active-p) @@ -829,15 +830,16 @@ (if (and arg (not (consp arg))) (forward-line 1))) (defun end-of-buffer (&optional arg) - "Move point to the end of the buffer; leave mark at previous position. -With \\[universal-argument] prefix, do not set mark at previous position. + "Move point to the end of the buffer. With numeric arg N, put point N/10 of the way from the end. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. +If the buffer is narrowed, this command uses the end of the +accessible part of the buffer. + +If Transient Mark mode is disabled, leave mark at previous +position, unless a \\[universal-argument] prefix is supplied. Don't use this command in Lisp programs! -\(goto-char (point-max)) is faster and avoids clobbering the mark." +\(goto-char (point-max)) is faster." (interactive "^P") (or (consp arg) (region-active-p) (push-mark)) (let ((size (- (point-max) (point-min))))
--- a/lisp/textmodes/dns-mode.el Wed Sep 01 22:54:47 2010 +0000 +++ b/lisp/textmodes/dns-mode.el Thu Sep 02 02:12:28 2010 +0000 @@ -227,5 +227,4 @@ (provide 'dns-mode) -;; arch-tag: 6a179f0a-072f-49db-8b01-37b8f23998c0 ;;; dns-mode.el ends here
--- a/src/ChangeLog Wed Sep 01 22:54:47 2010 +0000 +++ b/src/ChangeLog Thu Sep 02 02:12:28 2010 +0000 @@ -6,6 +6,36 @@ (Fself_insert_command): Adjust accordingly. (syms_of_cmds): Don't declare blink-paren-function. +2010-08-31 Kenichi Handa <handa@m17n.org> + + * dispextern.h (FACE_FOR_CHAR): Use an ASCII face for 8-bit + characters. + + * term.c (encode_terminal_code): Fix the previous change. + (produce_glyphs): Don't set it->char_to_display here. Don't + handle unibyte-display-via-language-environment here. + (produce_special_glyphs): Set temp_it.char_to_display before + calling produce_glyphs. + + * xdisp.c (get_next_display_element): Set it->char_to_display + here. Convert all 8-bit bytes from unibyte buffer/string to 8-bit + characters. + (get_overlay_arrow_glyph_row): Set it.char_to_display too before + calling PRODUCE_GLYPHS. + (append_space_for_newline): Save and store it->char_to_display. + Set it->char_to_display before calling PRODUCE_GLYPHS. + (extend_face_to_end_of_line): Set it->char_to_display before + calling PRODUCE_GLYPHS. + (get_glyph_face_and_encoding): Set the glyph code an 8-bit + character to its byte value. + (get_char_glyph_code): New function. + (produce_stretch_glyph): Set it2.char_to_display too before + calling x_produce_glyphs. + (x_produce_glyphs): Simplify by using the same code for ASCII and + non-ASCII characters. Don't set it->char_to_display here. Don't + handle unibyte-display-via-language-environment here. For a + charater of no glyph, use font->space_width instead of FONT_WIDTH. + 2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> * keyboard.c (Fwindow_system): Fix compilation for USE_LISP_UNION_TYPE. @@ -23,6 +53,11 @@ * composite.c (composition_update_it): Fix computing of cmp_it->width. +2010-08-29 Kenichi Handa <handa@m17n.org> + + * term.c (encode_terminal_code): Encode byte chars to the + correspnding bytes. + 2010-08-29 Jan Djärv <jan.h.d@swipnet.se> * nsterm.m (ns_draw_window_cursor): Draw BAR_CURSOR correct for R2L.
--- a/src/dispextern.h Wed Sep 01 22:54:47 2010 +0000 +++ b/src/dispextern.h Thu Sep 02 02:12:28 2010 +0000 @@ -1718,7 +1718,7 @@ This macro is only meaningful for multibyte character CHAR. */ #define FACE_FOR_CHAR(F, FACE, CHAR, POS, OBJECT) \ - (ASCII_CHAR_P (CHAR) \ + ((ASCII_CHAR_P (CHAR) || CHAR_BYTE8_P (CHAR)) \ ? (FACE)->ascii_face->id \ : face_for_char ((F), (FACE), (CHAR), (POS), (OBJECT))) @@ -2275,9 +2275,11 @@ composition. */ struct composition_it cmp_it; - /* The character to display, possibly translated to multibyte - if unibyte_display_via_language_environment is set. This - is set after produce_glyphs has been called. */ + /* The character to display, possibly translated to multibyte if + multibyte_p is zero or unibyte_display_via_language_environment + is set. This is set after get_next_display_element has been + called. If we are setting it->C directly before calling + PRODUCE_GLYPHS, this should be set beforehand too. */ int char_to_display; /* If what == IT_IMAGE, the id of the image to display. */
--- a/src/term.c Wed Sep 01 22:54:47 2010 +0000 +++ b/src/term.c Thu Sep 02 02:12:28 2010 +0000 @@ -689,7 +689,8 @@ encode_terminal_src_size); buf = encode_terminal_src + nbytes; } - if (char_charset (c, charset_list, NULL)) + if (CHAR_BYTE8_P (c) + || char_charset (c, charset_list, NULL)) { /* Store the multibyte form of C at BUF. */ buf += CHAR_STRING (c, buf); @@ -1614,18 +1615,15 @@ goto done; } - /* Maybe translate single-byte characters to multibyte. */ - it->char_to_display = it->c; - - if (it->c >= 040 && it->c < 0177) + if (it->char_to_display >= 040 && it->char_to_display < 0177) { it->pixel_width = it->nglyphs = 1; if (it->glyph_row) append_glyph (it); } - else if (it->c == '\n') + else if (it->char_to_display == '\n') it->pixel_width = it->nglyphs = 0; - else if (it->c == '\t') + else if (it->char_to_display == '\t') { int absolute_x = (it->current_x + it->continuation_lines_width); @@ -1656,32 +1654,19 @@ it->pixel_width = nspaces; it->nglyphs = nspaces; } - else if (CHAR_BYTE8_P (it->c)) + else if (CHAR_BYTE8_P (it->char_to_display)) { - if (unibyte_display_via_language_environment - && (it->c >= 0240)) - { - it->char_to_display = BYTE8_TO_CHAR (it->c); - it->pixel_width = CHAR_WIDTH (it->char_to_display); - it->nglyphs = it->pixel_width; - if (it->glyph_row) - append_glyph (it); - } - else - { - /* Coming here means that it->c is from display table, thus - we must send the raw 8-bit byte as is to the terminal. - Although there's no way to know how many columns it - occupies on a screen, it is a good assumption that a - single byte code has 1-column width. */ - it->pixel_width = it->nglyphs = 1; - if (it->glyph_row) - append_glyph (it); - } + /* Coming here means that we must send the raw 8-bit byte as is + to the terminal. Although there's no way to know how many + columns it occupies on a screen, it is a good assumption that + a single byte code has 1-column width. */ + it->pixel_width = it->nglyphs = 1; + if (it->glyph_row) + append_glyph (it); } else { - it->pixel_width = CHAR_WIDTH (it->c); + it->pixel_width = CHAR_WIDTH (it->char_to_display); it->nglyphs = it->pixel_width; if (it->glyph_row) @@ -1917,7 +1902,7 @@ else abort (); - temp_it.c = GLYPH_CHAR (glyph); + temp_it.c = temp_it.char_to_display = GLYPH_CHAR (glyph); temp_it.face_id = GLYPH_FACE (glyph); temp_it.len = CHAR_BYTES (temp_it.c);
--- a/src/xdisp.c Wed Sep 01 22:54:47 2010 +0000 +++ b/src/xdisp.c Thu Sep 02 02:12:28 2010 +0000 @@ -5762,10 +5762,23 @@ struct charset *unibyte = CHARSET_FROM_ID (charset_unibyte); enum { char_is_other = 0, char_is_nbsp, char_is_soft_hyphen } nbsp_or_shy = char_is_other; - int decoded = it->c; + int c = it->c; /* This is the character to display. */ + + if (! it->multibyte_p && ! ASCII_CHAR_P (c)) + { + xassert (SINGLE_BYTE_CHAR_P (c)); + if (unibyte_display_via_language_environment) + { + c = DECODE_CHAR (unibyte, c); + if (c < 0) + c = BYTE8_TO_CHAR (it->c); + } + else + c = BYTE8_TO_CHAR (it->c); + } if (it->dp - && (dv = DISP_CHAR_VECTOR (it->dp, it->c), + && (dv = DISP_CHAR_VECTOR (it->dp, c), VECTORP (dv))) { struct Lisp_Vector *v = XVECTOR (dv); @@ -5791,21 +5804,10 @@ goto get_next; } - if (unibyte_display_via_language_environment - && !ASCII_CHAR_P (it->c)) - decoded = DECODE_CHAR (unibyte, it->c); - - if (it->c >= 0x80 && ! NILP (Vnobreak_char_display)) - { - if (it->multibyte_p) - nbsp_or_shy = (it->c == 0xA0 ? char_is_nbsp - : it->c == 0xAD ? char_is_soft_hyphen - : char_is_other); - else if (unibyte_display_via_language_environment) - nbsp_or_shy = (decoded == 0xA0 ? char_is_nbsp - : decoded == 0xAD ? char_is_soft_hyphen - : char_is_other); - } + if (! ASCII_CHAR_P (c) && ! NILP (Vnobreak_char_display)) + nbsp_or_shy = (c == 0xA0 ? char_is_nbsp + : c == 0xAD ? char_is_soft_hyphen + : char_is_other); /* Translate control characters into `\003' or `^C' form. Control characters coming from a display table entry are @@ -5813,27 +5815,23 @@ the translation. This could easily be changed but I don't believe that it is worth doing. - If it->multibyte_p is nonzero, non-printable non-ASCII - characters are also translated to octal form. - - If it->multibyte_p is zero, eight-bit characters that - don't have corresponding multibyte char code are also + NBSP and SOFT-HYPEN are property translated too. + + Non-printable characters and raw-byte characters are also translated to octal form. */ - if ((it->c < ' ' + if (((c < ' ' || c == 127) /* ASCII control chars */ ? (it->area != TEXT_AREA /* In mode line, treat \n, \t like other crl chars. */ - || (it->c != '\t' + || (c != '\t' && it->glyph_row && (it->glyph_row->mode_line_p || it->avoid_cursor_p)) - || (it->c != '\n' && it->c != '\t')) + || (c != '\n' && c != '\t')) : (nbsp_or_shy - || (it->multibyte_p - ? ! CHAR_PRINTABLE_P (it->c) - : (! unibyte_display_via_language_environment - ? it->c >= 0x80 - : (decoded >= 0x80 && decoded < 0xA0)))))) - { - /* IT->c is a control character which must be displayed + || CHAR_BYTE8_P (c) + || ! CHAR_PRINTABLE_P (c)))) + { + /* C is a control character, NBSP, SOFT-HYPEN, raw-byte, + or a non-printable character which must be displayed either as '\003' or as `^C' where the '\\' and '^' can be defined in the display table. Fill IT->ctl_chars with glyphs for what we have to @@ -5845,7 +5843,7 @@ /* Handle control characters with ^. */ - if (it->c < 128 && it->ctl_arrow_p) + if (ASCII_CHAR_P (c) && it->ctl_arrow_p) { int g; @@ -5878,7 +5876,7 @@ } XSETINT (it->ctl_chars[0], g); - XSETINT (it->ctl_chars[1], it->c ^ 0100); + XSETINT (it->ctl_chars[1], c ^ 0100); ctl_len = 2; goto display_control; } @@ -5893,7 +5891,7 @@ face_id = merge_faces (it->f, Qnobreak_space, 0, it->face_id); - it->c = ' '; + c = ' '; XSETINT (it->ctl_chars[0], ' '); ctl_len = 1; goto display_control; @@ -5939,7 +5937,6 @@ if (EQ (Vnobreak_char_display, Qt) && nbsp_or_shy == char_is_soft_hyphen) { - it->c = '-'; XSETINT (it->ctl_chars[0], '-'); ctl_len = 1; goto display_control; @@ -5951,55 +5948,25 @@ if (nbsp_or_shy) { XSETINT (it->ctl_chars[0], escape_glyph); - it->c = (nbsp_or_shy == char_is_nbsp ? ' ' : '-'); - XSETINT (it->ctl_chars[1], it->c); + c = (nbsp_or_shy == char_is_nbsp ? ' ' : '-'); + XSETINT (it->ctl_chars[1], c); ctl_len = 2; goto display_control; } { - unsigned char str[MAX_MULTIBYTE_LENGTH]; - int len; - int i; - - /* Set IT->ctl_chars[0] to the glyph for `\\'. */ - if (CHAR_BYTE8_P (it->c)) - { - str[0] = CHAR_TO_BYTE8 (it->c); - len = 1; - } - else if (it->c < 256) - { - str[0] = it->c; - len = 1; - } - else - { - /* It's an invalid character, which shouldn't - happen actually, but due to bugs it may - happen. Let's print the char as is, there's - not much meaningful we can do with it. */ - str[0] = it->c; - str[1] = it->c >> 8; - str[2] = it->c >> 16; - str[3] = it->c >> 24; - len = 4; - } - + char str[10]; + int len, i; + + if (CHAR_BYTE8_P (c)) + /* Display \200 instead of \17777600. */ + c = CHAR_TO_BYTE8 (c); + len = sprintf (str, "%03o", c); + + XSETINT (it->ctl_chars[0], escape_glyph); for (i = 0; i < len; i++) - { - int g; - XSETINT (it->ctl_chars[i * 4], escape_glyph); - /* Insert three more glyphs into IT->ctl_chars for - the octal display of the character. */ - g = ((str[i] >> 6) & 7) + '0'; - XSETINT (it->ctl_chars[i * 4 + 1], g); - g = ((str[i] >> 3) & 7) + '0'; - XSETINT (it->ctl_chars[i * 4 + 2], g); - g = (str[i] & 7) + '0'; - XSETINT (it->ctl_chars[i * 4 + 3], g); - } - ctl_len = len * 4; + XSETINT (it->ctl_chars[i + 1], str[i]); + ctl_len = len + 1; } display_control: @@ -6014,6 +5981,11 @@ it->ellipsis_p = 0; goto get_next; } + it->char_to_display = c; + } + else if (success_p) + { + it->char_to_display = it->c; } } @@ -6040,7 +6012,8 @@ : STRINGP (it->string) ? IT_STRING_CHARPOS (*it) : IT_CHARPOS (*it)); - it->face_id = FACE_FOR_CHAR (it->f, face, it->c, pos, it->string); + it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display, pos, + it->string); } } #endif @@ -16481,15 +16454,19 @@ /* Get the next character. */ if (multibyte_p) - it.c = string_char_and_length (p, &it.len); - else - it.c = *p, it.len = 1; + it.c = it.char_to_display = string_char_and_length (p, &it.len); + else + { + it.c = it.char_to_display = *p, it.len = 1; + if (! ASCII_CHAR_P (it.c)) + it.char_to_display = BYTE8_TO_CHAR (it.c); + } p += it.len; /* Get its face. */ ilisp = make_number (p - arrow_string); face = Fget_text_property (ilisp, Qface, overlay_arrow_string); - it.face_id = compute_char_face (f, it.c, face); + it.face_id = compute_char_face (f, it.char_to_display, face); /* Compute its width, get its glyphs. */ n_glyphs_before = it.glyph_row->used[TEXT_AREA]; @@ -16721,6 +16698,7 @@ append_space_for_newline has been called. */ enum display_element_type saved_what = it->what; int saved_c = it->c, saved_len = it->len; + int saved_char_to_display = it->char_to_display; int saved_x = it->current_x; int saved_face_id = it->face_id; struct text_pos saved_pos; @@ -16733,7 +16711,7 @@ it->what = IT_CHARACTER; memset (&it->position, 0, sizeof it->position); it->object = make_number (0); - it->c = ' '; + it->c = it->char_to_display = ' '; it->len = 1; if (default_face_p) @@ -16754,6 +16732,7 @@ it->face_id = saved_face_id; it->len = saved_len; it->c = saved_c; + it->char_to_display = saved_char_to_display; return 1; } } @@ -16886,7 +16865,7 @@ it->what = IT_CHARACTER; memset (&it->position, 0, sizeof it->position); it->object = make_number (0); - it->c = ' '; + it->c = it->char_to_display = ' '; it->len = 1; /* The last row's blank glyphs should get the default face, to avoid painting the rest of the window with the region face, @@ -20490,7 +20469,12 @@ if (face->font) { - unsigned code = face->font->driver->encode_char (face->font, glyph->u.ch); + unsigned code; + + if (CHAR_BYTE8_P (glyph->u.ch)) + code = CHAR_TO_BYTE8 (glyph->u.ch); + else + code = face->font->driver->encode_char (face->font, glyph->u.ch); if (code != FONT_INVALID_CODE) STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF)); @@ -20505,6 +20489,26 @@ } +/* Get glyph code of character C in FONT in the two-byte form CHAR2B. + Retunr 1 if FONT has a glyph for C, otherwise return 0. */ + +static INLINE int +get_char_glyph_code (int c, struct font *font, XChar2b *char2b) +{ + unsigned code; + + if (CHAR_BYTE8_P (c)) + code = CHAR_TO_BYTE8 (c); + else + code = font->driver->encode_char (font, c); + + if (code == FONT_INVALID_CODE) + return 0; + STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF)); + return 1; +} + + /* Fill glyph string S with composition components specified by S->cmp. BASE_FACE is the base face of the composition. @@ -21909,10 +21913,14 @@ { int maxlen = ((IT_BYTEPOS (*it) >= GPT ? ZV : GPT) - IT_BYTEPOS (*it)); - it2.c = STRING_CHAR_AND_LENGTH (p, it2.len); - } - else - it2.c = *p, it2.len = 1; + it2.c = it2.char_to_display = STRING_CHAR_AND_LENGTH (p, it2.len); + } + else + { + it2.c = it2.char_to_display = *p, it2.len = 1; + if (! ASCII_CHAR_P (it2.c)) + it2.char_to_display = BYTE8_TO_CHAR (it2.c); + } it2.glyph_row = NULL; it2.what = IT_CHARACTER; @@ -22082,49 +22090,12 @@ if (it->what == IT_CHARACTER) { XChar2b char2b; - struct font *font; struct face *face = FACE_FROM_ID (it->f, it->face_id); - struct font_metrics *pcm; - int font_not_found_p; + struct font *font = face->font; + int font_not_found_p = font == NULL; + struct font_metrics *pcm = NULL; int boff; /* baseline offset */ - /* We may change it->multibyte_p upon unibyte<->multibyte - conversion. So, save the current value now and restore it - later. - - Note: It seems that we don't have to record multibyte_p in - struct glyph because the character code itself tells whether - or not the character is multibyte. Thus, in the future, we - must consider eliminating the field `multibyte_p' in the - struct glyph. */ - int saved_multibyte_p = it->multibyte_p; - - /* Maybe translate single-byte characters to multibyte, or the - other way. */ - it->char_to_display = it->c; - if (!ASCII_BYTE_P (it->c) - && ! it->multibyte_p) - { - if (SINGLE_BYTE_CHAR_P (it->c) - && unibyte_display_via_language_environment) - { - struct charset *unibyte = CHARSET_FROM_ID (charset_unibyte); - - /* get_next_display_element assures that this decoding - never fails. */ - it->char_to_display = DECODE_CHAR (unibyte, it->c); - it->multibyte_p = 1; - it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display, - -1, Qnil); - face = FACE_FROM_ID (it->f, it->face_id); - } - } - - /* Get font to use. Encode IT->char_to_display. */ - get_char_face_and_encoding (it->f, it->char_to_display, it->face_id, - &char2b, it->multibyte_p, 0); - font = face->font; - - font_not_found_p = font == NULL; + if (font_not_found_p) { /* When no suitable font found, display an empty box based @@ -22144,16 +22115,12 @@ boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; } - if (it->char_to_display >= ' ' - && (!it->multibyte_p || it->char_to_display < 128)) - { - /* Either unibyte or ASCII. */ + if (it->char_to_display != '\n' && it->char_to_display != '\t') + { int stretched_p; it->nglyphs = 1; - pcm = get_per_char_metric (it->f, font, &char2b); - if (it->override_ascent >= 0) { it->ascent = it->override_ascent; @@ -22166,6 +22133,15 @@ it->descent = FONT_DESCENT (font) - boff; } + if (! font_not_found_p + && get_char_glyph_code (it->char_to_display, font, &char2b)) + { + pcm = get_per_char_metric (it->f, font, &char2b); + if (pcm->width == 0 + && pcm->rbearing == 0 && pcm->lbearing == 0) + pcm = NULL; + } + if (pcm) { it->phys_ascent = pcm->ascent + boff; @@ -22177,7 +22153,7 @@ it->glyph_not_available_p = 1; it->phys_ascent = it->ascent; it->phys_descent = it->descent; - it->pixel_width = FONT_WIDTH (font); + it->pixel_width = font->space_width; } if (it->constrain_row_ascent_descent_p) @@ -22351,7 +22327,7 @@ } } } - else if (it->char_to_display == '\t') + else /* i.e. (it->char_to_display == '\t') */ { if (font->space_width > 0) { @@ -22382,85 +22358,6 @@ it->nglyphs = 1; } } - else - { - /* A multi-byte character. Assume that the display width of the - character is the width of the character multiplied by the - width of the font. */ - - /* If we found a font, this font should give us the right - metrics. If we didn't find a font, use the frame's - default font and calculate the width of the character by - multiplying the width of font by the width of the - character. */ - - pcm = get_per_char_metric (it->f, font, &char2b); - - if (font_not_found_p || !pcm) - { - int char_width = CHAR_WIDTH (it->char_to_display); - - if (char_width == 0) - /* This is a non spacing character. But, as we are - going to display an empty box, the box must occupy - at least one column. */ - char_width = 1; - it->glyph_not_available_p = 1; - it->pixel_width = font->space_width * char_width; - it->phys_ascent = FONT_BASE (font) + boff; - it->phys_descent = FONT_DESCENT (font) - boff; - } - else - { - it->pixel_width = pcm->width; - it->phys_ascent = pcm->ascent + boff; - it->phys_descent = pcm->descent - boff; - if (it->glyph_row - && (pcm->lbearing < 0 - || pcm->rbearing > pcm->width)) - it->glyph_row->contains_overlapping_glyphs_p = 1; - } - it->nglyphs = 1; - it->ascent = FONT_BASE (font) + boff; - it->descent = FONT_DESCENT (font) - boff; - if (face->box != FACE_NO_BOX) - { - int thick = face->box_line_width; - - if (thick > 0) - { - it->ascent += thick; - it->descent += thick; - } - else - thick = - thick; - - if (it->start_of_box_run_p) - it->pixel_width += thick; - if (it->end_of_box_run_p) - it->pixel_width += thick; - } - - /* If face has an overline, add the height of the overline - (1 pixel) and a 1 pixel margin to the character height. */ - if (face->overline_p) - it->ascent += overline_margin; - - take_vertical_position_into_account (it); - - if (it->ascent < 0) - it->ascent = 0; - if (it->descent < 0) - it->descent = 0; - - if (it->glyph_row) - append_glyph (it); - if (it->pixel_width == 0) - /* We assure that all visible glyphs have at least 1-pixel - width. */ - it->pixel_width = 1; - } - it->multibyte_p = saved_multibyte_p; } else if (it->what == IT_COMPOSITION && it->cmp_it.ch < 0) { @@ -22556,7 +22453,7 @@ } else { - width = FONT_WIDTH (font); + width = font->space_width; ascent = FONT_BASE (font); descent = FONT_DESCENT (font); lbearing = 0;