March 2005 - XEmacs-Patches - XEmacs Mailing List Archives

Stephen J. Turnbull

APPROVE COMMIT 21.5 No ChangeLog. [oops, this was supposed to go to -patches, sorry for the dupe.] >>>>> "APA" == Adrian Aichner <adrian(a)xemacs.org> writes: APA> by sheer luck of helping Malcolm debug his merge problem I am APA> finding these lost ChangeLog entries. APA> Could you please get these in at the appropriate location. Done. BTW, Adrian, feel free to just fix this stuff yourself and tell us what you did. There's no way a ChangeLog fix can break a build, so CVS means never having to say you're sorry, anyway. :-) (Admittedly, sometimes you do have to say #"&$% !!, eh, Malcolm?) Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/tests/ChangeLog,v retrieving revision 1.66 diff -u -u -r1.66 ChangeLog --- ChangeLog 11 Mar 2005 19:23:57 -0000 1.66 +++ ChangeLog 12 Mar 2005 08:57:22 -0000 ＠＠ -20,6 +20,25 ＠＠ * automated/regexp-tests.el: Test trivial subpatterns and backreferences with shy groups. +======= +2005-03-05 Malcolm Purvis <malcolmp(a)xemacs.org> + + * autoconf/regressiontest.pl: Added explict test for '--with-athena=3d' + +2005-01-30 Stephen J. Turnbull <stephen(a)xemacs.org> + + * autoconf/regressiontest.pl: Basename of configure need not be + "configure" and arguments differ. HAVE_DECL_SYS_SIGLIST + differences are known spurious. Delete those lines before diff. + Add my standard configure line to test hash. + Add usage notes. + +2005-01-29 Stephen J. Turnbull <stephen(a)xemacs.org> + + * autoconf: New directory for tests for configure. + * autoconf/regressiontest.pl: New file from Malcolm Purvis. + +>>>>>>> 1.62.2.2 2004-10-28 Stephen J. Turnbull <stephen(a)xemacs.org> * automated/os-tests.el: New file. Add tests for bug reported by -- Adrian Aichner mailto:adrian＠xemacs.org http://www.xemacs.org/ -- Institute of Policy and Planning Sciences http://turnbull.sk.tsukuba.ac.jp University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN Ask not how you can "do" free software business; ask what your business can "do for" free software. -- Institute of Policy and Planning Sciences http://turnbull.sk.tsukuba.ac.jp University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN Ask not how you can "do" free software business; ask what your business can "do for" free software.

1 participants
0 comments

[AC21.5] Document that asserts expand to empty statements 20 years

Stephen J. Turnbull

APPROVE COMMIT 21.5 Thanks to Adrian Aichner for diagnosing one of these. Index: man/ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/man/ChangeLog,v retrieving revision 1.293 diff -u -U0 -r1.293 ChangeLog --- man/ChangeLog 11 Mar 2005 19:22:19 -0000 1.293 +++ man/ChangeLog 14 Mar 2005 03:01:32 -0000 ＠＠ -0,0 +1,5 ＠＠ +2005-03-14 Stephen J. Turnbull <stephen(a)xemacs.org> + + * internals/internals.texi (How Lisp Objects Are Represented in C): + Document compiler warnings when assert expands to empty statement. + Index: man/internals/internals.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/man/internals/internals.texi,v retrieving revision 1.62 diff -u -r1.62 internals.texi --- man/internals/internals.texi 10 Mar 2005 11:44:22 -0000 1.62 +++ man/internals/internals.texi 14 Mar 2005 03:01:43 -0000 ＠＠ -7318,6 +7318,10 ＠＠ nothing unless the corresponding configure error checking flag was specified. +Note that in some cases ＠samp{assert}s will expand to nothing in a +context where that produces an empty statement. Some compilers will +warn about this. + ＠node Allocation of Objects in XEmacs Lisp, The Lisp Reader and Compiler, How Lisp Objects Are Represented in C, Top ＠chapter Allocation of Objects in XEmacs Lisp ＠cindex allocation of objects in XEmacs Lisp -- Institute of Policy and Planning Sciences http://turnbull.sk.tsukuba.ac.jp University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN Ask not how you can "do" free software business; ask what your business can "do for" free software.

1 participants
0 comments

Re: [R21.4] document CCL example 20 years

Aidan Kehoe

Ar an triú lá déag de mí Márta, scríobh Ben Wing: > > (Just got back from five days catching up with some old friends in > > London, that turned into six because of crazy London traffic > > patterns--really, 4.30 on a Thursday being rush hour? I should get to a > > good few things in my queue over the next three days.) > > 4:30am or 4:30pm? PM. AM would have been more surprising. No, I don’t drive, I probably don’t have that good a feel for traffic patterns in general. Lesson learned. Not that I plan to go back there anytime soon. -- “I, for instance, am gung-ho about open source because my family is being held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle, when we say something in public? No-one!” -- Danny O’Brien

1 participants
0 comments

[C] XEmacs 21.5-b20 "cilantro" (+CVS-20050312) i586-pc-win32 20 years

Marcus Crestani

>>>>> AA == Adrian Aichner writes: AA> The number is big enough to also run AA> M-x bench AA> and I'm even brave enough to run gnus with it. Thank you for finding a working stack size for this temporary fix, Adrian. I'll post a better solution next week. NOTE: This patch has been committed. src/ChangeLog addition: 2005-03-13 Marcus Crestani <crestani(a)informatik.uni-tuebingen.de> * alloc.c (KKCC_BT_STACK_SIZE): Temporary fix for KKCC backtrace. Thanks to Adrian. xemacs-21.5 source patch: Diff command: cvs -q diff -u Files affected: src/alloc.c Index: src/alloc.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v retrieving revision 1.109 diff -u -r1.109 alloc.c --- src/alloc.c 13 Mar 2005 09:21:04 -0000 1.109 +++ src/alloc.c 13 Mar 2005 11:18:00 -0000 ＠＠ -3323,7 +3323,7 ＠＠ static int kkcc_gc_stack_size; #ifdef DEBUG_XEMACS -#define KKCC_BT_STACK_SIZE 4096 +#define KKCC_BT_STACK_SIZE 524288 static struct { -- Marcus

1 participants
0 comments

[PATCH] XEmacs 21.5-b20 "cilantro" (+CVS-20050311) i586-pc-win32 20 years

Marcus Crestani

>>>>> AA == Adrian Aichner writes: AA> temacs crashes during build when using AA> DEBUG_XEMACS=0 AA> ERROR_CHECK_ALL=0 If DEBUG_XEMACS is not defined, the parameter of an assert() is not executed. This causes a problem in intl-win32.c: In function unicode_multibyte_convert_size the variable active_alloca_convert gets initialized only in a function call which is inside of an assert. Without DEBUG_XEMACS, the function is not called and the variable is not initialized. An assignment to the uninitialized variable later crashes. AA> See also compilation warnings at end. The ones with MALLOC_BEGIN get also fixed by this patch. src/ChangeLog addition: 2005-03-13 Marcus Crestani <crestani(a)informatik.uni-tuebingen.de> Fix native Windows build if DEBUG_XEMACS is not defined. * alloc.c (MALLOC_BEGIN): Remove unused parameter. * intl-win32.c (unicode_multibyte_convert_size): Move function call out of assert. xemacs-test source patch: Diff command: cvs -q diff -u Files affected: src/intl-win32.c src/alloc.c Index: src/alloc.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v retrieving revision 1.108 diff -u -r1.108 alloc.c --- src/alloc.c 11 Mar 2005 08:42:36 -0000 1.108 +++ src/alloc.c 13 Mar 2005 00:59:30 -0000 ＠＠ -349,7 +349,7 ＠＠ #else /* ERROR_CHECK_MALLOC */ -#define MALLOC_BEGIN(block) +#define MALLOC_BEGIN() #define FREE_OR_REALLOC_BEGIN(block) #define MALLOC_END() Index: src/intl-win32.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/intl-win32.c,v retrieving revision 1.14 diff -u -r1.14 intl-win32.c --- src/intl-win32.c 24 Jan 2005 23:34:00 -0000 1.14 +++ src/intl-win32.c 13 Mar 2005 00:59:35 -0000 ＠＠ -1972,8 +1972,9 ＠＠ Bytecount src_size, int to_unicode, int cp) { alloca_convert_vals vals; - - assert (find_pos_of_existing_active_alloca_convert (srctext) < 0); + + int pos = find_pos_of_existing_active_alloca_convert (srctext); + assert (pos < 0); vals.srctext = srctext; -- Marcus

2 participants
2 comments

[AC] [PACKAGES (net-utils)] Add dns-mode.el 20 years

Steve Youngs

APPROVE COMMIT Norbert, this one is good to go. :-) NOTE: This patch has been committed. net-utils patch: ChangeLog files diff command: cvs -q diff -U 0 Files affected: ChangeLog Source files diff command: cvs -q diff -uN Files affected: package-info.in dns-mode.el Makefile Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/ChangeLog,v retrieving revision 1.68 diff -u -p -U0 -r1.68 ChangeLog --- ChangeLog 4 Oct 2004 12:07:49 -0000 1.68 +++ ChangeLog 13 Mar 2005 02:54:12 -0000 ＠＠ -0,0 +1,4 ＠＠ +2005-03-13 Steve Youngs <steve(a)sxemacs.org> + + * dns-mode.el: New file. + Index: Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/Makefile,v retrieving revision 1.56 diff -u -p -u -r1.56 Makefile --- Makefile 4 Oct 2004 12:07:49 -0000 1.56 +++ Makefile 13 Mar 2005 02:53:59 -0000 ＠＠ -23,7 +23,7 ＠＠ MAINTAINER = Steve Youngs <steve＠youngs. PACKAGE = net-utils PKG_TYPE = single-file REQUIRES = bbdb w3 efs mail-lib xemacs-base eterm sh-script gnus rmail tm apel \ - vm fsf-compat mh-e mew ecrypto + vm mh-e mew ecrypto CATEGORY = standard DONTCOMPILE = _pkg.el auto-autoloads.el custom-load.el Index: dns-mode.el =================================================================== RCS file: dns-mode.el diff -N dns-mode.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ dns-mode.el 13 Mar 2005 02:53:59 -0000 ＠＠ -0,0 +1,198 ＠＠ +;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files +;; Copyright (c) 2000, 2001, 2003, 2004 Free Software Foundation, Inc. + +;; Author: Simon Josefsson <simon(a)josefsson.org> +;; Keywords: DNS master zone file SOA + +;; 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 2, 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Use M-x dns-mode RET to invoke in master files. +;; +;; C-c C-s Increment SOA serial. +;; Understands YYYYMMDDNN, Unix time, and serial number formats, +;; and complains if it fail to find SOA serial. +;; +;; Put something similar to the following in your ~/.emacs to use this file: +;; +;; (load "~/path/to/dns-mode.el") +;; (setq auto-mode-alist (cons '("\\.soa\\'" . dns-mode) auto-mode-alist)) + +;;; References: + +;; RFC 1034, "DOMAIN NAMES - CONCEPTS AND FACILITIES", P. Mockapetris. +;; RFC 1035, "DOMAIN NAMES - IMPLEMENTATION AND SPECIFICATION", P. Mockapetris. + +;;; Release history: + +;; 2004-09-11 Posted on gnu.emacs.sources. +;; 2004-09-13 Ported to XEmacs. +;; 2004-09-14 Installed in Emacs CVS. + +;;; Code: + +(defgroup dns-mode nil + "DNS master file mode configuration.") + +(defconst dns-mode-classes '("IN" "CS" "CH" "HS") + "List of strings with known DNS classes.") + +(defconst dns-mode-types '("A" "NS" "MD" "MF" "CNAME" "SOA" "MB" "MG" "MR" + "NULL" "WKS" "PTR" "HINFO" "MINFO" "MX" "TXT" + "RP" "AFSDB" "X25" "ISDN" "RT" "NSAP" "NSAP" + "SIG" "KEY" "PX" "GPOS" "AAAA" "LOC" "NXT" + "EID" "NIMLOC" "SRV" "ATMA" "NAPTR" "KX" "CERT" + "A6" "DNAME" "SINK" "OPT" "APL" "DS" "SSHFP" + "RRSIG" "NSEC" "DNSKEY" "UINFO" "UID" "GID" + "UNSPEC" "TKEY" "TSIG" "IXFR" "AXFR" "MAILB" + "MAILA") + "List of strings with known DNS types.") + +;; Font lock. + +(defvar dns-mode-control-entity-face 'font-lock-keyword-face + "Name of face used for control entities, e.g. $ORIGIN.") + +(defvar dns-mode-bad-control-entity-face 'font-lock-warning-face + "Name of face used for non-standard control entities, e.g. $FOO.") + +(defvar dns-mode-type-face 'font-lock-type-face + "Name of face used for DNS types, e.g., SOA.") + +(defvar dns-mode-class-face 'font-lock-constant-face + "Name of face used for DNS classes, e.g., IN.") + +(defcustom dns-mode-font-lock-keywords + `(("^$ORIGIN" 0 ,dns-mode-control-entity-face) + ("^$INCLUDE" 0 ,dns-mode-control-entity-face) + ("^$[a-z0-9A-Z]+" 0 ,dns-mode-bad-control-entity-face) + (,(regexp-opt dns-mode-classes) 0 ,dns-mode-class-face) + (,(regexp-opt dns-mode-types) 0 ,dns-mode-type-face)) + "Font lock keywords used to highlight text in DNS master file mode." +:type 'sexp +:group 'dns-mode) + +;; Syntax table. + +(defvar dns-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\; "< " table) + (modify-syntax-entry ?\n "> " table) + table) + "Syntax table in use in DNS master file buffers.") + +;; Keymap. + +(defvar dns-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-s" 'dns-mode-soa-increment-serial) + map) + "Keymap for DNS master file mode.") + +;; Menu. + +(defvar dns-mode-menu nil + "Menubar used in DNS master file mode.") + +(easy-menu-define dns-mode-menu dns-mode-map + "DNS Menu." + '("DNS" + ["Increment SOA serial" dns-mode-soa-increment-serial t])) + +;; Mode. + +;;;###autoload +(define-derived-mode dns-mode text-mode "DNS" + "Major mode for viewing and editing DNS master files. +This mode is inherited from text mode. It add syntax +highlighting, and some commands for handling DNS master files. +Its keymap inherits from `text-mode' and it has the same +variables for customizing indentation. It has its own abbrev +table and its own syntax table. + +Turning on DNS mode runs `dns-mode-hook'." + (set (make-local-variable 'comment-start) ";") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-start-skip) ";+ *") + (unless (featurep 'xemacs) + (set (make-local-variable 'font-lock-defaults) + '(dns-mode-font-lock-keywords nil nil ((?_ . "w"))))) + (easy-menu-add dns-mode-menu dns-mode-map)) + +;; Tools. + +;;;###autoload +(defun dns-mode-soa-increment-serial () + "Locate SOA record and increment the serial field." + (interactive) + (save-excursion + (goto-char (point-min)) + (unless (re-search-forward + (concat "^\$\\(\\([^ \t]+[ \t]+\$?[^ \t]+" + "[ \t]+\\)?[^ \t]+[ \t]+\\)?SOA") nil t) + (error "Cannot locate SOA record")) + (if (re-search-forward (concat "\\<\$" + ;; year + "\\(198\\|199\\|20[0-9]\$[0-9]" + ;; month + "\$0[0-9]\\|10\\|11\\|12\$" + ;; day + "\$[012][0-9]\\|30\\|31\$" + ;; counter + "\$[0-9]\\{1,3\\}\$" + "\\)\\>") + nil t) + ;; YYYYMMDDIII format, one to three I's. + (let* ((serial (match-string 1)) + (counterstr (match-string 5)) + (counter (string-to-number counterstr)) + (now (format-time-string "%Y%m%d")) + (nowandoldserial (concat now counterstr))) + (if (string< serial nowandoldserial) + (let ((new (format "%s00" now))) + (replace-match new nil nil nil 1) + (message "Replaced old serial %s with %s" serial new)) + (if (string= serial nowandoldserial) + (let ((new (format (format "%%s%%0%dd" (length counterstr)) + now (1+ counter)))) + (replace-match new nil nil nil 1) + (message "Replaced old serial %s with %s" serial new)) + (error "Current SOA serial is in the future")))) + (if (re-search-forward "\\<\$[0-9]\\{9,10\\}\$\\>" nil t) + ;; Unix time + (let* ((serial (match-string 1)) + (new (format-time-string "%s"))) + (if (not (string< serial new)) + (error "Current SOA serial is in the future") + (replace-match new nil nil nil 1) + (message "Replaced old serial %s with %s" serial new))) + (if (re-search-forward "\\<\$[0-9]+\$\\>" nil t) + ;; Just any serial number. + (let* ((serial (match-string 1)) + (new (format "%d" (1+ (string-to-number serial))))) + (replace-match new nil nil nil 1) + (message "Replaced old serial %s with %s" serial new)) + (error "Cannot locate serial number in SOA record")))))) + +;;;###autoload(add-to-list 'auto-mode-alist '("\\.soa\\'" . dns-mode)) + +(provide 'dns-mode) + +;; arch-tag: 6a179f0a-072f-49db-8b01-37b8f23998c0 +;;; dns-mode.el ends here Index: package-info.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/package-info.in,v retrieving revision 1.7 diff -u -p -u -r1.7 package-info.in --- package-info.in 5 Jan 2004 00:10:54 -0000 1.7 +++ package-info.in 13 Mar 2005 02:53:59 -0000 ＠＠ -13,7 +13,9 ＠＠ filename FILENAME md5sum MD5SUM size SIZE - provides (ilisp-browse-cltl2 xemacsbug feedmail metamail net-utils rcompile shadowfile webjump webster-www dig dns xml google-query mozmail) + provides (ilisp-browse-cltl2 xemacsbug feedmail metamail + net-utils rcompile shadowfile webjump webster-www + dig dns dns-mode xml google-query mozmail) requires (REQUIRES) type single )) -- |---<Steve Youngs>---------------<GnuPG KeyID: A94B3003>---| | I am Dyslexic of Borg. | | Fusistance is retile. Your arse will be laminated. | |------------------------------------<steve(a)sxemacs.org>---|

1 participants
0 comments

[AC] [PACKAGES (gnus)] agent bugfix 20 years

Steve Youngs

APPROVE COMMIT Thanks very much for this, Andrey. Please accept my deepest apologies for taking so long to get to it. Norbert, no not yet... still more to come. :-) NOTE: This patch has been committed. gnus patch: ChangeLog files diff command: cvs -q diff -U 0 Files affected: ChangeLog Source files diff command: cvs -q diff -uN Files affected: lisp/gnus.el Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/ChangeLog,v retrieving revision 1.84 diff -u -p -U0 -r1.84 ChangeLog --- ChangeLog 13 Mar 2005 00:23:03 -0000 1.84 +++ ChangeLog 13 Mar 2005 01:36:58 -0000 ＠＠ -2,0 +3,6 ＠＠ + * lisp/gnus.el: Don't try and mark `gnus-agent-save-groups' as an + autoloaded function. + From: Andrey Slusar <anrays(a)gmail.com>. + +2005-03-13 Steve Youngs <steve(a)sxemacs.org> + Index: lisp/gnus.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus.el,v retrieving revision 1.7 diff -u -p -u -r1.7 gnus.el --- lisp/gnus.el 13 Mar 2005 00:23:31 -0000 1.7 +++ lisp/gnus.el 13 Mar 2005 01:36:18 -0000 ＠＠ -2726,7 +2726,7 ＠＠ gnus-registry.el will populate this if i gnus-async-prefetch-article gnus-async-prefetch-remove-group gnus-async-halt-prefetch) ("gnus-agent" gnus-open-agent gnus-agent-get-function - gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p + gnus-agent-save-active gnus-agent-method-p gnus-agent-get-undownloaded-list gnus-agent-fetch-session gnus-summary-set-agent-mark gnus-agent-save-group-info gnus-agent-request-article gnus-agent-retrieve-headers) -- |---<Steve Youngs>---------------<GnuPG KeyID: A94B3003>---| | I am Dyslexic of Borg. | | Fusistance is retile. Your arse will be laminated. | |------------------------------------<steve(a)sxemacs.org>---|

1 participants
0 comments

[AC] [PACKAGES (gnus)] Sync with upstream stable branch 20 years

Steve Youngs

APPROVE COMMIT This is long overdue and I'm really sorry for being so slack with it. Norbert, please _don't_ roll a new package just yet, I've got a couple of patches in my queue to go in first. I'll be committing them later today. I'll let you know when it's ready. Thanks. NOTE: This patch has been committed. gnus patch: ChangeLog files diff command: cvs -q diff -U 0 Files affected: ChangeLog Source files diff command: cvs -q diff -uN Files affected: texi/splitindex texi/refcard.tex texi/postamble.tex texi/pixidx.sty texi/pagestyle.sty texi/message.texi texi/gnusref.tex texi/gnus.texi texi/gnus-faq.texi texi/emacs-mime.texi texi/doclicense.texi texi/booklet.tex texi/bk-lt.tex texi/bk-a4.tex texi/ChangeLog.upstream lisp/utf7.el lisp/spam.el lisp/spam-stat.el lisp/spam-report.el lisp/smime.el lisp/smiley.el.upstream lisp/rfc2231.el lisp/rfc2047.el lisp/nnweb.el lisp/nnspool.el lisp/nnrss.el lisp/nnml.el lisp/nnmail.el lisp/nnimap.el lisp/nnheader.el lisp/nnfolder.el lisp/nndiary.el lisp/nnagent.el lisp/mml2015.el lisp/mml.el lisp/mml-smime.el lisp/mml-sec.el lisp/mm-view.el lisp/mm-uu.el lisp/mm-util.el lisp/mm-url.el lisp/mm-decode.el lisp/mm-bodies.el lisp/message.el lisp/mailcap.el lisp/mail-source.el lisp/lpath.el lisp/legacy-gnus-agent.el lisp/imap.el lisp/html2text.el lisp/gpg.el lisp/gnus.el lisp/gnus-win.el lisp/gnus-util.el lisp/gnus-sum.el lisp/gnus-start.el lisp/gnus-srvr.el lisp/gnus-spec.el lisp/gnus-score.el lisp/gnus-registry.el lisp/gnus-range.el lisp/gnus-picon.el lisp/gnus-msg.el lisp/gnus-load.el lisp/gnus-int.el lisp/gnus-group.el lisp/gnus-fun.el lisp/gnus-draft.el lisp/gnus-diary.el lisp/gnus-delay.el lisp/gnus-cite.el lisp/gnus-cache.el lisp/gnus-async.el lisp/gnus-art.el lisp/gnus-agent.el lisp/flow-fill.el lisp/dgnushack.el lisp/dgnushack-xemacs.el lisp/deuglify.el lisp/canlock.el lisp/ChangeLog.upstream etc/gnus/reverse-smile.xpm etc/gnus/dead.xpm Makefile Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/ChangeLog,v retrieving revision 1.83 diff -u -p -U0 -r1.83 ChangeLog --- ChangeLog 1 Oct 2004 08:39:19 -0000 1.83 +++ ChangeLog 13 Mar 2005 00:12:51 -0000 ＠＠ -0,0 +1,7 ＠＠ +2005-03-13 Steve Youngs <steve(a)sxemacs.org> + + * Sync to upstream 5.10 branch. + See ChangeLog.upstream files for details. + + * Makefile (AUTHOR_VERSION): Bump to 5.10.7 + Index: Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/Makefile,v retrieving revision 1.103 diff -u -p -u -r1.103 Makefile --- Makefile 1 Oct 2004 08:39:19 -0000 1.103 +++ Makefile 13 Mar 2005 00:11:30 -0000 ＠＠ -18,7 +18,7 ＠＠ # Boston, MA 02111-1307, USA. VERSION = 1.82 -AUTHOR_VERSION = 5.10.6 +AUTHOR_VERSION = 5.10.7 MAINTAINER = Steve Youngs <steve(a)youngs.au.com> PACKAGE = gnus PKG_TYPE = regular Index: etc/gnus/dead.xpm =================================================================== RCS file: etc/gnus/dead.xpm diff -N etc/gnus/dead.xpm --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ etc/gnus/dead.xpm 13 Mar 2005 00:11:30 -0000 ＠＠ -0,0 +1,20 ＠＠ +/* XPM */ +static char * dead_xpm[] = { +"13 14 3 1", +" c None", +". c #000000", +"+ c #FFDD00", +" ....... ", +" ..+++++.. ", +" .+++++++++. ", +".+++++++++++.", +".++.+.+.+.++.", +".+++.+++.+++.", +".++.+.+.+.++.", +".+++++++++++.", +".+++++++++++.", +".+.+++++++.+.", +".++.......++.", +" .+++++++++. ", +" ..+++++.. ", +" ....... "}; Index: etc/gnus/reverse-smile.xpm =================================================================== RCS file: etc/gnus/reverse-smile.xpm diff -N etc/gnus/reverse-smile.xpm --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ etc/gnus/reverse-smile.xpm 13 Mar 2005 00:11:30 -0000 ＠＠ -0,0 +1,20 ＠＠ +/* XPM */ +static char * reverse_smile_xpm[] = { +"13 14 3 1", +" c None", +". c #000000", +"+ c #FFDD00", +" ....... ", +" ..+++++.. ", +" .+++++++++. ", +".+++.....+++.", +".++.+++++.++.", +".++.+++++.++.", +".+++++++++++.", +".+++++++++++.", +".++..+++..++.", +".++..+++..++.", +".+++++++++++.", +" .+++++++++. ", +" ..+++++.. ", +" ....... "}; Index: lisp/ChangeLog.upstream =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/ChangeLog.upstream,v retrieving revision 1.5 diff -u -p -u -r1.5 ChangeLog.upstream --- lisp/ChangeLog.upstream 28 Sep 2004 02:21:01 -0000 1.5 +++ lisp/ChangeLog.upstream 13 Mar 2005 00:11:31 -0000 ＠＠ -1,3 +1,976 ＠＠ +2005-03-13 Steve Youngs <steve(a)sxemacs.org> + + * mm-url.el: Require timer-funcs at compile time when in XEmacs + for `with-timeout'. + + * mail-source.el: Require timer-funcs at compile time when in + XEmacs for `run-with-idle-timer'. + + * gnus-async.el: Ditto. + + * dgnushack.el: No need to ignore `run-with-idle-timer', XEmacs + has this function now. + +2005-03-10 Stefan Monnier <monnier(a)iro.umontreal.ca> + + * nnimap.el (nnimap-retrieve-headers-from-server): Fix last change. + +2005-03-10 Arne Jørgensen <arne(a)arnested.dk> (tiny change) + + * nnimap.el (nnimap-retrieve-headers-from-server): Fix off-by-one + flaw. + +2005-03-08 Bjorn Solberg <bjorn_ding(a)hekneby.org> (tiny change) + + * nnimap.el (nnimap-retrieve-headers-from-server): Sort NOV + buffer (since IMAP server might return FETCH response out of + order, and the nntp buffer must be sorted). + +2005-03-04 Reiner Steib <Reiner.Steib(a)gmx.de> + + * message.el: Don't autoload former message-utils variables. + (message-strip-subject-trailing-was): Change doc string. + + * nnweb.el: Fixes for `gnus-group-make-web-group'. + (nnweb-type-definition): Don't add "hl=en" in `address'. Add `base'. + (nnweb-google-search): Add "hl=en" here. + (nnweb-google-parse-1, nnweb-google-create-mapping): + Don't hardcode URL. + +2005-03-03 Reiner Steib <Reiner.Steib(a)gmx.de> + + * message.el (message-get-reply-headers, message-followup): + Mention related variables `message-use-followup-to' and + `message-use-mail-followup-to', in the information buffer. + + * nnweb.el (nnweb-type-definition): Use groups.google.de instead + of broken groups(-beta).google.com. + +2005-03-01 Stefan Monnier <monnier(a)iro.umontreal.ca> + + * gnus-sum.el (gnus-summary-exit): Undo last change and fix it in + a more conservative way. + +2005-02-27 Arne Jørgensen <arne(a)arnested.dk> + + * mm-decode.el (mm-dissect-buffer): Pass the from field on to + `mm-dissect-multipart' and receive the from field as an (optional) + argument from `mm-dissect-multipart'. + (mm-dissect-multipart): Receive the from field as an argument and + pass it on when we call `mm-dissect-buffer' on MIME parts. + Fixes verification/decryption of signed/encrypted MIME parts. + +2005-02-26 Stefan Monnier <monnier(a)iro.umontreal.ca> + + * gnus-sum.el (gnus-summary-exit): Move point after displaying the + buffer, so it moves the window's cursor. + +2005-02-24 Reiner Steib <Reiner.Steib(a)gmx.de> + + * nnheader.el (nnheader-find-file-noselect): Add doc string. + + * nnfolder.el (nnfolder-read-folder): Use RAWFILE for + `nnheader-find-file-noselect' to avoid `large-file-warning-threshold'. + + * gnus-sum.el (gnus-summary-caesar-message): + Apply `gnus-treat-article' after rotation. + + * gnus-group.el (gnus-group-clear-data): Mention process/prefix in + doc string. + +2005-02-22 Arne Jørgensen <arne(a)arnested.dk> + + * smime.el (smime-sign-buffer): Signal an error if + `smime-sign-region' fails. + (smime-encrypt-buffer): Signal an error if `smime-encrypt-region' + fails. + +2005-02-21 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-art.el (gnus-parse-news-url, gnus-button-handle-news): + Handle news URL with given port correctly. + +2005-02-19 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-msg.el (gnus-copy-article-buffer): Quote decoded words + containing special characters. + + * gnus-sum.el (gnus-summary-edit-article): Ditto. + + * mml.el (mime-to-mml): Ditto. + + * rfc2047.el (rfc2047-quote-decoded-words-containing-tspecials): + New variable. + (rfc2047-decode-region): Quote decoded words containing special + characters when rfc2047-quote-decoded-words-containing-tspecials + is non-nil. + +2005-02-16 Teodor Zlatanov <tzz(a)lifelogs.com> + + * gnus-registry.el (gnus-registry-delete-group): Minor bug fix. + + * gnus.el (gnus-install-group-spam-parameters): Doc fix. + +2005-02-15 Simon Josefsson <jas(a)extundo.com> + + * nnimap.el (nnimap-debug): Doc fix. + + * imap.el (imap-debug): Doc fix. + +2005-02-14 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-group.el (gnus-group-make-doc-group): Mention prefix + argument in doc string. Make query for type more clear. + +2005-02-13 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus.el (gnus-group-startup-message): Search for gnus images in + etc/images/gnus. + * mm-util.el (mm-find-charset-region): Likewise. + * smiley.el (smiley-data-directory): Search for smilies in + etc/images/smilies. + +2005-02-09 Kim F. Storm <storm(a)cua.dk> + + Change Emacs release version from 21.4 to 22.1 throughout. + Change Emacs development version from 21.3.50 to 22.0.50. + +2005-02-08 Simon Josefsson <jas(a)extundo.com> + + * imap.el (imap-log): Doc fix. + +2005-02-03 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-art.el (gnus-mime-inline-part): Show the raw contents if a + prefix arg is neither nil nor a number, as info specifies. + +2005-01-30 Stefan Monnier <monnier(a)iro.umontreal.ca> + + * gnus-art.el (gnus-article-mode): Turn off the "\ " non-break space. + +2005-01-28 Stefan Monnier <monnier(a)iro.umontreal.ca> + + * message.el (message-beginning-of-line): Change the behavior when + invoked between BOL and : so that it first moves backward. + +2005-01-28 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-art.el (gnus-article-setup-buffer): Kill and re-create the + article buffer when editing of the article is discarded. + (gnus-article-prepare): Revert. + +2005-01-28 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-art.el (gnus-article-prepare): + Remove message-strip-forbidden-properties from the local hook. + +2005-01-24 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mml.el (mml-generate-mime-1): Convert string into unibyte when + inserting " *mml*" buffer's contents into a unibyte temp buffer. + +2005-01-20 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-decode.el (mm-insert-part): Switch the multibyteness of data + which will be inserted according to the multibyteness of a buffer + rather than the type of contents. Suggested by ARISAWA Akihiro + <ari(a)mbf.ocn.ne.jp>. + +2005-01-05 Reiner Steib <Reiner.Steib(a)gmx.de> + + * spam.el (spam-face): New face. Don't use `gnus-splash-face' + which is unreadable in some setups. + +2004-12-27 Simon Josefsson <jas(a)extundo.com> + + * mm-bodies.el (mm-body-encoding): Don't permit 7-bit to be used when + mm-use-ultra-safe-encoding is enabled (e.g., for PGP/MIME) and we have + trailing white space. Reported by Werner Koch <wk(a)gnupg.org>. + +2004-12-17 Kim F. Storm <storm(a)cua.dk> + + * gnus-group.el (gnus-group-mode-map): Map follow-link to mouse-face. + + * gnus-sum.el (gnus-summary-mode-map): Likewise. + +2004-12-22 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-spec.el (gnus-spec-tab): Make a Lisp form which works + correctly even if there are wide characters. + +2004-12-21 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * rfc2231.el (rfc2231-parse-string): Decode encoded value after + concatenating segments rather than before concatenating them. + Suggested by ARISAWA Akihiro <ari(a)mbf.ocn.ne.jp>. + +2004-12-17 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-util.el (mm-xemacs-find-mime-charset): New macro. + +2004-12-17 Aidan Kehoe <kehoea(a)parhasard.net> + + * mm-util.el (mm-xemacs-find-mime-charset-1): New function used to + unify Latin characters in XEmacs. + (mm-find-mime-charset-region): Use it. + +2004-12-17 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-util.el (gnus-delete-directory): New function. + + * gnus-agent.el (gnus-agent-delete-group): Use it. + + * gnus-cache.el (gnus-cache-delete-group): Use it. + +2004-12-08 Stefan Monnier <monnier(a)iro.umontreal.ca> + + * gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min. + +2004-12-13 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-group.el (gnus-group-make-rss-group): + Use gnus-group-make-group instead of gnus-group-unsubscribe-group. + + * gnus-start.el (gnus-setup-news): Honor user's setting to + gnus-message-archive-method. Suggested by Lute Kamstra + <lute(a)gnu.org>. + +2004-12-02 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * message.el (message-forward-make-body-mml): Remove headers + according to message-forward-ignored-headers if a message is decoded. + +2004-12-02 Romain Francoise <romain(a)orebokech.com> + + * message.el (message-forward-make-body-plain): Always remove + headers according to message-forward-ignored-headers. + +2004-11-26 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * lpath.el: Remove bbdb-create-internal, bbdb-records, + spam-BBDB-register-routine and spam-enter-ham-BBDB. + + * nnrss.el (nnrss-string-as-multibyte): Redefine it as a macro in + order to silence the byte compiler. + + * pop3.el (pop3-md5): Define it before being used. + + * spam.el: Fix the way to silence the byte compiler, which + complained about bbdb-buffer, bbdb-create-internal, + bbdb-search-simple, mail-check-payment, spam-BBDB-register-routine, + spam-enter-ham-BBDB, spam-stat-buffer-change-to-non-spam, + spam-stat-buffer-change-to-spam, spam-stat-buffer-is-non-spam, + spam-stat-buffer-is-spam, spam-stat-load, + spam-stat-register-ham-routine, spam-stat-register-spam-routine, + spam-stat-save and spam-stat-split-fancy. + +2004-11-26 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * canlock.el (canlock-password): Remove `:size 0' or `:size 1' + which may confuse users. + (canlock-password-for-verify): Ditto. + + * deuglify.el (gnus-outlook-deuglify-unwrap-stop-chars): Ditto. + + * gnus-art.el (gnus-emphasis-alist): Ditto. + + * gnus-registry.el (gnus-registry-max-entries): Ditto. + + * gnus-score.el (gnus-adaptive-word-length-limit): Ditto. + + * gnus-start.el (gnus-save-killed-list): Ditto. + + * gnus-sum.el (gnus-thread-hide-subtree): Ditto. + (gnus-sum-thread-tree-root): Ditto. + (gnus-sum-thread-tree-false-root): Ditto. + (gnus-sum-thread-tree-single-indent): Ditto. + + * message.el (message-courtesy-message): Ditto. + (message-archive-note): Ditto. + (message-subscribed-address-file): Ditto. + (message-user-fqdn): Ditto. + + * spam-report.el (spam-report-gmane-regex): Ditto. + + * spam.el (spam-blackhole-good-server-regex): Ditto. + +2004-11-25 Reiner Steib <Reiner.Steib(a)gmx.de> + + * message.el (message-forbidden-properties): Fix typo in doc string. + +2004-11-25 Lars Magne Ingebrigtsen <larsi(a)gnus.org> + + * message.el (message-strip-forbidden-properties): + Bind buffer-read-only (etc) to nil. + +2004-11-25 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-util.el (gnus-replace-in-string): Add doc string. + + * nnmail.el (nnmail-split-header-length-limit): Increase to 2048 + to avoid problems when splitting mails with many recipients. + +2004-11-23 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * rfc2047.el (rfc2047-header-encoding-alist): Add In-Reply-To to + address-mime. Suggested by ARISAWA Akihiro <ari(a)mbf.ocn.ne.jp>. + +2004-11-22 Marek Martin <marek.martin(a)mum.pri.ee> (tiny change) + + * nnfolder.el (nnfolder-request-create-group): Save current buffer. + +2004-11-22 Stefan Monnier <monnier(a)iro.umontreal.ca> + + * gnus-sum.el (gnus-summary-exit): Remove redundant and harmful + pop-to-buffer, covered by the subsequent gnus-configure-windows. + +2004-11-14 Luc Teirlinck <teirllm(a)auburn.edu> + + * nnfolder.el (nnfolder-save-marks): Add missing format field in + call to `error'. + * nnml.el (nnml-save-marks): Ditto. + +2004-11-14 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus.el (gnus-version-number): Bump version to 5.10.7. + + * gnus-start.el (gnus-convert-old-newsrc): + Assign legacy-gnus-agent to 5.10.7. + +2004-11-10 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-art.el (gnus-emphasis-alist): Don't hide asterisks by + default; improve customization type. + (gnus-emphasis-custom-with-format): New macro. + (gnus-emphasis-custom-value-to-external): New function. + (gnus-emphasis-custom-value-to-internal): New function. + +2004-11-07 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-msg.el (gnus-configure-posting-styles): Don't cause the + "Args out of range" error. Reported by Arnaud Giersch + <arnaud.giersch(a)free.fr>. + +2004-11-04 Richard M. Stallman <rms(a)gnu.org> + + * spam.el (spam group): Add :version. + + * pgg-def.el (pgg group): Add :version. + +2004-11-04 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-art. (gnus-article-edit-article): Don't associate the + article buffer with a draft file. This is a temporary measure + against the 2004-08-22 change to gnus-article-edit-mode. + +2004-11-02 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * html2text.el (html2text-get-attr): Remove unused argument `tag'. + (html2text-format-tags): Remove unused variable `attr'. + + * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of + after-load-alist. + + * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251 + entry. From Ilya N. Golubev <gin(a)mo.msk.ru>. + (mm-enrich-utf-8-by-mule-ucs): New function run when Mule-UCS is + loaded under XEmacs. + (): Don't make duplicated entries in mm-mime-mule-charset-alist. + + * mm-util.el (mm-coding-system-p): Return a coding-system. + (mm-mime-mule-charset-alist): Use shift_jis instead of + iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new + entries for the mime charsets iso-2022-jp-3 and shift_jis. + (mm-coding-system-priorities): Use shift_jis and iso-8859-1 + instead of japanese-shift-jis and iso-latin-1 respectively in + order to share the default value with both Emacs and XEmacs-mule. + (mm-mule-charset-to-mime-charset): + Make mm-coding-system-priorities effective. + (mm-sort-coding-systems-predicate): Canonicalize coding-systems + while predicating of candidates upon the priorities. + +2004-11-01 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-msg.el (gnus-summary-resend-default-address): Add :version. + + * tls.el (tls-process-connection-type, tls-success) + (tls-certtool-program): Add :version. + + * starttls.el (starttls-gnutls-program, starttls-use-gnutls) + (starttls-extra-arguments, starttls-process-connection-type) + (starttls-connect, starttls-failure, starttls-success): + + * spam-stat.el (spam-stat): Add :version. + + * sieve.el (sieve): Add :version. + + * sha1.el (sha1): Add :version. + (sha1-use-external): Remove redundant version. + + * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups) + (nnmail-cache-ignore-groups, nnmail-spool-hook) + (nnmail-split-fancy-match-partial-words) + (nnmail-split-lowercase-expanded): + + * nndiary.el (nndiary): Add :version. + + * mml2015.el (mml2015-unabbrev-trust-alist): Add :version. + + * mml-sec.el (mml-default-sign-method) + (mml-default-encrypt-method, mml-signencrypt-style-alist): + Add :version. + + * mm-uu.el (mm-uu-diff-groups-regexp): Add :version. + + * mm-url.el (mm-url-use-external, mm-url-program) + (mm-url-arguments): Add :version. + + * mm-decode.el (mm-inline-text-html-with-w3m-keymap) + (mm-attachment-file-modes, mm-decrypt-option) + (mm-w3m-safe-url-regexp): Add :version. + + * message.el (message-cite-prefix-regexp) + (message-sendmail-envelope-from, message-minibuffer-local-map) + (message-user-fqdn, message-completion-alist): Add :version. + + * gnus-win.el (gnus-configure-windows-hook) + (gnus-use-frames-on-any-display): Add :version. + + * gnus-art.el (gnus-article-address-banner-alist) + (gnus-treat-unsplit-urls, gnus-treat-unfold-headers) + (gnus-treat-from-picon, gnus-treat-mail-picon) + (gnus-treat-x-pgp-sig): Add :version. + + * gnus-sum.el (gnus-spam-mark, gnus-recent-mark) + (gnus-undownloaded-mark, gnus-summary-article-move-hook) + (gnus-summary-article-delete-hook) + (gnus-summary-display-while-building): Add :version. + + * gnus-start.el (gnus-subscribe-newsgroup-hooks) + (gnus-get-top-new-news-hook):Add :version. + + * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) + (gnus-server-closed-face, gnus-server-denied-face): Add :version. + + * gnus-registry.el (gnus-registry): Add :version. + + * gnus-spec.el (gnus-use-correct-string-widths) + (gnus-make-format-preserve-properties): Add :version. + + * gnus.el (gnus-group-charter-alist) + (gnus-group-fetch-control-use-browse-url) + (gnus-install-group-spam-parameters): Add :version. + + * gnus-diary.el (gnus-diary): Add :version. + + * gnus-delay.el (gnus-delay): Add :version. + + * gnus-cite.el (gnus-cite-unsightly-citation-regexp) + (gnus-cite-ignore-quoted-from, gnus-cite-attribution-face) + (gnus-cite-blank-line-after-header, gnus-article-boring-faces): + Add :version. + + * gnus-agent.el (gnus-agent-max-fetch-size) + (gnus-agent-enable-expiration, gnus-agent-queue-mail) + (gnus-agent-prompt-send-queue): Add :version. + + * deuglify.el (gnus-outlook-deuglify): Add :version. + + * html2text.el: Beautify code. Improve doc strings. Some checkdoc + cleanup. + (html2text-get-attr, html2text-fix-paragraph): Simplify code. + (html2text-format-tag-list): Add "strong" and "em". + From "Alfred M. Szmidt" <ams(a)kemisten.nu> (tiny change). + +2004-10-29 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-msg.el (gnus-configure-posting-styles): Work with empty + signature file. Suggested by Manoj Srivastava + <srivasta(a)golden-gryphon.com>. + + * mm-util.el (mm-coding-system-priorities): Prefer iso-8859-1 than + iso-2022-jp even in the Japanese language environment. + Suggested by Jason Rumney <jasonr(a)gnu.org>. + +2004-10-28 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-sum.el (gnus-update-summary-mark-positions): Allow users to + use the same characters as the dummy marks; make it free from + getting affected by the language environment. + (gnus-summary-read-group-1): Update mark positions only when the + format spec is updated. + + * gnus-spec.el (gnus-update-format-specifications): Return a list + of updated types. + +2004-10-26 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * nnspool.el (nnspool-spool-directory): Use news-path if the + news-directory variable is not bound. + + * gnus-group.el (gnus-group-line-format-alist): Convert the value + of gnus-tmp-news-method into string if it may be passed to + gnus-correct-length which takes only a string argument. + +2004-10-25 Reiner Steib <Reiner.Steib(a)gmx.de> + + * html2text.el (html2text-buffer-head): Remove. Use `goto-char' + instead. + +2004-10-24 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-start.el (gnus-convert-old-newsrc): Fix numeric + comparison on string. + +2004-10-21 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * mm-view.el (mm-display-inline-fontify): Inhibit font-lock when + running the major-mode function. + +2004-10-21 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-start.el (gnus-convert-old-newsrc): Two of the converters + have been backported to 'Gnus v5.11' from 'No Gnus v0.2'. Added a + boolean check to not apply converters that apply to future + versions of gnus. + +2004-10-19 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-sum.el (gnus-update-summary-mark-positions): Search for + dummy marks in the right way. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * nnagent.el (nnagent-request-type): Bind gnus-agent to nil to + avoid infinite recursion via gnus-get-function. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-agent.el (gnus-agent-synchronize-group-flags): + When necessary, pass full group name to gnus-request-set-marks. + (gnus-agent-synchronize-group-flags): Add support for sync'ing + tick marks. + (gnus-agent-synchronize-flags-server): Be silent when writing file. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-agent.el (gnus-agent-synchronize-group-flags): + Replace gnus-request-update-info with explicit code to sync the + in-memory info read flags with the marks being sync'd to the backend. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore servers + that are offline. Avoids having gnus-agent-toggle-plugged first ask if + you want to open a server and then, even when you responded with no, + asking if you want to synchronize the server's flags. + (gnus-agent-synchronize-flags-server): Rewrite read loop to handle + multi-line expressions. + (gnus-agent-synchronize-group-flags): New internal function. + Updates marks in memory (in the info structure) AND in the backend. + (gnus-agent-check-overview-buffer): Fix range of + deletion to remove entire duplicate line. Fixes merged article + number bug. + + * gnus-util.el (gnus-remassoc): Fix typo in documentation. + + * nnagent.el (nnagent-request-set-mark): + Use gnus-agent-synchronize-group-flags, not backend's request-set-mark + method, to ensure that synchronization updates marks in the + backend and in the info (in memory) structure. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-agent.el (gnus-agent-synchronize-flags-server): Do nothing + unless plugged. Disable the agent so that an open failure causes + an error. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> for Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-agent.el (gnus-agent-fetched-hook): Add :version. + (gnus-agent-go-online): Change :version. + (gnus-agent-expire-unagentized-dirs) + (gnus-agent-auto-agentize-methods): Add :version. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * legacy-gnus-agent.el + (gnus-agent-convert-to-compressed-agentview-prompt): + New function. Used internally to only display 'gnus converting + files' message when actually necessary. + + * gnus-sum.el: Remove (require 'gnus-agent) as required + methods now autoloaded. + + * gnus-int.el (gnus-request-move-article): + Use gnus-agent-unfetch-articles in place of gnus-agent-expire to + improve performance. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-agent.el (gnus-agent-cat-groups): Rewrite avoiding defsetf + to avoid run-time CL dependencies. + (gnus-agent-unfetch-articles): New function. + (gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate + article numbers even when local .overview file is missing. + (gnus-agent-read-article-number): New function. Only accepts + 27-bit article numbers. + (gnus-agent-copy-nov-line, gnus-agent-uncached-articles): + Use gnus-agent-read-article-number. + (gnus-agent-braid-nov): Rewrote to validate article numbers coming + from backend while recognizing that article numbers in .overview + must be valid. + + * gnus-start.el (gnus-convert-old-newsrc): Change message text as + some users confused by references to .newsrc when they only have a + .newsrc.eld file. + (gnus-convert-mark-converter-prompt) + (gnus-convert-converter-needs-prompt): Fix use of property list. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> for Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> for Lars Magne Ingebrigtsen <larsi(a)gnus.org> + + * gnus-start.el (gnus-get-unread-articles-in-group): Don't do + stuff for non-living groups. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> for Lars Magne Ingebrigtsen <larsi(a)gnus.org> + + * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil. + (gnus-agent-regenerate-group): Using nil messages aren't valid. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> for Lars Magne Ingebrigtsen <larsi(a)gnus.org> + + * gnus-agent.el (gnus-agent-read-agentview): + Inline gnus-uncompress-range. + +2004-10-18 Kevin Greiner <kgreiner(a)xpediantsolutions.com> + + * legacy-gnus-agent.el + (gnus-agent-convert-to-compressed-agentview): Fix typos with + help from Florian Weimer <fw(a)deneb.enyo.de> + + * gnus-agent.el (gnus-agentize): + gnus-agent-send-mail-real-function no longer set to current value + of message-send-mail-function but rather a lambda that calls + message-send-mail-function. The change makes the agent real-time + responsive to user changes to message-send-mail-function. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> for Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-start.el (gnus-get-unread-articles): Fix last commit. + +2004-10-18 Kevin Greiner <kgreiner(a)xpediantsolutions.com> + + * gnus-cache.el (gnus-cache-rename-group): New function. + (gnus-cache-delete-group): New function. + + * gnus-agent.el (gnus-agent-rename-group): New function. + (gnus-agent-delete-group): New function. + (gnus-agent-save-group-info): Use gnus-command-method when + `method' parameter is nil. Don't write nil entries into the + active file. + (gnus-agent-get-group-info): New function. + (gnus-agent-get-local): Add optional parameters to avoid calling + gnus-group-real-name and gnus-find-method-for-group. + (gnus-agent-set-local): Delete stored entry if either min, or max, + are nil. + (gnus-agent-fetch-session): Reword error/quit messages. + On quit, use gnus-agent-regenerate-group to record existance of any + articles fetched to disk before the quit occurred. + + * gnus-int.el (gnus-request-delete-group): + Use gnus-cache-delete-group and gnus-agent-delete-group to keep the + local disk in sync with the server. + (gnus-request-rename-group): + Use gnus-cache-rename-group and gnus-agent-rename-group to keep the + local disk in sync with the server. + + * gnus-start.el (gnus-get-unread-articles): + Cosmetic simplification to logic. + + * gnus-group.el (gnus-group-delete-group): No longer update + gnus-cache-active-altered as gnus-request-delete-group now keeps + the cache in sync. + (gnus-group-list-active): Let the agent store a server's active + list if currently plugged. + + * gnus-util.el (gnus-rename-file): New function. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> for Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-agent.el (gnus-agent-regenerate-group): Activate the group + when the group's active is not available. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> for Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to + error. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-start.el (gnus-convert-old-newsrc): Only write the conversion + message to newsrc-dribble when an actual conversion is performed. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-agent.el (gnus-agent-read-local): + Bind nnheader-file-coding-system to gnus-agent-file-coding-system to + avoid the implicit assumption that they will always be equal. + (gnus-agent-save-local): Bind buffer-file-coding-system, not + coding-system-for-write, as the with-temp-file macro first prints + to a buffer then saves the buffer. + +2004-10-18 Kevin Greiner <kgreiner(a)xpediantsolutions.com> + + * legacy-gnus-agent.el (): New. Provides converters that are only + loaded when gnus-convert-old-newsrc needs to call them. + + * gnus-agent.el (gnus-agent-read-agentview): Remove support for + old file versions. + (gnus-group-prepare-hook): Remove function that converted list + form of gnus-agent-expire-days to group properties. + + * gnus-start.el (gnus-convert-old-newsrc): Register new + converters to handle old agent file formats. Added logic for a + "backup before upgrading warning". + (gnus-convert-mark-converter-prompt): Developers can mark + functions as needing (default), or not needing, + gnus-convert-old-newsrc's "backup before upgrading warning". + (gnus-convert-converter-needs-prompt): Tests whether the user + should be protected from potentially irreversable changes by the + function. + +2004-10-18 Kevin Greiner <kgreiner(a)xpediantsolutions.com> + + * gnus-int.el (gnus-request-accept-article): Inform the agent that + articles are being added to a group. + (gnus-request-replace-article): Inform the agent that articles + need to be uncached as the cached contents are no longer valid. + + * gnus-agent.el (gnus-agent-file-header-cache): Remove. + (gnus-agent-possibly-alter-active): Avoid null in numeric comparison. + (gnus-agent-set-local): Refuse to save null in local object table. + (gnus-agent-regenerate-group): The REREAD parameter can now be a + list of articles that will be marked as unread. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-range.el (gnus-sorted-range-intersection): Now accepts + single-interval range of the form (min . max). Previously the + range had to look like ((min . max)). Likewise, return + (min . max) rather than ((min . max)). + (gnus-range-map): Use gnus-range-normalize to accept + single-interval range. + + * gnus-sum.el (gnus-summary-highlight-line): Articles stored in + the cache, but not the agent, now appear with their usual face. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of + marks consisting of a single range {for example, (3 . 5)} rather + than a list of a single range { ((3 . 5)) }. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the + uncompressed list. + +2004-10-18 Kevin Greiner <kevin.greiner(a)compsol.cc> + + * gnus-draft.el (gnus-group-send-queue): Pass the group name + "nndraft:queue" along to gnus-draft-send. + Use gnus-agent-prompt-send-queue. + (gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group + is "nndraft:queue". Suggested by Gaute Strokkenes + <gs234(a)srcf.ucam.org> + + * gnus-group.el (gnus-group-catchup): Use new + gnus-sequence-of-unread-articles, not + gnus-list-of-unread-articles, to avoid exhausting memory with huge + numbers of articles. Use gnus-range-map to avoid having to + uncompress the unread list. + (gnus-group-archive-directory) + (gnus-group-recent-archive-directory): Fix invalid ange-ftp reference. + + * gnus-range.el (gnus-range-map): Iterate over list or sequence. + (gnus-sorted-range-intersection): Intersection of two ranges + without requiring that they first be uncompressed. + + * gnus-start.el (gnus-activate-group): Unless blocked by the + caller, possibly expand the active range to include both cached + and agentized articles. + (gnus-convert-old-newsrc): Rewrote in anticipation of having + multiple version-dependent converters. + (gnus-groups-to-gnus-format): Replace gnus-agent-save-groups with + gnus-agent-save-active. + (gnus-save-newsrc-file): Save dirty agent range limits. + + * gnus-sum.el (gnus-select-newgroup): Replace inline code with + gnus-agent-possibly-alter-active. + (gnus-adjust-marked-articles): Faster handling of simple lists + +2004-10-18 David Edmondson <dme(a)dme.org> + + * mm-view.el (mm-w3m-cid-retrieve-1): Don't use recursive call + excessively. + +2004-10-18 Reiner Steib <Reiner.Steib(a)gmx.de> + + * mml.el (mml-preview): Use `pop-to-buffer'. + + * message.el (message-goto-mail-followup-to): Insert after "To". + (message-carefully-insert-headers): Add comment. + + * gnus-sum.el (gnus-summary-make-menu-bar): Add help texts. + + * gnus-art.el (gnus-button-alist): + Improve `gnus-button-handle-library' entry. + + * gnus-art.el (gnus-button-alist): Fix regexp for manual links. + + * gnus-group.el (gnus-group-get-new-news-this-group): Add doc-string. + + * gnus-start.el (gnus-activate-group): Add doc-string. + + * gnus-art.el (gnus-button-handle-man, gnus-button-alist): Try to + handle manual section. + + * imap.el (imap-store-password): New variable. + (imap-interactive-login): Use it. + Suggested by Mark Plaksin <happy(a)mcplaksin.org>. + + * gnus-art.el (gnus-button-alist, gnus-header-button-alist): + Allow / in mailto URLs. + + * spam.el (spam-directory): Derive from `gnus-directory'. + + * gnus-sum.el (gnus-pick-line-number): Add autoload. + +2004-10-17 Richard M. Stallman <rms(a)gnu.org> + + * gnus-registry.el (gnus-registry-unload-hook): + Set as a variable with add-hook. + + * nnspool.el (nnspool-spool-directory): Use news-directory instead + of news-path. + + * spam-stat.el (spam-stat-unload-hook): Set as a variable w/ add-hook. + + * spam.el: Delete duplicate `provide'. + (spam-unload-hook): Set as a variable with add-hook. + +2004-10-15 Reiner Steib <Reiner.Steib(a)gmx.de> + + * pop3.el (pop3-leave-mail-on-server): Describe possible problems + in the doc string. + + * message.el (message-ignored-news-headers) + (message-ignored-supersedes-headers) + (message-ignored-resent-headers) + (message-forward-ignored-headers): Improve custom type. + +2004-10-15 Simon Josefsson <jas(a)extundo.com> + + * pop3.el (top-level): Don't require nnheader. + (pop3-read-timeout): Add. + (pop3-accept-process-output): Add. + (pop3-read-response, pop3-retr): Use it. + +2004-10-13 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * message.el (message-tokenize-header): Fix 2004-09-06 change + which used point-min in the wrong place. + +2004-10-12 Simon Josefsson <jas(a)extundo.com> + + * net/tls.el (tls-certtool-program): New variable. + (tls-certificate-information): New function, based on + ssl-certificate-information. + +2004-10-11 Reiner Steib <Reiner.Steib(a)gmx.de> + + * message.el (message-bury): Use `window-dedicated-p'. + +2004-10-10 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-sum.el: Mention that multibyte characters don't work as marks. + + * gnus.el (message-y-or-n-p): Autoload. + + * pop3.el (pop3-maildrop, pop3-mailhost, pop3-port) + (pop3-password-required, pop3-authentication-scheme) + (pop3-leave-mail-on-server): Made customizable. + (pop3): New custom group. + (pop3-retr): Remove `sleep-for' statements. + Suggested by Dave Love <fx(a)gnu.org>. + + * nnheader.el (nnheader-read-timeout): Explain 1.0 timeout for + Windows/DOS. + + * imap.el (imap-parse-flag-list, imap-parse-body-extension) + (imap-parse-body): Fix incorrect use of `assert'. Suggested by + Dave Love <fx(a)gnu.org>. + + * mml.el (mml-minibuffer-read-disposition): Require match. + Suggested by Dave Love <fx(a)gnu.org>. + +2004-10-06 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-group.el (gnus-update-group-mark-positions): + * gnus-sum.el (gnus-update-summary-mark-positions): + * message.el (message-check-news-body-syntax): + * gnus-msg.el (gnus-debug): Use mm-string-as-multibyte instead + of string-as-multibyte. + + * gnus-sum.el (gnus-summary-insert-subject): Remove redundant setq. + +2004-10-05 Juri Linkov <juri(a)jurta.org> + + * gnus-group.el (gnus-update-group-mark-positions): + * gnus-sum.el (gnus-update-summary-mark-positions): + * message.el (message-check-news-body-syntax): + * gnus-msg.el (gnus-debug): Use `string-as-multibyte' to convert + 8-bit unibyte values to a multibyte string for search functions. + +2004-10-01 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus-sum.el (gnus-summary-toggle-header): Make it work even if + there's no visible header. + +2004-10-01 Simon Josefsson <jas(a)extundo.com> + + * mailcap.el (mailcap-mime-data): Add pdf. Remove non-free + acroread. + +2004-09-29 Jesper Harder <harder(a)ifa.au.dk> + + * gnus.el (gnus-method-to-server): Oops, move it don't delete it. + +2004-09-28 Jesper Harder <harder(a)ifa.au.dk> + + * gnus-picon.el: Require cl. + + * mml-sec.el (mml-signencrypt-style): Don't depend on Gnus. + + * mml-smime.el: Require cl. Autoload message-fetch-field. + + * gnus-fun.el: Require gnus-ems and gnus-util. + + * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr + + * gnus-art.el (gnus-article-edit-mode): Define before first reference. + + * gnus.el (gnus-method-to-server): Move defsubst before first use. + + * spam.el (spam-check-spamoracle, spam-spamoracle-learn): + Fix format string mismatch. + * nnml.el (nnml-request-set-mark, nnml-save-marks): Do. + * nnfolder.el (nnfolder-request-set-mark, nnfolder-save-marks): Do. + 2004-09-27 Katsumi Yamaoka <yamaoka(a)jpl.org> * mm-decode.el (mm-copy-to-buffer): Don't use set-buffer-multibyte. ＠＠ -9,18 +982,18 ＠＠ * mm-util.el (mm-charset-synonym-alist): Remove obsolete entries for big5 and gb2312. - + * rfc2047.el (rfc2047-pad-base64): Deal with more cases of invalid padding. - * mm-bodies.el (mm-7bit-chars): Don't include \r. + * mm-bodies.el (mm-7bit-chars): Don't include \r. * mml.el (mml-compute-boundary-1): Don't uncompress files. * rfc2047.el (rfc2047-qp-or-base64): New function to reduce dependencies. (rfc2047-encode): Use it. - + * flow-fill.el: Typo. * mml.el (mml-generate-mime-1): Don't use format=flowed with ＠＠ -152,7 +1125,7 ＠＠ * gnus-delay.el (gnus-delay-default-hour): Add :version. * gnus-cite.el (gnus-cite-blank-line-after-header) - (gnus-article-boring-faces): + (gnus-article-boring-faces): * gnus-art.el (gnus-buttonized-mime-types) (gnus-inhibit-mime-unbuttonizing) ＠＠ -340,7 +1313,7 ＠＠ * pgg-gpg.el (pgg-gpg-lookup-all-secret-keys) (pgg-gpg-lookup-key): Use regexp match instead of split-string (split-string is different between emacs 21.2 and - 21.4). Reported by ultrasoul(a)ultrasoul.com (David D. Smith). + 22.1). Reported by ultrasoul(a)ultrasoul.com (David D. Smith). 2004-07-28 Simon Josefsson <jas(a)extundo.com> ＠＠ -356,13 +1329,12 ＠＠ * starttls.el: Merge with my GNUTLS based starttls.el. (starttls-gnutls-program, starttls-use-gnutls) (starttls-extra-arguments, starttls-process-connection-type) - (starttls-connect, starttls-failure, starttls-success): New - variables. + (starttls-connect, starttls-failure, starttls-success): New variables. (starttls-program, starttls-extra-args): Doc fix. - (starttls-negotiate-gnutls, starttls-open-stream-gnutls): New - functions. - (starttls-negotiate, starttls-open-stream): Check - `starttls-use-gnutls' and pass on to corresponding *-gnutls + (starttls-negotiate-gnutls, starttls-open-stream-gnutls): + New functions. + (starttls-negotiate, starttls-open-stream): + Check `starttls-use-gnutls' and pass on to corresponding *-gnutls function if it is set. 2004-08-30 Juanma Barranquero <lektu(a)terra.es> ＠＠ -394,8 +1366,8 ＠＠ 2004-08-30 Simon Josefsson <jas(a)extundo.com> * ietf-drums.el (ietf-drums-syntax-table): Set syntax of ?* ?\; - and ?\' to symbol instead of whitespace (tiny patch). From - Andreas Schwab <schwab(a)suse.de>. + and ?\' to symbol instead of whitespace (tiny patch). + From Andreas Schwab <schwab(a)suse.de>. 2004-08-30 Simon Josefsson <jas(a)extundo.com> ＠＠ -422,7 +1394,7 ＠＠ 2004-05-16 Lars Magne Ingebrigtsen <larsi(a)gnus.org> - * message.el (message-idna-inside-rhs-p): Removed. + * message.el (message-idna-inside-rhs-p): Remove. (message-idna-to-ascii-rhs-1): Use proper address parsing. 2004-08-30 Katsumi Yamaoka <yamaoka(a)jpl.org> ＠＠ -451,8 +1423,8 ＠＠ Karl Chen <quarl(a)nospam.quarl.org> and Reiner Steib <Reiner.Steib(a)gmx.de>. - * gnus-cus.el (gnus-agent-cat-prepare-category-field): Replace - pp-to-string with gnus-pp-to-string. + * gnus-cus.el (gnus-agent-cat-prepare-category-field): + Replace pp-to-string with gnus-pp-to-string. * gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp. ＠＠ -461,8 +1433,8 ＠＠ * gnus-msg.el (gnus-setup-message): Ignore an article copy while parsing gnus-posting-styles when the message is not for replying. - (gnus-summary-resend-message-edit): Call mime-to-mml. Suggested - by Hiroshi Fujishima <pooh(a)nature.tsukuba.ac.jp>. + (gnus-summary-resend-message-edit): Call mime-to-mml. + Suggested by Hiroshi Fujishima <pooh(a)nature.tsukuba.ac.jp>. (gnus-debug): Replace pp with gnus-pp. * gnus-score.el (gnus-score-save): Replace pp with gnus-pp. ＠＠ -471,8 +1443,8 ＠＠ gnus-pp-to-string. * gnus-sum.el (gnus-read-header): Don't remove a header for the - parent article of a sparse article in the thread hashtb. From - Stefan Wiens <s.wi(a)gmx.net>. + parent article of a sparse article in the thread hashtb. + From Stefan Wiens <s.wi(a)gmx.net>. * gnus-util.el (gnus-bind-print-variables): New macro. (gnus-prin1): Use it. ＠＠ -496,8 +1468,8 ＠＠ t while entering a file name using the mm-with-multibyte macro. Suggested by Hiroshi Fujishima <pooh(a)nature.tsukuba.ac.jp>. - * mm-encode.el (mm-content-transfer-encoding-defaults): Use - qp-or-base64 for the application/* types. + * mm-encode.el (mm-content-transfer-encoding-defaults): + Use qp-or-base64 for the application/* types. (mm-safer-encoding): Consider 7bit is safe. * mm-util.el (mm-with-multibyte-buffer): New macro. ＠＠ -524,9 +1496,9 ＠＠ 2004-08-25 Katsumi Yamaoka <yamaoka(a)jpl.org> - * gnus-art.el (gnus-article-wash-html-with-w3m): Bind - w3m-safe-url-regexp as the value for mm-w3m-safe-url-regexp; use - w3m-minor-mode-map instead of mm-w3m-local-map-property. + * gnus-art.el (gnus-article-wash-html-with-w3m): + Bind w3m-safe-url-regexp as the value for mm-w3m-safe-url-regexp; + use w3m-minor-mode-map instead of mm-w3m-local-map-property. (gnus-mime-save-part-and-strip): Use mm-complicated-handles instead of mm-multiple-handles. (gnus-mime-delete-part): Ditto. ＠＠ -551,8 +1523,8 ＠＠ 2004-08-22 Katsumi Yamaoka <yamaoka(a)jpl.org> - * gnus-art.el (article-hide-list-identifiers): Bind - inhibit-read-only as t. + * gnus-art.el (article-hide-list-identifiers): + Bind inhibit-read-only as t. 2004-08-22 Reiner Steib <Reiner.Steib(a)gmx.de> ＠＠ -583,8 +1555,8 ＠＠ 2004-08-05 Reiner Steib <Reiner.Steib(a)gmx.de> - * mm-decode.el (mime-display, mime-security): Fix custom-manual - entries. + * gnus.el (gnus-group, gnus-summary, gnus-summary-sort): + Fix custom-manual entries. * gnus-art.el (gnus-article): Fix custom-manual entries. ＠＠ -600,8 +1572,8 ＠＠ 2004-05-19 Reiner Steib <Reiner.Steib(a)gmx.de> - * gnus-msg.el (gnus-summary-followup-with-original): Document - yanking of region when active. + * gnus-msg.el (gnus-summary-followup-with-original): + Document yanking of region when active. 2004-04-13 Kevin Greiner <kgreiner(a)xpediantsolutions.com> Index: lisp/canlock.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/canlock.el,v retrieving revision 1.3 diff -u -p -u -r1.3 canlock.el --- lisp/canlock.el 28 Sep 2004 02:21:02 -0000 1.3 +++ lisp/canlock.el 13 Mar 2005 00:11:31 -0000 ＠＠ -55,13 +55,13 ＠＠ (defcustom canlock-password nil "Password to use when signing a Cancel-Lock or a Cancel-Key header." :type '(radio (const :format "Not specified " nil) - (string :tag "Password" :size 0)) + (string :tag "Password")) :group 'canlock) (defcustom canlock-password-for-verify canlock-password "Password to use when verifying a Cancel-Lock or a Cancel-Key header." :type '(radio (const :format "Not specified " nil) - (string :tag "Password" :size 0)) + (string :tag "Password")) :group 'canlock) (defcustom canlock-force-insert-header nil Index: lisp/deuglify.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/deuglify.el,v retrieving revision 1.3 diff -u -p -u -r1.3 deuglify.el --- lisp/deuglify.el 28 Sep 2004 02:21:02 -0000 1.3 +++ lisp/deuglify.el 13 Mar 2005 00:11:32 -0000 ＠＠ -1,6 +1,6 ＠＠ ;;; deuglify.el --- deuglify broken Outlook (Express) articles -;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. ;; Copyright (C) 2001, 2002 Raymond Scholz ;; Author: Raymond Scholz <rscholz(a)zonix.de> ＠＠ -146,7 +146,7 ＠＠ ;; Hey, John. There's no in all your sentences! ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; +;; ;; Usage ;; ----- ;; ＠＠ -230,59 +230,60 ＠＠ ;;; User Customizable Variables: (defgroup gnus-outlook-deuglify nil - "Deuglify articles generated by broken user agents like MS Outlook (Express).") + "Deuglify articles generated by broken user agents like MS Outlook (Express)." +:version "22.1") ;;;###autoload (defcustom gnus-outlook-deuglify-unwrap-min 45 "Minimum length of the cited line above the (possibly) wrapped line." -:version "21.4" +:version "22.1" :type 'integer :group 'gnus-outlook-deuglify) ;;;###autoload (defcustom gnus-outlook-deuglify-unwrap-max 95 "Maximum length of the cited line after unwrapping." -:version "21.4" +:version "22.1" :type 'integer :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-cite-marks ">|#%" "Characters that indicate cited lines." -:version "21.4" +:version "22.1" :type 'string :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil "Characters that inhibit unwrapping if they are the last one on the cited line above the possible wrapped line." -:version "21.4" +:version "22.1" :type '(radio (const :format "None " nil) - (string :size 0 :value ".?!")) + (string :value ".?!")) :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-no-wrap-chars "`" "Characters that inhibit unwrapping if they are the first one in the possibly wrapped line." -:version "21.4" +:version "22.1" :type 'string :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-attrib-cut-regexp "\$On \\|Am \$?\$Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\$,[^,]+, " "Regular expression matching the beginning of an attribution line that should be cut off." -:version "21.4" +:version "22.1" :type 'string :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-attrib-verb-regexp "wrote\\|writes\\|says\\|schrieb\\|schreibt\\|meinte\\|skrev\\|a écrit\\|schreef\\|escribió" "Regular expression matching the verb used in an attribution line." -:version "21.4" +:version "22.1" :type 'string :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-attrib-end-regexp ": *\\|\\.\\.\\." "Regular expression matching the end of an attribution line." -:version "21.4" +:version "22.1" :type 'string :group 'gnus-outlook-deuglify) ＠＠ -290,7 +291,7 ＠＠ (defcustom gnus-outlook-display-hook nil "A hook called after an deuglified article has been prepared. It is run after `gnus-article-prepare-hook'." -:version "21.4" +:version "22.1" :type 'hook :group 'gnus-outlook-deuglify) Index: lisp/dgnushack-xemacs.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/dgnushack-xemacs.el,v retrieving revision 1.2 diff -u -p -u -r1.2 dgnushack-xemacs.el --- lisp/dgnushack-xemacs.el 8 Dec 2003 06:55:18 -0000 1.2 +++ lisp/dgnushack-xemacs.el 13 Mar 2005 00:11:32 -0000 ＠＠ -63,34 +63,6 ＠＠ (defalias 'overlays-in 'ignore) (defalias 'replace-dehighlight 'ignore) (defalias 'replace-highlight 'ignore) - (defalias 'run-with-idle-timer 'ignore) - (defalias 'w3-coding-system-for-mime-charset 'ignore) - (defalias 'timer-create 'make-itimer) - (defalias 'cancel-timer 'delete-itimer) - (defalias 'timer-activate 'activate-itimer) - (defalias 'timer-set-time 'set-itimer-value) - (defalias 'timer-set-function 'set-itimer-function) - (unless (fboundp 'timer-relative-time) - (defun timer-relative-time (time secs &optional usecs) - "Advance TIME by SECS seconds and optionally USECS microseconds. -SECS may be a fraction." - (let ((high (car time)) - (low (if (consp (cdr time)) (nth 1 time) (cdr time))) - (micro (if (numberp (car-safe (cdr-safe (cdr time)))) - (nth 2 time) - 0))) - ;; Add - (if usecs (setq micro (+ micro usecs))) - (if (floatp secs) - (setq micro (+ micro (floor (* 1000000 (- secs (floor secs))))))) - (setq low (+ low (floor secs))) - ;; Normalize - (setq low (+ low (/ micro 1000000))) - (setq micro (mod micro 1000000)) - (setq high (+ high (/ low 65536))) - (setq low (logand low 65535)) - (list high low (and (/= micro 0) micro))))))) - - + (defalias 'w3-coding-system-for-mime-charset 'ignore))) ;;; dgnushack-xemacs.el ends here Index: lisp/dgnushack.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/dgnushack.el,v retrieving revision 1.5 diff -u -p -u -r1.5 dgnushack.el --- lisp/dgnushack.el 28 Sep 2004 02:21:02 -0000 1.5 +++ lisp/dgnushack.el 13 Mar 2005 00:11:32 -0000 ＠＠ -202,6 +202,7 ＠＠ than subr.el." (autoload 'dolist "cl-macs" nil nil 'macro) (autoload 'enriched-decode "enriched") (autoload 'info "info" nil t) + (autoload 'mail-fetch-field "mail-utils") (autoload 'make-annotation "annotations") (autoload 'make-display-table "disp-table") (autoload 'pp "pp") ＠＠ -232,7 +233,6 ＠＠ than subr.el." (defalias 'overlays-in 'ignore) (defalias 'replace-dehighlight 'ignore) (defalias 'replace-highlight 'ignore) - (defalias 'run-with-idle-timer 'ignore) (defalias 'w3-coding-system-for-mime-charset 'ignore))) (defun dgnushack-compile-verbosely () Index: lisp/flow-fill.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/flow-fill.el,v retrieving revision 1.4 diff -u -p -u -r1.4 flow-fill.el --- lisp/flow-fill.el 28 Sep 2004 02:21:03 -0000 1.4 +++ lisp/flow-fill.el 13 Mar 2005 00:11:32 -0000 ＠＠ -56,7 +56,7 ＠＠ (defcustom fill-flowed-display-column 'fill-column "Column beyond which format=flowed lines are wrapped, when displayed. This can be a Lisp expression or an integer." -:version "21.4" +:version "22.1" :group 'mime-display :type '(choice (const :tag "Standard `fill-column'" fill-column) (const :tag "Fit Window" (- (window-width) 5)) ＠＠ -67,7 +67,7 ＠＠ This can be a Lisp expression or an inte "Column beyond which format=flowed lines are wrapped, in outgoing messages. This can be a Lisp expression or an integer. RFC 2646 suggests 66 characters for readability." -:version "21.4" +:version "22.1" :group 'mime-display :type '(choice (const :tag "Standard fill-column" fill-column) (const :tag "RFC 2646 default (66)" 66) ＠＠ -163,19 +163,19 ＠＠ RFC 2646 suggests 66 characters for read '( ;; The syntax of each list element is: ;; (INPUT . EXPECTED-OUTPUT) - ("> Thou villainous ill-breeding spongy dizzy-eyed -> reeky elf-skinned pigeon-egg! ->> Thou artless swag-bellied milk-livered + ("> Thou villainous ill-breeding spongy dizzy-eyed +> reeky elf-skinned pigeon-egg! +>> Thou artless swag-bellied milk-livered >> dismal-dreaming idle-headed scut! ->>> Thou errant folly-fallen spleeny reeling-ripe +>>> Thou errant folly-fallen spleeny reeling-ripe >>> unmuzzled ratsbane! ->>>> Henceforth, the coding style is to be strictly +>>>> Henceforth, the coding style is to be strictly >>>> enforced, including the use of only upper case. ->>>>> I've noticed a lack of adherence to the coding +>>>>> I've noticed a lack of adherence to the coding >>>>> styles, of late. >>>>>> Any complaints? " . "> Thou villainous ill-breeding spongy dizzy-eyed reeky elf-skinned -> pigeon-egg! +> pigeon-egg! >> Thou artless swag-bellied milk-livered dismal-dreaming idle-headed >> scut! >>> Thou errant folly-fallen spleeny reeling-ripe unmuzzled ratsbane! ＠＠ -186,8 +186,8 ＠＠ RFC 2646 suggests 66 characters for read ") ; (" ;> foo -;> -;> +;> +;> ;> bar ;" . " ;> foo bar Index: lisp/gnus-agent.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-agent.el,v retrieving revision 1.6 diff -u -p -u -r1.6 gnus-agent.el --- lisp/gnus-agent.el 28 Sep 2004 02:21:03 -0000 1.6 +++ lisp/gnus-agent.el 13 Mar 2005 00:11:33 -0000 ＠＠ -60,7 +60,7 ＠＠ (defcustom gnus-agent-fetched-hook nil "Hook run when finished fetching articles." -:version "21.4" +:version "22.1" :group 'gnus-agent :type 'hook) ＠＠ -114,7 +114,7 ＠＠ If nil, only read articles will be expir :group 'gnus-agent :type 'function) -(defcustom gnus-agent-synchronize-flags 'ask +(defcustom gnus-agent-synchronize-flags nil "Indicate if flags are synchronized when you plug in. If this is `ask' the hook will query the user." :version "21.1" ＠＠ -152,7 +152,7 ＠＠ whether unread articles are downloaded o groups with large active ranges may open slower and you may also want to look into the agent expiry settings to block the expiration of read articles as they would just be downloaded again." -:version "21.4" +:version "22.1" :type 'boolean :group 'gnus-agent) ＠＠ -160,6 +160,7 ＠＠ read articles as they would just be down "Chunk size for `gnus-agent-fetch-session'. The function will split its article fetches into chunks smaller than this limit." +:version "22.1" :group 'gnus-agent :type 'integer) ＠＠ -170,6 +171,7 ＠＠ contents from a group's local storage. to disable expiration in specific categories, topics, and groups. Of course, you could change gnus-agent-enable-expiration to DISABLE then enable expiration per categories, topics, and groups." +:version "22.1" :group 'gnus-agent :type '(radio (const :format "Enable " ENABLE) (const :format "Disable " DISABLE))) ＠＠ -179,7 +181,7 ＠＠ enable expiration per categories, topics Have gnus-agent-expire scan the directories under \(gnus-agent-directory) for groups that are no longer agentized. When found, offer to remove them." -:version "21.4" +:version "22.1" :type 'boolean :group 'gnus-agent) ＠＠ -187,7 +189,7 ＠＠ When found, offer to remove them." "Initially, all servers from these methods are agentized. The user may remove or add servers using the Server buffer. See Info node `(gnus)Server Buffer'." -:version "21.4" +:version "22.1" :type '(repeat symbol) :group 'gnus-agent) ＠＠ -195,6 +197,7 ＠＠ See Info node `(gnus)Server Buffer'." "Whether and when outgoing mail should be queued by the agent. When `always', always queue outgoing mail. When nil, never queue. Otherwise, queue if and only if unplugged." +:version "22.1" :group 'gnus-agent :type '(radio (const :format "Always" always) (const :format "Never" nil) ＠＠ -203,6 +206,7 ＠＠ queue. Otherwise, queue if and only if (defcustom gnus-agent-prompt-send-queue nil "If non-nil, `gnus-group-send-queue' will prompt if called when unplugged." +:version "22.1" :group 'gnus-agent :type 'boolean) ＠＠ -211,13 +215,13 ＠＠ unplugged." (defvar gnus-agent-history-buffers nil) (defvar gnus-agent-buffer-alist nil) (defvar gnus-agent-article-alist nil - "An assoc list identifying the articles whose headers have been fetched. + "An assoc list identifying the articles whose headers have been fetched. If successfully fetched, these headers will be stored in the group's overview file. The key of each assoc pair is the article ID, the value of each assoc pair is a flag indicating whether the identified article has been downloaded \(gnus-agent-fetch-articles sets the value to the day of the download). NOTES: -1) The last element of this list can not be expired as some +1) The last element of this list can not be expired as some routines (for example, get-agent-fetch-headers) use the last value to track which articles have had their headers retrieved. 2) The function `gnus-agent-regenerate' may destructively modify the value.") ＠＠ -362,9 +366,23 ＠＠ manipulated as follows: (gnus-agent-cat-defaccessor gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces) + +;; This form is equivalent to defsetf except that it calls make-symbol +;; whereas defsetf calls gensym (Using gensym creates a run-time +;; dependency on the CL library). + (eval-and-compile - (defsetf gnus-agent-cat-groups (category) (groups) - (list 'gnus-agent-set-cat-groups category groups))) + (define-setf-method gnus-agent-cat-groups (category) + (let* ((--category--temp-- (make-symbol "--category--")) + (--groups--temp-- (make-symbol "--groups--"))) + (list (list --category--temp--) + (list category) + (list --groups--temp--) + (let* ((category --category--temp--) + (groups --groups--temp--)) + (list (quote gnus-agent-set-cat-groups) category groups)) + (list (quote gnus-agent-cat-groups) --category--temp--)))) + ) (defun gnus-agent-set-cat-groups (category groups) (unless (eq groups 'ignore) ＠＠ -624,7 +642,7 ＠＠ minor mode in all Gnus buffers." (unless gnus-agent-send-mail-function (setq gnus-agent-send-mail-function (or message-send-mail-real-function - message-send-mail-function) + (function (lambda () (funcall message-send-mail-function)))) message-send-mail-real-function 'gnus-agent-send-mail)) ;; If the servers file doesn't exist, auto-agentize some servers and ＠＠ -790,25 +808,39 ＠＠ be a select method." (interactive) (save-excursion (dolist (gnus-command-method (gnus-agent-covered-methods)) - (when (file-exists-p (gnus-agent-lib-file "flags")) + (when (and (file-exists-p (gnus-agent-lib-file "flags")) + (not (eq (gnus-server-status gnus-command-method) 'offline))) (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) (defun gnus-agent-synchronize-flags-server (method) "Synchronize flags set when unplugged for server." - (let ((gnus-command-method method)) + (let ((gnus-command-method method) + (gnus-agent nil)) (when (file-exists-p (gnus-agent-lib-file "flags")) (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) (erase-buffer) (nnheader-insert-file-contents (gnus-agent-lib-file "flags")) - (if (null (gnus-check-server gnus-command-method)) - (gnus-message 1 "Couldn't open server %s" (nth 1 gnus-command-method)) - (while (not (eobp)) - (if (null (eval (read (current-buffer)))) - (gnus-delete-line) - (write-file (gnus-agent-lib-file "flags")) - (error "Couldn't set flags from file %s" - (gnus-agent-lib-file "flags")))) - (delete-file (gnus-agent-lib-file "flags"))) + (cond ((null gnus-plugged) + (gnus-message + 1 "You must be plugged to synchronize flags with server %s" + (nth 1 gnus-command-method))) + ((null (gnus-check-server gnus-command-method)) + (gnus-message + 1 "Couldn't open server %s" (nth 1 gnus-command-method))) + (t + (condition-case err + (while t + (let ((bgn (point))) + (eval (read (current-buffer))) + (delete-region bgn (point)))) + (end-of-file + (delete-file (gnus-agent-lib-file "flags"))) + (error + (let ((file (gnus-agent-lib-file "flags"))) + (write-region (point-min) (point-max) + (gnus-agent-lib-file "flags") nil 'silent) + (error "Couldn't set flags from file %s due to %s" + file (error-message-string err))))))) (kill-buffer nil)))) (defun gnus-agent-possibly-synchronize-flags-server (method) ＠＠ -820,6 +852,56 ＠＠ be a select method." (cadr method))))) (gnus-agent-synchronize-flags-server method))) +;;;###autoload +(defun gnus-agent-rename-group (old-group new-group) + "Rename fully-qualified OLD-GROUP as NEW-GROUP. Always updates the agent, even when +disabled, as the old agent files would corrupt gnus when the agent was +next enabled. Depends upon the caller to determine whether group renaming is supported." + (let* ((old-command-method (gnus-find-method-for-group old-group)) + (old-path (directory-file-name + (let (gnus-command-method old-command-method) + (gnus-agent-group-pathname old-group)))) + (new-command-method (gnus-find-method-for-group new-group)) + (new-path (directory-file-name + (let (gnus-command-method new-command-method) + (gnus-agent-group-pathname new-group))))) + (gnus-rename-file old-path new-path t) + + (let* ((old-real-group (gnus-group-real-name old-group)) + (new-real-group (gnus-group-real-name new-group)) + (old-active (gnus-agent-get-group-info old-command-method old-real-group))) + (gnus-agent-save-group-info old-command-method old-real-group nil) + (gnus-agent-save-group-info new-command-method new-real-group old-active) + + (let ((old-local (gnus-agent-get-local old-group + old-real-group old-command-method))) + (gnus-agent-set-local old-group + nil nil + old-real-group old-command-method) + (gnus-agent-set-local new-group + (car old-local) (cdr old-local) + new-real-group new-command-method))))) + +;;;###autoload +(defun gnus-agent-delete-group (group) + "Delete fully-qualified GROUP. Always updates the agent, even when +disabled, as the old agent files would corrupt gnus when the agent was +next enabled. Depends upon the caller to determine whether group deletion is supported." + (let* ((command-method (gnus-find-method-for-group group)) + (path (directory-file-name + (let (gnus-command-method command-method) + (gnus-agent-group-pathname group))))) + (gnus-delete-directory path) + + (let* ((real-group (gnus-group-real-name group))) + (gnus-agent-save-group-info command-method real-group nil) + + (let ((local (gnus-agent-get-local group + real-group command-method))) + (gnus-agent-set-local group + nil nil + real-group command-method))))) + ;;; ;;; Server mode commands ;;; ＠＠ -855,7 +937,7 ＠＠ be a select method." (unless (member named-server gnus-agent-covered-methods) (error "Server not in the agent program")) - (setq gnus-agent-covered-methods + (setq gnus-agent-covered-methods (delete named-server gnus-agent-covered-methods) gnus-agent-method-p-cache nil) ＠＠ -865,7 +947,7 ＠＠ be a select method." (defun gnus-agent-read-servers () "Read the alist of covered servers." - (setq gnus-agent-covered-methods + (setq gnus-agent-covered-methods (gnus-agent-read-file (nnheader-concat gnus-agent-directory "lib/servers")) gnus-agent-method-p-cache nil) ＠＠ -969,6 +1051,7 ＠＠ article's mark is toggled." gnus-downloadable-mark) 'unread)))) +;;;###autoload (defun gnus-agent-get-undownloaded-list () "Construct list of articles that have not been downloaded." (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) ＠＠ -996,7 +1079,7 ＠＠ article's mark is toggled." ;; imply that this article isn't in the agent. (gnus-agent-append-to-list tail-undownloaded h) (gnus-agent-append-to-list tail-unfetched h) - (setq headers (cdr headers))) + (setq headers (cdr headers))) ((cdar alist) (setq alist (cdr alist)) (setq headers (cdr headers)) ＠＠ -1005,7 +1088,7 ＠＠ article's mark is toggled." (t (setq alist (cdr alist)) (setq headers (cdr headers)) - + ;; This article isn't in the agent. Check to see ;; if it is in the cache. If it is, it's been ;; downloaded. ＠＠ -1083,7 +1166,7 ＠＠ Optional arg ALL, if non-nil, means to f gnus-newsgroup-name articles))))) (save-excursion (dolist (article articles) - (let ((was-marked-downloadable + (let ((was-marked-downloadable (memq article gnus-newsgroup-downloadable))) (cond (gnus-agent-mark-unread-after-downloaded (setq gnus-newsgroup-downloadable ＠＠ -1113,6 +1196,49 ＠＠ This can be added to `gnus-select-articl ;;; Internal functions ;;; +(defun gnus-agent-synchronize-group-flags (group actions server) +"Update a plugged group by performing the indicated actions." + (let* ((gnus-command-method (gnus-server-to-method server)) + (info + ;; This initializer is required as gnus-request-set-mark + ;; calls gnus-group-real-name to strip off the host name + ;; before calling the backend. Now that the backend is + ;; trying to call gnus-request-set-mark, I have to + ;; reconstruct the original group name. + (or (gnus-get-info group) + (gnus-get-info + (setq group (gnus-group-full-name + group gnus-command-method)))))) + (gnus-request-set-mark group actions) + + (when info + (dolist (action actions) + (let ((range (nth 0 action)) + (what (nth 1 action)) + (marks (nth 2 action))) + (dolist (mark marks) + (cond ((eq mark 'read) + (gnus-info-set-read + info + (funcall (if (eq what 'add) + 'gnus-range-add + 'gnus-remove-from-range) + (gnus-info-read info) + range)) + (gnus-get-unread-articles-in-group + info + (gnus-active (gnus-info-group info)))) + ((memq mark '(tick)) + (let ((info-marks (assoc mark (gnus-info-marks info)))) + (unless info-marks + (gnus-info-set-marks info (cons (setq info-marks (list mark)) (gnus-info-marks info)))) + (setcdr info-marks (funcall (if (eq what 'add) + 'gnus-range-add + 'gnus-remove-from-range) + (cdr info-marks) + range))))))))) + nil)) + (defun gnus-agent-save-active (method) (when (gnus-agent-method-p method) (let* ((gnus-command-method method) ＠＠ -1131,6 +1257,7 ＠＠ This can be added to `gnus-select-articl ;; will add it while reading the file. (gnus-write-active-file file new nil))) +;;;###autoload (defun gnus-agent-possibly-alter-active (group active &optional info) "Possibly expand a group's active range to include articles downloaded into the agent." ＠＠ -1166,11 +1293,11 ＠＠ downloaded into the agent." ;; file. (let ((read (gnus-info-read info))) - (gnus-info-set-read - info - (gnus-range-add - read - (list (cons (1+ agent-max) + (gnus-info-set-read + info + (gnus-range-add + read + (list (cons (1+ agent-max) (1- active-min)))))) ;; Lie about the agent's local range for this group to ＠＠ -1183,7 +1310,7 ＠＠ downloaded into the agent." (defun gnus-agent-save-group-info (method group active) "Update a single group's active range in the agent's copy of the server's active file." (when (gnus-agent-method-p method) - (let* ((gnus-command-method method) + (let* ((gnus-command-method (or method gnus-command-method)) (coding-system-for-write nnheader-file-coding-system) (file-name-coding-system nnmail-pathname-coding-system) (file (gnus-agent-lib-file "active")) ＠＠ -1199,15 +1326,39 ＠＠ downloaded into the agent." (when (re-search-forward (concat "^" (regexp-quote group) " ") nil t) (save-excursion - (setq oactive-max (read (current-buffer)) ;; max + (setq oactive-max (read (current-buffer)) ;; max oactive-min (read (current-buffer)))) ;; min (gnus-delete-line))) - (insert (format "%S %d %d y\n" (intern group) - (max (or oactive-max (cdr active)) (cdr active)) - (min (or oactive-min (car active)) (car active)))) - (goto-char (point-max)) - (while (search-backward "\\." nil t) - (delete-char 1)))))) + (when active + (insert (format "%S %d %d y\n" (intern group) + (max (or oactive-max (cdr active)) (cdr active)) + (min (or oactive-min (car active)) (car active)))) + (goto-char (point-max)) + (while (search-backward "\\." nil t) + (delete-char 1))))))) + +(defun gnus-agent-get-group-info (method group) + "Get a single group's active range in the agent's copy of the server's active file." + (when (gnus-agent-method-p method) + (let* ((gnus-command-method (or method gnus-command-method)) + (coding-system-for-write nnheader-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system) + (file (gnus-agent-lib-file "active")) + oactive-min oactive-max) + (gnus-make-directory (file-name-directory file)) + (with-temp-buffer + ;; Emacs got problem to match non-ASCII group in multibyte buffer. + (mm-disable-multibyte) + (when (file-exists-p file) + (nnheader-insert-file-contents file) + + (goto-char (point-min)) + (when (re-search-forward + (concat "^" (regexp-quote group) " ") nil t) + (save-excursion + (setq oactive-max (read (current-buffer)) ;; max + oactive-min (read (current-buffer))) ;; min + (cons oactive-min oactive-max)))))))) (defun gnus-agent-group-path (group) "Translate GROUP into a file name." ＠＠ -1219,7 +1370,7 ＠＠ downloaded into the agent." (setq group (nnheader-translate-file-chars (nnheader-replace-duplicate-chars-in-string - (nnheader-replace-chars-in-string + (nnheader-replace-chars-in-string (gnus-group-real-name group) ?/ ?_) ?. ?_))) ＠＠ -1300,7 +1451,7 ＠＠ downloaded into the agent." (unless (and (eq article (caar alist)) (cdar alist)) ;; Skip headers preceeding this article - (while (> article + (while (> article (setq header-number (let* ((header (car headers))) (if header ＠＠ -1413,6 +1564,31 ＠＠ downloaded into the agent." (gnus-message 7 "")) (cdr fetched-articles)))))) +(defun gnus-agent-unfetch-articles (group articles) + "Delete ARTICLES that were fetched from GROUP into the agent." + (when articles + (gnus-agent-load-alist group) + (let* ((alist (cons nil gnus-agent-article-alist)) + (articles (sort articles #'<)) + (next-possibility alist) + (delete-this (pop articles))) + (while (and (cdr next-possibility) delete-this) + (let ((have-this (caar (cdr next-possibility)))) + (cond ((< delete-this have-this) + (setq delete-this (pop articles))) + ((= delete-this have-this) + (let ((timestamp (cdar (cdr next-possibility)))) + (when timestamp + (let* ((file-name (concat (gnus-agent-group-pathname group) + (number-to-string have-this)))) + (delete-file file-name)))) + + (setcdr next-possibility (cddr next-possibility))) + (t + (setq next-possibility (cdr next-possibility)))))) + (setq gnus-agent-article-alist (cdr alist)) + (gnus-agent-save-alist group)))) + (defun gnus-agent-crosspost (crosses article &optional date) (setq date (or date t)) ＠＠ -1487,7 +1663,7 ＠＠ and that there are no duplicates." (setq backed-up (gnus-agent-backup-overview-buffer))) (gnus-message 1 "Duplicate overview line for %d" cur) - (delete-region (point) (progn (forward-line 1) (point)))) + (delete-region p (progn (forward-line 1) (point)))) ((< cur prev-num) (or backed-up (setq backed-up (gnus-agent-backup-overview-buffer))) ＠＠ -1519,6 +1695,7 ＠＠ and that there are no duplicates." (insert "\n")) (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))) +;;;###autoload (defun gnus-agent-find-parameter (group symbol) "Search for GROUPs SYMBOL in the group's parameters, the group's topic parameters, the group's category, or the customizable ＠＠ -1623,8 +1800,10 ＠＠ article numbers will be returned." ;; of FILE. (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) - (when (file-exists-p file) - (gnus-agent-braid-nov group articles file)) + ;; NOTE: Call g-a-brand-nov even when the file does not + ;; exist. As a minimum, it will validate the article + ;; numbers already in the buffer. + (gnus-agent-braid-nov group articles file) (let ((coding-system-for-write gnus-agent-file-coding-system)) (gnus-agent-check-overview-buffer) ＠＠ -1636,11 +1815,32 ＠＠ article numbers will be returned." (nnheader-insert-file-contents file))))) articles)) +(defsubst gnus-agent-read-article-number () + "Reads the article number at point. Returns nil when a valid article number can not be read." + + ;; It is unfortunite but the read function quietly overflows + ;; integer. As a result, I have to use string operations to test + ;; for overflow BEFORE calling read. + (when (looking-at "[0-9]+\t") + (let ((len (- (match-end 0) (match-beginning 0)))) + (cond ((< len 9) + (read (current-buffer))) + ((= len 9) + ;; Many 9 digit base-10 numbers can be represented in a 27-bit int + ;; Back convert from int to string to ensure that this is one of them. + (let* ((str1 (buffer-substring (match-beginning 0) (1- (match-end 0)))) + (num (read (current-buffer))) + (str2 (int-to-string num))) + (when (equal str1 str2) + num))))))) + (defsubst gnus-agent-copy-nov-line (article) + "Copy the indicated ARTICLE from the overview buffer to the nntp server buffer." (let (art b e) (set-buffer gnus-agent-overview-buffer) (while (and (not (eobp)) - (< (setq art (read (current-buffer))) article)) + (or (not (setq art (gnus-agent-read-article-number))) + (< art article))) (forward-line 1)) (beginning-of-line) (if (or (eobp) ＠＠ -1653,64 +1853,77 ＠＠ article numbers will be returned." (defun gnus-agent-braid-nov (group articles file) "Merge agent overview data with given file. -Takes headers for ARTICLES from `gnus-agent-overview-buffer' and the given -FILE and places the combined headers into `nntp-server-buffer'." +Takes unvalidated headers for ARTICLES from +`gnus-agent-overview-buffer' and validated headers from the given +FILE and places the combined valid headers into +`nntp-server-buffer'. This function can be used, when file +doesn't exist, to valid the overview buffer." (let (start last) (set-buffer gnus-agent-overview-buffer) (goto-char (point-min)) (set-buffer nntp-server-buffer) (erase-buffer) - (nnheader-insert-file-contents file) + (when (file-exists-p file) + (nnheader-insert-file-contents file)) (goto-char (point-max)) (forward-line -1) - (unless (looking-at "[0-9]+\t") - ;; Remove corrupted lines - (gnus-message - 1 "Overview %s is corrupted. Removing corrupted lines..." file) - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at "[0-9]+\t") - (forward-line 1) - (delete-region (point) (progn (forward-line 1) (point))))) - (forward-line -1)) + (unless (or (= (point-min) (point-max)) (< (setq last (read (current-buffer))) (car articles))) - ;; We do it the hard way. + ;; Old and new overlap -- We do it the hard way. (when (nnheader-find-nov-line (car articles)) ;; Replacing existing NOV entry (delete-region (point) (progn (forward-line 1) (point)))) (gnus-agent-copy-nov-line (pop articles)) (ignore-errors - (while articles - (while (let ((art (read (current-buffer)))) - (cond ((< art (car articles)) - (forward-line 1) - t) - ((= art (car articles)) - (beginning-of-line) - (delete-region - (point) (progn (forward-line 1) (point))) - nil) - (t - (beginning-of-line) - nil)))) + (while articles + (while (let ((art (read (current-buffer)))) + (cond ((< art (car articles)) + (forward-line 1) + t) + ((= art (car articles)) + (beginning-of-line) + (delete-region + (point) (progn (forward-line 1) (point))) + nil) + (t + (beginning-of-line) + nil)))) - (gnus-agent-copy-nov-line (pop articles))))) + (gnus-agent-copy-nov-line (pop articles))))) - ;; Copy the rest lines - (set-buffer nntp-server-buffer) (goto-char (point-max)) + + ;; Append the remaining lines (when articles (when last (set-buffer gnus-agent-overview-buffer) - (ignore-errors - (while (<= (read (current-buffer)) last) - (forward-line 1))) - (beginning-of-line) (setq start (point)) (set-buffer nntp-server-buffer)) - (insert-buffer-substring gnus-agent-overview-buffer start)))) + + (let ((p (point))) + (insert-buffer-substring gnus-agent-overview-buffer start) + (goto-char p)) + + (setq last (or last -134217728)) + (let (sort art) + (while (not (eobp)) + (setq art (gnus-agent-read-article-number)) + (cond ((not art) + ;; Bad art num - delete this line + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point)))) + ((< art last) + ;; Art num out of order - enable sort + (setq sort t) + (forward-line 1)) + (t + ;; Good art num + (setq last art) + (forward-line 1)))) + (when sort + (sort-numeric-fields 1 (point-min) (point-max))))))) ;; Keeps the compiler from warning about the free variable in ;; gnus-agent-read-agentview. ＠＠ -1735,7 +1948,8 ＠＠ FILE and places the combined headers int (defun gnus-agent-read-agentview (file) "Load FILE and do a `read' there." (with-temp-buffer - (ignore-errors + (condition-case nil + (progn (nnheader-insert-file-contents file) (goto-char (point-min)) (let ((alist (read (current-buffer))) ＠＠ -1744,6 +1958,8 ＠＠ FILE and places the combined headers int changed-version) (cond + ((< version 2) + (error "gnus-agent-read-agentview no longer supports version %d. Stop gnus, manually evaluate gnus-agent-convert-to-compressed-agentview, then restart gnus." version)) ((= version 0) (let ((inhibit-quit t) entry) ＠＠ -1767,8 +1983,9 ＠＠ FILE and places the combined headers int (mapcar (lambda (comp-list) (let ((state (car comp-list)) - (sequence (gnus-uncompress-sequence - (cdr comp-list)))) + (sequence (inline + (gnus-uncompress-range + (cdr comp-list))))) (mapcar (lambda (article-id) (setq uncomp (cons (cons article-id state) uncomp))) sequence))) ＠＠ -1777,7 +1994,8 ＠＠ FILE and places the combined headers int (when changed-version (let ((gnus-agent-article-alist alist)) (gnus-agent-save-alist gnus-agent-read-agentview))) - alist)))) + alist)) + (file-error nil)))) (defun gnus-agent-save-alist (group &optional articles state) "Save the article-state alist for GROUP." ＠＠ -1799,8 +2017,8 ＠＠ FILE and places the combined headers int (setq prev (cdr prev))) (setq gnus-agent-article-alist (cdr all)) - (gnus-agent-set-local group - (caar gnus-agent-article-alist) + (gnus-agent-set-local group + (caar gnus-agent-article-alist) (caar (last gnus-agent-article-alist))) (gnus-make-directory (gnus-agent-article-name "" group)) ＠＠ -1855,12 +2073,13 ＠＠ modified) original contents, they are fi (defun gnus-agent-read-local (file) "Load FILE and do a `read' there." - (let ((my-obarray (gnus-make-hashtable (count-lines (point-min) + (let ((my-obarray (gnus-make-hashtable (count-lines (point-min) (point-max)))) (line 1)) (with-temp-buffer (condition-case nil - (nnheader-insert-file-contents file) + (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file)) (file-error)) (goto-char (point-min)) ＠＠ -1871,7 +2090,7 ＠＠ modified) original contents, they are fi (while (not (eobp)) (condition-case err - (let (group + (let (group min max (cur (current-buffer))) ＠＠ -1889,7 +2108,7 ＠＠ modified) original contents, they are fi file line (error-message-string err)))) (forward-line 1) (setq line (1+ line)))) - + (set (intern "+dirty" my-obarray) nil) (set (intern "+method" my-obarray) gnus-command-method) my-obarray)) ＠＠ -1903,31 +2122,31 ＠＠ modified) original contents, they are fi ;; NOTE: gnus-command-method is used within gnus-agent-lib-file. (dest (gnus-agent-lib-file "local"))) (gnus-make-directory (gnus-agent-lib-file "")) - (with-temp-file dest - (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) - (file-name-coding-system nnmail-pathname-coding-system) - (coding-system-for-write - gnus-agent-file-coding-system) - print-level print-length item article - (standard-output (current-buffer))) - (mapatoms (lambda (symbol) - (cond ((not (boundp symbol)) - nil) - ((member (symbol-name symbol) '("+dirty" "+method")) - nil) - (t - (prin1 symbol) - (let ((range (symbol-value symbol))) - (princ " ") - (princ (car range)) - (princ " ") - (princ (cdr range)) - (princ "\n"))))) - my-obarray))))))) - -(defun gnus-agent-get-local (group) - (let* ((gmane (gnus-group-real-name group)) - (gnus-command-method (gnus-find-method-for-group group)) + + (let ((buffer-file-coding-system gnus-agent-file-coding-system)) + (with-temp-file dest + (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) + (file-name-coding-system nnmail-pathname-coding-system) + print-level print-length item article + (standard-output (current-buffer))) + (mapatoms (lambda (symbol) + (cond ((not (boundp symbol)) + nil) + ((member (symbol-name symbol) '("+dirty" "+method")) + nil) + (t + (prin1 symbol) + (let ((range (symbol-value symbol))) + (princ " ") + (princ (car range)) + (princ " ") + (princ (cdr range)) + (princ "\n"))))) + my-obarray)))))))) + +(defun gnus-agent-get-local (group &optional gmane method) + (let* ((gmane (or gmane (gnus-group-real-name group))) + (gnus-command-method (or method (gnus-find-method-for-group group))) (local (gnus-agent-load-local)) (symb (intern gmane local)) (minmax (and (boundp symb) (symbol-value symb)))) ＠＠ -1941,7 +2160,7 ＠＠ modified) original contents, they are fi (setq minmax (cons (caar alist) (caar (last alist)))) - (gnus-agent-set-local group (car minmax) (cdr minmax) + (gnus-agent-set-local group (car minmax) (cdr minmax) gmane gnus-command-method local)))) minmax)) ＠＠ -1951,7 +2170,7 ＠＠ modified) original contents, they are fi (local (or local (gnus-agent-load-local))) (symb (intern gmane local)) (minmax (and (boundp symb) (symbol-value symb)))) - + (if (cond ((and minmax (or (not (eq min (car minmax))) (not (eq max (cdr minmax))))) ＠＠ -1962,7 +2181,9 ＠＠ modified) original contents, they are fi nil) ((and min max) (set symb (cons min max)) - t)) + t) + (t + (unintern symb local))) (set (intern "+dirty" local) t)))) (defun gnus-agent-article-name (article group) ＠＠ -2012,13 +2233,14 ＠＠ modified) original contents, they are fi group gnus-command-method) (error (unless (funcall gnus-agent-confirmation-function - (format "Error %s. Continue? " + (format "Error %s while fetching session. Should gnus continue? " (error-message-string err))) (error "Cannot fetch articles into the Gnus agent"))) (quit + (gnus-agent-regenerate-group group) (unless (funcall gnus-agent-confirmation-function (format - "Quit fetching session %s. Continue? " + "%s while fetching session. Should gnus continue? " (error-message-string err))) (signal 'quit "Cannot fetch articles into the Gnus agent"))))))))) ＠＠ -2614,7 +2836,7 ＠＠ The following commands are available: It is okay to miss some cases, but there must be no false positives. That is, if this predicate returns true, then indeed the predicate must return only unread articles." - (eq t (gnus-function-implies-unread-1 + (eq t (gnus-function-implies-unread-1 (gnus-category-make-function-1 predicate)))) (defun gnus-function-implies-unread-1 (function) ＠＠ -2735,329 +2957,335 ＠＠ FORCE is equivalent to setting the expir (let ((dir (gnus-agent-group-pathname group))) (when (boundp 'gnus-agent-expire-current-dirs) - (set 'gnus-agent-expire-current-dirs - (cons dir - (symbol-value 'gnus-agent-expire-current-dirs)))) + (set 'gnus-agent-expire-current-dirs + (cons dir + (symbol-value 'gnus-agent-expire-current-dirs)))) (if (and (not force) - (eq 'DISABLE (gnus-agent-find-parameter group - 'agent-enable-expiration))) - (gnus-message 5 "Expiry skipping over %s" group) + (eq 'DISABLE (gnus-agent-find-parameter group + 'agent-enable-expiration))) + (gnus-message 5 "Expiry skipping over %s" group) (gnus-message 5 "Expiring articles in %s" group) (gnus-agent-load-alist group) - (let* ((stats (if (boundp 'gnus-agent-expire-stats) - ;; Use the list provided by my caller - (symbol-value 'gnus-agent-expire-stats) - ;; otherwise use my own temporary list - (list 0 0 0.0))) - (info (gnus-get-info group)) - (alist gnus-agent-article-alist) - (day (- (time-to-days (current-time)) - (gnus-agent-find-parameter group 'agent-days-until-old))) - (specials (if (and alist - (not force)) - ;; This could be a bit of a problem. I need to - ;; keep the last article to avoid refetching - ;; headers when using nntp in the backend. At - ;; the same time, if someone uses a backend - ;; that supports article moving then I may have - ;; to remove the last article to complete the - ;; move. Right now, I'm going to assume that - ;; FORCE overrides specials. - (list (caar (last alist))))) - (unreads ;; Articles that are excluded from the - ;; expiration process - (cond (gnus-agent-expire-all - ;; All articles are marked read by global decree - nil) - ((eq articles t) - ;; All articles are marked read by function - ;; parameter - nil) - ((not articles) - ;; Unread articles are marked protected from - ;; expiration Don't call - ;; gnus-list-of-unread-articles as it returns - ;; articles that have not been fetched into the - ;; agent. - (ignore-errors - (gnus-agent-unread-articles group))) - (t - ;; All articles EXCEPT those named by the caller - ;; are protected from expiration - (gnus-sorted-difference - (gnus-uncompress-range - (cons (caar alist) - (caar (last alist)))) - (sort articles '<))))) - (marked ;; More articles that are excluded from the - ;; expiration process - (cond (gnus-agent-expire-all - ;; All articles are unmarked by global decree - nil) - ((eq articles t) - ;; All articles are unmarked by function - ;; parameter - nil) - (articles - ;; All articles may as well be unmarked as the - ;; unreads list already names the articles we are - ;; going to keep - nil) - (t - ;; Ticked and/or dormant articles are excluded - ;; from expiration - (nconc - (gnus-uncompress-range - (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'dormant - (gnus-info-marks info)))))))) - (nov-file (concat dir ".overview")) - (cnt 0) - (completed -1) - dlist - type) - - ;; The normal article alist contains elements that look like - ;; (article# . fetch_date) I need to combine other - ;; information with this list. For example, a flag indicating - ;; that a particular article MUST BE KEPT. To do this, I'm - ;; going to transform the elements to look like (article# - ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse - ;; the process to generate the expired article alist. - - ;; Convert the alist elements to (article# fetch_date nil - ;; nil). - (setq dlist (mapcar (lambda (e) - (list (car e) (cdr e) nil nil)) alist)) - - ;; Convert the keep lists to elements that look like (article# - ;; nil keep_flag nil) then append it to the expanded dlist - ;; These statements are sorted by ascending precidence of the - ;; keep_flag. - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'unread nil)) - unreads))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'marked nil)) - marked))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'special nil)) - specials))) + (let* ((bytes-freed 0) + (files-deleted 0) + (nov-entries-deleted 0) + (info (gnus-get-info group)) + (alist gnus-agent-article-alist) + (day (- (time-to-days (current-time)) + (gnus-agent-find-parameter group 'agent-days-until-old))) + (specials (if (and alist + (not force)) + ;; This could be a bit of a problem. I need to + ;; keep the last article to avoid refetching + ;; headers when using nntp in the backend. At + ;; the same time, if someone uses a backend + ;; that supports article moving then I may have + ;; to remove the last article to complete the + ;; move. Right now, I'm going to assume that + ;; FORCE overrides specials. + (list (caar (last alist))))) + (unreads ;; Articles that are excluded from the + ;; expiration process + (cond (gnus-agent-expire-all + ;; All articles are marked read by global decree + nil) + ((eq articles t) + ;; All articles are marked read by function + ;; parameter + nil) + ((not articles) + ;; Unread articles are marked protected from + ;; expiration Don't call + ;; gnus-list-of-unread-articles as it returns + ;; articles that have not been fetched into the + ;; agent. + (ignore-errors + (gnus-agent-unread-articles group))) + (t + ;; All articles EXCEPT those named by the caller + ;; are protected from expiration + (gnus-sorted-difference + (gnus-uncompress-range + (cons (caar alist) + (caar (last alist)))) + (sort articles '<))))) + (marked ;; More articles that are excluded from the + ;; expiration process + (cond (gnus-agent-expire-all + ;; All articles are unmarked by global decree + nil) + ((eq articles t) + ;; All articles are unmarked by function + ;; parameter + nil) + (articles + ;; All articles may as well be unmarked as the + ;; unreads list already names the articles we are + ;; going to keep + nil) + (t + ;; Ticked and/or dormant articles are excluded + ;; from expiration + (nconc + (gnus-uncompress-range + (cdr (assq 'tick (gnus-info-marks info)))) + (gnus-uncompress-range + (cdr (assq 'dormant + (gnus-info-marks info)))))))) + (nov-file (concat dir ".overview")) + (cnt 0) + (completed -1) + dlist + type) + + ;; The normal article alist contains elements that look like + ;; (article# . fetch_date) I need to combine other + ;; information with this list. For example, a flag indicating + ;; that a particular article MUST BE KEPT. To do this, I'm + ;; going to transform the elements to look like (article# + ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse + ;; the process to generate the expired article alist. + + ;; Convert the alist elements to (article# fetch_date nil + ;; nil). + (setq dlist (mapcar (lambda (e) + (list (car e) (cdr e) nil nil)) alist)) + + ;; Convert the keep lists to elements that look like (article# + ;; nil keep_flag nil) then append it to the expanded dlist + ;; These statements are sorted by ascending precidence of the + ;; keep_flag. + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'unread nil)) + unreads))) + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'marked nil)) + marked))) + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'special nil)) + specials))) - (set-buffer overview) - (erase-buffer) - (buffer-disable-undo) - (when (file-exists-p nov-file) - (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 - ;; If I successfully read an integer (the plus zero - ;; ensures a numeric type), prepend a marker entry - ;; to the list - (push (list (+ 0 (read (current-buffer))) nil nil - (set-marker (make-marker) p)) - dlist) - (error - (gnus-message 1 "gnus-agent-expire: read error \ + (set-buffer overview) + (erase-buffer) + (buffer-disable-undo) + (when (file-exists-p nov-file) + (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 + ;; If I successfully read an integer (the plus zero + ;; ensures a numeric type), prepend a marker entry + ;; to the list + (push (list (+ 0 (read (current-buffer))) nil nil + (set-marker (make-marker) p)) + dlist) + (error + (gnus-message 1 "gnus-agent-expire: read error \ occurred when reading expression at %s in %s. Skipping to next \ line." (point) nov-file))) - ;; Whether I succeeded, or failed, it doesn't matter. - ;; Move to the next line then try again. - (forward-line 1))) - - (gnus-message - 7 "gnus-agent-expire: Loading overview... Done")) - (set-buffer-modified-p nil) - - ;; At this point, all of the information is in dlist. The - ;; only problem is that much of it is spread across multiple - ;; entries. Sort then MERGE!! - (gnus-message 7 "gnus-agent-expire: Sorting entries... ") - ;; If two entries have the same article-number then sort by - ;; ascending keep_flag. - (let ((special 0) - (marked 1) - (unread 2)) - (setq dlist - (sort dlist - (lambda (a b) - (cond ((< (nth 0 a) (nth 0 b)) - t) - ((> (nth 0 a) (nth 0 b)) - nil) - (t - (let ((a (or (symbol-value (nth 2 a)) - 3)) - (b (or (symbol-value (nth 2 b)) - 3))) - (<= a b)))))))) - (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") - (gnus-message 7 "gnus-agent-expire: Merging entries... ") - (let ((dlist dlist)) - (while (cdr dlist) ; I'm not at the end-of-list - (if (eq (caar dlist) (caadr dlist)) - (let ((first (cdr (car dlist))) - (secnd (cdr (cadr dlist)))) - (setcar first (or (car first) - (car secnd))) ; fetch_date - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) - (car secnd))) ; Keep_flag - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) - (car secnd))) ; NOV_entry_marker - - (setcdr dlist (cddr dlist))) - (setq dlist (cdr dlist))))) - (gnus-message 7 "gnus-agent-expire: Merging entries... Done") - - (let* ((len (float (length dlist))) - (alist (list nil)) - (tail-alist alist)) - (while dlist - (let ((new-completed (truncate (* 100.0 - (/ (setq cnt (1+ cnt)) - len)))) + ;; Whether I succeeded, or failed, it doesn't matter. + ;; Move to the next line then try again. + (forward-line 1))) + + (gnus-message + 7 "gnus-agent-expire: Loading overview... Done")) + (set-buffer-modified-p nil) + + ;; At this point, all of the information is in dlist. The + ;; only problem is that much of it is spread across multiple + ;; entries. Sort then MERGE!! + (gnus-message 7 "gnus-agent-expire: Sorting entries... ") + ;; If two entries have the same article-number then sort by + ;; ascending keep_flag. + (let ((special 0) + (marked 1) + (unread 2)) + (setq dlist + (sort dlist + (lambda (a b) + (cond ((< (nth 0 a) (nth 0 b)) + t) + ((> (nth 0 a) (nth 0 b)) + nil) + (t + (let ((a (or (symbol-value (nth 2 a)) + 3)) + (b (or (symbol-value (nth 2 b)) + 3))) + (<= a b)))))))) + (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") + (gnus-message 7 "gnus-agent-expire: Merging entries... ") + (let ((dlist dlist)) + (while (cdr dlist) ; I'm not at the end-of-list + (if (eq (caar dlist) (caadr dlist)) + (let ((first (cdr (car dlist))) + (secnd (cdr (cadr dlist)))) + (setcar first (or (car first) + (car secnd))) ; fetch_date + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) + (car secnd))) ; Keep_flag + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) + (car secnd))) ; NOV_entry_marker + + (setcdr dlist (cddr dlist))) + (setq dlist (cdr dlist))))) + (gnus-message 7 "gnus-agent-expire: Merging entries... Done") + + (let* ((len (float (length dlist))) + (alist (list nil)) + (tail-alist alist)) + (while dlist + (let ((new-completed (truncate (* 100.0 + (/ (setq cnt (1+ cnt)) + len)))) message-log-max) - (when (> new-completed completed) - (setq completed new-completed) - (gnus-message 7 "%3d%% completed..." completed))) - (let* ((entry (car dlist)) - (article-number (nth 0 entry)) - (fetch-date (nth 1 entry)) - (keep (nth 2 entry)) - (marker (nth 3 entry))) - - (cond - ;; Kept articles are unread, marked, or special. - (keep - (gnus-agent-message 10 - "gnus-agent-expire: %s:%d: Kept %s article%s." - group article-number keep (if fetch-date " and file" "")) - (when fetch-date - (unless (file-exists-p - (concat dir (number-to-string - article-number))) - (setf (nth 1 entry) nil) - (gnus-agent-message 3 "gnus-agent-expire cleared \ + (when (> new-completed completed) + (setq completed new-completed) + (gnus-message 7 "%3d%% completed..." completed))) + (let* ((entry (car dlist)) + (article-number (nth 0 entry)) + (fetch-date (nth 1 entry)) + (keep (nth 2 entry)) + (marker (nth 3 entry))) + + (cond + ;; Kept articles are unread, marked, or special. + (keep + (gnus-agent-message 10 + "gnus-agent-expire: %s:%d: Kept %s article%s." + group article-number keep (if fetch-date " and file" "")) + (when fetch-date + (unless (file-exists-p + (concat dir (number-to-string + article-number))) + (setf (nth 1 entry) nil) + (gnus-agent-message 3 "gnus-agent-expire cleared \ download flag on %s:%d as the cached article file is missing." - group (caar dlist))) - (unless marker - (gnus-message 1 "gnus-agent-expire detected a \ + group (caar dlist))) + (unless marker + (gnus-message 1 "gnus-agent-expire detected a \ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) - (gnus-agent-append-to-list - tail-alist - (cons article-number fetch-date))) - - ;; The following articles are READ, UNMARKED, and - ;; ORDINARY. See if they can be EXPIRED!!! - ((setq type - (cond - ((not (integerp fetch-date)) - 'read) ;; never fetched article (may expire - ;; right now) - ((not (file-exists-p - (concat dir (number-to-string - article-number)))) - (setf (nth 1 entry) nil) - 'externally-expired) ;; Can't find the cached - ;; article. Handle case - ;; as though this article - ;; was never fetched. - - ;; We now have the arrival day, so we see - ;; whether it's old enough to be expired. - ((< fetch-date day) - 'expired) - (force - 'forced))) - - ;; I found some reason to expire this entry. - - (let ((actions nil)) - (when (memq type '(forced expired)) - (ignore-errors ; Just being paranoid. - (let ((file-name (concat dir (number-to-string - article-number)))) - (incf (nth 2 stats) (nth 7 (file-attributes file-name))) - (incf (nth 1 stats)) - (delete-file file-name)) - (push "expired cached article" actions)) - (setf (nth 1 entry) nil) - ) - - (when marker - (push "NOV entry removed" actions) - (goto-char marker) - - (incf (nth 0 stats)) - - (let ((from (gnus-point-at-bol)) - (to (progn (forward-line 1) (point)))) - (incf (nth 2 stats) (- to from)) - (delete-region from to))) - - ;; If considering all articles is set, I can only - ;; expire article IDs that are no longer in the - ;; active range (That is, articles that preceed the - ;; first article in the new alist). - (if (and gnus-agent-consider-all-articles - (>= article-number (car active))) - ;; I have to keep this ID in the alist - (gnus-agent-append-to-list - tail-alist (cons article-number fetch-date)) - (push (format "Removed %s article number from \ + (gnus-agent-append-to-list + tail-alist + (cons article-number fetch-date))) + + ;; The following articles are READ, UNMARKED, and + ;; ORDINARY. See if they can be EXPIRED!!! + ((setq type + (cond + ((not (integerp fetch-date)) + 'read) ;; never fetched article (may expire + ;; right now) + ((not (file-exists-p + (concat dir (number-to-string + article-number)))) + (setf (nth 1 entry) nil) + 'externally-expired) ;; Can't find the cached + ;; article. Handle case + ;; as though this article + ;; was never fetched. + + ;; We now have the arrival day, so we see + ;; whether it's old enough to be expired. + ((< fetch-date day) + 'expired) + (force + 'forced))) + + ;; I found some reason to expire this entry. + + (let ((actions nil)) + (when (memq type '(forced expired)) + (ignore-errors ; Just being paranoid. + (let* ((file-name (nnheader-concat dir (number-to-string + article-number))) + (size (float (nth 7 (file-attributes file-name))))) + (incf bytes-freed size) + (incf files-deleted) + (delete-file file-name)) + (push "expired cached article" actions)) + (setf (nth 1 entry) nil) + ) + + (when marker + (push "NOV entry removed" actions) + (goto-char marker) + + (incf nov-entries-deleted) + + (let ((from (gnus-point-at-bol)) + (to (progn (forward-line 1) (point)))) + (incf bytes-freed (- to from)) + (delete-region from to))) + + ;; If considering all articles is set, I can only + ;; expire article IDs that are no longer in the + ;; active range (That is, articles that preceed the + ;; first article in the new alist). + (if (and gnus-agent-consider-all-articles + (>= article-number (car active))) + ;; I have to keep this ID in the alist + (gnus-agent-append-to-list + tail-alist (cons article-number fetch-date)) + (push (format "Removed %s article number from \ article alist" type) actions)) (when actions (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" group article-number (mapconcat 'identity actions ", "))))) - (t - (gnus-agent-message - 10 "gnus-agent-expire: %s:%d: Article kept as \ + (t + (gnus-agent-message + 10 "gnus-agent-expire: %s:%d: Article kept as \ expiration tests failed." group article-number) - (gnus-agent-append-to-list - tail-alist (cons article-number fetch-date))) - ) - - ;; Clean up markers as I want to recycle this buffer - ;; over several groups. - (when marker - (set-marker marker nil)) - - (setq dlist (cdr dlist)))) - - (setq alist (cdr alist)) - - (let ((inhibit-quit t)) - (unless (equal alist gnus-agent-article-alist) - (setq gnus-agent-article-alist alist) - (gnus-agent-save-alist group)) - - (when (buffer-modified-p) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (gnus-make-directory dir) - (write-region (point-min) (point-max) nov-file nil - 'silent) - ;; clear the modified flag as that I'm not confused by - ;; its status on the next pass through this routine. - (set-buffer-modified-p nil))) - - (when (eq articles t) - (gnus-summary-update-info)))))))) + (gnus-agent-append-to-list + tail-alist (cons article-number fetch-date))) + ) + + ;; Clean up markers as I want to recycle this buffer + ;; over several groups. + (when marker + (set-marker marker nil)) + + (setq dlist (cdr dlist)))) + + (setq alist (cdr alist)) + + (let ((inhibit-quit t)) + (unless (equal alist gnus-agent-article-alist) + (setq gnus-agent-article-alist alist) + (gnus-agent-save-alist group)) + + (when (buffer-modified-p) + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (gnus-make-directory dir) + (write-region (point-min) (point-max) nov-file nil + 'silent) + ;; clear the modified flag as that I'm not confused by + ;; its status on the next pass through this routine. + (set-buffer-modified-p nil))) + + (when (eq articles t) + (gnus-summary-update-info)))) + + (when (boundp 'gnus-agent-expire-stats) + (let ((stats (symbol-value 'gnus-agent-expire-stats))) + (incf (nth 2 stats) bytes-freed) + (incf (nth 1 stats) files-deleted) + (incf (nth 0 stats) nov-entries-deleted))) + )))) (defun gnus-agent-expire (&optional articles group force) "Expire all old articles. ＠＠ -3071,7 +3299,7 ＠＠ The articles on which the expiration pro Setting GROUP will limit expiration to that group. FORCE is equivalent to setting the expiration predicates to true." (interactive) - + (if group (gnus-agent-expire-group group articles force) (if (or (not (eq articles t)) ＠＠ -3100,7 +3328,7 ＠＠ articles in every agentized group.")) gnus-command-method)) (let* ((active (gnus-gethash-safe expiring-group orig))) - + (when active (save-excursion (gnus-agent-expire-group-1 ＠＠ -3121,9 +3349,9 ＠＠ articles in every agentized group.")) units (cdr units))) (format "Expiry recovered %d NOV entries, deleted %d files,\ - and freed %f %s." - (nth 0 stats) - (nth 1 stats) + and freed %f %s." + (nth 0 stats) + (nth 1 stats) size (car units))) "Expiry...done")) ＠＠ -3151,9 +3379,9 ＠＠ articles in every agentized group.")) (checker (function (lambda (d) - "Given a directory, check it and its subdirectories for - membership in the keep hash. If it isn't found, add - it to to-remove." + "Given a directory, check it and its subdirectories for + membership in the keep hash. If it isn't found, add + it to to-remove." (let ((files (directory-files d)) file) (while (setq file (pop files)) ＠＠ -3161,7 +3389,7 ＠＠ articles in every agentized group.")) nil) ((equal file "..") ; Ignore parent nil) - ((equal file ".overview") + ((equal file ".overview") ;; Directory must contain .overview to be ;; agent's cache of a group. (let ((d (file-name-as-directory d)) ＠＠ -3174,7 +3402,7 ＠＠ articles in every agentized group.")) d (directory-file-name d))) ;; if ANY ancestor was NOT in keep hash and ;; it it's already in to-remove, add it to - ;; to-remove. + ;; to-remove. (if (and r (not (member r to-remove))) (push r to-remove)))) ＠＠ -3248,7 +3476,7 ＠＠ articles in every agentized group.")) (defun gnus-agent-uncached-articles (articles group &optional cached-header) "Restrict ARTICLES to numbers already fetched. -Returns a sublist of ARTICLES that excludes thos article ids in GROUP +Returns a sublist of ARTICLES that excludes those article ids in GROUP that have already been fetched. If CACHED-HEADER is nil, articles are only excluded if the article itself has been fetched." ＠＠ -3338,12 +3566,11 ＠＠ has been fetched." ;; Get the list of articles that were fetched (goto-char (point-min)) - (let ((pm (point-max))) + (let ((pm (point-max)) + art) (while (< (point) pm) - (when (looking-at "[0-9]+\t") - (gnus-agent-append-to-list - tail-fetched-articles - (read (current-buffer)))) + (when (setq art (gnus-agent-read-article-number)) + (gnus-agent-append-to-list tail-fetched-articles art)) (forward-line 1))) ;; Clip this list to the headers that will ＠＠ -3380,12 +3607,12 ＠＠ has been fetched." (set-buffer nntp-server-buffer) (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) - ;; Merge the temp buffer with the known headers (found on - ;; disk in FILE) into the nntp-server-buffer - (when (and uncached-articles (file-exists-p file)) + ;; Merge the temp buffer with the known headers (found on + ;; disk in FILE) into the nntp-server-buffer + (when uncached-articles (gnus-agent-braid-nov group uncached-articles file)) - ;; Save the new set of known headers to FILE + ;; Save the new set of known headers to FILE (set-buffer nntp-server-buffer) (let ((coding-system-for-write gnus-agent-file-coding-system)) ＠＠ -3465,7 +3692,6 ＠＠ If REREAD is not nil, downloaded article (gnus-message 3 "Ignoring unexpected input") (sit-for 1) t))))) - (when group (gnus-message 5 "Regenerating in %s" group) (let* ((gnus-command-method (or gnus-command-method ＠＠ -3506,7 +3732,7 ＠＠ If REREAD is not nil, downloaded article (gnus-delete-line) (setq nov-arts (cdr nov-arts)) (gnus-message 4 "gnus-agent-regenerate-group: NOV\ -entry of article %s deleted." l1)) + entry of article %s deleted." l1)) ((not l2) nil) ((< l1 l2) ＠＠ -3628,7 +3854,7 ＠＠ entry of article %s deleted." l1)) (when regenerated (gnus-agent-save-alist group) - + ;; I have to alter the group's active range NOW as ;; gnus-make-ascending-articles-unread will use it to ;; recalculate the number of unread articles in the group ＠＠ -3651,10 +3877,9 ＠＠ entry of article %s deleted." l1)) gnus-agent-article-alist)))) (when (gnus-buffer-live-p gnus-group-buffer) - (gnus-group-update-group group t) - (sit-for 0))) + (gnus-group-update-group group t))) - (gnus-message 5 nil) + (gnus-message 5 "") regenerated))) ;;;###autoload ＠＠ -3699,49 +3924,6 ＠＠ If CLEAN, obsolete (ignore)." (defun gnus-agent-group-covered-p (group) (gnus-agent-method-p (gnus-group-method group))) - -(add-hook 'gnus-group-prepare-hook - (lambda () - 'gnus-agent-do-once - - (when (listp gnus-agent-expire-days) - (beep) - (beep) - (gnus-message 1 "WARNING: gnus-agent-expire-days no longer\ - supports being set to a list.")(sleep-for 3) - (gnus-message 1 "Change your configuration to set it to an\ - integer.")(sleep-for 3) - (gnus-message 1 "I am now setting group parameters on each\ - group to match the configuration that the list offered.") - - (save-excursion - (let ((groups (gnus-group-listed-groups))) - (while groups - (let* ((group (pop groups)) - (days gnus-agent-expire-days) - (day (catch 'found - (while days - (when (eq 0 (string-match - (caar days) - group)) - (throw 'found (cadar days))) - (setq days (cdr days))) - nil))) - (when day - (gnus-group-set-parameter group 'agent-days-until-old - day)))))) - - (let ((h gnus-group-prepare-hook)) - (while h - (let ((func (pop h))) - (when (and (listp func) - (eq (cadr (caddr func)) 'gnus-agent-do-once)) - (remove-hook 'gnus-group-prepare-hook func) - (setq h nil))))) - - (gnus-message 1 "I have finished setting group parameters on\ - each group. You may now customize your groups and/or topics to control the\ - agent.")))) (provide 'gnus-agent) Index: lisp/gnus-art.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-art.el,v retrieving revision 1.5 diff -u -p -u -r1.5 gnus-art.el --- lisp/gnus-art.el 28 Sep 2004 02:21:04 -0000 1.5 +++ lisp/gnus-art.el 13 Mar 2005 00:11:36 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -213,7 +213,7 ＠＠ By default, if you set this t, then Gnus signatures, but will never scroll down to show you a page consisting only of boring text. Boring text is controlled by `gnus-article-boring-faces'." -:version "21.4" +:version "22.1" :type 'boolean :group 'gnus-article-hiding) ＠＠ -318,29 +318,58 ＠＠ advertisements. For example: (symbol :tag "Item in `gnus-article-banner-alist'" none) regexp (const :tag "None" nil)))) +:version "22.1" :group 'gnus-article-washing) +(defmacro gnus-emphasis-custom-with-format (&rest body) + `(let ((format "\ +\$\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\$\$%s\\(\\w+\\(\\s-+\\w+\$*[.,]?\\)%s\\)\ +\$\\([-,.;:!?\"]\\|\\s)\$+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")) + ,＠body)) + +(defun gnus-emphasis-custom-value-to-external (value) + (gnus-emphasis-custom-with-format + (if (consp (car value)) + (list (format format (car (car value)) (cdr (car value))) + 2 + (if (nth 1 value) 2 3) + (nth 2 value)) + value))) + +(defun gnus-emphasis-custom-value-to-internal (value) + (gnus-emphasis-custom-with-format + (let ((regexp (concat "\\`" + (format (regexp-quote format) + "\$[^()]+\$" "\$[^()]+\$") + "\\'")) + pattern) + (if (string-match regexp (setq pattern (car value))) + (list (cons (match-string 1 pattern) (match-string 2 pattern)) + (= (nth 2 value) 2) + (nth 3 value)) + value)))) + (defcustom gnus-emphasis-alist - (let ((format - "\$\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\$\$%s\\(\\w+\\(\\s-+\\w+\$*[.,]?\\)%s\\)\$\\([-,.;:!?\"]\\|\\s)\$+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)") - (types - '(("\\*" "\\*" bold) + (let ((types + '(("\\*" "\\*" bold nil 2) ("_" "_" underline) ("/" "/" italic) ("_/" "/_" underline-italic) ("_\\*" "\\*_" underline-bold) ("\\*/" "/\\*" bold-italic) ("_\\*/" "/\\*_" underline-bold-italic)))) - `(,＠(mapcar - (lambda (spec) - (list - (format format (car spec) (cadr spec)) - 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) - types) - ("\$\\s-\\|^\$\$-\\(\\(\\w\\|-[^-]\$+\\)-\\)\$\\s-\\|[?!.,;]\$" - 2 3 gnus-emphasis-strikethru) - ("\$\\s-\\|^\$\$_\\(\\(\\w\\|_[^_]\$+\\)_\\)\$\\s-\\|[?!.,;]\$" - 2 3 gnus-emphasis-underline))) + (nconc + (gnus-emphasis-custom-with-format + (mapcar (lambda (spec) + (list (format format (car spec) (cadr spec)) + (or (nth 3 spec) 2) + (or (nth 4 spec) 3) + (intern (format "gnus-emphasis-%s" (nth 2 spec))))) + types)) + '(("\$\\s-\\|^\$\$-\\(\\(\\w\\|-[^-]\$+\\)-\\)\$\\s-\\|[?!.,;]\$" + 2 3 gnus-emphasis-strikethru) + ("\$\\s-\\|^\$\$_\\(\\(\\w\\|_[^_]\$+\\)_\\)\$\\s-\\|[?!.,;]\$" + 2 3 gnus-emphasis-underline)))) "*Alist that says how to fontify certain phrases. Each item looks like this: ＠＠ -351,11 +380,43 ＠＠ is a number that says what regular expre the entire emphasized word. The third is a number that says what regexp grouping should be displayed and highlighted. The fourth is the face used for highlighting." -:type '(repeat (list :value ("" 0 0 default) - regexp - (integer :tag "Match group") - (integer :tag "Emphasize group") - face)) +:type + '(repeat + (menu-choice +:format "%[Customizing Style%]\n%v" +:indent 2 + (group :tag "Default" + :value ("" 0 0 default) + :value-create + (lambda (widget) + (let ((value (widget-get + (cadr (widget-get (widget-get widget :parent) + :args)) + :value))) + (if (not (eq (nth 2 value) 'default)) + (widget-put + widget + :value + (gnus-emphasis-custom-value-to-external value)))) + (widget-group-value-create widget)) + regexp + (integer :format "Match group: %v") + (integer :format "Emphasize group: %v") + face) + (group :tag "Simple" + :value (("_" . "_") nil default) + (cons :format "%v" + (regexp :format "Start regexp: %v") + (regexp :format "End regexp: %v")) + (boolean :format "Show start and end patterns: %[%v%]\n" + :on " On " :off " Off ") + face))) +:get (lambda (symbol) + (mapcar 'gnus-emphasis-custom-value-to-internal + (default-value symbol))) +:set (lambda (symbol value) + (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external + value))) :group 'gnus-article-emphasis) (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n" ＠＠ -745,7 +806,7 ＠＠ If set, this variable overrides `gnus-un To see e.g. security buttons you could set this to `(\"multipart/signed\")'. This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." -:version "21.4" +:version "22.1" :group 'gnus-article-mime :type '(repeat regexp)) ＠＠ -754,14 +815,14 ＠＠ This variable is only used when `gnus-in When nil (the default value), then some MIME parts do not get buttons, as described by the variables `gnus-buttonized-mime-types' and `gnus-unbuttonized-mime-types'." -:version "21.4" +:version "22.1" :type 'boolean) (defcustom gnus-body-boundary-delimiter "_" "String used to delimit header and body. This variable is used by `gnus-article-treat-body-boundary' which can be controlled by `gnus-treat-body-boundary'." -:version "21.4" +:version "22.1" :group 'gnus-article-various :type '(choice (item :tag "None" :value nil) string)) ＠＠ -770,7 +831,7 ＠＠ be controlled by `gnus-treat-body-bounda "Defines the location of the faces database. For information on obtaining this database of pretty pictures, please see http://www.cs.indiana.edu/picons/ftp/index.html" -:version "21.4" +:version "22.1" :type '(repeat directory) :link '(url-link :tag "download" "http://www.cs.indiana.edu/picons/ftp/index.html") ＠＠ -911,7 +972,7 ＠＠ See Info node `(gnus)Customizing Article "Remove carriage returns. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." -:version "21.4" +:version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) ＠＠ -920,6 +981,7 ＠＠ See Info node `(gnus)Customizing Article "Remove newlines from within URLs. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." +:version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) ＠＠ -928,7 +990,7 ＠＠ See Info node `(gnus)Customizing Article "Remove leading whitespace in headers. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." -:version "21.4" +:version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) ＠＠ -1048,7 +1110,7 ＠＠ See Info node `(gnus)Customizing Article "Display the Date in a format that can be read aloud in English. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." -:version "21.4" +:version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) ＠＠ -1124,6 +1186,7 ＠＠ See Info node `(gnus)Customizing Article "Unfold folded header lines. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." +:version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) ＠＠ -1132,7 +1195,7 ＠＠ See Info node `(gnus)Customizing Article "Fold headers. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." -:version "21.4" +:version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) ＠＠ -1141,7 +1204,7 ＠＠ See Info node `(gnus)Customizing Article "Fold the Newsgroups and Followup-To headers. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." -:version "21.4" +:version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) ＠＠ -1207,7 +1270,7 ＠＠ Valid values are nil, t, `head', `last', See Info node `(gnus)Customizing Articles' and Info node `(gnus)X-Face' for details." :group 'gnus-article-treat -:version "21.4" +:version "22.1" :link '(custom-manual "(gnus)Customizing Articles") :link '(custom-manual "(gnus)X-Face") :type gnus-article-treat-head-custom) ＠＠ -1238,6 +1301,7 ＠＠ See Info node `(gnus)Customizing Article Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." +:version "22.1" :group 'gnus-article-treat :group 'gnus-picon :link '(custom-manual "(gnus)Customizing Articles") ＠＠ -1253,6 +1317,7 ＠＠ See Info node `(gnus)Customizing Article Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." +:version "22.1" :group 'gnus-article-treat :group 'gnus-picon :link '(custom-manual "(gnus)Customizing Articles") ＠＠ -1268,7 +1333,7 ＠＠ See Info node `(gnus)Customizing Article Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." -:version "21.4" +:version "22.1" :group 'gnus-article-treat :group 'gnus-picon :link '(custom-manual "(gnus)Customizing Articles") ＠＠ -1284,7 +1349,7 ＠＠ See Info node `(gnus)Customizing Article "Draw a boundary at the end of the headers. Valid values are nil and `head'. See Info node `(gnus)Customizing Articles' for details." -:version "21.4" +:version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) ＠＠ -1302,7 +1367,7 ＠＠ See Info node `(gnus)Customizing Article "Format as HTML. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." -:version "21.4" +:version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) ＠＠ -1338,6 +1403,7 ＠＠ See Info node `(gnus)Customizing Article To automatically treat X-PGP-Sig, set it to head. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." +:version "22.1" :group 'gnus-article-treat :group 'mime-security :link '(custom-manual "(gnus)Customizing Articles") ＠＠ -1351,7 +1417,7 ＠＠ See Info node `(gnus)Customizing Article (defcustom gnus-article-encrypt-protocol "PGP" "The protocol used for encrypt articles. It is a string, such as \"PGP\". If nil, ask user." -:version "21.4" +:version "22.1" :type 'string :group 'mime-security) ＠＠ -1363,13 +1429,13 ＠＠ It is a string, such as \"PGP\". If nil, (executable-find idna-program)) "Whether IDNA decoding of headers is used when viewing messages. This requires GNU Libidn, and by default only enabled if it is found." -:version "21.4" +:version "22.1" :group 'gnus-article-headers :type 'boolean) (defcustom gnus-article-over-scroll nil "If non-nil, allow scrolling the article buffer even when there no more text." -:version "21.4" +:version "22.1" :group 'gnus-article :type 'boolean) ＠＠ -1464,6 +1530,8 ＠＠ Initialized from `text-mode-syntax-table (defvar gnus-inhibit-hiding nil) +(defvar gnus-article-edit-mode nil) + ;;; Macros for dealing with the article buffer. (defmacro gnus-with-article-headers (&rest forms) ＠＠ -3643,6 +3711,8 ＠＠ commands: (make-local-variable 'gnus-article-image-alist) (make-local-variable 'gnus-article-charset) (make-local-variable 'gnus-article-ignored-charsets) + ;; Prevent recent Emacsen from displaying non-break space as "\ ". + (set (make-local-variable 'show-nonbreak-escape) nil) (gnus-set-default-directory) (buffer-disable-undo) (setq buffer-read-only t) ＠＠ -3675,14 +3745,19 ＠＠ commands: (mm-enable-multibyte) (setq major-mode 'gnus-original-article-mode) (make-local-variable 'gnus-original-article)) - (if (get-buffer name) + (if (and (get-buffer name) + (with-current-buffer name + (if gnus-article-edit-mode + (if (y-or-n-p "Article mode edit in progress; discard? ") + (progn + (set-buffer-modified-p nil) + (gnus-kill-buffer name) + (message "") + nil) + (error "Action aborted")) + t))) (save-excursion (set-buffer name) - (when (and gnus-article-edit-mode - (buffer-modified-p) - (not - (y-or-n-p "Article mode edit in progress; discard? "))) - (error "Action aborted")) (set (make-local-variable 'gnus-article-edit-mode) nil) (when gnus-article-mime-handles (mm-destroy-parts gnus-article-mime-handles) ＠＠ -4279,7 +4354,16 ＠＠ are decompressed." (setq charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (mm-read-coding-system "Charset: "))))) + (mm-read-coding-system "Charset: ")))) + (t + (if (mm-handle-undisplayer handle) + (mm-remove-part handle)) + (setq contents + (if (fboundp 'string-to-multibyte) + (string-to-multibyte contents) + (mapconcat + (lambda (ch) (mm-string-as-multibyte (char-to-string ch))) + contents ""))))) (forward-line 2) (mm-insert-inline handle (if (and charset ＠＠ -4619,7 +4703,7 ＠＠ If t, it overrides nil values of (defcustom gnus-mime-display-multipart-alternative-as-mixed nil "Display \"multipart/alternative\" parts as \"multipart/mixed\"." -:version "21.4" +:version "22.1" :group 'gnus-article-mime :type 'boolean) ＠＠ -4629,7 +4713,7 ＠＠ If t, it overrides nil values of If displaying \"text/html\" is discouraged $see `mm-discouraged-alternatives'$ images or other material inside a \"multipart/related\" part might be overlooked when this variable is nil." -:version "21.4" +:version "22.1" :group 'gnus-article-mime :type 'boolean) ＠＠ -4998,7 +5082,7 ＠＠ If given a numerical ARG, move forward A (goto-char (point-min)) (gnus-insert-prev-page-button))) (when (and (gnus-visual-p 'page-marker) - (< (+ (point-max) 2) (buffer-size))) + (< (point-max) (save-restriction (widen) (point-max)))) (save-excursion (goto-char (point-max)) (gnus-insert-next-page-button)))))) ＠＠ -5643,7 +5727,10 ＠＠ groups." "Start editing the contents of the current article buffer." (let ((winconf (current-window-configuration))) (set-buffer gnus-article-buffer) - (gnus-article-edit-mode) + (let ((message-auto-save-directory + ;; Don't associate the article buffer with a draft file. + nil)) + (gnus-article-edit-mode)) (funcall start-func) (set-buffer-modified-p nil) (gnus-configure-windows 'edit-article) ＠＠ -5734,7 +5821,7 ＠＠ groups." (defcustom gnus-button-valid-fqdn-regexp message-valid-fqdn-regexp "Regular expression that matches a valid FQDN." -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :type 'regexp) ＠＠ -5742,7 +5829,7 ＠＠ groups." "Function to use for displaying man pages. The function must take at least one argument with a string naming the man page." -:version "21.4" +:version "22.1" :type '(choice (function-item :tag "Man" manual-entry) (function-item :tag "Woman" woman) (function :tag "Other")) ＠＠ -5753,7 +5840,7 ＠＠ man page." If the default site is too slow, try to find a CTAN mirror, see <URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>. See also the variable `gnus-button-handle-ctan'." -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :link '(custom-manual "(gnus)Group Parameters") :type '(choice (const "http://www.tex.ac.uk/tex-archive/") ＠＠ -5764,14 +5851,14 ＠＠ the variable `gnus-button-handle-ctan'." (defcustom gnus-button-ctan-handler 'browse-url "Function to use for displaying CTAN links. The function must take one argument, the string naming the URL." -:version "21.4" +:version "22.1" :type '(choice (function-item :tag "Browse Url" browse-url) (function :tag "Other")) :group 'gnus-article-buttons) (defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/" "Bogus strings removed from CTAN URLs." -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :type '(choice (const "^/?tex-archive/\\|/") (regexp :tag "Other"))) ＠＠ -5785,7 +5872,7 ＠＠ The function must take one argument, the "\\)") "Regular expression for ctan directories. It should match all directories in the top level of `gnus-ctan-url'." -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :type 'regexp) ＠＠ -5795,7 +5882,7 ＠＠ It should match all directories in the t gnus-button-valid-fqdn-regexp ">?\\)\\b") "Regular expression that matches a message ID or a mail address." -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :type 'regexp) ＠＠ -5807,7 +5894,7 ＠＠ message ID or a mail address, respective symbol `ask', always query the user what do do. If it is a function, this function will be called with the string as it's only argument. The function must return `mid', `mail', `invalid' or `ask'." -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :type '(choice (function-item :tag "Heuristic function" gnus-button-mid-or-mail-heuristic) ＠＠ -5871,7 +5958,7 ＠＠ must return `mid', `mail', `invalid' or A negative RATE indicates a message IDs, whereas a positive indicates a mail address. The REGEXP is processed with `case-fold-search' set to nil." -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :type '(repeat (cons (number :tag "Rate") (regexp :tag "Regexp")))) ＠＠ -6056,7 +6143,7 ＠＠ positives are possible. Note that you c specific groups. Setting it higher in TeX groups is probably a good idea. See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on how to set variables in specific groups." -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :link '(custom-manual "(gnus)Group Parameters") :type 'integer) ＠＠ -6068,7 +6155,7 ＠＠ positives are possible. Note that you c specific groups. Setting it higher in Unix groups is probably a good idea. See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on how to set variables in specific groups." -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :link '(custom-manual "(gnus)Group Parameters") :type 'integer) ＠＠ -6080,7 +6167,7 ＠＠ positives are possible. Note that you c specific groups. Setting it higher in Emacs or Gnus related groups is probably a good idea. See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on how to set variables in specific groups." -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :link '(custom-manual "(gnus)Group Parameters") :type 'integer) ＠＠ -6090,7 +6177,7 ＠＠ probably a good idea. See Info node `(g The higher the number, the more buttons will appear and the more false positives are possible." ;; mail addresses, MIDs, URLs for news, ... -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :type 'integer) ＠＠ -6099,7 +6186,7 ＠＠ positives are possible." The higher the number, the more buttons will appear and the more false positives are possible." ;; stuff handled by `browse-url' or `gnus-button-embedded-url' -:version "21.4" +:version "22.1" :group 'gnus-article-buttons :type 'integer) ＠＠ -6120,7 +6207,7 ＠＠ positives are possible." ("\$<URL: *\$mailto: *\$[^> \n\t]+\$>" 0 (>= gnus-button-message-level 0) gnus-url-mailto 2) ;; RFC 2368 (The mailto URL scheme) - ("mailto:\$[-a-z.＠_+0-9%=?&]+\$" + ("\\bmailto:\$[-a-z.＠_+0-9%=?&/]+\$" 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) ("\\bmailto:\$[^ \n\t]+\$" 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) ＠＠ -6168,8 +6255,9 ＠＠ positives are possible." ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\$[^ \t\n]+\$[ \t\n]+RET" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1) ;; The following entries may lead to many false positives so don't enable - ;; them by default (use a high button level): - ("/\$[a-z][-a-z0-9]+\\.el\$\\>" + ;; them by default (use a high button level). + ("/\$[a-z][-a-z0-9]+\\.el\$\\>[^.?]" + ;; Exclude [.?] for URLs in gmane.emacs.cvs 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) ("`\$[a-z][-a-z0-9]+\\.el\$'" 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) ＠＠ -6202,16 +6290,16 ＠＠ positives are possible." (gnus-button-url-regexp 0 (>= gnus-button-browse-level 0) browse-url 0) ;; man pages - ("\\b\$[a-z][a-z]+\$([1-9])\\W" + ("\\b\$[a-z][a-z]+([1-9])\$\\W" 0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3)) gnus-button-handle-man 1) ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x) - ("\\b\$[a-z][-_.a-z0-9]+\$([1-9])\\W" + ("\\b\$[a-z][-_.a-z0-9]+([1-9])\$\\W" 0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5)) gnus-button-handle-man 1) ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm), ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7) - ("\\b\$[a-z][-+_.:a-z0-9]+\$([1-9][X1a-z]*)\\W\\|\\b\$X\$([1-9])\\W" + ("\\b\$\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\$\\|\\b\$?:X([1-9])\$\\)\\W" 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1) ;; MID or mail: To avoid too many false positives we don't try to catch ;; all kind of allowed MIDs or mail addresses. Domain part must contain ＠＠ -6255,7 +6343,7 ＠＠ variable it the real callback function." 0 (>= gnus-button-browse-level 0) browse-url 0) ("^[^:]+:" gnus-button-url-regexp 0 (>= gnus-button-browse-level 0) browse-url 0) - ("^[^:]+:" "\\bmailto:\$[-a-z.＠_+0-9%=?&]+\$" + ("^[^:]+:" "\\bmailto:\$[-a-z.＠_+0-9%=?&/]+\$" 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) ("^[^:]+:" "\$<\\(url: \$?\$nntp\\|news\$:\$[^>\n ]*\$>\\)" 1 (>= gnus-button-message-level 0) gnus-button-message-id 4)) ＠＠ -6560,15 +6648,18 ＠＠ specified by `gnus-button-alist'." (cons fun args))))))) (defun gnus-parse-news-url (url) - (let (scheme server group message-id articles) + (let (scheme server port group message-id articles) (with-temp-buffer (insert url) (goto-char (point-min)) (when (looking-at "\$[A-Za-z]+\$:") (setq scheme (match-string 1)) (goto-char (match-end 0))) - (when (looking-at "//\$[^/]+\$/") + (when (looking-at "//\$[^:/]+\$\$:?\$\$[0-9]+\$?/") (setq server (match-string 1)) + (setq port (if (stringp (match-string 3)) + (string-to-number (match-string 3)) + (match-string 3))) (goto-char (match-end 0))) (cond ＠＠ -6581,18 +6672,23 ＠＠ specified by `gnus-button-alist'." (setq group (match-string 1))) (t (error "Unknown news URL syntax")))) - (list scheme server group message-id articles))) + (list scheme server port group message-id articles))) (defun gnus-button-handle-news (url) "Fetch a news URL." - (destructuring-bind (scheme server group message-id articles) + (destructuring-bind (scheme server port group message-id articles) (gnus-parse-news-url url) (cond (message-id (save-excursion (set-buffer gnus-summary-buffer) (if server - (let ((gnus-refer-article-method (list (list 'nntp server)))) + (let ((gnus-refer-article-method + (nconc (list (list 'nntp server)) + gnus-refer-article-method)) + (nntp-port-number (or port "nntp"))) + (gnus-message 7 "Fetching %s with %s" + message-id gnus-refer-article-method) (gnus-summary-refer-article message-id)) (gnus-summary-refer-article message-id)))) (group ＠＠ -6600,6 +6696,10 ＠＠ specified by `gnus-button-alist'." (defun gnus-button-handle-man (url) "Fetch a man page." + (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) + (when (eq gnus-button-man-handler 'woman) + (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" ""))) + (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) (funcall gnus-button-man-handler url)) (defun gnus-button-handle-info-url (url) ＠＠ -6624,10 +6724,10 ＠＠ specified by `gnus-button-alist'." (if (string-match "\$[^#]+\$#?\$.*\$" url) (gnus-info-find-node (concat "(" - (gnus-url-unhex-string + (gnus-url-unhex-string (match-string 1 url)) ")" - (or (gnus-url-unhex-string + (or (gnus-url-unhex-string (match-string 2 url)) "Top"))) (error "Can't parse %s" url))) Index: lisp/gnus-async.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-async.el,v retrieving revision 1.3 diff -u -p -u -r1.3 gnus-async.el --- lisp/gnus-async.el 28 Sep 2004 02:21:04 -0000 1.3 +++ lisp/gnus-async.el 13 Mar 2005 00:11:36 -0000 ＠＠ -32,6 +32,10 ＠＠ (require 'gnus-sum) (require 'nntp) +(eval-when-compile + (when (featurep 'xemacs) + (require 'timer-funcs))) + (defgroup gnus-asynchronous nil "Support for asynchronous operations." :group 'gnus) Index: lisp/gnus-cache.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cache.el,v retrieving revision 1.4 diff -u -p -u -r1.4 gnus-cache.el --- lisp/gnus-cache.el 28 Sep 2004 02:21:04 -0000 1.4 +++ lisp/gnus-cache.el 13 Mar 2005 00:11:36 -0000 ＠＠ -726,6 +726,46 ＠＠ If GROUP is non-nil, also cater to `gnus (or (not gnus-uncacheable-groups) (not (string-match gnus-uncacheable-groups group))))))) +;;;###autoload +(defun gnus-cache-rename-group (old-group new-group) + "Rename OLD-GROUP as NEW-GROUP. Always updates the cache, even when +disabled, as the old cache files would corrupt gnus when the cache was +next enabled. Depends upon the caller to determine whether group renaming is supported." + (let ((old-dir (gnus-cache-file-name old-group "")) + (new-dir (gnus-cache-file-name new-group ""))) + (gnus-rename-file old-dir new-dir t)) + + (let ((no-save gnus-cache-active-hashtb)) + (unless gnus-cache-active-hashtb + (gnus-cache-read-active)) + (let* ((old-group-hash-value (gnus-gethash old-group gnus-cache-active-hashtb)) + (new-group-hash-value (gnus-gethash new-group gnus-cache-active-hashtb)) + (delta (or old-group-hash-value new-group-hash-value))) + (gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb) + (gnus-sethash old-group nil gnus-cache-active-hashtb) + + (if no-save + (setq gnus-cache-active-altered delta) + (gnus-cache-write-active delta))))) + +;;;###autoload +(defun gnus-cache-delete-group (group) + "Delete GROUP. Always updates the cache, even when +disabled, as the old cache files would corrupt gnus when the cache was +next enabled. Depends upon the caller to determine whether group deletion is supported." + (let ((dir (gnus-cache-file-name group ""))) + (gnus-delete-directory dir)) + + (let ((no-save gnus-cache-active-hashtb)) + (unless gnus-cache-active-hashtb + (gnus-cache-read-active)) + (let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb))) + (gnus-sethash group nil gnus-cache-active-hashtb) + + (if no-save + (setq gnus-cache-active-altered group-hash-value) + (gnus-cache-write-active group-hash-value))))) + (provide 'gnus-cache) ;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a Index: lisp/gnus-cite.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cite.el,v retrieving revision 1.4 diff -u -p -u -r1.4 gnus-cite.el --- lisp/gnus-cite.el 28 Sep 2004 02:21:04 -0000 1.4 +++ lisp/gnus-cite.el 13 Mar 2005 00:11:37 -0000 ＠＠ -124,6 +124,7 ＠＠ The text matching the first grouping wil (defcustom gnus-cite-unsightly-citation-regexp "^-----Original Message-----\nFrom: \$.+\n\$+\n" "Regexp matching Microsoft-type rest-of-message citations." +:version "22.1" :group 'gnus-cite :type 'regexp) ＠＠ -131,6 +132,7 ＠＠ The text matching the first grouping wil "Non-nil means don't regard lines beginning with \">From \" as cited text. Those lines may have been quoted by MTAs in order not to mix up with the envelope From line." +:version "22.1" :group 'gnus-cite :type 'boolean) ＠＠ -141,6 +143,7 ＠＠ the envelope From line." (defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face "Face used for attribution lines. It is merged with the face for the cited text belonging to the attribution." +:version "22.1" :group 'gnus-cite :type 'face) ＠＠ -278,7 +281,6 ＠＠ This should make it easier to see who wr (defcustom gnus-cite-blank-line-after-header t "If non-nil, put a blank line between the citation header and the button." -:version "21.4" :group 'gnus-cite :type 'boolean) ＠＠ -290,7 +292,6 ＠＠ This should make it easier to see who wr If an article has more pages below the one you are looking at, but nothing on those pages is a word of at least three letters that is not in a boring face, then the pages will be skipped." -:version "21.4" :type '(repeat face) :group 'gnus-article-hiding) Index: lisp/gnus-delay.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-delay.el,v retrieving revision 1.2 diff -u -p -u -r1.2 gnus-delay.el --- lisp/gnus-delay.el 28 Sep 2004 02:21:05 -0000 1.2 +++ lisp/gnus-delay.el 13 Mar 2005 00:11:37 -0000 ＠＠ -41,6 +41,7 ＠＠ ;;;###autoload (defgroup gnus-delay nil "Arrange for sending postings later." +:version "22.1" :group 'gnus) (defcustom gnus-delay-group "delayed" ＠＠ -60,7 +61,7 ＠＠ (defcustom gnus-delay-default-hour 8 "*If deadline is given as date, then assume this time of day." -:version "21.4" +:version "22.1" :type 'integer :group 'gnus-delay) Index: lisp/gnus-diary.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-diary.el,v retrieving revision 1.2 diff -u -p -u -r1.2 gnus-diary.el --- lisp/gnus-diary.el 28 Sep 2004 02:21:05 -0000 1.2 +++ lisp/gnus-diary.el 13 Mar 2005 00:11:37 -0000 ＠＠ -102,7 +102,8 ＠＠ (require 'gnus-art) (defgroup gnus-diary nil - "Utilities on top of the nndiary backend for Gnus.") + "Utilities on top of the nndiary backend for Gnus." +:version "22.1") (defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n" "*Summary line format for nndiary groups." ＠＠ -204,7 +205,7 ＠＠ There are currently two built-in format (let ((head (cdr (assoc (intern (format "X-Diary-%s" (car elt))) headers)))) (when head - (nndiary-parse-schedule-value head (cadr elt) (caddr elt))))) + (nndiary-parse-schedule-value head (cadr elt) (car (cddr elt)))))) nndiary-headers)) ;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any Index: lisp/gnus-draft.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-draft.el,v retrieving revision 1.4 diff -u -p -u -r1.4 gnus-draft.el --- lisp/gnus-draft.el 28 Sep 2004 02:21:05 -0000 1.4 +++ lisp/gnus-draft.el 13 Mar 2005 00:11:37 -0000 ＠＠ -132,17 +132,21 ＠＠ (defun gnus-draft-send (article &optional group interactive) "Send message ARTICLE." - (let ((message-syntax-checks (if interactive message-syntax-checks - 'dont-check-for-anything-just-trust-me)) - (message-hidden-headers nil) - (message-inhibit-body-encoding (or (not group) - (equal group "nndraft:queue") - message-inhibit-body-encoding)) - (message-send-hook (and group (not (equal group "nndraft:queue")) - message-send-hook)) - (message-setup-hook (and group (not (equal group "nndraft:queue")) - message-setup-hook)) - type method move-to) + (let* ((is-queue (or (not group) + (equal group "nndraft:queue"))) + (message-syntax-checks (if interactive message-syntax-checks + 'dont-check-for-anything-just-trust-me)) + (message-hidden-headers nil) + (message-inhibit-body-encoding (or is-queue + message-inhibit-body-encoding)) + (message-send-hook (and (not is-queue) + message-send-hook)) + (message-setup-hook (and (not is-queue) + message-setup-hook)) + (gnus-agent-queue-mail (and (not is-queue) + gnus-agent-queue-mail)) + (rfc2047-encode-encoded-words nil) + type method move-to) (gnus-draft-setup article (or group "nndraft:queue")) ;; We read the meta-information that says how and where ;; this message is to be sent. ＠＠ -196,22 +200,25 ＠＠ (defun gnus-group-send-queue () "Send all sendable articles from the queue group." (interactive) - (gnus-activate-group "nndraft:queue") - (save-excursion - (let* ((articles (nndraft-articles)) - (unsendable (gnus-uncompress-range - (cdr (assq 'unsend - (gnus-info-marks - (gnus-get-info "nndraft:queue")))))) - (gnus-posting-styles nil) - (total (length articles)) - article) - (while (setq article (pop articles)) - (unless (memq article unsendable) - (let ((message-sending-message - (format "Sending message %d of %d..." - (- total (length articles)) total))) - (gnus-draft-send article))))))) + (when (or gnus-plugged + (not gnus-agent-prompt-send-queue) + (gnus-y-or-n-p "Gnus is unplugged; really send queue? ")) + (gnus-activate-group "nndraft:queue") + (save-excursion + (let* ((articles (nndraft-articles)) + (unsendable (gnus-uncompress-range + (cdr (assq 'unsend + (gnus-info-marks + (gnus-get-info "nndraft:queue")))))) + (gnus-posting-styles nil) + (total (length articles)) + article) + (while (setq article (pop articles)) + (unless (memq article unsendable) + (let ((message-sending-message + (format "Sending message %d of %d..." + (- total (length articles)) total))) + (gnus-draft-send article)))))))) ;;;###autoload (defun gnus-draft-reminder () ＠＠ -265,12 +272,13 ＠＠ `(lambda (arg) (gnus-post-method arg ,(car ga)))) (unless (equal (cadr ga) "") - (message-add-action - `(progn - (gnus-add-mark ,(car ga) 'replied ,(cadr ga)) - (gnus-request-set-mark ,(car ga) (list (list (list ,(cadr ga)) - 'add '(reply))))) - 'send)))))) + (dolist (article (cdr ga)) + (message-add-action + `(progn + (gnus-add-mark ,(car ga) 'replied ,article) + (gnus-request-set-mark ,(car ga) (list (list (list ,article) + 'add '(reply))))) + 'send))))))) (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable." Index: lisp/gnus-fun.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-fun.el,v retrieving revision 1.4 diff -u -p -u -r1.4 gnus-fun.el --- lisp/gnus-fun.el 28 Sep 2004 02:21:06 -0000 1.4 +++ lisp/gnus-fun.el 13 Mar 2005 00:11:37 -0000 ＠＠ -26,18 +26,21 ＠＠ ;;; Code: (eval-when-compile - (require 'cl) - (require 'mm-util)) + (require 'cl)) + +(require 'mm-util) +(require 'gnus-ems) +(require 'gnus-util) (defcustom gnus-x-face-directory (expand-file-name "x-faces" gnus-directory) "*Directory where X-Face PBM files are stored." -:version "21.4" +:version "22.1" :group 'gnus-fun :type 'directory) (defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface" "Command for converting a PBM to an X-Face." -:version "21.4" +:version "22.1" :group 'gnus-fun :type 'string) ＠＠ -45,7 +48,7 ＠＠ "Command for converting an image to an X-Face. By default it takes a GIF filename and output the X-Face header data on stdout." -:version "21.4" +:version "22.1" :group 'gnus-fun :type 'string) ＠＠ -53,7 +56,7 ＠＠ on stdout." "Command for converting an image to an Face. By default it takes a JPEG filename and output the Face header data on stdout." -:version "21.4" +:version "22.1" :group 'gnus-fun :type 'string) Index: lisp/gnus-group.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-group.el,v retrieving revision 1.4 diff -u -p -u -r1.4 gnus-group.el --- lisp/gnus-group.el 28 Sep 2004 02:21:06 -0000 1.4 +++ lisp/gnus-group.el 13 Mar 2005 00:11:39 -0000 ＠＠ -44,13 +44,13 ＠＠ (eval-when-compile (require 'mm-url)) (defcustom gnus-group-archive-directory - "*ftp＠ftp.hpc.uh.edu:/pub/emacs/ding-list/" + "/ftp＠ftp.hpc.uh.edu:/pub/emacs/ding-list/" "*The address of the (ding) archives." :group 'gnus-group-foreign :type 'directory) (defcustom gnus-group-recent-archive-directory - "*ftp＠ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" + "/ftp＠ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" "*The address of the most recent (ding) articles." :group 'gnus-group-foreign :type 'directory) ＠＠ -435,7 +435,7 ＠＠ For example: If non-nil, the value should be a string, e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group: nnml:\" in the minibuffer prompt." -:version "21.4" +:version "22.1" :group 'gnus-group-various :type '(choice (string :tag "Prompt string") (const :tag "Empty" nil))) ＠＠ -491,7 +491,10 ＠＠ simple manner.") (?O gnus-tmp-moderated-string ?s) (?p gnus-tmp-process-marked ?c) (?s gnus-tmp-news-server ?s) - (?n gnus-tmp-news-method ?s) + (?n ,(if (featurep 'xemacs) + '(symbol-name gnus-tmp-news-method) + 'gnus-tmp-news-method) + ?s) (?P gnus-group-indentation ?s) (?E gnus-tmp-group-icon ?s) (?B gnus-tmp-summary-live ?c) ＠＠ -588,6 +591,7 ＠＠ simple manner.") "\M-e" gnus-group-edit-group-method "^" gnus-group-enter-server-mode gnus-mouse-2 gnus-mouse-pick-group + [follow-link] mouse-face "<" beginning-of-buffer ">" end-of-buffer "\C-c\C-b" gnus-bug ＠＠ -1046,7 +1050,8 ＠＠ The following commands are available: (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) (goto-char (point-min)) (setq gnus-group-mark-positions - (list (cons 'process (and (search-forward "\200" nil t) + (list (cons 'process (and (search-forward + (mm-string-as-multibyte "\200") nil t) (- (point) 2)))))))) (defun gnus-mouse-pick-group (e) ＠＠ -1960,14 +1965,14 ＠＠ Same as `gnus-large-newsgroup', but only If the number of articles in a newsgroup is greater than this value, confirmation is required for selecting the newsgroup. If it is nil, no confirmation is required." -:version "21.4" +:version "22.1" :group 'gnus-group-select :type '(choice (const :tag "No limit" nil) integer)) (defcustom gnus-fetch-old-ephemeral-headers nil "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups." -:version "21.4" +:version "22.1" :group 'gnus-thread :type '(choice (const :tag "off" nil) (const some) ＠＠ -2282,8 +2287,6 ＠＠ ADDRESS." (lambda (group) (gnus-group-delete-group group nil t)))))) -(defvar gnus-cache-active-altered) - (defun gnus-group-delete-group (group &optional force no-prompt) "Delete the current group. Only meaningful with editable groups. If FORCE (the prefix) is non-nil, all the articles in the group will ＠＠ -2313,10 +2316,6 ＠＠ be removed from the server, even when it (gnus-group-goto-group group) (gnus-group-kill-group 1 t) (gnus-sethash group nil gnus-active-hashtb) - (if (boundp 'gnus-cache-active-hashtb) - (when gnus-cache-active-hashtb - (gnus-sethash group nil gnus-cache-active-hashtb) - (setq gnus-cache-active-altered t))) t)) (gnus-group-position-point))) ＠＠ -2503,7 +2502,9 ＠＠ group already exists: (gnus-group-position-point)) (defun gnus-group-make-doc-group (file type) - "Create a group that uses a single file as the source." + "Create a group that uses a single file as the source. + +If called with a prefix argument, ask for the file type." (interactive (list (read-file-name "File name: ") (and current-prefix-arg 'ask))) ＠＠ -2512,7 +2513,7 ＠＠ group already exists: char found) (while (not found) (message - "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: " + "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [m, b, d, f, a, g]: " err) (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) ((= char ?b) 'babyl) ＠＠ -2594,8 +2595,7 ＠＠ If there is, use Gnus to create an nnrss (href (cdr (assoc 'href feedinfo)))) (push (list title href desc) nnrss-group-alist) - (gnus-group-unsubscribe-group - (concat "nnrss:" title)) + (gnus-group-make-group title '(nnrss "")) (nnrss-save-server-data nil)) (error "No feeds found for %s" url)))) ＠＠ -3028,7 +3028,8 ＠＠ sort in reverse order." ;;; Clearing data (defun gnus-group-clear-data (&optional arg) - "Clear all marks and read ranges from the current group." + "Clear all marks and read ranges from the current group. +Obeys the process/prefix convention." (interactive "P") (gnus-group-iterate arg (lambda (group) ＠＠ -3132,7 +3133,7 ＠＠ or nil if no action could be taken." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (num (car entry)) (marks (nth 3 (nth 2 entry))) - (unread (gnus-list-of-unread-articles group))) + (unread (gnus-sequence-of-unread-articles group))) ;; Remove entries for this group. (nnmail-purge-split-history (gnus-group-real-name group)) ;; Do the updating only if the newsgroup isn't killed. ＠＠ -3145,16 +3146,17 ＠＠ or nil if no action could be taken." 'del '(tick)) (list (cdr (assq 'dormant marks)) 'del '(dormant)))) - (setq unread (gnus-uncompress-range - (gnus-range-add (gnus-range-add - unread (cdr (assq 'dormant marks))) - (cdr (assq 'tick marks))))) + (setq unread (gnus-range-add (gnus-range-add + unread (cdr (assq 'dormant marks))) + (cdr (assq 'tick marks)))) (gnus-add-marked-articles group 'tick nil nil 'force) (gnus-add-marked-articles group 'dormant nil nil 'force)) ;; Do auto-expirable marks if that's required. (when (gnus-group-auto-expirable-p group) - (gnus-add-marked-articles group 'expire unread) - (gnus-request-set-mark group (list (list unread 'add '(expire))))) + (gnus-range-map (lambda (article) + (gnus-add-marked-articles group 'expire (list article)) + (gnus-request-set-mark group (list (list (list article) 'add '(expire))))) + unread)) (let ((gnus-newsgroup-name group)) (gnus-run-hooks 'gnus-group-catchup-group-hook)) num))) ＠＠ -3516,7 +3518,7 ＠＠ entail asking the server for the groups. ;; First we make sure that we have really read the active file. (unless (gnus-read-active-file-p) (let ((gnus-read-active-file t) - (gnus-agent nil)) ; Trick the agent into ignoring the active file. + (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent. (gnus-read-active-file))) ;; Find all groups and sort them. (let ((groups ＠＠ -3598,7 +3600,8 ＠＠ re-scanning. If ARG is non-nil and not (defun gnus-group-get-new-news-this-group (&optional n dont-scan) "Check for newly arrived news in the current group (and the N-1 next groups). The difference between N and the number of newsgroup checked is returned. -If N is negative, this group and the N-1 previous groups will be checked." +If N is negative, this group and the N-1 previous groups will be checked. +If DONT-SCAN is non-nil, scan non-activated groups as well." (interactive "P") (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) Index: lisp/gnus-int.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-int.el,v retrieving revision 1.5 diff -u -p -u -r1.5 gnus-int.el --- lisp/gnus-int.el 28 Sep 2004 02:21:06 -0000 1.5 +++ lisp/gnus-int.el 13 Mar 2005 00:11:39 -0000 ＠＠ -33,6 +33,7 ＠＠ (require 'gnus-range) (autoload 'gnus-agent-expire "gnus-agent") +(autoload 'gnus-agent-regenerate-group "gnus-agent") (autoload 'gnus-agent-read-servers-validate-native "gnus-agent") (defcustom gnus-open-server-hook nil ＠＠ -46,7 +47,7 ＠＠ If the server is covered by Gnus agent, `denied', set the server denied; `offline', set the server offline; nil, ask user. If the server is not covered by Gnus agent, set the server denied." -:version "21.4" +:version "22.1" :group 'gnus-start :type '(choice (const :tag "Ask" nil) (const :tag "Deny server" denied) ＠＠ -176,7 +177,7 ＠＠ If it is down, start it up (again)." (setq method (gnus-server-to-method method))) ;; Check cache of constructed names. (let* ((method-sym (if gnus-agent - (gnus-agent-get-function method) + (inline (gnus-agent-get-function method)) (car method))) (method-fns (get method-sym 'gnus-method-functions)) (func (let ((method-fnlist-elt (assq function method-fns))) ＠＠ -570,9 +571,9 ＠＠ If GROUP is nil, all groups on GNUS-COMM (nth 1 gnus-command-method) accept-function last))) (when (and result gnus-agent (gnus-agent-method-p gnus-command-method)) - (gnus-agent-expire (list article) group 'force)) + (gnus-agent-unfetch-articles group (list article))) result)) - + (defun gnus-request-accept-article (group &optional gnus-command-method last no-encode) ;; Make sure there's a newline at the end of the article. ＠＠ -580,7 +581,8 ＠＠ If GROUP is nil, all groups on GNUS-COMM (setq gnus-command-method (gnus-server-to-method gnus-command-method))) (when (and (not gnus-command-method) (stringp group)) - (setq gnus-command-method (gnus-group-name-to-method group))) + (setq gnus-command-method (or (gnus-find-method-for-group group) + (gnus-group-name-to-method group)))) (goto-char (point-max)) (unless (bolp) (insert "\n")) ＠＠ -592,12 +594,17 ＠＠ If GROUP is nil, all groups on GNUS-COMM (let ((mail-parse-charset message-default-charset)) (mail-encode-encoded-word-buffer))) (message-encode-message-body))) - (let ((gnus-command-method (or gnus-command-method - (gnus-find-method-for-group group)))) - (funcall (gnus-get-function gnus-command-method 'request-accept-article) - (if (stringp group) (gnus-group-real-name group) group) - (cadr gnus-command-method) - last))) +(let ((gnus-command-method (or gnus-command-method + (gnus-find-method-for-group group))) + (result + (funcall + (gnus-get-function gnus-command-method 'request-accept-article) + (if (stringp group) (gnus-group-real-name group) group) + (cadr gnus-command-method) + last))) + (when (and gnus-agent (gnus-agent-method-p gnus-command-method)) + (gnus-agent-regenerate-group group (list (cdr result)))) + result)) (defun gnus-request-replace-article (article group buffer &optional no-encode) (unless no-encode ＠＠ -608,9 +615,12 ＠＠ If GROUP is nil, all groups on GNUS-COMM (let ((mail-parse-charset message-default-charset)) (mail-encode-encoded-word-buffer))) (message-encode-message-body))) - (let ((func (car (gnus-group-name-to-method group)))) - (funcall (intern (format "%s-request-replace-article" func)) - article (gnus-group-real-name group) buffer))) + (let* ((func (car (gnus-group-name-to-method group))) + (result (funcall (intern (format "%s-request-replace-article" func)) + article (gnus-group-real-name group) buffer))) + (when (and gnus-agent (gnus-agent-method-p gnus-command-method)) + (gnus-agent-regenerate-group group (list article))) + result)) (defun gnus-request-associate-buffer (group) (let ((gnus-command-method (gnus-find-method-for-group group))) ＠＠ -633,15 +643,25 ＠＠ If GROUP is nil, all groups on GNUS-COMM (gnus-group-real-name group) (nth 1 gnus-command-method) args))) (defun gnus-request-delete-group (group &optional force) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-delete-group) - (gnus-group-real-name group) force (nth 1 gnus-command-method)))) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (result + (funcall (gnus-get-function gnus-command-method 'request-delete-group) + (gnus-group-real-name group) force (nth 1 gnus-command-method)))) + (when result + (gnus-cache-delete-group group) + (gnus-agent-delete-group group)) + result)) (defun gnus-request-rename-group (group new-name) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-rename-group) - (gnus-group-real-name group) - (gnus-group-real-name new-name) (nth 1 gnus-command-method)))) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (result + (funcall (gnus-get-function gnus-command-method 'request-rename-group) + (gnus-group-real-name group) + (gnus-group-real-name new-name) (nth 1 gnus-command-method)))) + (when result + (gnus-cache-rename-group group new-name) + (gnus-agent-rename-group group new-name)) + result)) (defun gnus-close-backends () ;; Send a close request to all backends that support such a request. Index: lisp/gnus-load.el =================================================================== RCS file: lisp/gnus-load.el diff -N lisp/gnus-load.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/gnus-load.el 13 Mar 2005 00:11:39 -0000 ＠＠ -0,0 +1,9 ＠＠ + +(provide 'gnus-load) + +;;; Local Variables: +;;; version-control: never +;;; no-byte-compile: t +;;; no-update-autoloads: t +;;; End: +;;; gnus-load.el ends here \ No newline at end of file Index: lisp/gnus-msg.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-msg.el,v retrieving revision 1.5 diff -u -p -u -r1.5 gnus-msg.el --- lisp/gnus-msg.el 28 Sep 2004 02:21:07 -0000 1.5 +++ lisp/gnus-msg.el 13 Mar 2005 00:11:40 -0000 ＠＠ -142,7 +142,7 ＠＠ See Info node `(gnus)Posting Styles'." (defcustom gnus-gcc-mark-as-read nil "If non-nil, automatically mark Gcc articles as read." -:version "21.4" +:version "22.1" :group 'gnus-message :type 'boolean) ＠＠ -154,7 +154,7 ＠＠ See Info node `(gnus)Posting Styles'." If it is `all', attach files as external parts; if a regexp and matches the Gcc group name, attach files as external parts; if nil, attach files as normal parts." -:version "21.4" +:version "22.1" :group 'gnus-message :type '(choice (const nil :tag "None") (const all :tag "Any") ＠＠ -212,7 +212,7 ＠＠ List of charsets that are permitted to b "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el" "mm-util.el" "mm-decode.el" "nnmail.el" "message.el") "Files whose variables will be reported in `gnus-bug'." -:version "21.4" +:version "22.1" :group 'gnus-message :type '(repeat (string :tag "File"))) ＠＠ -220,7 +220,7 ＠＠ List of charsets that are permitted to b '(mm-mime-mule-charset-alist nnmail-split-fancy message-minibuffer-local-map) "Variables that should not be reported in `gnus-bug'." -:version "21.4" +:version "22.1" :group 'gnus-message :type '(repeat (symbol :tag "Variable"))) ＠＠ -228,7 +228,7 ＠＠ List of charsets that are permitted to b '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir) "A list of back ends that are not used in \"real\" newsgroups. This variable is used only when `gnus-post-method' is `current'." -:version "21.4" +:version "22.1" :group 'gnus-group-foreign :type '(repeat (symbol :tag "Back end"))) ＠＠ -260,7 +260,7 ＠＠ This can also be a function receiving th parameter which should return non-nil iff a confirmation is needed, or a regexp, in which case a confirmation is asked for iff the group name matches the regexp." -:version "21.4" +:version "22.1" :group 'gnus-message :type '(choice (const :tag "No" nil) (const :tag "Yes" t) ＠＠ -273,7 +273,7 ＠＠ matches the regexp." when replying by mail. See the `gnus-confirm-mail-reply-to-news' variable for fine-tuning this. If nil, Gnus will never ask for confirmation if replying to mail." -:version "21.4" +:version "22.1" :group 'gnus-message :type 'boolean) ＠＠ -281,6 +281,7 ＠＠ If nil, Gnus will never ask for confirma "If non-nil, Gnus tries to suggest a default address to resend to. If nil, the address field will always be empty after invoking `gnus-summary-resend-message'." +:version "22.1" :group 'gnus-message :type 'boolean) ＠＠ -875,7 +876,8 ＠＠ header line with the old Message-ID." ;; Decode charsets. (let ((gnus-article-decode-hook (delq 'article-decode-charset - (copy-sequence gnus-article-decode-hook)))) + (copy-sequence gnus-article-decode-hook))) + (rfc2047-quote-decoded-words-containing-tspecials t)) (run-hooks 'gnus-article-decode-hook))))) gnus-article-copy))) ＠＠ -1534,7 +1536,8 ＠＠ The source file has to be in the Emacs l ;; Remove any control chars - they seem to cause trouble for some ;; mailers. (Byte-compiled output from the stuff above.) (goto-char point) - (while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t) + (while (re-search-forward (mm-string-as-multibyte + "[\000-\010\013-\037\200-\237]") nil t) (replace-match (format "\\%03o" (string-to-char (match-string 0))) t t)))) ＠＠ -1869,10 +1872,13 ＠＠ this is a reply." (when (and filep v) (setq v (with-temp-buffer (insert-file-contents v) - (goto-char (point-max)) - (while (bolp) - (delete-char -1)) - (buffer-string)))) + (buffer-substring + (point-min) + (progn + (goto-char (point-max)) + (if (zerop (skip-chars-backward "\n")) + (point) + (1+ (point)))))))) (setq results (delq (assoc element results) results)) (push (cons element v) results)))) ;; Now we have all the styles, so we insert them. Index: lisp/gnus-picon.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-picon.el,v retrieving revision 1.5 diff -u -p -u -r1.5 gnus-picon.el --- lisp/gnus-picon.el 28 Sep 2004 02:21:07 -0000 1.5 +++ lisp/gnus-picon.el 13 Mar 2005 00:11:40 -0000 ＠＠ -40,8 +40,9 ＠＠ ;; ;;; Code: +(eval-when-compile (require 'cl)) + (require 'gnus) -(require 'custom) (require 'gnus-art) ;;; User variables: Index: lisp/gnus-range.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-range.el,v retrieving revision 1.3 diff -u -p -u -r1.3 gnus-range.el --- lisp/gnus-range.el 28 Sep 2004 02:21:07 -0000 1.3 +++ lisp/gnus-range.el 13 Mar 2005 00:11:40 -0000 ＠＠ -1,6 +1,6 ＠＠ ;;; gnus-range.el --- range and sequence functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -184,6 +184,58 ＠＠ LIST1 and LIST2 have to be sorted over < (nreverse out))) ;;;###autoload +(defun gnus-sorted-range-intersection (range1 range2) + "Return intersection of RANGE1 and RANGE2. +RANGE1 and RANGE2 have to be sorted over <." + (let* (out + (min1 (car range1)) + (max1 (if (numberp min1) + (if (numberp (cdr range1)) + (prog1 (cdr range1) + (setq range1 nil)) min1) + (prog1 (cdr min1) + (setq min1 (car min1))))) + (min2 (car range2)) + (max2 (if (numberp min2) + (if (numberp (cdr range2)) + (prog1 (cdr range2) + (setq range2 nil)) min2) + (prog1 (cdr min2) + (setq min2 (car min2)))))) + (setq range1 (cdr range1) + range2 (cdr range2)) + (while (and min1 min2) + (cond ((< max1 min2) ; range1 preceeds range2 + (setq range1 (cdr range1) + min1 nil)) + ((< max2 min1) ; range2 preceeds range1 + (setq range2 (cdr range2) + min2 nil)) + (t ; some sort of overlap is occurring + (let ((min (max min1 min2)) + (max (min max1 max2))) + (setq out (if (= min max) + (cons min out) + (cons (cons min max) out)))) + (if (< max1 max2) ; range1 ends before range2 + (setq min1 nil) ; incr range1 + (setq min2 nil)))) ; incr range2 + (unless min1 + (setq min1 (car range1) + max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1)))) + range1 (cdr range1))) + (unless min2 + (setq min2 (car range2) + max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2)))) + range2 (cdr range2)))) + (cond ((cdr out) + (nreverse out)) + ((numberp (car out)) + out) + (t + (car out))))) + +;;;###autoload (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection) ;;;###autoload ＠＠ -588,6 +640,19 ＠＠ LIST is a sorted list." (unless (eq (car list) num) (setcdr prev (cons num list))) (cdr top))) + +(defun gnus-range-map (func range) + "Apply FUNC to each value contained by RANGE." + (setq range (gnus-range-normalize range)) + (while range + (let ((span (pop range))) + (if (numberp span) + (funcall func span) + (let ((first (car span)) + (last (cdr span))) + (while (<= first last) + (funcall func first) + (setq first (1+ first)))))))) (provide 'gnus-range) Index: lisp/gnus-registry.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-registry.el,v retrieving revision 1.4 diff -u -p -u -r1.4 gnus-registry.el --- lisp/gnus-registry.el 28 Sep 2004 02:21:07 -0000 1.4 +++ lisp/gnus-registry.el 13 Mar 2005 00:11:40 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; gnus-registry.el --- article registry for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Ted Zlatanov <tzz(a)lifelogs.com> ＠＠ -66,6 +66,7 ＠＠ (defgroup gnus-registry nil "The Gnus registry." +:version "22.1" :group 'gnus) (defvar gnus-registry-hashtb nil ＠＠ -98,7 +99,7 ＠＠ Registry entries are considered empty wh The Subject and Sender (From:) headers are currently tracked this way." :group 'gnus-registry -:type +:type '(set :tag "Tracking choices" (const :tag "Track by subject (Subject: header)" subject) (const :tag "Track by sender (From: header)" sender))) ＠＠ -127,7 +128,7 ＠＠ way." "Maximum number of entries in the registry, nil for unlimited." :group 'gnus-registry :type '(radio (const :format "Unlimited " nil) - (integer :format "Maximum number: %v\n" :size 0))) + (integer :format "Maximum number: %v"))) ;; Function(s) missing in Emacs 20 (when (memq nil (mapcar 'fboundp '(puthash))) ＠＠ -187,12 +188,12 ＠＠ way." "%s#tmp#%d")) working-dir (setq i (1+ i)))) (file-exists-p working-file))) - + (unwind-protect (progn (gnus-with-output-to-file working-file (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist)) - + ;; These bindings will mislead the current buffer ;; into thinking that it is visiting the startup ;; file. ＠＠ -202,14 +203,14 ＠＠ way." (setmodes (file-modes startup-file))) ;; Backup the current version of the startup file. (backup-buffer) - + ;; Replace the existing startup file with the temp file. (rename-file working-file startup-file t) (set-file-modes startup-file setmodes))) (condition-case nil (delete-file working-file) (file-error nil))))) - + (gnus-kill-buffer (current-buffer)) (gnus-message 5 "Saving %s...done" file)))) ＠＠ -237,10 +238,10 ＠＠ way." (remhash key gnus-registry-hashtb))) gnus-registry-hashtb) ;; remove empty entries - (when gnus-registry-clean-empty + (when gnus-registry-clean-empty (gnus-registry-clean-empty-function)) ;; now trim the registry appropriately - (setq gnus-registry-alist (gnus-registry-trim + (setq gnus-registry-alist (gnus-registry-trim (hashtable-to-alist gnus-registry-hashtb))) ;; really save (gnus-registry-cache-save) ＠＠ -282,15 +283,15 ＠＠ way." (setq alist (nthcdr trim-length - (sort alist + (sort alist (lambda (a b) - (time-less-p + (time-less-p (cdr (gethash (car a) timehash)) (cdr (gethash (car b) timehash)))))))))) (defun alist-to-hashtable (alist) "Build a hashtable from the values in ALIST." - (let ((ht (make-hash-table + (let ((ht (make-hash-table :size 4096 :test 'equal))) (mapc ＠＠ -310,7 +311,7 ＠＠ way." (defun gnus-registry-action (action data-header from &optional to method) (let* ((id (mail-header-id data-header)) - (subject (gnus-registry-simplify-subject + (subject (gnus-registry-simplify-subject (mail-header-subject data-header))) (sender (mail-header-from data-header)) (from (gnus-group-guess-full-name-from-command-method from)) ＠＠ -326,7 +327,7 ＠＠ way." ;; All except copy will need a delete (gnus-registry-delete-group id from) - (when (equal 'copy action) + (when (equal 'copy action) (gnus-registry-add-group id from subject sender)) ; undo the delete (gnus-registry-add-group id to subject sender))) ＠＠ -346,7 +347,7 ＠＠ way." "Split this message into the same group as its parent. The parent is obtained from the registry. This function can be used as an entry in `nnmail-split-fancy' or `nnimap-split-fancy', for example like -this: (: gnus-registry-split-fancy-with-parent) +this: (: gnus-registry-split-fancy-with-parent) For a message to be split, it looks for the parent message in the References or In-Reply-To header and then looks in the registry to ＠＠ -368,7 +369,7 ＠＠ See the Info node `(gnus)Fancy Mail Spli (when (or (gnus-registry-grep-in-list res gnus-registry-unfollowed-groups) - (gnus-registry-grep-in-list + (gnus-registry-grep-in-list res nnmail-split-fancy-with-parent-ignore-groups)) (setq res nil))) ＠＠ -384,7 +385,7 ＠＠ See the Info node `(gnus)Fancy Mail Spli sender) (maphash (lambda (key value) - (let ((this-sender (cdr + (let ((this-sender (cdr (gnus-registry-fetch-extra key 'sender)))) (when (and single-match this-sender ＠＠ -407,7 +408,7 ＠＠ See the Info node `(gnus)Fancy Mail Spli (< gnus-registry-minimum-subject-length (length subject))) (maphash (lambda (key value) - (let ((this-subject (cdr + (let ((this-subject (cdr (gnus-registry-fetch-extra key 'subject)))) (when (and single-match this-subject ＠＠ -431,26 +432,26 ＠＠ See the Info node `(gnus)Fancy Mail Spli refstr) (setq res nil)))) (gnus-message - 5 + 5 "gnus-registry-split-fancy-with-parent traced %s to group %s" refstr (if res res "nil")) (when (and res gnus-registry-use-long-group-names) (let ((m1 (gnus-find-method-for-group res)) - (m2 (or gnus-command-method + (m2 (or gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) (short-res (gnus-group-short-name res))) (if (gnus-methods-equal-p m1 m2) (progn (gnus-message - 9 + 9 "gnus-registry-split-fancy-with-parent stripped group %s to %s" res short-res) (setq res short-res)) ;; else... (gnus-message - 5 + 5 "gnus-registry-split-fancy-with-parent ignored foreign group %s" res) (setq res nil)))) ＠＠ -462,9 +463,9 ＠＠ See the Info node `(gnus)Fancy Mail Spli (dolist (article gnus-newsgroup-articles) (let ((id (gnus-registry-fetch-message-id-fast article))) (unless (gnus-registry-fetch-group id) - (gnus-message 9 "Registry: Registering article %d with group %s" + (gnus-message 9 "Registry: Registering article %d with group %s" article gnus-newsgroup-name) - (gnus-registry-add-group + (gnus-registry-add-group (gnus-registry-fetch-message-id-fast article) gnus-newsgroup-name (gnus-registry-fetch-simplified-message-subject-fast article) ＠＠ -503,7 +504,7 ＠＠ See the Info node `(gnus)Fancy Mail Spli (when word (memq nil (mapcar 'not - (mapcar + (mapcar (lambda (x) (string-match x word)) list))))) ＠＠ -539,7 +540,7 ＠＠ Update the entry cache if needed." ;; get the entree from the hash table or from the alist (setq entree (gethash id entry-cache))) - + (unless entree (setq entree (assq entry alist)) (when gnus-registry-entry-caching ＠＠ -580,8 +581,8 ＠＠ Returns the first place where the trail (let ((trail (gethash id gnus-registry-hashtb))) (dolist (crumb trail) (when (stringp crumb) - (return (if gnus-registry-use-long-group-names - crumb + (return (if gnus-registry-use-long-group-names + crumb (gnus-group-short-name crumb)))))))) (defun gnus-registry-group-count (id) ＠＠ -605,7 +606,9 ＠＠ Returns the first place where the trail (when gnus-registry-trim-articles-without-groups (unless (gnus-registry-group-count id) (gnus-registry-delete-id id))) - (gnus-registry-store-extra-entry id 'mtime (current-time))))) + ;; is this ID still in the registry? + (when (gethash id gnus-registry-hashtb) + (gnus-registry-store-extra-entry id 'mtime (current-time)))))) (defun gnus-registry-delete-id (id) "Delete a message ID from the registry." ＠＠ -623,8 +626,8 ＠＠ Returns the first place where the trail (when (and id (not (string-match "totally-fudged-out-message-id" id))) (let ((full-group group) - (group (if gnus-registry-use-long-group-names - group + (group (if gnus-registry-use-long-group-names + group (gnus-group-short-name group)))) (gnus-registry-delete-group id group) ＠＠ -640,16 +643,16 ＠＠ Returns the first place where the trail (when (and (gnus-registry-track-subject-p) subject) (gnus-registry-store-extra-entry - id - 'subject + id + 'subject (gnus-registry-simplify-subject subject))) (when (and (gnus-registry-track-sender-p) sender) (gnus-registry-store-extra-entry - id + id 'sender sender)) - + (gnus-registry-store-extra-entry id 'mtime (current-time))))))) (defun gnus-registry-clear () ＠＠ -670,11 +673,11 ＠＠ Returns the first place where the trail (defun gnus-registry-install-hooks () "Install the registry hooks." (interactive) - (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action) + (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action) (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action) - + (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save) (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read) ＠＠ -683,15 +686,17 ＠＠ Returns the first place where the trail (defun gnus-registry-unload-hook () "Uninstall the registry hooks." (interactive) - (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action) + (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action) (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action) - + (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save) (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read) (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) + +(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook) (when gnus-registry-install (gnus-registry-install-hooks) Index: lisp/gnus-score.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-score.el,v retrieving revision 1.4 diff -u -p -u -r1.4 gnus-score.el --- lisp/gnus-score.el 28 Sep 2004 02:21:08 -0000 1.4 +++ lisp/gnus-score.el 13 Mar 2005 00:11:41 -0000 ＠＠ -237,10 +237,10 ＠＠ This variable allows the same syntax as (defcustom gnus-adaptive-word-length-limit nil "*Words of a length lesser than this limit will be ignored when doing adaptive scoring." -:version "21.4" +:version "22.1" :group 'gnus-score-adapt :type '(radio (const :format "Unlimited " nil) - (integer :format "Maximum length: %v\n" :size 0))) + (integer :format "Maximum length: %v"))) (defcustom gnus-ignored-adaptive-words nil "List of words to be ignored when doing adaptive word scoring." Index: lisp/gnus-spec.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-spec.el,v retrieving revision 1.4 diff -u -p -u -r1.4 gnus-spec.el --- lisp/gnus-spec.el 28 Sep 2004 02:21:09 -0000 1.4 +++ lisp/gnus-spec.el 13 Mar 2005 00:11:41 -0000 ＠＠ -32,12 +32,14 ＠＠ (defcustom gnus-use-correct-string-widths (featurep 'xemacs) "*If non-nil, use correct functions for dealing with wide characters." +:version "22.1" :group 'gnus-format :type 'boolean) (defcustom gnus-make-format-preserve-properties (featurep 'xemacs) "*If non-nil, use a replacement `format' function which preserves text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." +:version "22.1" :group 'gnus-format :type 'boolean) ＠＠ -183,7 +185,8 ＠＠ text properties. This is only needed on (insert (gnus-pp-to-string spec)))) (defun gnus-update-format-specifications (&optional force &rest types) - "Update all (necessary) format specifications." + "Update all (necessary) format specifications. +Return a list of updated types." ;; Make the indentation array. ;; See whether all the stored info needs to be flushed. (when (or force ＠＠ -195,13 +198,12 ＠＠ text properties. This is only needed on (setq gnus-format-specs nil)) ;; Go through all the formats and see whether they need updating. - (let (new-format entry type val) + (let (new-format entry type val updated) (while (setq type (pop types)) ;; Jump to the proper buffer to find out the value of the ;; variable, if possible. (It may be buffer-local.) (save-excursion - (let ((buffer (intern (format "gnus-%s-buffer" type))) - val) + (let ((buffer (intern (format "gnus-%s-buffer" type)))) (when (and (boundp buffer) (setq val (symbol-value buffer)) (gnus-buffer-exists-p val)) ＠＠ -231,10 +233,12 ＠＠ text properties. This is only needed on (setcar (cdr entry) val) (setcar entry new-format)) (push (list type new-format val) gnus-format-specs)) - (set (intern (format "gnus-%s-line-format-spec" type)) val))))) + (set (intern (format "gnus-%s-line-format-spec" type)) val) + (push type updated)))) - (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs))) + (unless (assq 'version gnus-format-specs) + (push (cons 'version emacs-version) gnus-format-specs)) + updated)) (defvar gnus-mouse-face-0 'highlight) (defvar gnus-mouse-face-1 'highlight) ＠＠ -271,21 +275,15 ＠＠ text properties. This is only needed on (defun gnus-spec-tab (column) (if (> column 0) - `(insert (make-string (max (- ,column (current-column)) 0) ? )) + `(insert-char ? (max (- ,column (current-column)) 0)) (let ((column (abs column))) - (if gnus-use-correct-string-widths - `(progn - (if (> (current-column) ,column) - (while (progn - (delete-backward-char 1) - (> (current-column) ,column)))) - (insert (make-string (max (- ,column (current-column)) 0) ? ))) - `(progn - (if (> (current-column) ,column) - (delete-region (point) - (- (point) (- (current-column) ,column))) - (insert (make-string (max (- ,column (current-column)) 0) - ? )))))))) + `(if (> (current-column) ,column) + (let ((end (point))) + (if (= (move-to-column ,column) ,column) + (delete-region (point) end) + (delete-region (1- (point)) end) + (insert " "))) + (insert-char ? (max (- ,column (current-column)) 0)))))) (defun gnus-correct-length (string) "Return the correct width of STRING." Index: lisp/gnus-srvr.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-srvr.el,v retrieving revision 1.4 diff -u -p -u -r1.4 gnus-srvr.el --- lisp/gnus-srvr.el 28 Sep 2004 02:21:09 -0000 1.4 +++ lisp/gnus-srvr.el 13 Mar 2005 00:11:42 -0000 ＠＠ -71,7 +71,7 ＠＠ See Info node `(gnus)Formatting Variable (defcustom gnus-server-browse-in-group-buffer nil "Whether server browsing should take place in the group buffer. If nil, a faster, but more primitive, buffer is used instead." -:version "21.4" +:version "22.1" :group 'gnus-server-visual :type 'boolean) ＠＠ -205,27 +205,31 ＠＠ If nil, a faster, but more primitive, bu (defcustom gnus-server-agent-face 'gnus-server-agent-face "Face name to use on AGENTIZED servers." +:version "22.1" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-opened-face 'gnus-server-opened-face "Face name to use on OPENED servers." +:version "22.1" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-closed-face 'gnus-server-closed-face "Face name to use on CLOSED servers." +:version "22.1" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-denied-face 'gnus-server-denied-face "Face name to use on DENIED servers." +:version "22.1" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-offline-face 'gnus-server-offline-face "Face name to use on OFFLINE servers." -:version "21.4" +:version "22.1" :group 'gnus-server-visual :type 'face) ＠＠ -732,10 +736,10 ＠＠ gnus-method-to-server." (if (eq (car method) 'nntp) (while (not (eobp)) (ignore-errors - (push (cons - (buffer-substring + (push (cons + (buffer-substring (point) - (progn + (progn (skip-chars-forward "^ \t") (point))) (let ((last (read cur))) ＠＠ -899,7 +903,7 ＠＠ buffer. (beginning-of-line) (let ((name (get-text-property (point) 'gnus-group))) (when (re-search-forward ": \$.*\$$" (gnus-point-at-eol) t) - (concat (gnus-method-to-server-name gnus-browse-current-method) ":" + (concat (gnus-method-to-server-name gnus-browse-current-method) ":" (or name (match-string-no-properties 1))))))) Index: lisp/gnus-start.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-start.el,v retrieving revision 1.5 diff -u -p -u -r1.5 gnus-start.el --- lisp/gnus-start.el 28 Sep 2004 02:21:09 -0000 1.5 +++ lisp/gnus-start.el 13 Mar 2005 00:11:43 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -34,8 +34,15 ＠＠ (require 'gnus-util) (autoload 'message-make-date "message") (autoload 'gnus-agent-read-servers-validate "gnus-agent") +(autoload 'gnus-agent-save-local "gnus-agent") (autoload 'gnus-agent-possibly-alter-active "gnus-agent") -(eval-when-compile (require 'cl)) + +(eval-when-compile + (require 'cl) + + (defvar gnus-agent-covered-methods nil) + (defvar gnus-agent-file-loading-local nil) + (defvar gnus-agent-file-loading-cache nil)) (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") "Your `.newsrc' file. ＠＠ -47,7 +54,7 ＠＠ "Whether to create backup files. This variable takes the same values as the `version-control' variable." -:version "21.4" +:version "22.1" :group 'gnus-start :type '(choice (const :tag "Never" never) (const :tag "If existing" nil) ＠＠ -58,7 +65,7 ＠＠ variable." the buffer or write directly to the file. The buffer is faster because all of the contents are written at once. The direct write uses considerably less memory." -:version "21.4" +:version "22.1" :group 'gnus-start :type '(choice (const :tag "Write via buffer" t) (const :tag "Write directly to file" nil))) ＠＠ -251,7 +258,7 ＠＠ not match this regexp will be removed be (and value (not (stringp value)))) :value t) (const nil) - (regexp :format "%t: %v\n" :size 0))) + regexp)) (defcustom gnus-ignored-newsgroups (mapconcat 'identity ＠＠ -292,6 +299,7 ＠＠ claim them." (defcustom gnus-subscribe-newsgroup-hooks nil "*Hooks run after you subscribe to a new group. The hooks will be called with new group's name as argument." +:version "22.1" :group 'gnus-group-new :type 'hook) ＠＠ -398,6 +406,7 ＠＠ This hook is called as the first thing w (defcustom gnus-get-top-new-news-hook nil "A hook run just before Gnus checks for new news globally." +:version "22.1" :group 'gnus-group-new :type 'hook) ＠＠ -663,6 +672,8 ＠＠ the first newsgroup." (setq gnus-list-of-killed-groups nil gnus-have-read-active-file nil gnus-agent-covered-methods nil + gnus-agent-file-loading-local nil + gnus-agent-file-loading-cache nil gnus-server-method-cache nil gnus-newsrc-alist nil gnus-newsrc-hashtb nil ＠＠ -941,16 +952,28 ＠＠ If LEVEL is non-nil, the news will be se ;; Make sure the archive server is available to all and sundry. (when gnus-message-archive-method (unless (assoc "archive" gnus-server-alist) - (push `("archive" - nnfolder - "archive" - (nnfolder-directory - ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file - ,(nnheader-concat message-directory "archive/active")) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t)) - gnus-server-alist))) + (let ((method (or (and (stringp gnus-message-archive-method) + (gnus-server-to-method + gnus-message-archive-method)) + gnus-message-archive-method))) + ;; Check whether the archive method is writable. + (unless (or (stringp method) + (memq 'respool (assoc (format "%s" (car method)) + gnus-valid-select-methods))) + (setq method "archive")) ;; The default. + (push (if (stringp method) + `("archive" + nnfolder + ,method + (nnfolder-directory + ,(nnheader-concat message-directory method)) + (nnfolder-active-file + ,(nnheader-concat message-directory + (concat method "/active"))) + (nnfolder-get-new-mail nil) + (nnfolder-inhibit-expiry t)) + (cons "archive" method)) + gnus-server-alist)))) ;; If we don't read the complete active file, we fill in the ;; hashtb here. ＠＠ -1479,8 +1502,8 ＠＠ newsgroup." (setcdr active (cdr cache-active)))))))) (defun gnus-activate-group (group &optional scan dont-check method) - ;; Check whether a group has been activated or not. - ;; If SCAN, request a scan of that group as well. + "Check whether a group has been activated or not. +If SCAN, request a scan of that group as well." (let ((method (or method (inline (gnus-find-method-for-group group)))) active) (and (inline (gnus-check-server method)) ＠＠ -1511,12 +1534,21 ＠＠ newsgroup." (gnus-active group)) (gnus-active group) + ;; If a cache is present, we may have to alter the active info. + (when gnus-use-cache + (inline (gnus-cache-possibly-alter-active + group active))) + + ;; If the agent is enabled, we may have to alter the active info. + (when gnus-agent + (gnus-agent-possibly-alter-active group active)) + (gnus-set-active group active) ;; Return the new active info. active))))) (defun gnus-get-unread-articles-in-group (info active &optional update) - (when active + (when (and info active) ;; Allow the backend to update the info in the group. (when (and update (gnus-request-update-info ＠＠ -1526,6 +1558,10 ＠＠ newsgroup." (let* ((range (gnus-info-read info)) (num 0)) + + ;; These checks are present in gnus-activate-group but skipped + ;; due to setting dont-check in the preceeding call. + ;; If a cache is present, we may have to alter the active info. (when (and gnus-use-cache info) (inline (gnus-cache-possibly-alter-active ＠＠ -1533,8 +1569,7 ＠＠ newsgroup." ;; If the agent is enabled, we may have to alter the active info. (when (and gnus-agent info) - (gnus-agent-possibly-alter-active - (gnus-info-group info) active)) + (gnus-agent-possibly-alter-active (gnus-info-group info) active info)) ;; Modify the list of read articles according to what articles ;; are available; then tally the unread articles and add the ＠＠ -1630,7 +1665,7 ＠＠ newsgroup." (while newsrc (setq active (gnus-active (setq group (gnus-info-group - (setq info (pop newsrc)))))) + (setq info (pop newsrc)))))) ;; Check newsgroups. If the user doesn't want to check them, or ;; they can't be checked (for instance, if the news server can't ＠＠ -1653,61 +1688,60 ＠＠ newsgroup." (when (and method (not (setq method-type (cdr (assoc method type-cache))))) (setq method-type - (cond - ((gnus-secondary-method-p method) - 'secondary) - ((inline (gnus-server-equal gnus-select-method method)) - 'primary) - (t - 'foreign))) + (cond + ((gnus-secondary-method-p method) + 'secondary) + ((inline (gnus-server-equal gnus-select-method method)) + 'primary) + (t + 'foreign))) (push (cons method method-type) type-cache)) - (if (and method - (eq method-type 'foreign)) - ;; These groups are foreign. Check the level. - (when (and (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan))) - ;; Let the Gnus agent save the active file. - (when (and gnus-agent active (gnus-online method)) - (gnus-agent-save-group-info - method (gnus-group-real-name group) active)) - (unless (inline (gnus-virtual-group-p group)) - (inline (gnus-close-group group))) - (when (fboundp (intern (concat (symbol-name (car method)) - "-request-update-info"))) - (inline (gnus-request-update-info info method)))) - ;; These groups are native or secondary. - (cond - ;; We don't want these groups. - ((> (gnus-info-level info) level) - (setq active 'ignore)) - ;; Activate groups. - ((not gnus-read-active-file) - (if (gnus-check-backend-function 'retrieve-groups group) - ;; if server support gnus-retrieve-groups we push - ;; the group onto retrievegroups for later checking - (if (assoc method retrieve-groups) - (setcdr (assoc method retrieve-groups) - (cons group (cdr (assoc method retrieve-groups)))) - (push (list method group) retrieve-groups)) - ;; hack: `nnmail-get-new-mail' changes the mail-source depending - ;; on the group, so we must perform a scan for every group - ;; if the users has any directory mail sources. - ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, - ;; for it scan all spool files even when the groups are - ;; not required. - (if (and - (or nnmail-scan-directory-mail-source-once - (null (assq 'directory - (or mail-sources - (if (listp nnmail-spool-file) - nnmail-spool-file - (list nnmail-spool-file)))))) - (member method scanned-methods)) - (setq active (gnus-activate-group group)) - (setq active (gnus-activate-group group 'scan)) - (push method scanned-methods)) - (when active - (gnus-close-group group)))))) + + (cond ((and method (eq method-type 'foreign)) + ;; These groups are foreign. Check the level. + (when (and (<= (gnus-info-level info) foreign-level) + (setq active (gnus-activate-group group 'scan))) + ;; Let the Gnus agent save the active file. + (when (and gnus-agent active (gnus-online method)) + (gnus-agent-save-group-info + method (gnus-group-real-name group) active)) + (unless (inline (gnus-virtual-group-p group)) + (inline (gnus-close-group group))) + (when (fboundp (intern (concat (symbol-name (car method)) + "-request-update-info"))) + (inline (gnus-request-update-info info method))))) + ;; These groups are native or secondary. + ((> (gnus-info-level info) level) + ;; We don't want these groups. + (setq active 'ignore)) + ;; Activate groups. + ((not gnus-read-active-file) + (if (gnus-check-backend-function 'retrieve-groups group) + ;; if server support gnus-retrieve-groups we push + ;; the group onto retrievegroups for later checking + (if (assoc method retrieve-groups) + (setcdr (assoc method retrieve-groups) + (cons group (cdr (assoc method retrieve-groups)))) + (push (list method group) retrieve-groups)) + ;; hack: `nnmail-get-new-mail' changes the mail-source depending + ;; on the group, so we must perform a scan for every group + ;; if the users has any directory mail sources. + ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, + ;; for it scan all spool files even when the groups are + ;; not required. + (if (and + (or nnmail-scan-directory-mail-source-once + (null (assq 'directory + (or mail-sources + (if (listp nnmail-spool-file) + nnmail-spool-file + (list nnmail-spool-file)))))) + (member method scanned-methods)) + (setq active (gnus-activate-group group)) + (setq active (gnus-activate-group group 'scan)) + (push method scanned-methods)) + (when active + (gnus-close-group group))))) ;; Get the number of unread articles in the group. (cond ＠＠ -1734,8 +1768,8 ＠＠ newsgroup." (when (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan nil method)) (gnus-read-active-file-2 - (mapcar (lambda (group) (gnus-group-real-name group)) groups) - method) + (mapcar (lambda (group) (gnus-group-real-name group)) groups) + method) (dolist (group groups) (cond ((setq active (gnus-active (gnus-info-group ＠＠ -1872,7 +1906,7 ＠＠ newsgroup." (setcdr range (1- article)) (setq modified t) ranges)))))))) - + (when modified (when (eq modified 'remove-null) (setq r (delq nil r))) ＠＠ -1980,10 +2014,10 ＠＠ newsgroup." (while (setq info (pop newsrc)) (when (inline (gnus-server-equal - (inline - (gnus-find-method-for-group - (gnus-info-group info) info)) - gmethod)) + (inline + (gnus-find-method-for-group + (gnus-info-group info) info)) + gmethod)) (push (gnus-group-real-name (gnus-info-group info)) groups))) (gnus-read-active-file-2 groups method))) ＠＠ -2127,7 +2161,7 ＠＠ newsgroup." (gnus-online method) (gnus-agent-method-p method)) (progn - (gnus-agent-save-groups method) + (gnus-agent-save-active method) (gnus-active-to-gnus-format method hashtb nil real-active)) (goto-char (point-min)) ＠＠ -2203,17 +2237,94 ＠＠ If FORCE is non-nil, the .newsrc file is (gnus-convert-old-newsrc)))) (defun gnus-convert-old-newsrc () - "Convert old newsrc into the new format, if needed." + "Convert old newsrc formats into the current format, if needed." (let ((fcv (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version)))) - (cond - ;; No .newsrc.eld file was loaded. - ((null fcv) nil) - ;; Gnus 5 .newsrc.eld was loaded. - ((< fcv (gnus-continuum-version "September Gnus v0.1")) - (gnus-convert-old-ticks))))) + (gnus-continuum-version gnus-newsrc-file-version))) + (gcv (gnus-continuum-version))) + (when fcv + ;; A newsrc file was loaded. + (let (prompt-displayed + (converters + (sort + (mapcar (lambda (date-func) + (cons (gnus-continuum-version (car date-func)) + date-func)) + ;; This is a list of converters that must be run + ;; to bring the newsrc file up to the current + ;; version. If you create an incompatibility + ;; with older versions, you should create an + ;; entry here. The entry should consist of the + ;; current gnus version (hardcoded so that it + ;; doesn't change with each release) and the + ;; function that must be applied to convert the + ;; previous version into the current version. + '(("September Gnus v0.1" nil + gnus-convert-old-ticks) + ("Oort Gnus v0.08" "legacy-gnus-agent" + gnus-agent-convert-to-compressed-agentview) + ("Gnus v5.10.7" "legacy-gnus-agent" + gnus-agent-unlist-expire-days) + ("Gnus v5.10.7" "legacy-gnus-agent" + gnus-agent-unhook-expire-days))) + #'car-less-than-car))) + ;; Skip converters older than the file version + (while (and converters (>= fcv (caar converters))) + (pop converters)) + + ;; Perform converters to bring older version up to date. + (when (and converters (< fcv (caar converters))) + (while (and converters (< fcv (caar converters)) + (<= (caar converters) gcv)) + (let* ((converter-spec (pop converters)) + (convert-to (nth 1 converter-spec)) + (load-from (nth 2 converter-spec)) + (func (nth 3 converter-spec))) + (when (and load-from + (not (fboundp func))) + (load load-from t)) + (or prompt-displayed + (not (gnus-convert-converter-needs-prompt func)) + (while (let (c + (cursor-in-echo-area t) + (echo-keystrokes 0)) + (message "Convert gnus from version '%s' to '%s'? (n/y/?)" + gnus-newsrc-file-version gnus-version) + (setq c (read-char-exclusive)) + + (cond ((or (eq c ?n) (eq c ?N)) + (error "Can not start gnus without converting")) + ((or (eq c ?y) (eq c ?Y)) + (setq prompt-displayed t) + nil) + ((eq c ?\?) + (message "This conversion is irreversible. \ + To be safe, you should backup your files before proceeding.") + (sit-for 5) + t) + (t + (gnus-message 3 "Ignoring unexpected input") + (sit-for 3) + t))))) + + (funcall func convert-to))) + (gnus-dribble-enter + (format ";Converted gnus from version '%s' to '%s'." + gnus-newsrc-file-version gnus-version))))))) + +(defun gnus-convert-mark-converter-prompt (converter no-prompt) + "Indicate whether CONVERTER requires gnus-convert-old-newsrc to + display the conversion prompt. NO-PROMPT may be nil (prompt), + t (no prompt), or any form that can be called as a function. + The form should return either t or nil." + (put converter 'gnus-convert-no-prompt no-prompt)) + +(defun gnus-convert-converter-needs-prompt (converter) + (let ((no-prompt (get converter 'gnus-convert-no-prompt))) + (not (if (memq no-prompt '(t nil)) + no-prompt + (funcall no-prompt))))) -(defun gnus-convert-old-ticks () +(defun gnus-convert-old-ticks (converting-to) (let ((newsrc (cdr gnus-newsrc-alist)) marks info dormant ticked) (while (setq info (pop newsrc)) ＠＠ -2593,6 +2704,10 ＠＠ If FORCE is non-nil, the .newsrc file is ;; from the variable gnus-newsrc-alist. (when (and (or gnus-newsrc-alist gnus-killed-list) gnus-current-startup-file) + ;; Save agent range limits for the currently active method. + (when gnus-agent + (gnus-agent-save-local force)) + (save-excursion (if (and (or gnus-use-dribble-file gnus-slave) (not force) ＠＠ -2610,6 +2725,7 ＠＠ If FORCE is non-nil, the .newsrc file is (gnus-message 8 "Saving %s..." gnus-current-startup-file) (gnus-gnus-to-newsrc-format) (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) + ;; Save .newsrc.eld. (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*")) (make-local-variable 'version-control) Index: lisp/gnus-sum.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-sum.el,v retrieving revision 1.5 diff -u -p -u -r1.5 gnus-sum.el --- lisp/gnus-sum.el 28 Sep 2004 02:21:09 -0000 1.5 +++ lisp/gnus-sum.el 13 Mar 2005 00:11:47 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -44,6 +44,7 ＠＠ (autoload 'gnus-cache-write-active "gnus-cache") (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) +(autoload 'gnus-pick-line-number "gnus-salt" nil t) (autoload 'mm-uu-dissect "mm-uu") (autoload 'gnus-article-outlook-deuglify-article "deuglify" "Deuglify broken Outlook (Express) articles and redisplay." ＠＠ -118,7 +119,7 ＠＠ given by the `gnus-summary-same-subject' (defcustom gnus-summary-make-false-root-always nil "Always make a false dummy root." -:version "21.4" +:version "22.1" :group 'gnus-thread :type 'boolean) ＠＠ -219,7 +220,7 ＠＠ If this variable is nil, scoring will be "*Default threshold for a high scored article. An article will be highlighted as high scored if its score is greater than this score." -:version "21.4" +:version "22.1" :group 'gnus-score-default :type 'integer) ＠＠ -227,7 +228,7 ＠＠ than this score." "*Default threshold for a low scored article. An article will be highlighted as low scored if its score is smaller than this score." -:version "21.4" +:version "22.1" :group 'gnus-score-default :type 'integer) ＠＠ -263,7 +264,7 ＠＠ to expose hidden threads." (not (or (consp value) (functionp value)))) :value t) (const nil) - (sexp :tag "Predicate specifier" :size 0))) + (sexp :tag "Predicate specifier"))) (defcustom gnus-thread-hide-killed t "*If non-nil, hide killed threads automatically." ＠＠ -323,7 +324,7 ＠＠ the first unseen article), 'unseen-or-un line of the first unseen article or, if all article have been seen, on the subject line of the first unread article), or a function to be called to place point on some subject line." -:version "21.4" +:version "22.1" :group 'gnus-group-select :type '(choice (const best) (const unread) ＠＠ -367,7 +368,7 ＠＠ ignores articles whose headers have not NOTE: The list of unfetched articles will always be nil when plugged and, when unplugged, a subset of the undownloaded article list." -:version "21.4" +:version "22.1" :group 'gnus-summary-maneuvering :type '(choice (const :tag "None" nil) (const :tag "Undownloaded when unplugged" undownloaded) ＠＠ -428,6 +429,9 ＠＠ this variable specifies group names." (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) +;; FIXME: Although the custom type is `character' for the following variables, +;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs + (defcustom gnus-unread-mark ? ;Whitespace "*Mark used for unread articles." :group 'gnus-summary-marks ＠＠ -465,6 +469,7 ＠＠ this variable specifies group names." (defcustom gnus-spam-mark ?$ "*Mark used for spam articles." +:version "22.1" :group 'gnus-summary-marks :type 'character) ＠＠ -495,12 +500,13 ＠＠ this variable specifies group names." (defcustom gnus-forwarded-mark ?F "*Mark used for articles that have been forwarded." -:version "21.4" +:version "22.1" :group 'gnus-summary-marks :type 'character) (defcustom gnus-recent-mark ?N "*Mark used for articles that are recent." +:version "22.1" :group 'gnus-summary-marks :type 'character) ＠＠ -516,13 +522,13 ＠＠ this variable specifies group names." (defcustom gnus-unseen-mark ?. "*Mark used for articles that haven't been seen." -:version "21.4" +:version "22.1" :group 'gnus-summary-marks :type 'character) (defcustom gnus-no-mark ? ;Whitespace "*Mark used for articles that have no other secondary mark." -:version "21.4" +:version "22.1" :group 'gnus-summary-marks :type 'character) ＠＠ -548,6 +554,7 ＠＠ this variable specifies group names." (defcustom gnus-undownloaded-mark ?- "*Mark used for articles that weren't downloaded." +:version "22.1" :group 'gnus-summary-marks :type 'character) ＠＠ -886,16 +893,19 ＠＠ automatically when it is selected." (defcustom gnus-summary-article-move-hook nil "*A hook called after an article is moved, copied, respooled, or crossposted." +:version "22.1" :group 'gnus-summary :type 'hook) (defcustom gnus-summary-article-delete-hook nil "*A hook called after an article is deleted." +:version "22.1" :group 'gnus-summary :type 'hook) (defcustom gnus-summary-article-expire-hook nil "*A hook called after an article is expired." +:version "22.1" :group 'gnus-summary :type 'hook) ＠＠ -903,7 +913,7 ＠＠ automatically when it is selected." (and (fboundp 'display-graphic-p) (display-graphic-p)) "*If non-nil, display an arrow highlighting the current article." -:version "21.4" +:version "22.1" :group 'gnus-summary :type 'boolean) ＠＠ -1081,13 +1091,13 ＠＠ type of files to save." This is mostly relevant for slow back ends where the user may wish to widen the summary buffer to include all headers that were fetched. Say, for nnultimate groups." -:version "21.4" +:version "22.1" :group 'gnus-summary :type '(choice boolean regexp)) (defcustom gnus-summary-muttprint-program "muttprint" "Command (and optional arguments) used to run Muttprint." -:version "21.4" +:version "22.1" :group 'gnus-summary :type 'string) ＠＠ -1097,7 +1107,7 ＠＠ Some brain-damaged MUA/MTA, e.g. Lotus D supply the MIME-Version header or deliberately strip it from the mail. Set it to non-nil, Gnus will treat some articles as MIME even if the MIME-Version header is missed." -:version "21.4" +:version "22.1" :type 'boolean :group 'gnus-article-mime) ＠＠ -1106,7 +1116,7 ＠＠ the MIME-Version header is missed." This means that Gnus will search message bodies for text that look like uuencoded bits, yEncoded bits, and so on, and present that using the normal Gnus MIME machinery." -:version "21.4" +:version "22.1" :type 'boolean :group 'gnus-article-mime) ＠＠ -1693,6 +1703,7 ＠＠ increase the score of each group you rea "Q" gnus-summary-exit-no-update "\C-c\C-i" gnus-info-find-node gnus-mouse-2 gnus-mouse-pick-article + [follow-link] mouse-face "m" gnus-summary-mail-other-window "a" gnus-summary-post-news "i" gnus-summary-news-other-window ＠＠ -2235,8 +2246,12 ＠＠ gnus-summary-show-article-from-menu-as-c ["Pipe through a filter..." gnus-summary-pipe-output t] ["Add to SOUP packet" gnus-soup-add-article t] ["Print with Muttprint..." gnus-summary-muttprint t] - ["Print" gnus-summary-print-article t]) - ("Backend" + ["Print" gnus-summary-print-article + ,＠(if (featurep 'xemacs) '(t) + '(:help "Generate and print a PostScript image"))]) + ("Copy, move,... (Backend)" + ,＠(if (featurep 'xemacs) '(t) + '(:help "Copying, moving, expiring articles...")) ["Respool article..." gnus-summary-respool-article t] ["Move article..." gnus-summary-move-article (gnus-check-backend-function ＠＠ -2327,7 +2342,7 ＠＠ gnus-summary-show-article-from-menu-as-c `("Post" ["Send a message (mail or news)" gnus-summary-post-news ,＠(if (featurep 'xemacs) '(t) - '(:help "Post an article"))] + '(:help "Compose a new message (mail or news)"))] ["Followup" gnus-summary-followup ,＠(if (featurep 'xemacs) '(t) '(:help "Post followup to this article"))] ＠＠ -3217,34 +3232,55 ＠＠ buffer that was in action when the last (save-excursion (when (gnus-buffer-exists-p gnus-summary-buffer) (set-buffer gnus-summary-buffer)) - (let ((gnus-replied-mark 129) - (gnus-score-below-mark 130) - (gnus-score-over-mark 130) - (gnus-undownloaded-mark 131) - (spec gnus-summary-line-format-spec) - gnus-visual pos) + (let ((spec gnus-summary-line-format-spec) + pos) (save-excursion (gnus-set-work-buffer) - (let ((gnus-summary-line-format-spec spec) - (gnus-newsgroup-downloadable '(0))) - (gnus-summary-insert-line - [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil] - 0 nil t 128 t nil "" nil 1) + (let ((gnus-tmp-unread ?Z) + (gnus-replied-mark ?Z) + (gnus-score-below-mark ?Z) + (gnus-score-over-mark ?Z) + (gnus-undownloaded-mark ?Z) + (gnus-summary-line-format-spec spec) + (gnus-newsgroup-downloadable '(0)) + (header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]) + case-fold-search ignores) + ;; Here, all marks are bound to Z. + (gnus-summary-insert-line header + 0 nil t gnus-tmp-unread t nil "" nil 1) + (goto-char (point-min)) + ;; Memorize the positions of the same characters as dummy marks. + (while (re-search-forward "[A-D]" nil t) + (push (point) ignores)) + (erase-buffer) + ;; We use A-D as dummy marks in order to know column positions + ;; where marks should be inserted. + (setq gnus-tmp-unread ?A + gnus-replied-mark ?B + gnus-score-below-mark ?C + gnus-score-over-mark ?C + gnus-undownloaded-mark ?D) + (gnus-summary-insert-line header + 0 nil t gnus-tmp-unread t nil "" nil 1) + ;; Ignore characters which aren't dummy marks. + (dolist (p ignores) + (delete-region (goto-char (1- p)) p) + (insert ?Z)) (goto-char (point-min)) - (setq pos (list (cons 'unread (and (search-forward "\200" nil t) - (- (point) (point-min) 1))))) + (setq pos (list (cons 'unread + (and (search-forward "A" nil t) + (- (point) (point-min) 1))))) (goto-char (point-min)) - (push (cons 'replied (and (search-forward "\201" nil t) + (push (cons 'replied (and (search-forward "B" nil t) (- (point) (point-min) 1))) pos) (goto-char (point-min)) - (push (cons 'score (and (search-forward "\202" nil t) + (push (cons 'score (and (search-forward "C" nil t) (- (point) (point-min) 1))) pos) (goto-char (point-min)) - (push (cons 'download - (and (search-forward "\203" nil t) - (- (point) (point-min) 1))) + (push (cons 'download (and (search-forward "D" nil t) + (- (point) (point-min) 1))) pos))) (setq gnus-summary-mark-positions pos)))) ＠＠ -3541,9 +3577,11 ＠＠ If NO-DISPLAY, don't generate a summary (gnus-active gnus-newsgroup-name))) ;; You can change the summary buffer in some way with this hook. (gnus-run-hooks 'gnus-select-group-hook) - (gnus-update-format-specifications - nil 'summary 'summary-mode 'summary-dummy) - (gnus-update-summary-mark-positions) + (when (memq 'summary (gnus-update-format-specifications + nil 'summary 'summary-mode 'summary-dummy)) + ;; The format specification for the summary line was updated, + ;; so we need to update the mark positions as well. + (gnus-update-summary-mark-positions)) ;; Do score processing. (when gnus-use-scoring (gnus-possibly-score-headers)) ＠＠ -4601,39 +4639,39 ＠＠ Unscored articles will be counted as hav (defcustom gnus-sum-thread-tree-root "> " "With %B spec, used for the root of a thread. If nil, use subject instead." -:version "21.4" -:type '(radio (const :format "%v " nil) (string :size 0)) +:version "22.1" +:type '(radio (const :format "%v " nil) string) :group 'gnus-thread) (defcustom gnus-sum-thread-tree-false-root "> " "With %B spec, used for a false root of a thread. If nil, use subject instead." -:version "21.4" -:type '(radio (const :format "%v " nil) (string :size 0)) +:version "22.1" +:type '(radio (const :format "%v " nil) string) :group 'gnus-thread) (defcustom gnus-sum-thread-tree-single-indent "" "With %B spec, used for a thread with just one message. If nil, use subject instead." -:version "21.4" -:type '(radio (const :format "%v " nil) (string :size 0)) +:version "22.1" +:type '(radio (const :format "%v " nil) string) :group 'gnus-thread) (defcustom gnus-sum-thread-tree-vertical "| " "With %B spec, used for drawing a vertical line." -:version "21.4" +:version "22.1" :type 'string :group 'gnus-thread) (defcustom gnus-sum-thread-tree-indent " " "With %B spec, used for indenting." -:version "21.4" +:version "22.1" :type 'string :group 'gnus-thread) (defcustom gnus-sum-thread-tree-leaf-with-other "+-> " "With %B spec, used for a leaf with brothers." -:version "21.4" +:version "22.1" :type 'string :group 'gnus-thread) (defcustom gnus-sum-thread-tree-single-leaf "\\-> " "With %B spec, used for a leaf without brothers." -:version "21.4" +:version "22.1" :type 'string :group 'gnus-thread) ＠＠ -5058,16 +5096,7 ＠＠ If SELECT-ARTICLES, only select those ar group (gnus-status-message group))) (when gnus-agent - ;; The agent may be storing articles that are no longer in the - ;; server's active range. If that is the case, the active range - ;; needs to be expanded such that the agent's articles can be - ;; included in the summary. - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (alist (gnus-agent-load-alist group)) - (active (gnus-active group))) - (if (and (car alist) - (< (caar alist) (car active))) - (gnus-set-active group (cons (caar alist) (cdr active))))) + (gnus-agent-possibly-alter-active group (gnus-active group) info) (setq gnus-summary-use-undownloaded-faces (gnus-agent-find-parameter ＠＠ -5397,7 +5426,8 ＠＠ If SELECT-ARTICLES, only select those ar (min (car active)) (max (cdr active)) (types gnus-article-mark-lists) - marks var articles article mark mark-type) + marks var articles article mark mark-type + bgn end) (dolist (marks marked-lists) (setq mark (car marks) ＠＠ -5407,13 +5437,30 ＠＠ If SELECT-ARTICLES, only select those ar ;; We set the variable according to the type of the marks list, ;; and then adjust the marks to a subset of the active articles. (cond - ;; Adjust "simple" lists. + ;; Adjust "simple" lists - compressed yet unsorted ((eq mark-type 'list) - (set var (setq articles (gnus-uncompress-range (cdr marks)))) - (when (memq mark '(tick dormant expire reply save)) - (while articles - (when (or (< (setq article (pop articles)) min) (> article max)) - (set var (delq article (symbol-value var))))))) + ;; Simultaneously uncompress and clip to active range + ;; See gnus-uncompress-range for a description of possible marks + (let (l lh) + (if (not (cadr marks)) + (set var nil) + (setq articles (if (numberp (cddr marks)) + (list (cdr marks)) + (cdr marks)) + lh (cons nil nil) + l lh) + + (while (setq article (pop articles)) + (cond ((consp article) + (setq bgn (max (car article) min) + end (min (cdr article) max)) + (while (<= bgn end) + (setq l (setcdr l (cons bgn nil)) + bgn (1+ bgn)))) + ((and (<= min article) + (>= max article)) + (setq l (setcdr l (cons article nil)))))) + (set var (cdr lh))))) ;; Adjust assocs. ((eq mark-type 'tuple) (set var (setq articles (cdr marks))) ＠＠ -6009,8 +6056,7 ＠＠ the subject line on." ;; Remove list identifiers from subject. (when gnus-list-identifiers (let ((gnus-newsgroup-headers (list header))) - (gnus-summary-remove-list-identifiers) - (setq header (car gnus-newsgroup-headers)))) + (gnus-summary-remove-list-identifiers))) (when old-header (mail-header-set-number header (mail-header-number old-header))) (setq gnus-newsgroup-sparse ＠＠ -6347,15 +6393,15 ＠＠ displayed, no centering will be performe (while read (when first (while (< first nlast) - (push first unread) - (setq first (1+ first)))) + (setq unread (cons first unread) + first (1+ first)))) (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) (setq read (cdr read))))) ;; And add the last unread articles. (while (<= first last) - (push first unread) - (setq first (1+ first))) + (setq unread (cons first unread) + first (1+ first))) ;; Return the list of unread articles. (delq 0 (nreverse unread)))) ＠＠ -6373,6 +6419,44 ＠＠ displayed, no centering will be performe (cdr (assq 'dormant marked))) (cdr (assq 'tick marked)))))) +;; This function returns a sequence of article numbers based on the +;; difference between the ranges of read articles in this group and +;; the range of active articles. +(defun gnus-sequence-of-unread-articles (group) + (let* ((read (gnus-info-read (gnus-get-info group))) + (active (or (gnus-active group) (gnus-activate-group group))) + (last (cdr active)) + first nlast unread) + ;; If none are read, then all are unread. + (if (not read) + (setq first (car active)) + ;; If the range of read articles is a single range, then the + ;; first unread article is the article after the last read + ;; article. Sounds logical, doesn't it? + (if (and (not (listp (cdr read))) + (or (< (car read) (car active)) + (progn (setq read (list read)) + nil))) + (setq first (max (car active) (1+ (cdr read)))) + ;; `read' is a list of ranges. + (when (/= (setq nlast (or (and (numberp (car read)) (car read)) + (caar read))) + 1) + (setq first (car active))) + (while read + (when first + (push (cons first nlast) unread)) + (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) + (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) + (setq read (cdr read))))) + ;; And add the last unread articles. + (cond ((< first last) + (push (cons first last) unread)) + ((= first last) + (push first unread))) + ;; Return the sequence of unread articles. + (delq 0 (nreverse unread)))) + ;; Various summary commands (defun gnus-summary-select-article-buffer () ＠＠ -6593,15 +6677,16 ＠＠ If FORCE (the prefix), also save the .ne (when (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf))) (setq gnus-current-select-method gnus-select-method) - (if leave-hidden - (set-buffer gnus-group-buffer) - (pop-to-buffer gnus-group-buffer)) - (if (not quit-config) - (progn - (goto-char group-point) - (unless leave-hidden - (gnus-configure-windows 'group 'force))) - (gnus-handle-ephemeral-exit quit-config)) + (set-buffer gnus-group-buffer) + (if quit-config + (gnus-handle-ephemeral-exit quit-config) + (goto-char group-point) + ;; If gnus-group-buffer is already displayed, make sure we also move + ;; the cursor in the window that displays it. + (let ((win (get-buffer-window (current-buffer) 0))) + (if win (set-window-point win (point)))) + (unless leave-hidden + (gnus-configure-windows 'group 'force))) ;; Clear the current group name. (unless quit-config (setq gnus-newsgroup-name nil))))) ＠＠ -6964,7 +7049,7 ＠＠ If optional argument UNREAD is non-nil, (gnus-summary-goto-subject article t))) (gnus-summary-limit (append articles gnus-newsgroup-limit)) (gnus-summary-position-point)) - + (defun gnus-summary-goto-subject (article &optional force silent) "Go the subject line of ARTICLE. If FORCE, also allow jumping to articles not currently shown." ＠＠ -8732,7 +8817,8 ＠＠ If ARG is a negative number, hide the un (inhibit-point-motion-hooks t) (hidden (if (numberp arg) (>= arg 0) - (gnus-article-hidden-text-p 'headers))) + (or (not (looking-at "[^ \t\n]+:")) + (gnus-article-hidden-text-p 'headers)))) s e) (delete-region (point-min) (point-max)) (with-current-buffer gnus-original-article-buffer ＠＠ -8777,7 +8863,9 ＠＠ forward." (let ((start (window-start)) buffer-read-only) (message-caesar-buffer-body arg) - (set-window-start (get-buffer-window (current-buffer)) start)))))) + (set-window-start (get-buffer-window (current-buffer)) start))))) + ;; Create buttons and stuff... + (gnus-treat-article nil)) (autoload 'unmorse-region "morse" "Convert morse coded text in region to ordinary ASCII text." ＠＠ -9059,7 +9147,7 ＠＠ ACTION can be either `move' (the default ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) - + (gnus-summary-goto-subject article) (when (eq action 'move) (gnus-summary-mark-article article gnus-canceled-mark)))) ＠＠ -9100,6 +9188,7 ＠＠ If nil, use to the current newsgroup met "If non-nil, show and update the summary buffer as it's being built. If the value is t, update the buffer after every line is inserted. If the value is an integer (N), update the display every N lines." +:version "22.1" :group 'gnus-thread :type '(choice (const :tag "off" nil) number ＠＠ -9402,7 +9491,8 ＠＠ groups." `(lambda () (let ((mbl mml-buffer-list)) (setq mml-buffer-list nil) - (mime-to-mml ,'current-handles) + (let ((rfc2047-quote-decoded-words-containing-tspecials t)) + (mime-to-mml ,'current-handles)) (let ((mbl1 mml-buffer-list)) (setq mml-buffer-list mbl) (set (make-local-variable 'mml-buffer-list) mbl1)) ＠＠ -11298,7 +11388,8 ＠＠ If REVERSE, save parts that do not match (default-high gnus-summary-default-high-score) (default-low gnus-summary-default-low-score) (uncached (and gnus-summary-use-undownloaded-faces - (memq article gnus-newsgroup-undownloaded)))) + (memq article gnus-newsgroup-undownloaded) + (not (memq article gnus-newsgroup-cached))))) (let ((face (funcall (gnus-summary-highlight-line-0)))) (unless (eq face (get-text-property beg 'face)) (gnus-put-text-property-excluding-characters-with-faces ＠＠ -11683,5 +11774,5 ＠＠ If ALL is a number, fetch this number of ;; coding: iso-8859-1 ;; End: -;;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235 +;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235 ;;; gnus-sum.el ends here Index: lisp/gnus-util.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-util.el,v retrieving revision 1.7 diff -u -p -u -r1.7 gnus-util.el --- lisp/gnus-util.el 28 Sep 2004 02:21:10 -0000 1.7 +++ lisp/gnus-util.el 13 Mar 2005 00:11:48 -0000 ＠＠ -38,7 +38,11 ＠＠ (eval-when-compile (require 'cl) ;; Fixme: this should be a gnus variable, not nnmail-. - (defvar nnmail-pathname-coding-system)) + (defvar nnmail-pathname-coding-system) + + ;; Inappropriate references to other parts of Gnus. + (defvar gnus-emphasize-whitespace-regexp) + ) (require 'time-date) (require 'netrc) ＠＠ -56,10 +60,20 ＠＠ ((fboundp 'replace-in-string) (defalias 'gnus-replace-in-string 'replace-in-string)) ((fboundp 'replace-regexp-in-string) - (defun gnus-replace-in-string (string regexp newtext &optional literal) + (defun gnus-replace-in-string (string regexp newtext &optional literal) + "Replace all matches for REGEXP with NEWTEXT in STRING. +If LITERAL is non-nil, insert NEWTEXT literally. Return a new +string containing the replacements. + +This is a compatibility function for different Emacsen." (replace-regexp-in-string regexp newtext string nil literal))) (t (defun gnus-replace-in-string (string regexp newtext &optional literal) + "Replace all matches for REGEXP with NEWTEXT in STRING. +If LITERAL is non-nil, insert NEWTEXT literally. Return a new +string containing the replacements. + +This is a compatibility function for different Emacsen." (let ((start 0) tail) (while (string-match regexp string start) (setq tail (- (length string) (match-end 0))) ＠＠ -694,6 +708,23 ＠＠ Bind `print-quoted' and `print-readably' (when (file-exists-p file) (delete-file file))) +(defun gnus-delete-directory (directory) + "Delete files in DIRECTORY. Subdirectories remain. +If there's no subdirectory, delete DIRECTORY as well." + (when (file-directory-p directory) + (let ((files (directory-files + directory t "^\$[^.]\\|\\.\\([^.]\\|\\..\$\\).*")) + file dir) + (while files + (setq file (pop files)) + (if (eq t (car (file-attributes file))) + ;; `file' is a subdirectory. + (setq dir t) + ;; `file' is a file or a symlink. + (delete-file file))) + (unless dir + (delete-directory directory))))) + (defun gnus-strip-whitespace (string) "Return STRING stripped of all whitespace." (while (string-match "[\r\n\t ]+" string) ＠＠ -1094,7 +1125,7 ＠＠ Return the modified alist." (standard-output (lambda (c) (aset ,buffer ,leng c) - + (if (= ,size (setq ,leng (1+ ,leng))) (progn (write-region ,buffer nil ,file ,append 'no-msg) (setq ,leng 0 ＠＠ -1163,7 +1194,7 ＠＠ Return the modified alist." Setting it to nil has no effect after the first time `gnus-byte-compile' is run." :type 'boolean -:version "21.4" +:version "22.1" :group 'gnus-various) (defun gnus-byte-compile (form) ＠＠ -1186,7 +1217,7 ＠＠ is run." "Delete by side effect any elements of LIST whose car is `equal' to KEY. The modified LIST is returned. If the first member of LIST has a car that is `equal' to KEY, there is no way to remove it -by side effect; therefore, write `(setq foo (remassoc key foo))' to be +by side effect; therefore, write `(setq foo (gnus-remassoc key foo))' to be sure of changing the value of `foo'." (when alist (if (equal key (caar alist)) ＠＠ -1511,6 +1542,28 ＠＠ predicate on the elements." ")")) ""))) (t emacs-version)))) + +(defun gnus-rename-file (old-path new-path &optional trim) + "Rename OLD-PATH as NEW-PATH. If TRIM, recursively delete +empty directories from OLD-PATH." + (when (file-exists-p old-path) + (let* ((old-dir (file-name-directory old-path)) + (old-name (file-name-nondirectory old-path)) + (new-dir (file-name-directory new-path)) + (new-name (file-name-nondirectory new-path)) + temp) + (gnus-make-directory new-dir) + (rename-file old-path new-path t) + (when trim + (while (progn (setq temp (directory-files old-dir)) + (while (member (car temp) '("." "..")) + (setq temp (cdr temp))) + (= (length temp) 0)) + (delete-directory old-dir) + (setq old-dir (file-name-as-directory + (file-truename + (concat old-dir ".."))))))))) + (provide 'gnus-util) Index: lisp/gnus-win.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-win.el,v retrieving revision 1.3 diff -u -p -u -r1.3 gnus-win.el --- lisp/gnus-win.el 28 Sep 2004 02:21:10 -0000 1.3 +++ lisp/gnus-win.el 13 Mar 2005 00:11:48 -0000 ＠＠ -62,6 +62,7 ＠＠ "*If non-nil, frames on all displays will be considered useable by Gnus. When nil, only frames on the same display as the selected frame will be used to display Gnus windows." +:version "22.1" :group 'gnus-windows :type 'boolean) ＠＠ -198,6 +199,7 ＠＠ See the Gnus manual for an explanation o (defcustom gnus-configure-windows-hook nil "*A hook called when configuring windows." +:version "22.1" :group 'gnus-windows :type 'hook) Index: lisp/gnus.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus.el,v retrieving revision 1.6 diff -u -p -u -r1.6 gnus.el --- lisp/gnus.el 28 Sep 2004 02:21:10 -0000 1.6 +++ lisp/gnus.el 13 Mar 2005 00:11:49 -0000 ＠＠ -34,6 +34,7 ＠＠ (require 'wid-edit) (require 'mm-util) (require 'nnheader) +(autoload 'message-y-or-n-p "message" nil nil 'macro) (defgroup gnus nil "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." ＠＠ -282,7 +283,7 ＠＠ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.10.6" +(defconst gnus-version-number "5.10.7" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) ＠＠ -325,7 +326,8 ＠＠ be set in `.emacs' instead." (defvar gnus-mode-line-image-cache t) (if (fboundp 'find-image) (defun gnus-mode-line-buffer-identification (line) - (let ((str (car-safe line))) + (let ((str (car-safe line)) + (load-path (mm-image-load-path))) (if (and (stringp str) (string-match "^Gnus:" str)) (progn (add-text-properties ＠＠ -874,7 +876,7 ＠＠ be set in `.emacs' instead." ((and (fboundp 'find-image) (display-graphic-p) - (let* ((data-directory (nnheader-find-etc-directory "gnus")) + (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) (image (find-image `((:type xpm :file "gnus.xpm" :color-symbols ＠＠ -963,7 +965,7 ＠＠ For example: (\"mail\\\\.me\" (gnus-use-scoring t)) (\"list\\\\..*\" (total-expire . t) (broken-reply-to . t)))" -:version "21.4" +:version "22.1" :group 'gnus-group-various :type '(repeat (cons regexp (repeat sexp)))) ＠＠ -1313,6 +1315,7 ＠＠ If the default site is too slow, try one (gnus-replace-in-string name "\\." "-") "-charter.html"))) "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter. When FORM is evaluated `name' is bound to the name of the group." +:version "22.1" :group 'gnus-group-various :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form")))) ＠＠ -1320,6 +1323,7 ＠＠ When FORM is evaluated `name' is bound t "*Non-nil means that control messages are displayed using `browse-url'. Otherwise they are fetched with ange-ftp and displayed in an ephemeral group." +:version "22.1" :group 'gnus-group-various :type 'boolean) ＠＠ -1778,7 +1782,7 ＠＠ total number of articles in the group.") (list (regexp :tag "Group Name Regular Expression") (boolean :tag "Ignored"))) - + :parameter-type '(boolean :tag "Group Ignored by the Registry") :parameter-document "Whether the Gnus Registry should ignore this group.") ＠＠ -1787,6 +1791,7 ＠＠ total number of articles in the group.") (defcustom gnus-install-group-spam-parameters t "*Disable the group parameters for spam detection. Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report." +:version "22.1" :type 'boolean :group 'gnus-start) ＠＠ -1814,11 +1819,12 ＠＠ registry.") :variable gnus-spam-newsgroup-contents :variable-default nil :variable-document - "*Groups in which to automatically mark new articles as spam on -summary entry. If non-nil, this should be a list of group name -regexps that should match all groups in which to do automatic spam -tagging, associated with a classification (spam, ham, or neither). -This only makes sense for mail groups." + "*Group classification (spam, ham, or neither). Only +meaningful when spam.el is loaded. If non-nil, this should be a +list of group name regexps associated with a classification for +each one. In spam groups, new articles are marked as spam on +summary entry. There is other behavior associated with ham and +no classification when spam.el is loaded - see the manual." :variable-group spam :variable-type '(repeat (list :tag "Group contents spam/ham classification" ＠＠ -1835,7 +1841,9 ＠＠ This only makes sense for mail groups." (const :tag "Unclassified" nil))) :parameter-document "The spam classification (spam, ham, or neither) of this group. -When a spam group is entered, all unread articles are marked as spam.") +When a spam group is entered, all unread articles are marked as +spam. There is other behavior associated with ham and no +classification when spam.el is loaded - see the manual.") (defvar gnus-group-spam-exit-processor-ifile "ifile" "OBSOLETE: The ifile summary exit spam processor.") ＠＠ -1887,8 +1895,8 ＠＠ Only applicable to non-spam (unclassifie (gnus-define-group-parameter spam-process :type list -:parameter-type - '(choice +:parameter-type + '(choice :tag "Spam Summary Exit Processor" :value nil (list :tag "Spam Summary Exit Processor Choices" ＠＠ -1929,11 +1937,11 ＠＠ a backend on summary exit. If non-nil, name regexps that should match all groups in which to do automatic spam processing, associated with the appropriate processor." :variable-group spam -:variable-type +:variable-type '(repeat :tag "Spam/Ham Processors" (list :tag "Spam Summary Exit Processor Choices" (regexp :tag "Group Regexp") - (set + (set :tag "Spam/Ham Summary Exit Processor" (variable-item gnus-group-spam-exit-processor-ifile) (variable-item gnus-group-spam-exit-processor-stat) ＠＠ -1968,7 +1976,7 ＠＠ spam processing, associated with the app (gnus-define-group-parameter spam-autodetect :type list -:parameter-type +:parameter-type '(boolean :tag "Spam autodetection") :function-document "Should spam be autodetected (with spam-split) in this group?" ＠＠ -1979,7 +1987,7 ＠＠ spam processing, associated with the app Only unseen articles will be examined, unless spam-autodetect-recheck-messages is set." :variable-group spam -:variable-type +:variable-type '(repeat :tag "Autodetection setting" (list ＠＠ -1993,7 +2001,7 ＠＠ spam-autodetect-recheck-messages is set. (gnus-define-group-parameter spam-autodetect-methods :type list -:parameter-type +:parameter-type '(choice :tag "Spam autodetection-specific methods" (const none) (const default) ＠＠ -2020,7 +2028,7 ＠＠ Requires the spam-autodetect parameter. will be examined, unless spam-autodetect-recheck-messages is set." :variable-group spam -:variable-type +:variable-type '(repeat :tag "Autodetection methods" (list ＠＠ -2042,7 +2050,7 ＠＠ set." (variable-item spam-use-bogofilter-headers) (variable-item spam-use-bogofilter))))) :parameter-document - "Spam autodetection methods. + "Spam autodetection methods. Requires the spam-autodetect parameter. Only unseen articles will be examined, unless spam-autodetect-recheck-messages is set.") ＠＠ -2050,7 +2058,7 ＠＠ set.") (gnus-define-group-parameter spam-process-destination :type list -:parameter-type +:parameter-type '(choice :tag "Destination for spam-processed articles at summary exit" (string :tag "Move to a group") (repeat :tag "Move to multiple groups" ＠＠ -2068,7 +2076,7 ＠＠ to do spam-processed article moving, ass group or nil for explicit expiration. This only makes sense for mail groups." :variable-group spam -:variable-type +:variable-type '(repeat :tag "Spam-processed articles destination" (list ＠＠ -2081,11 +2089,11 ＠＠ mail groups." (const :tag "Expire" nil)))) :parameter-document "Where spam-processed articles will go at summary exit.") - + (gnus-define-group-parameter ham-process-destination :type list -:parameter-type +:parameter-type '(choice :tag "Destination for ham articles at summary exit from a spam group" (string :tag "Move to a group") ＠＠ -2105,7 +2113,7 ＠＠ to do ham article moving, associated wit group or nil for explicit ignoring. This only makes sense for mail groups, and only works in spam groups." :variable-group spam -:variable-type +:variable-type '(repeat :tag "Ham articles destination" (list ＠＠ -2292,7 +2300,7 ＠＠ face." When set, Gnus will prefer using the locally stored content rather than re-fetching it from the server. You also need to enable `gnus-agent' for this to have any affect." -:version "21.4" +:version "22.1" :group 'gnus-agent :type 'boolean) ＠＠ -2311,7 +2319,7 ＠＠ covered by that variable." You may customize gnus-agent to disable its use. However, some back ends have started to use the agent as a client-side cache. Disabling the agent may result in noticeable loss of performance." -:version "21.4" +:version "22.1" :group 'gnus-agent :type 'boolean) ＠＠ -2343,7 +2351,7 ＠＠ It can be one of the symbols `gnus' $sh `emacs-gnus' plus system configuration$, `emacs-gnus-type' $same as `emacs-gnus' plus system type$ or a custom string. If you set it to a string, be sure to use a valid format, see RFC 2616." -:version "21.4" +:version "22.1" :group 'gnus-message :type '(choice (item :tag "Show Gnus and Emacs versions and system type" ＠＠ -3261,6 +3269,38 ＠＠ that that variable is buffer-local to th (nth 1 method)))) method))) +(defsubst gnus-method-to-server (method) + (catch 'server-name + (setq method (or method gnus-select-method)) + + ;; Perhaps it is already in the cache. + (mapc (lambda (name-method) + (if (equal (cdr name-method) method) + (throw 'server-name (car name-method)))) + gnus-server-method-cache) + + (mapc + (lambda (server-alist) + (mapc (lambda (name-method) + (when (gnus-methods-equal-p (cdr name-method) method) + (unless (member name-method gnus-server-method-cache) + (push name-method gnus-server-method-cache)) + (throw 'server-name (car name-method)))) + server-alist)) + (let ((alists (list gnus-server-alist + gnus-predefined-server-alist))) + (if gnus-select-method + (push (list (cons "native" gnus-select-method)) alists)) + alists)) + + (let* ((name (if (member (cadr method) '(nil "")) + (format "%s" (car method)) + (format "%s:%s" (car method) (cadr method)))) + (name-method (cons name method))) + (unless (member name-method gnus-server-method-cache) + (push name-method gnus-server-method-cache)) + name))) + (defsubst gnus-server-to-method (server) "Map virtual server names to select methods." (or (and server (listp server) server) ＠＠ -3295,7 +3335,7 ＠＠ that that variable is buffer-local to th ;; gnus-server-method-cache so this only happens once, ;; if at all. (let (match) - (mapcar + (mapcar (lambda (info) (let ((info-method (gnus-info-method info))) (unless (stringp info-method) ＠＠ -3308,38 +3348,6 ＠＠ that that variable is buffer-local to th (push (cons server result) gnus-server-method-cache)) result))) -(defsubst gnus-method-to-server (method) - (catch 'server-name - (setq method (or method gnus-select-method)) - - ;; Perhaps it is already in the cache. - (mapc (lambda (name-method) - (if (equal (cdr name-method) method) - (throw 'server-name (car name-method)))) - gnus-server-method-cache) - - (mapc - (lambda (server-alist) - (mapc (lambda (name-method) - (when (gnus-methods-equal-p (cdr name-method) method) - (unless (member name-method gnus-server-method-cache) - (push name-method gnus-server-method-cache)) - (throw 'server-name (car name-method)))) - server-alist)) - (let ((alists (list gnus-server-alist - gnus-predefined-server-alist))) - (if gnus-select-method - (push (list (cons "native" gnus-select-method)) alists)) - alists)) - - (let* ((name (if (member (cadr method) '(nil "")) - (format "%s" (car method)) - (format "%s:%s" (car method) (cadr method)))) - (name-method (cons name method))) - (unless (member name-method gnus-server-method-cache) - (push name-method gnus-server-method-cache)) - name))) - (defsubst gnus-server-get-method (group method) ;; Input either a server name, and extended server name, or a ;; select method, and return a select method. ＠＠ -3917,9 +3925,6 ＠＠ If NEWSGROUP is nil, return the global k (setq valids (cdr valids))) outs)) -(eval-when-compile - (autoload 'message-y-or-n-p "message" nil nil 'macro)) - (defun gnus-read-group (prompt &optional default) "Prompt the user for a group name. Disallow invalid group names." ＠＠ -3991,10 +3996,10 ＠＠ Allow completion over sensible values." (defun gnus-agent-method-p (method) "Say whether METHOD is covered by the agent." (or (eq (car gnus-agent-method-p-cache) method) - (setq gnus-agent-method-p-cache + (setq gnus-agent-method-p-cache (cons method - (member (if (stringp method) - method + (member (if (stringp method) + method (gnus-method-to-server method)) gnus-agent-covered-methods)))) (cdr gnus-agent-method-p-cache)) Index: lisp/gpg.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gpg.el,v retrieving revision 1.5 diff -u -p -u -r1.5 gpg.el --- lisp/gpg.el 28 Sep 2004 02:21:11 -0000 1.5 +++ lisp/gpg.el 13 Mar 2005 00:11:50 -0000 ＠＠ -106,7 +106,9 ＠＠ ;;; Code: -(require 'timer) +(if (featurep 'xemacs) + (require 'timer-funcs) + (require 'timer)) (eval-when-compile (require 'cl)) (eval-and-compile ＠＠ -115,6 +117,21 ＠＠ 'point-at-eol 'line-end-position))) +;; itimer/timer compatibility +(eval-and-compile + (if (featurep 'xemacs) + (progn + (defalias 'gpg-cancel-timer 'delete-itimer) + (defalias 'gpg-timer-activate 'activate-itimer) + (defalias 'gpg-timer-create 'make-itimer) + (defalias 'gpg-timer-set-function 'set-itimer-function) + (defalias 'gpg-timer-set-time 'set-itimer-value)) + (defalias 'gpg-cancel-timer 'cancel-timer) + (defalias 'gpg-timer-activate 'timer-activate) + (defalias 'gpg-timer-create 'timer-create) + (defalias 'gpg-timer-set-function 'timer-set-function) + (defalias 'gpg-timer-set-time 'timer-set-time))) + ;;;; Customization: ;;; Customization: Groups: ＠＠ -779,7 +796,7 ＠＠ evaluates BODY, like `progn'. If BODY e ;;; Passphrase handling: (defvar gpg-passphrase-timer - (timer-create) + (gpg-timer-create) "This timer will clear the passphrase cache periodically.") (defvar gpg-passphrase ＠＠ -799,7 +816,7 ＠＠ evaluates BODY, like `progn'. If BODY e "Forget stored passphrase." (interactive) (when gpg-passphrase - (cancel-timer gpg-passphrase-timer) + (gpg-cancel-timer gpg-passphrase-timer) (setq gpg-passphrase-timer nil) (gpg-passphrase-clear-string gpg-passphrase) (setq gpg-passphrase nil))) ＠＠ -809,14 +826,14 ＠＠ evaluates BODY, like `progn'. If BODY e Updates the timeout for clearing the cache to `gpg-passphrase-timeout'." (unless (equal gpg-passphrase-timeout 0) (if (null gpg-passphrase-timer) - (setq gpg-passphrase-timer (timer-create))) - (timer-set-time gpg-passphrase-timer - (timer-relative-time (current-time) - gpg-passphrase-timeout)) - (timer-set-function gpg-passphrase-timer 'gpg-passphrase-forget) + (setq gpg-passphrase-timer (gpg-timer-create))) + (gpg-timer-set-time gpg-passphrase-timer + (timer-relative-time (current-time) + gpg-passphrase-timeout)) + (gpg-timer-set-function gpg-passphrase-timer 'gpg-passphrase-forget) (unless (and (fboundp 'itimer-live-p) (itimer-live-p gpg-passphrase-timer)) - (timer-activate gpg-passphrase-timer)) + (gpg-timer-activate gpg-passphrase-timer)) (setq gpg-passphrase passphrase)) passphrase) Index: lisp/html2text.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/html2text.el,v retrieving revision 1.3 diff -u -p -u -r1.3 html2text.el --- lisp/html2text.el 28 Sep 2004 02:21:11 -0000 1.3 +++ lisp/html2text.el 13 Mar 2005 00:11:50 -0000 ＠＠ -24,11 +24,11 ＠＠ ;; These functions provide a simple way to wash/clean html infected ;; mails. Definitely do not work in all cases, but some improvement -;; in readability is generally obtained. Formatting is only done in +;; in readability is generally obtained. Formatting is only done in ;; the buffer, so the next time you enter the article it will be ;; "re-htmlized". ;; -;; The main function is "html2text" +;; The main function is `html2text'. ;;; Code: ＠＠ -47,9 +47,9 ＠＠ "The map of entity to text. This is an alist were each element is a dotted pair consisting of an -old string, and a replacement string. This replacement is done by the -function \"html2text-substitute\" which basically performs a -replace-string operation for every element in the list. This is +old string, and a replacement string. This replacement is done by the +function `html2text-substitute' which basically performs a +`replace-string' operation for every element in the list. This is completely verbatim - without any use of REGEXP.") (defvar html2text-remove-tag-list ＠＠ -57,11 +57,11 ＠＠ completely verbatim - without any use of "A list of removable tags. This is a list of tags which should be removed, without any -formatting. Observe that if you the tags in the list are presented -*without* any \"<\" or \">\". All occurences of a tag appearing in -this list are removed, irrespective of whether it is a closing or -opening tag, or if the tag has additional attributes. The actual -deletion is done by the function \"html2text-remove-tags\". +formatting. Note that tags in the list are presented *without* +any \"<\" or \">\". All occurences of a tag appearing in this +list are removed, irrespective of whether it is a closing or +opening tag, or if the tag has additional attributes. The +deletion is done by the function `html2text-remove-tags'. For instance the text: ＠＠ -75,8 +75,10 ＠＠ If this list contains the element \"font (defvar html2text-format-tag-list '(("b" . html2text-clean-bold) + ("strong" . html2text-clean-bold) ("u" . html2text-clean-underline) ("i" . html2text-clean-italic) + ("em" . html2text-clean-italic) ("blockquote" . html2text-clean-blockquote) ("a" . html2text-clean-anchor) ("ul" . html2text-clean-ul) ＠＠ -86,7 +88,7 ＠＠ If this list contains the element \"font "An alist of tags and processing functions. This is an alist where each dotted pair consists of a tag, and then -the name of a function to be called when this tag is found. The +the name of a function to be called when this tag is found. The function is called with the arguments p1, p2, p3 and p4. These are demontrated below: ＠＠ -116,24 +118,16 ＠＠ formatting, and then moved afterward.") ;; <Utility functions> ;; -(defun html2text-buffer-head () - (if (string= mode-name "Article") - (beginning-of-buffer) - (beginning-of-buffer) - ) - ) -(defun html2text-replace-string (from-string to-string p1 p2) - (goto-char p1) +(defun html2text-replace-string (from-string to-string min max) + "Replace FROM-STRING with TO-STRING in region from MIN to MAX." + (goto-char min) (let ((delta (- (string-width to-string) (string-width from-string))) (change 0)) - (while (search-forward from-string p2 t) + (while (search-forward from-string max t) (replace-match to-string) - (setq change (+ change delta)) - ) - change - ) - ) + (setq change (+ change delta))) + change)) ;; ;; </Utility functions> ＠＠ -146,11 +140,11 ＠＠ formatting, and then moved afterward.") ;; <Functions related to attributes> i.e. ;; -(defun html2text-attr-value (attr-list attr) - (nth 1 (assoc attr attr-list)) - ) +(defun html2text-attr-value (list attribute) + "Get value of ATTRIBUTE from LIST." + (nth 1 (assoc attribute list))) -(defun html2text-get-attr (p1 p2 tag) +(defun html2text-get-attr (p1 p2) (goto-char p1) (re-search-forward " +[^ ]" p2 t) (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2))) ＠＠ -167,14 +161,10 ＠＠ formatting, and then moved afterward.") ((string-match "[^ ]=[^ ]" prev) (let ((attr (nth 0 (split-string prev "="))) (value (nth 1 (split-string prev "=")))) - (setq attr-list (cons (list attr value) attr-list)) - ) - ) + (setq attr-list (cons (list attr value) attr-list)))) ;; size= 3 ((string-match "[^ ]=\\'" prev) - (setq attr-list (cons (list (substring prev 0 -1) this) attr-list)) - ) - ) + (setq attr-list (cons (list (substring prev 0 -1) this) attr-list)))) (while (< index (length tmp-list)) (cond ＠＠ -182,29 +172,20 ＠＠ formatting, and then moved afterward.") ((string-match "[^ ]=[^ ]" this) (let ((attr (nth 0 (split-string this "="))) (value (nth 1 (split-string this "=")))) - (setq attr-list (cons (list attr value) attr-list)) - ) - ) + (setq attr-list (cons (list attr value) attr-list)))) ;; size =3 ((string-match "\\`=[^ ]" this) (setq attr-list (cons (list prev (substring this 1)) attr-list))) - ;; size= 3 ((string-match "[^ ]=\\'" this) - (setq attr-list (cons (list (substring this 0 -1) next) attr-list)) - ) - + (setq attr-list (cons (list (substring this 0 -1) next) attr-list))) ;; size = 3 ((string= "=" this) - (setq attr-list (cons (list prev next) attr-list)) - ) - ) + (setq attr-list (cons (list prev next) attr-list)))) (setq index (1+ index)) (setq prev this) (setq this next) - (setq next (nth (1+ index) tmp-list)) - ) - + (setq next (nth (1+ index) tmp-list))) ;; ;; Tags with no accompanying "=" i.e. value=nil ;; ＠＠ -213,41 +194,25 ＠＠ formatting, and then moved afterward.") (setq next (nth 2 tmp-list)) (setq index 1) - (if (not (string-match "=" prev)) - (progn - (if (not (string= (substring this 0 1) "=")) - (setq attr-list (cons (list prev nil) attr-list)) - ) - ) - ) - + (when (and (not (string-match "=" prev)) + (not (string= (substring this 0 1) "="))) + (setq attr-list (cons (list prev nil) attr-list))) (while (< index (1- (length tmp-list))) - (if (not (string-match "=" this)) - (if (not (or (string= (substring next 0 1) "=") - (string= (substring prev -1) "="))) - (setq attr-list (cons (list this nil) attr-list)) - ) - ) + (when (and (not (string-match "=" this)) + (not (or (string= (substring next 0 1) "=") + (string= (substring prev -1) "=")))) + (setq attr-list (cons (list this nil) attr-list))) (setq index (1+ index)) (setq prev this) (setq this next) - (setq next (nth (1+ index) tmp-list)) - ) + (setq next (nth (1+ index) tmp-list))) - (if this - (progn - (if (not (string-match "=" this)) - (progn - (if (not (string= (substring prev -1) "=")) - (setq attr-list (cons (list this nil) attr-list)) - ) - ) - ) - ) - ) - attr-list ;; return - value - ) - ) + (when (and this + (not (string-match "=" this)) + (not (string= (substring prev -1) "="))) + (setq attr-list (cons (list this nil) attr-list))) + ;; return - value + attr-list)) ;; ;; </Functions related to attributes> ＠＠ -272,10 +237,7 ＠＠ formatting, and then moved afterward.") (cond ((string= list-type "ul") (insert " o ")) ((string= list-type "ol") (insert (format " %s: " item-nr))) - (t (insert " x "))) - ) - ) - ) + (t (insert " x ")))))) (defun html2text-clean-dtdd (p1 p2) (goto-char p1) ＠＠ -314,61 +276,51 ＠＠ formatting, and then moved afterward.") (html2text-delete-single-tag p1 p2) (goto-char p1) (newline 1) - (insert (make-string fill-column ?-)) - ) + (insert (make-string fill-column ?-))) (defun html2text-clean-ul (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul") - ) + (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul")) (defun html2text-clean-ol (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol") - ) + (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol")) (defun html2text-clean-dl (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-dtdd p1 (- p3 (- p1 p2))) - ) + (html2text-clean-dtdd p1 (- p3 (- p1 p2)))) (defun html2text-clean-center (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (center-region p1 (- p3 (- p2 p1))) - ) + (center-region p1 (- p3 (- p2 p1)))) (defun html2text-clean-bold (p1 p2 p3 p4) (put-text-property p2 p3 'face 'bold) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-title (p1 p2 p3 p4) (put-text-property p2 p3 'face 'bold) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-underline (p1 p2 p3 p4) (put-text-property p2 p3 'face 'underline) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-italic (p1 p2 p3 p4) (put-text-property p2 p3 'face 'italic) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-font (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-blockquote (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-anchor (p1 p2 p3 p4) - ;; If someone can explain how to make the URL clickable I will - ;; surely improve upon this. - (let* ((attr-list (html2text-get-attr p1 p2 "a")) + ;; If someone can explain how to make the URL clickable I will surely + ;; improve upon this. + ;; Maybe `goto-addr.el' can be used here. + (let* ((attr-list (html2text-get-attr p1 p2)) (href (html2text-attr-value attr-list "href"))) (delete-region p1 p4) (when href ＠＠ -392,38 +344,27 ＠＠ formatting, and then moved afterward.") (let ((has-br-line) (refill-start) (refill-stop)) - (if (re-search-forward " $" p2 t) - (setq has-br-line t) - ) - (if has-br-line - (progn - (goto-char p1) - (if (re-search-forward ".+[^<][^b][^r][^>]$" p2 t) - (progn - (beginning-of-line) - (setq refill-start (point)) - (goto-char p2) - (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t) - (next-line 1) - (end-of-line) - ;; refill-stop should ideally be adjusted to - ;; accomodate the " " strings which are removed - ;; between refill-start and refill-stop. Can simply - ;; be returned from my-replace-string - (setq refill-stop (+ (point) - (html2text-replace-string - " " "" - refill-start (point)))) - ;; (message "Point = %s refill-stop = %s" (point) refill-stop) - ;; (sleep-for 4) - (fill-region refill-start refill-stop) - ) - ) - ) - ) - ) - (html2text-replace-string " " "" p1 p2) - ) + (when (re-search-forward " $" p2 t) + (goto-char p1) + (when (re-search-forward ".+[^<][^b][^r][^>]$" p2 t) + (beginning-of-line) + (setq refill-start (point)) + (goto-char p2) + (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t) + (next-line 1) + (end-of-line) + ;; refill-stop should ideally be adjusted to + ;; accomodate the " " strings which are removed + ;; between refill-start and refill-stop. Can simply + ;; be returned from my-replace-string + (setq refill-stop (+ (point) + (html2text-replace-string + " " "" + refill-start (point)))) + ;; (message "Point = %s refill-stop = %s" (point) refill-stop) + ;; (sleep-for 4) + (fill-region refill-start refill-stop)))) + (html2text-replace-string " " "" p1 p2)) ;; ;; This one is interactive ... ＠＠ -432,11 +373,11 ＠＠ formatting, and then moved afterward.") "This _tries_ to fix up the paragraphs - this is done in quite a ad-hook fashion, quite close to pure guess-work. It does work in some cases though." (interactive) - (html2text-buffer-head) + (goto-char (point-min)) (replace-regexp "^ $" "") ;; Removing lonely on a single line, if they are left intact we ;; dont have any paragraphs at all. - (html2text-buffer-head) + (goto-char (point-min)) (while (not (eobp)) (let ((p1 (point))) (forward-paragraph 1) ＠＠ -458,27 +399,26 ＠＠ fashion, quite close to pure guess-work. ;; (defun html2text-remove-tags (tag-list) - "Removes the tags listed in the list \"html2text-remove-tag-list\". + "Removes the tags listed in the list `html2text-remove-tag-list'. See the documentation for that variable." (interactive) (dolist (tag tag-list) - (html2text-buffer-head) + (goto-char (point-min)) (while (re-search-forward (format "\$</?%s[^>]*>\$" tag) (point-max) t) (delete-region (match-beginning 0) (match-end 0))))) (defun html2text-format-tags () - "See the variable \"html2text-format-tag-list\" for documentation" + "See the variable `html2text-format-tag-list' for documentation." (interactive) (dolist (tag-and-function html2text-format-tag-list) (let ((tag (car tag-and-function)) (function (cdr tag-and-function))) - (html2text-buffer-head) + (goto-char (point-min)) (while (re-search-forward (format "\$<%s\\( [^>]*\$?>\\)" tag) (point-max) t) (let ((p1) (p2 (point)) - (p3) (p4) - (attr (match-string 1))) + (p3) (p4)) (search-backward "<" (point-min) t) (setq p1 (point)) (re-search-forward (format "</%s>" tag) (point-max) t) ＠＠ -486,44 +426,30 ＠＠ See the documentation for that variable. (search-backward "</" (point-min) t) (setq p3 (point)) (funcall function p1 p2 p3 p4) - (goto-char p1) - ) - ) - ) - ) - ) + (goto-char p1)))))) (defun html2text-substitute () - "See the variable \"html2text-replace-list\" for documentation" + "See the variable `html2text-replace-list' for documentation." (interactive) (dolist (e html2text-replace-list) - (html2text-buffer-head) + (goto-char (point-min)) (let ((old-string (car e)) (new-string (cdr e))) - (html2text-replace-string old-string new-string (point-min) (point-max)) - ) - ) - ) + (html2text-replace-string old-string new-string (point-min) (point-max))))) (defun html2text-format-single-elements () - "" (interactive) (dolist (tag-and-function html2text-format-single-element-list) (let ((tag (car tag-and-function)) (function (cdr tag-and-function))) - (html2text-buffer-head) + (goto-char (point-min)) (while (re-search-forward (format "\$<%s\\( [^>]*\$?>\\)" tag) (point-max) t) (let ((p1) (p2 (point))) (search-backward "<" (point-min) t) (setq p1 (point)) - (funcall function p1 p2) - ) - ) - ) - ) - ) + (funcall function p1 p2)))))) ;; ;; Main function ＠＠ -546,6 +472,6 ＠＠ See the documentation for that variable. ;; ;; </Interactive functions> ;; - +(provide 'html2text) ;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e ;;; html2text.el ends here Index: lisp/imap.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/imap.el,v retrieving revision 1.4 diff -u -p -u -r1.4 imap.el --- lisp/imap.el 28 Sep 2004 02:21:11 -0000 1.4 +++ lisp/imap.el 13 Mar 2005 00:11:51 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; imap.el --- imap library -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2005 ;; Free Software Foundation, Inc. ;; Author: Simon Josefsson <jas(a)pdc.kth.se> ＠＠ -69,7 +69,7 ＠＠ ;; imap-message-append, imap-envelope-from ;; imap-body-lines ;; -;; It is my hope that theese commands should be pretty self +;; It is my hope that these commands should be pretty self ;; explanatory for someone that know IMAP. All functions have ;; additional documentation on how to invoke them. ;; ＠＠ -228,7 +228,7 ＠＠ pipe, or t or `pty' to use a pty. The v system has no ptys or if all ptys are busy: then a pipe is used in any case. The value takes effect when a IMAP server is opened, changing it after that has no effect." -:version "21.4" +:version "22.1" :group 'imap :type 'boolean) ＠＠ -241,12 +241,20 ＠＠ encoded mailboxes which doesn't translat :type 'boolean) (defcustom imap-log nil - "If non-nil, a imap session trace is placed in *imap-log* buffer." + "If non-nil, a imap session trace is placed in *imap-log* buffer. +Note that username, passwords and other privacy sensitive +information (such as e-mail) may be stored in the *imap-log* +buffer. It is not written to disk, however. Do not enable this +variable unless you are comfortable with that." :group 'imap :type 'boolean) (defcustom imap-debug nil - "If non-nil, random debug spews are placed in *imap-debug* buffer." + "If non-nil, random debug spews are placed in *imap-debug* buffer. +Note that username, passwords and other privacy sensitive +information (such as e-mail) may be stored in the *imap-debug* +buffer. It is not written to disk, however. Do not enable this +variable unless you are comfortable with that." :group 'imap :type 'boolean) ＠＠ -270,6 +278,11 ＠＠ Shorter values mean quicker response, bu :type 'number :group 'imap) +(defcustom imap-store-password nil + "If non-nil, store session password without promting." +:group 'imap +:type 'boolean) + ;; Various variables. (defvar imap-fetch-data-hook nil ＠＠ -320,7 +333,7 ＠＠ for doing the actual authentication.") (defvar imap-error nil "Error codes from the last command.") -;; Internal constants. Change theese and die. +;; Internal constants. Change these and die. (defconst imap-default-port 143) (defconst imap-default-ssl-port 993) ＠＠ -827,9 +840,10 ＠＠ Returns t if login was successful, nil o (progn (setq ret t imap-username user) - (if (and (not imap-password) - (y-or-n-p "Store password for this session? ")) - (setq imap-password passwd))) + (when (and (not imap-password) + (or imap-store-password + (y-or-n-p "Store password for this session? "))) + (setq imap-password passwd))) (message "Login failed...") (setq passwd nil) (setq imap-password nil) ＠＠ -1450,7 +1464,7 ＠＠ or 'unseen. The IMAP command tag is ret (defun imap-fetch (uids props &optional receive nouidfetch buffer) "Fetch properties PROPS from message set UIDS from server in BUFFER. UIDS can be a string, number or a list of numbers. If RECEIVE -is non-nil return theese properties." +is non-nil return these properties." (with-current-buffer (or buffer (current-buffer)) (when (imap-ok-p (imap-send-command-wait (format "%sFETCH %s %s" (if nouidfetch "" "UID ") ＠＠ -2421,7 +2435,7 ＠＠ Return nil if no complete line has arriv (defun imap-parse-flag-list () (let (flag-list start) - (assert (eq (char-after) ?$) t "In imap-parse-flag-list") + (assert (eq (char-after) ?\() nil "In imap-parse-flag-list") (while (and (not (eq (char-after) ?$)) (setq start (progn (imap-forward) ＠＠ -2430,7 +2444,7 ＠＠ Return nil if no complete line has arriv (point))) (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0)) (push (buffer-substring start (point)) flag-list)) - (assert (eq (char-after) ?\)) t "In imap-parse-flag-list") + (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list") (imap-forward) (nreverse flag-list))) ＠＠ -2515,7 +2529,7 ＠＠ Return nil if no complete line has arriv (while (eq (char-after) ?\ ) (imap-forward) (push (imap-parse-body-extension) b-e)) - (assert (eq (char-after) ?\)) t "In imap-parse-body-extension") + (assert (eq (char-after) ?\)) nil "In imap-parse-body-extension") (imap-forward) (nreverse b-e)) (or (imap-parse-number) ＠＠ -2641,7 +2655,7 ＠＠ Return nil if no complete line has arriv (push (and (imap-parse-nil) nil) body)) (setq body (append (imap-parse-body-ext) body))) ;; body-ext-... - (assert (eq (char-after) ?\)) t "In imap-parse-body") + (assert (eq (char-after) ?\)) nil "In imap-parse-body") (imap-forward) (nreverse body)) ＠＠ -2701,7 +2715,7 ＠＠ Return nil if no complete line has arriv (push (imap-parse-nstring) body) ;; body-fld-md5 (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part.. - (assert (eq (char-after) ?\)) t "In imap-parse-body 2") + (assert (eq (char-after) ?\)) nil "In imap-parse-body 2") (imap-forward) (nreverse body))))) Index: lisp/legacy-gnus-agent.el =================================================================== RCS file: lisp/legacy-gnus-agent.el diff -N lisp/legacy-gnus-agent.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/legacy-gnus-agent.el 13 Mar 2005 00:11:51 -0000 ＠＠ -0,0 +1,227 ＠＠ +(require 'gnus-start) +(require 'gnus-util) +(require 'gnus-range) +(require 'gnus-agent) + +; Oort Gnus v0.08 - This release updated agent to no longer use +; history file and to support a compressed alist. + +(defvar gnus-agent-compressed-agentview-search-only nil) + +(defun gnus-agent-convert-to-compressed-agentview (converting-to) + "Iterates over all agentview files to ensure that they have been +converted to the compressed format." + + (let ((search-in (list gnus-agent-directory)) + here + members + member + converted-something) + (while (setq here (pop search-in)) + (setq members (directory-files here t)) + (while (setq member (pop members)) + (cond ((string-match "/\\.\\.?$" member) + nil) + ((file-directory-p member) + (push member search-in)) + ((equal (file-name-nondirectory member) ".agentview") + (setq converted-something + (or (gnus-agent-convert-agentview member) + converted-something)))))) + + (if converted-something + (gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to)))) + +(defun gnus-agent-convert-to-compressed-agentview-prompt () + (catch 'found-file-to-convert + (let ((gnus-agent-compressed-agentview-search-only t)) + (gnus-agent-convert-to-compressed-agentview nil)))) + +(gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt) + +(defun gnus-agent-convert-agentview (file) + "Load FILE and do a `read' there." + (with-temp-buffer + (nnheader-insert-file-contents file) + (goto-char (point-min)) + (let ((inhibit-quit t) + (alist (read (current-buffer))) + (version (condition-case nil (read (current-buffer)) + (end-of-file 0))) + changed-version + history-file) + + (cond + ((= version 0) + (let (entry + (gnus-command-method nil)) + (mm-disable-multibyte) ;; everything is binary + (erase-buffer) + (insert "\n") + (let ((file (concat (file-name-directory file) "/history"))) + (when (file-exists-p file) + (nnheader-insert-file-contents file) + (setq history-file file))) + + (goto-char (point-min)) + (while (not (eobp)) + (if (and (looking-at + "[^\t\n]+\t\$[0-9]+\$\t\$[^ \n]+\$ \$[0-9]+\$") + (string= (gnus-agent-article-name ".agentview" (match-string 2)) + file) + (setq entry (assoc (string-to-number (match-string 3)) alist))) + (setcdr entry (string-to-number (match-string 1)))) + (forward-line 1)) + (setq changed-version t))) + ((= version 1) + (setq changed-version t))) + + (when changed-version + (when gnus-agent-compressed-agentview-search-only + (throw 'found-file-to-convert t)) + + (erase-buffer) + (let ((compressed nil)) + (mapcar (lambda (pair) + (let* ((article-id (car pair)) + (day-of-download (cdr pair)) + (comp-list (assq day-of-download compressed))) + (if comp-list + (setcdr comp-list + (cons article-id (cdr comp-list))) + (setq compressed + (cons (list day-of-download article-id) + compressed))) + nil)) alist) + (mapcar (lambda (comp-list) + (setcdr comp-list + (gnus-compress-sequence + (nreverse (cdr comp-list))))) + compressed) + (princ compressed (current-buffer))) + (insert "\n2\n") + (write-file file) + (when history-file + (delete-file history-file)) + t)))) + +;; End of Oort Gnus v0.08 updates + +;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus +;; from previous versions. Therefore, the previous +;; hacks to handle a gnus-agent-expire-days that +;; specifies a list of values can be removed. + +(defun gnus-agent-unlist-expire-days (converting-to) + (when (listp gnus-agent-expire-days) + (let (buffer) + (unwind-protect + (save-window-excursion + (setq buffer (gnus-get-buffer-create " *Gnus agent upgrade*")) + (set-buffer buffer) + (erase-buffer) + (insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n ") + (gnus-pp gnus-agent-expire-days) + + (insert "\nIn order to use version '" converting-to "' of gnus, you will need to set\n") + (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n") + (insert "expiration days to individual groups, you must instead set the\n") + (insert "'agent-days-until-old group and/or topic parameter.\n") + (insert "\n") + (insert "If you would like, gnus can iterate over every group comparing its name to the\n") + (insert "regular expressions that you currently have in gnus-agent-expire-days. When\n") + (insert "gnus finds a match, it will update that group's 'agent-days-until-old group\n") + (insert "parameter to the value associated with the regular expression.\n") + (insert "\n") + (insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n") + (insert "ERROR as soon as this function completes. The reason is that you must\n") + (insert "manually edit your configuration to either not set gnus-agent-expire-days or\n") + (insert "to set it to an integer before gnus can be used.\n") + (insert "\n") + (insert "Once you have successfully edited gnus-agent-expire-days, gnus will be able to\n") + (insert "execute past this function.\n") + (insert "\n") + (insert "Should gnus use gnus-agent-expire-days to assign\n") + (insert "agent-days-until-old parameters to individual groups? (Y/N)") + + (switch-to-buffer buffer) + (beep) + (beep) + + (let ((echo-keystrokes 0) + c) + (while (progn (setq c (read-char-exclusive)) + (cond ((or (eq c ?y) (eq c ?Y)) + (save-excursion + (let ((groups (gnus-group-listed-groups))) + (while groups + (let* ((group (pop groups)) + (days gnus-agent-expire-days) + (day (catch 'found + (while days + (when (eq 0 (string-match + (caar days) + group)) + (throw 'found (cadar days))) + (setq days (cdr days))) + nil))) + (when day + (gnus-group-set-parameter group 'agent-days-until-old + day)))))) + nil + ) + ((or (eq c ?n) (eq c ?N)) + nil) + (t + t)))))) + (kill-buffer buffer)) + (error "Change gnus-agent-expire-days to an integer for gnus to start.")))) + +;; The gnus-agent-unlist-expire-days has its own conversion prompt. +;; Therefore, hide the default prompt. +(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t) + +(defun gnus-agent-unhook-expire-days (converting-to) + "Remove every lambda from gnus-group-prepare-hook that mention the +symbol gnus-agent-do-once in their definition. This should NOT be +necessary as gnus-agent.el no longer adds them. However, it is +possible that the hook was persistently saved." + (let ((h t)) ; iterate from bgn of hook + (while h + (let ((func (progn (when (eq h t) + ;; init h to list of functions + (setq h (cond ((listp gnus-group-prepare-hook) + gnus-group-prepare-hook) + ((boundp 'gnus-group-prepare-hook) + (list gnus-group-prepare-hook))))) + (pop h)))) + + (when (cond ((eq (type-of func) 'compiled-function) + ;; Search def. of compiled function for gnus-agent-do-once string + (let* (definition + print-level + print-length + (standard-output + (lambda (char) + (setq definition (cons char definition))))) + (princ func) ; populates definition with reversed list of characters + (let* ((i (length definition)) + (s (make-string i 0))) + (while definition + (aset s (setq i (1- i)) (pop definition))) + + (string-match "\\bgnus-agent-do-once\\b" s)))) + ((listp func) + (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; handles eval'd lambda + )) + + (remove-hook 'gnus-group-prepare-hook func) + ;; I don't what remove-hook is going to actually do to the + ;; hook list so start over from the beginning. + (setq h t)))))) + +;; gnus-agent-unhook-expire-days is safe in that it does not modify +;; the .newsrc.eld file. +(gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t) + +;;; arch-tag: 845c7b8a-88f7-4468-b8d7-94e8fc72cf1a Index: lisp/lpath.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/lpath.el,v retrieving revision 1.6 diff -u -p -u -r1.6 lpath.el --- lisp/lpath.el 28 Sep 2004 02:21:11 -0000 1.6 +++ lisp/lpath.el 13 Mar 2005 00:11:51 -0000 ＠＠ -10,13 +10,12 ＠＠ (mapcar (lambda (var) (unless (boundp var) (set var nil))) args)) (maybe-fbind '(Info-directory - Info-menu bbdb-create-internal bbdb-records create-image + Info-menu create-image display-graphic-p find-coding-system find-image image-size image-type-available-p insert-image make-mode-line-mouse-map make-temp-file propertize put-image replace-regexp-in-string rmail-msg-is-pruned rmail-msg-restore-non-pruned-header - sort-coding-systems spam-BBDB-register-routine - spam-enter-ham-BBDB string-to-multibyte tool-bar-add-item + sort-coding-systems string-to-multibyte tool-bar-add-item tool-bar-add-item-from-menu tool-bar-local-item-from-menu url-generic-parse-url url-http-file-exists-p url-insert-file-contents vcard-pretty-print w32-focus-frame Index: lisp/mail-source.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mail-source.el,v retrieving revision 1.5 diff -u -p -u -r1.5 mail-source.el --- lisp/mail-source.el 28 Sep 2004 02:21:12 -0000 1.5 +++ lisp/mail-source.el 13 Mar 2005 00:11:52 -0000 ＠＠ -236,7 +236,7 ＠＠ See Info node `(gnus)Mail Source Specifi "*Ignore errors when querying mail sources. If nil, the user will be prompted when an error occurs. If non-nil, the error will be ignored." -:version "21.4" +:version "22.1" :group 'mail-source :type 'boolean) ＠＠ -257,7 +257,7 ＠＠ If non-nil, this maildrop will be checke :type 'file) (defcustom mail-source-directory message-directory - "Directory where files (if any) will be stored." + "Directory where incoming mail source files (if any) will be stored." :group 'mail-source :type 'directory) ＠＠ -284,7 +284,7 ＠＠ files older than number of days." "*If non-nil, ask for for confirmation before deleting old incoming files. This variable only applies when `mail-source-delete-incoming' is a positive number." -:version "21.4" +:version "22.1" :group 'mail-source :type 'boolean) ＠＠ -305,7 +305,7 ＠＠ number." (defcustom mail-source-movemail-program nil "If non-nil, name of program for fetching new mail." -:version "21.4" +:version "22.1" :group 'mail-source :type '(choice (const nil) string)) ＠＠ -512,7 +512,7 ＠＠ Return the number of files that were fou (format "Mail source %s error (%s). Continue? " (if (memq ':password source) (let ((s (copy-sequence source))) - (setcar (cdr (memq ':password s)) + (setcar (cdr (memq ':password s)) "********") s) source) ＠＠ -862,7 +862,7 ＠＠ See the Gnus manual for details." (eval-when-compile (if (featurep 'xemacs) - (require 'itimer) + (require 'timer-funcs) (require 'timer))) (defun mail-source-start-idle-timer () Index: lisp/mailcap.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mailcap.el,v retrieving revision 1.4 diff -u -p -u -r1.4 mailcap.el --- lisp/mailcap.el 28 Sep 2004 02:21:12 -0000 1.4 +++ lisp/mailcap.el 13 Mar 2005 00:11:52 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; mailcap.el --- MIME media types configuration -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: William M. Perry <wmperry(a)aventail.com> ＠＠ -135,23 +135,21 ＠＠ (non-viewer . t) (type . "application/zip") ("copiousoutput")) - ;; Prefer free viewers. ("pdf" (viewer . "gv -safer %s") (type . "application/pdf") (test . window-system) ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command))) ("pdf" - (viewer . "xpdf %s") + (viewer . "gpdf %s") (type . "application/pdf") ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) (test . (eq window-system 'x))) ("pdf" - (viewer . "acroread %s") - (type . "application/pdf") - ("print" . ,(concat "cat %s | acroread -toPostScript | " - mailcap-print-command)) - (test . window-system)) + (viewer . "xpdf %s") + (type . "application/pdf") + ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) + (test . (eq window-system 'x))) ("pdf" (viewer . ,(concat "pdftotext %s -")) (type . "application/pdf") Index: lisp/message.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/message.el,v retrieving revision 1.5 diff -u -p -u -r1.5 message.el --- lisp/message.el 28 Sep 2004 02:21:12 -0000 1.5 +++ lisp/message.el 13 Mar 2005 00:11:55 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; message.el --- composing mail and news messages -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -135,7 +135,7 ＠＠ mailbox format." (defcustom message-fcc-externalize-attachments nil "If non-nil, attachments are included as external parts in Fcc copies." -:version "21.4" +:version "22.1" :type 'boolean :group 'message-sending) ＠＠ -146,7 +146,7 ＠＠ If the string contains the format spec \ the article has been posted to will be inserted there. If this variable is nil, no such courtesy message will be added." :group 'message-sending -:type '(radio (string :format "%t: %v\n" :size 0) (const nil))) +:type '(radio string (const nil))) (defcustom message-ignored-bounced-headers "^\$Received\\|Return-Path\\|Delivered-To\$:" ＠＠ -175,7 +175,7 ＠＠ Otherwise, most addresses look like `ang (defcustom message-insert-canlock t "Whether to insert a Cancel-Lock header in news postings." -:version "21.4" +:version "22.1" :group 'message-headers :type 'boolean) ＠＠ -204,7 +204,7 ＠＠ Checks include `subject-cmsg', `multiple "*Headers to be generated or prompted for when sending a message. Also see `message-required-news-headers' and `message-required-mail-headers'." -:version "21.4" +:version "22.1" :group 'message-news :group 'message-headers :link '(custom-manual "(message)Message Headers") ＠＠ -212,7 +212,7 ＠＠ Also see `message-required-news-headers' (defcustom message-draft-headers '(References From) "*Headers to be generated when saving a draft message." -:version "21.4" +:version "22.1" :group 'message-news :group 'message-headers :link '(custom-manual "(message)Message Headers") ＠＠ -255,7 +255,12 ＠＠ included. Organization and User-Agent a :group 'message-news :group 'message-headers :link '(custom-manual "(message)Message Headers") -:type 'regexp) +:type '(repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) + regexp)) (defcustom message-ignored-mail-headers "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" ＠＠ -271,7 +276,12 ＠＠ It's best to delete old Path and Date he any confusion." :group 'message-interface :link '(custom-manual "(message)Superseding") -:type 'regexp) +:type '(repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) + regexp)) (defcustom message-subject-re-regexp "^[ \t]*\$[Rr][Ee]\\(\\[[0-9]*\\]\$*:[ \t]*\\)*[ \t]*" ＠＠ -290,7 +300,7 ＠＠ the user what do do. In this case, the `message-subject-trailing-was-query' is t, always strip the trailing old subject. In this case, `message-subject-trailing-was-regexp' is used." -:version "21.4" +:version "22.1" :type '(choice (const :tag "never" nil) (const :tag "always strip" t) (const ask)) ＠＠ -307,7 +317,7 ＠＠ the variable is t instead of `ask', use `message-subject-trailing-was-regexp' instead. It is okay to create some false positives here, as the user is asked." -:version "21.4" +:version "22.1" :group 'message-various :link '(custom-manual "(message)Message Headers") :type 'regexp) ＠＠ -320,51 +330,43 ＠＠ If `message-subject-trailing-was-query' matched against `message-subject-trailing-was-regexp' in `message-strip-subject-trailing-was'. You should use a regexp creating very few false positives here." -:version "21.4" +:version "22.1" :group 'message-various :link '(custom-manual "(message)Message Headers") :type 'regexp) -;; Fixme: Why are all these things autoloaded? - ;;; marking inserted text -;;;###autoload (defcustom message-mark-insert-begin "--8<---------------cut here---------------start------------->8---\n" "How to mark the beginning of some inserted text." -:version "21.4" +:version "22.1" :type 'string :link '(custom-manual "(message)Insertion Variables") :group 'message-various) -;;;###autoload (defcustom message-mark-insert-end "--8<---------------cut here---------------end--------------->8---\n" "How to mark the end of some inserted text." -:version "21.4" +:version "22.1" :type 'string :link '(custom-manual "(message)Insertion Variables") :group 'message-various) -;;;###autoload -(defcustom message-archive-header - "X-No-Archive: Yes\n" +(defcustom message-archive-header "X-No-Archive: Yes\n" "Header to insert when you don't want your article to be archived. Archives $such as groups.google.com$ respect this header." -:version "21.4" +:version "22.1" :type 'string :link '(custom-manual "(message)Header Commands") :group 'message-various) -;;;###autoload (defcustom message-archive-note "X-No-Archive: Yes - save http://groups.google.com/" "Note to insert why you wouldn't want this posting archived. If nil, don't insert any text in the body." -:version "21.4" -:type '(radio (string :format "%t: %v\n" :size 0) - (const nil)) +:version "22.1" +:type '(radio string (const nil)) :link '(custom-manual "(message)Header Commands") :group 'message-various) ＠＠ -376,40 +378,33 ＠＠ If nil, don't insert any text in the bod "Old target for cross-posts or follow-ups.") (make-variable-buffer-local 'message-cross-post-old-target) -;;;###autoload (defcustom message-cross-post-default t "When non-nil `message-cross-post-followup-to' will perform a crosspost. If nil, `message-cross-post-followup-to' will only do a followup. Note that you can explicitly override this setting by calling `message-cross-post-followup-to' with a prefix." -:version "21.4" +:version "22.1" :type 'boolean :group 'message-various) -;;;###autoload -(defcustom message-cross-post-note - "Crosspost & Followup-To: " +(defcustom message-cross-post-note "Crosspost & Followup-To: " "Note to insert before signature to notify of cross-post and follow-up." -:version "21.4" +:version "22.1" :type 'string :group 'message-various) -;;;###autoload -(defcustom message-followup-to-note - "Followup-To: " +(defcustom message-followup-to-note "Followup-To: " "Note to insert before signature to notify of follow-up only." -:version "21.4" +:version "22.1" :type 'string :group 'message-various) -;;;###autoload -(defcustom message-cross-post-note-function - 'message-cross-post-insert-note +(defcustom message-cross-post-note-function 'message-cross-post-insert-note "Function to use to insert note about Crosspost or Followup-To. The function will be called with four arguments. The function should not only insert a note, but also ensure old notes are deleted. See the documentation for `message-cross-post-insert-note'." -:version "21.4" +:version "22.1" :type 'function :group 'message-various) ＠＠ -534,13 +529,22 ＠＠ Done before generating the new subject o "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface :link '(custom-manual "(message)Resending") -:type 'regexp) +:type '(repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) + regexp)) (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" "*All headers that match this regexp will be deleted when forwarding a message." :version "21.1" :group 'message-forwarding -:type '(choice (const :tag "None" nil) +:type '(repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) regexp)) (defcustom message-ignored-cited-headers "." ＠＠ -568,6 +572,7 ＠＠ Done before generating the new subject o non-word-constituents "]\\)+>+\\|[ \t]*[]>|}+]\\)+")))) "*Regexp matching the longest possible citation prefix on a line." +:version "22.1" :group 'message-insertion :link '(custom-manual "(message)Insertion Variables") :type 'regexp) ＠＠ -652,7 +657,7 ＠＠ always query the user whether to use the If nil, always ignore the header. If it is the symbol `ask', always query the user whether to use the value. If it is the symbol `use', always use the value." -:version "21.4" +:version "22.1" :group 'message-interface :link '(custom-manual "(message)Mailing Lists") :type '(choice (const :tag "ignore" nil) ＠＠ -666,7 +671,7 ＠＠ If non-nil, this variable contains a lis regular expressions to match lists. These functions can be used in conjunction with `message-subscribed-regexps' and `message-subscribed-addresses'." -:version "21.4" +:version "22.1" :group 'message-interface :link '(custom-manual "(message)Mailing Lists") :type '(repeat sexp)) ＠＠ -675,18 +680,17 ＠＠ conjunction with `message-subscribed-reg "*A file containing addresses the user is subscribed to. If nil, do not look at any files to determine list subscriptions. If non-nil, each line of this file should be a mailing list address." -:version "21.4" +:version "22.1" :group 'message-interface :link '(custom-manual "(message)Mailing Lists") -:type '(radio (file :format "%t: %v\n" :size 0) - (const nil))) +:type '(radio file (const nil))) (defcustom message-subscribed-addresses nil "*Specifies a list of addresses the user is subscribed to. If nil, do not use any predefined list subscriptions. This list of addresses can be used in conjunction with `message-subscribed-address-functions' and `message-subscribed-regexps'." -:version "21.4" +:version "22.1" :group 'message-interface :link '(custom-manual "(message)Mailing Lists") :type '(repeat string)) ＠＠ -696,7 +700,7 ＠＠ addresses can be used in conjunction wit If nil, do not use any predefined list subscriptions. This list of regular expressions can be used in conjunction with `message-subscribed-address-functions' and `message-subscribed-addresses'." -:version "21.4" +:version "22.1" :group 'message-interface :link '(custom-manual "(message)Mailing Lists") :type '(repeat regexp)) ＠＠ -706,7 +710,7 ＠＠ regular expressions can be used in conju If it is the symbol `always', the posting is allowed. If it is the symbol `never', the posting is not allowed. If it is the symbol `ask', you are prompted." -:version "21.4" +:version "22.1" :group 'message-interface :link '(custom-manual "(message)Message Headers") :type '(choice (const always) ＠＠ -724,6 +728,7 ＠＠ Doing so would be even more evil than le "*Envelope-from when sending mail with sendmail. If this is nil, use `user-mail-address'. If it is the symbol `header', use the From: header of the message." +:version "22.1" :type '(choice (string :tag "From name") (const :tag "Use From: header from message" header) (const :tag "Use `user-mail-address'" nil)) ＠＠ -781,7 +786,7 ＠＠ variable isn't used." ;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138 (defcustom message-generate-headers-first '(references) "Which headers should be generated before starting to compose a message. -If `t', generate all required headers. This can also be a list of headers to +If t, generate all required headers. This can also be a list of headers to generate. The variables `message-required-news-headers' and `message-required-mail-headers' specify which headers to generate. ＠＠ -836,7 +841,8 ＠＠ the signature is inserted." (let ((map (make-sparse-keymap 'message-minibuffer-local-map))) (set-keymap-parent map minibuffer-local-map) map) - "Keymap for `message-read-from-minibuffer'.") + "Keymap for `message-read-from-minibuffer'." +:version "22.1") ;;;###autoload (defcustom message-citation-line-function 'message-insert-citation-line ＠＠ -863,7 +869,7 ＠＠ See also `message-yank-cited-prefix'." "*Prefix inserted on cited or empty lines of yanked messages. Fix `message-cite-prefix-regexp' if it is set to an abnormal value. See also `message-yank-prefix'." -:version "21.4" +:version "22.1" :type 'string :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) ＠＠ -920,7 +926,7 ＠＠ If nil, don't insert a signature." ;;;###autoload (defcustom message-signature-insert-empty-line t "*If non-nil, insert an empty line before the signature separator." -:version "21.4" +:version "22.1" :type 'boolean :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) ＠＠ -1101,7 +1107,7 ＠＠ candidates: "Regexp of headers to be hidden when composing new messages. This can also be a list of regexps to match headers. Or a list starting with `not' and followed by regexps." -:version "21.4" +:version "22.1" :group 'message :link '(custom-manual "(message)Message Headers") :type '(repeat regexp)) ＠＠ -1377,7 +1383,7 ＠＠ subaddresses. So if the first address a for a message, the subaddresses will be removed (if present) before the mail is sent. All addresses in this structure should be downcased." -:version "21.4" +:version "22.1" :group 'message-headers :type '(repeat (repeat string))) ＠＠ -1385,7 +1391,7 ＠＠ downcased." "Like `mail-user-agent'. Except if it is nil, use Gnus native MUA; if it is t, use `mail-user-agent'." -:version "21.4" +:version "22.1" :type '(radio (const :tag "Gnus native" :format "%t\n" nil) ＠＠ -1409,17 +1415,18 ＠＠ If this variable is non-nil, pose the qu recipients?\" before a wide reply to multiple recipients. If the user answers yes, reply to all recipients as usual. If the user answers no, only reply back to the author." -:version "21.4" +:version "22.1" :group 'message-headers :link '(custom-manual "(message)Wide Reply") :type 'boolean) (defcustom message-user-fqdn nil "*Domain part of Messsage-Ids." +:version "22.1" :group 'message-headers :link '(custom-manual "(message)News Headers") :type '(radio (const :format "%v " nil) - (string :format "FQDN: %v\n" :size 0))) + (string :format "FQDN: %v"))) (defcustom message-use-idna (and (condition-case nil (require 'idna) (file-error)) ＠＠ -1427,7 +1434,7 ＠＠ no, only reply back to the author." (executable-find idna-program) 'ask) "Whether to encode non-ASCII in domain names into ASCII according to IDNA." -:version "21.4" +:version "22.1" :group 'message-headers :link '(custom-manual "(message)IDNA") :type '(choice (const :tag "Ask" ask) ＠＠ -1553,7 +1560,7 ＠＠ no, only reply back to the author." "\\)") "Regular expression that matches a valid FQDN." ;; see also: gnus-button-valid-fqdn-regexp -:version "21.4" +:version "22.1" :group 'message-headers :type 'regexp) ＠＠ -1615,11 +1622,11 ＠＠ is used by default." (if (not header) nil (let ((regexp (format "[%s]+" (or separator ","))) - (beg (point-min)) (first t) - quoted elems paren) + beg quoted elems paren) (with-temp-buffer (mm-enable-multibyte) + (setq beg (point-min)) (insert header) (goto-char (point-min)) (while (not (eobp)) ＠＠ -1745,7 +1752,7 ＠＠ see `message-narrow-to-headers-or-head'. ;;; Start of functions adopted from `message-utils.el'. (defun message-strip-subject-trailing-was (subject) - "Remove trailing \"(Was: <old subject>)\" from SUBJECT lines. + "Remove trailing \"(was: <old subject>)\" from SUBJECT lines. Leading \"Re: \" is not stripped by this function. Use the function `message-strip-subject-re' for this." (let* ((query message-subject-trailing-was-query) ＠＠ -2363,7 +2370,7 ＠＠ these properties from the message compos packages requires these properties to be present in order to work. If you use one of these packages, turn this option off, and hope the message composition doesn't break too bad." -:version "21.4" +:version "22.1" :group 'message-various :link '(custom-manual "(message)Various Message Variables") :type 'boolean) ＠＠ -2380,7 +2387,7 ＠＠ message composition doesn't break too ba ;; fontified: is used by font-lock. ;; syntax-table, local-map: I dunno. ;; We need to add XEmacs names to the list. - "Property list of with properties.forbidden in message buffers. + "Property list of with properties forbidden in message buffers. The values of the properties are ignored, only the property names are used.") (defun message-tamago-not-in-use-p (pos) ＠＠ -2403,11 +2410,13 ＠＠ This function is intended to be called f See also `message-forbidden-properties'." (when (and message-strip-special-text-properties (message-tamago-not-in-use-p begin)) - (while (not (= begin end)) - (when (not (get-text-property begin 'message-hidden)) - (remove-text-properties begin (1+ begin) - message-forbidden-properties)) - (incf begin)))) + (let ((buffer-read-only nil) + (inhibit-read-only t)) + (while (not (= begin end)) + (when (not (get-text-property begin 'message-hidden)) + (remove-text-properties begin (1+ begin) + message-forbidden-properties)) + (incf begin))))) ;;;###autoload (define-derived-mode message-mode text-mode "Message" ＠＠ -2610,7 +2619,7 ＠＠ M-RET `message-newline-and-reformat' (defun message-goto-mail-followup-to () "Move point to the Mail-Followup-To header." (interactive) - (message-position-on-field "Mail-Followup-To" "From")) + (message-position-on-field "Mail-Followup-To" "To")) (defun message-goto-keywords () "Move point to the Keywords header." ＠＠ -2708,7 +2717,7 ＠＠ prefix FORCE is given." E.g., if this list contains a member list with elements `Cc' and `To', then `message-carefully-insert-headers' will not insert a `To' header when the message is already `Cc'ed to the recipient." -:version "21.4" +:version "22.1" :group 'message-headers :link '(custom-manual "(message)Message Headers") :type '(repeat sexp)) ＠＠ -2720,6 +2729,7 ＠＠ or in the synonym headers, defined by `m ;; FIXME: Should compare only the address and not the full name. Comparison ;; should be done case-folded (and with `string=' rather than ;; `string-match'). + ;; (mail-strip-quoted-names "Foo Bar <foo＠bar>, bla＠fasel (Bla Fasel)") (dolist (header headers) (let* ((header-name (symbol-name (car header))) (new-header (cdr header)) ＠＠ -4399,7 +4409,9 ＠＠ Otherwise, generate and save a value for nil)))) ;; Check for control characters. (message-check 'control-chars - (if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t) + (if (re-search-forward + (mm-string-as-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]") + nil t) (y-or-n-p "The article contains control characters. Really post? ") t)) ＠＠ -5150,10 +5162,10 ＠＠ Headers already prepared in the buffer a If the current line has `message-yank-prefix', insert it on the new line." (interactive "*") (condition-case nil - (split-line message-yank-prefix) ;; Emacs 21.3.50+ supports arg. + (split-line message-yank-prefix) ;; Emacs 22.1+ supports arg. (error (split-line)))) - + (defun message-fill-header (header value) (let ((begin (point)) (fill-column 78) ＠＠ -5255,7 +5267,7 ＠＠ than 988 characters long, and if they ar (defcustom message-beginning-of-line t "Whether \\<message-mode-map>\\[message-beginning-of-line]\ goes to beginning of header values." -:version "21.4" +:version "22.1" :group 'message-buffers :link '(custom-manual "(message)Movement") :type 'boolean) ＠＠ -5269,10 +5281,10 ＠＠ outside the message header or if the opt is nil. If point is in the message header and on a (non-continued) header -line, move point to the beginning of the header value. If point -is already there, move point to beginning of line. Therefore, -repeated calls will toggle point between beginning of field and -beginning of line." +line, move point to the beginning of the header value or the beginning of line, +whichever is closer. If point is already at beginning of line, move point to +beginning of header value. Therefore, repeated calls will toggle point +between beginning of field and beginning of line." (interactive "p") (let ((zrs 'zmacs-region-stays)) (when (and (interactive-p) (boundp zrs)) ＠＠ -5283,9 +5295,9 ＠＠ beginning of line." (bol (progn (beginning-of-line n) (point))) (eol (gnus-point-at-eol)) (eoh (re-search-forward ": *" eol t))) - (if (or (not eoh) (equal here eoh)) - (goto-char bol) - (goto-char eoh))) + (goto-char + (if (and eoh (or (< eoh here) (= bol here))) + eoh bol))) (beginning-of-line n))) (defun message-buffer-name (type &optional to group) ＠＠ -5649,7 +5661,10 ＠＠ because discussions that are spread over fragmented and very difficult to follow. Also, some source/announcement lists are not intended for discussion; -responses here are directed to other addresses."))) +responses here are directed to other addresses. + +You may customize the variable `message-use-mail-followup-to', if you +want to get rid of this query permanently."))) (setq recipients (concat ", " mft))) (to-address (setq recipients (concat ", " to-address)) ＠＠ -5845,7 +5860,10 ＠＠ You should normally obey the Followup-To `Followup-To: poster' sends your response via e-mail instead of news. A typical situation where `Followup-To: poster' is used is when the poster -does not read the newsgroup, so he wouldn't see any replies sent to it.")) +does not read the newsgroup, so he wouldn't see any replies sent to it. + +You may customize the variable `message-use-followup-to', if you +want to get rid of this query permanently.")) (progn (setq message-this-is-news nil) (cons 'To (or mrt reply-to from ""))) ＠＠ -5868,7 +5886,10 ＠＠ because discussions that are spread over be fragmented and very difficult to follow. Also, some source/announcement newsgroups are not intended for discussion; -responses here are directed to other newsgroups.")) +responses here are directed to other newsgroups. + +You may customize the variable `message-use-followup-to', if you +want to get rid of this query permanently.")) (cons 'Newsgroups followup-to) (cons 'Newsgroups newsgroups)))))) (posted-to ＠＠ -6167,8 +6188,7 ＠＠ Optional DIGEST will use digest to forwa (setq e (point)) (insert "\n-------------------- End of forwarded message --------------------\n") - (when (and (not current-prefix-arg) - message-forward-ignored-headers) + (when message-forward-ignored-headers (save-restriction (narrow-to-region b e) (goto-char b) ＠＠ -6214,7 +6234,7 ＠＠ Optional DIGEST will use digest to forwa (goto-char (point-max)))) (setq e (point)) (insert " \n") - (when (and (not current-prefix-arg) + (when (and (not message-forward-decoded-p) message-forward-ignored-headers) (save-restriction (narrow-to-region b e) ＠＠ -6568,13 +6588,14 ＠＠ which specify the range to operate on." '("^\$Disposition-Notification-To\\|Return-Receipt-To\$:" . message-expand-name)) "Alist of (RE . FUN). Use FUN for completion on header lines matching RE." +:version "22.1" :group 'message :type '(alist :key-type regexp :value-type function)) (defcustom message-tab-body-function nil "*Function to execute when `message-tab' (TAB) is executed in the body. If nil, the function bound in `text-mode-map' or `global-map' is executed." -:version "21.4" +:version "22.1" :group 'message :link '(custom-manual "(message)Various Commands") :type 'function) ＠＠ -6854,5 +6875,5 ＠＠ regexp VARSTR." ;; coding: iso-8859-1 ;; End: -;;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0 +;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0 ;;; message.el ends here Index: lisp/mm-bodies.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-bodies.el,v retrieving revision 1.5 diff -u -p -u -r1.5 mm-bodies.el --- lisp/mm-bodies.el 28 Sep 2004 02:21:13 -0000 1.5 +++ lisp/mm-bodies.el 13 Mar 2005 00:11:55 -0000 ＠＠ -1,6 +1,6 ＠＠ ;;; mm-bodies.el --- Functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2001, 2003 +;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -139,7 +139,8 ＠＠ If no encoding was done, nil is returned (cond ((and (not longp) (not (and mm-use-ultra-safe-encoding - (save-excursion (re-search-forward "^From " nil t)))) + (or (save-excursion (re-search-forward " $" nil t)) + (save-excursion (re-search-forward "^From " nil t))))) (eq bits '7bit)) bits) ((and (not mm-use-ultra-safe-encoding) Index: lisp/mm-decode.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-decode.el,v retrieving revision 1.5 diff -u -p -u -r1.5 mm-decode.el --- lisp/mm-decode.el 28 Sep 2004 02:21:13 -0000 1.5 +++ lisp/mm-decode.el 13 Mar 2005 00:11:55 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; mm-decode.el --- Functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -115,7 +115,7 ＠＠ The defined renderer types are: `lynx' : use lynx; `html2text' : use html2text; nil : use external viewer." -:version "21.4" +:version "22.1" :type '(choice (const w3) (const w3m) (const w3m-standalone) ＠＠ -134,7 +134,7 ＠＠ It is suggested to customize `mm-text-ht "If non-nil, Gnus will allow retrieving images in HTML contents with the <img> tags. It has no effect on Emacs/w3. See also the documentation for the `mm-w3m-safe-url-regexp' variable." -:version "21.4" +:version "22.1" :type 'boolean :group 'mime-display) ＠＠ -150,12 +150,14 ＠＠ when displaying the image. The default matches parts embedded to the Multipart/Related type MIME contents and Gnus will never connect to the spammer's site arbitrarily. You may set this variable to nil if you consider all urls to be safe." +:version "22.1" :type '(choice (regexp :tag "Regexp") (const :tag "All URLs are safe" nil)) :group 'mime-display) (defcustom mm-inline-text-html-with-w3m-keymap t "If non-nil, use emacs-w3m command keys in the article buffer." +:version "22.1" :type 'boolean :group 'mime-display) ＠＠ -165,7 +167,7 ＠＠ set this variable to nil if you consider If t, all defined external MIME handlers are used. If nil, files are saved by `mailcap-save-binary-file'. If it is the symbol `ask', you are prompted before the external MIME handler is invoked." -:version "21.4" +:version "22.1" :type '(choice (const :tag "Always" t) (const :tag "Never" nil) (const :tag "Ask" ask)) ＠＠ -281,7 +283,7 ＠＠ type inline." "application/pdf" "application/x-dvi") "List of media types for which the external viewer will not be killed when selecting a different article." -:version "21.4" +:version "22.1" :type '(repeat string) :group 'mime-display) ＠＠ -378,12 +380,13 ＠＠ If not set, `default-directory' will be (defcustom mm-attachment-file-modes 384 "Set the mode bits of saved attachments to this integer." +:version "22.1" :type 'integer :group 'mime-display) (defcustom mm-external-terminal-program "xterm" "The program to start an external terminal." -:version "21.4" +:version "22.1" :type 'string :group 'mime-display) ＠＠ -416,7 +419,7 ＠＠ If not set, `default-directory' will be "Option of verifying signed parts. `never', not verify; `always', always verify; `known', only verify known protocols. Otherwise, ask user." -:version "21.4" +:version "22.1" :type '(choice (item always) (item never) (item :tag "only known protocols" known) ＠＠ -435,6 +438,7 ＠＠ If not set, `default-directory' will be "Option of decrypting encrypted parts. `never', not decrypt; `always', always decrypt; `known', only decrypt known protocols. Otherwise, ask user." +:version "22.1" :type '(choice (item always) (item never) (item :tag "only known protocols" known) ＠＠ -505,10 +509,10 ＠＠ Postpone undisplaying of viewers for typ (message "Destroying external MIME viewers") (mm-destroy-parts mm-postponed-undisplay-list))) -(defun mm-dissect-buffer (&optional no-strict-mime loose-mime) +(defun mm-dissect-buffer (&optional no-strict-mime loose-mime from) "Dissect the current buffer and return a list of MIME handles." (save-excursion - (let (ct ctl type subtype cte cd description id result from) + (let (ct ctl type subtype cte cd description id result) (save-restriction (mail-narrow-to-head) (when (or no-strict-mime ＠＠ -519,8 +523,9 ＠＠ Postpone undisplaying of viewers for typ cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") description (mail-fetch-field "content-description") - from (mail-fetch-field "from") id (mail-fetch-field "content-id")) + (unless from + (setq from (mail-fetch-field "from"))) ;; FIXME: In some circumstances, this code is running within ;; an unibyte macro. mail-extract-address-components ;; creates unibyte buffers. This `if', though not a perfect ＠＠ -563,7 +568,7 ＠＠ Postpone undisplaying of viewers for typ 'from from 'start start) (car ctl)) - (cons (car ctl) (mm-dissect-multipart ctl)))) + (cons (car ctl) (mm-dissect-multipart ctl from)))) (t (mm-possibly-verify-or-decrypt (mm-dissect-singlepart ＠＠ -590,7 +595,7 ＠＠ Postpone undisplaying of viewers for typ (mm-make-handle (mm-copy-to-buffer) ctl cte nil cdl description nil id))) -(defun mm-dissect-multipart (ctl) +(defun mm-dissect-multipart (ctl from) (goto-char (point-min)) (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary))) (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$")) ＠＠ -607,7 +612,7 ＠＠ Postpone undisplaying of viewers for typ (save-excursion (save-restriction (narrow-to-region start (point)) - (setq parts (nconc (list (mm-dissect-buffer t)) parts))))) + (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts))))) (end-of-line 2) (or (looking-at boundary) (forward-line 1)) ＠＠ -616,7 +621,7 ＠＠ Postpone undisplaying of viewers for typ (save-excursion (save-restriction (narrow-to-region start end) - (setq parts (nconc (list (mm-dissect-buffer t)) parts))))) + (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts))))) (mm-possibly-verify-or-decrypt (nreverse parts) ctl))) (defun mm-copy-to-buffer () ＠＠ -1028,27 +1033,10 ＠＠ external if displayed external." (defun mm-insert-part (handle) "Insert the contents of HANDLE in the current buffer." - (let ((cur (current-buffer))) - (save-excursion - (if (member (mm-handle-media-supertype handle) '("text" "message")) - (with-temp-buffer - (insert-buffer-substring (mm-handle-buffer handle)) - (prog1 - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle)) - (let ((temp (current-buffer))) - (set-buffer cur) - (insert-buffer-substring temp)))) - (mm-with-unibyte-buffer - (insert-buffer-substring (mm-handle-buffer handle)) - (prog1 - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle)) - (let ((temp (current-buffer))) - (set-buffer cur) - (insert-buffer-substring temp)))))))) + (save-excursion + (insert (if (mm-multibyte-p) + (mm-string-as-multibyte (mm-get-part handle)) + (mm-get-part handle))))) (defun mm-file-name-delete-whitespace (file-name) "Remove all whitespace characters from FILE-NAME." Index: lisp/mm-url.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-url.el,v retrieving revision 1.3 diff -u -p -u -r1.3 mm-url.el --- lisp/mm-url.el 4 Jan 2004 22:49:25 -0000 1.3 +++ lisp/mm-url.el 13 Mar 2005 00:11:55 -0000 ＠＠ -37,10 +37,9 ＠＠ (eval-and-compile (autoload 'executable-find "executable")) -;;; XEmacs Change: waiting for an XEmacs answer to `with-timeout'. -;;; See `mm-url-insert' further down for more details --SY. (eval-when-compile - (unless (featurep 'xemacs) + (if (featurep 'xemacs) + (require 'timer-funcs) (require 'timer))) (defgroup mm-url nil ＠＠ -52,6 +51,7 ＠＠ (require 'url) (error nil))) "*If non-nil, use external grab program `mm-url-program'." +:version "22.1" :type 'boolean :group 'mm-url) ＠＠ -70,6 +70,7 ＠＠ (t "GET")) "The url grab program. Likely values are `wget', `w3m', `lynx' and `curl'." +:version "22.1" :type '(choice (symbol :tag "wget" wget) (symbol :tag "w3m" w3m) ＠＠ -80,6 +81,7 ＠＠ Likely values are `wget', `w3m', `lynx' (defcustom mm-url-arguments nil "The arguments for `mm-url-program'." +:version "22.1" :type '(repeat string) :group 'mm-url) ＠＠ -328,59 +330,31 ＠＠ If `mm-url-use-external' is non-nil, use (defvar mm-url-retries 10 "The number of retries after timing out when fetching an URL.") -;; XEmacs Change: This is what we need `with-timeout' for. It was the -;; only thing in Gnus that meant the XEmacs Gnus package required the -;; fsf-compat package. So I've re-written the function so it doesn't -;; use a timeout at all. The function still does what the doc strings -;; advertises, it just won't do any retries and the timeout will be -;; whatever the normal network timeouts are. -;; -;; Yes, I know that's no where near as nifty and cool as the original -;; function, but, to my mind, it's better than having to require the -;; fsf-compat package. I am working on an XEmacs equivalent of -;; `with-timeout' and once that's done, the original functionality -;; will be back. Thank you for your understanding and patience. --SY. -;;(defun mm-url-insert (url &optional follow-refresh) -;; "Insert the contents from an URL in the current buffer. -;;If FOLLOW-REFRESH is non-nil, redirect refresh url in META." -;; (let ((times mm-url-retries) -;; (done nil) -;; (first t) -;; result) -;; (while (and (not (zerop (decf times))) -;; (not done)) -;; (with-timeout (mm-url-timeout) -;; (unless first -;; (message "Trying again (%s)..." (- mm-url-retries times))) -;; (setq first nil) -;; (if follow-refresh -;; (save-restriction -;; (narrow-to-region (point) (point)) -;; (mm-url-insert-file-contents url) -;; (goto-char (point-min)) -;; (when (re-search-forward -;; "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\$[^\"]+\$\"" nil t) -;; (let ((url (match-string 1))) -;; (delete-region (point-min) (point-max)) -;; (setq result (mm-url-insert url t))))) -;; (setq result (mm-url-insert-file-contents url))) -;; (setq done t))) -;; result)) (defun mm-url-insert (url &optional follow-refresh) "Insert the contents from an URL in the current buffer. If FOLLOW-REFRESH is non-nil, redirect refresh url in META." - (let (result) - (if follow-refresh - (save-restriction - (narrow-to-region (point) (point)) - (mm-url-insert-file-contents url) - (goto-char (point-min)) - (when (re-search-forward - "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\$[^\"]+\$\"" nil t) - (let ((url (match-string 1))) - (delete-region (point-min) (point-max)) - (setq result (mm-url-insert url t))))) - (setq result (mm-url-insert-file-contents url))) + (let ((times mm-url-retries) + (done nil) + (first t) + result) + (while (and (not (zerop (decf times))) + (not done)) + (with-timeout (mm-url-timeout) + (unless first + (message "Trying again (%s)..." (- mm-url-retries times))) + (setq first nil) + (if follow-refresh + (save-restriction + (narrow-to-region (point) (point)) + (mm-url-insert-file-contents url) + (goto-char (point-min)) + (when (re-search-forward + "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\$[^\"]+\$\"" nil t) + (let ((url (match-string 1))) + (delete-region (point-min) (point-max)) + (setq result (mm-url-insert url t))))) + (setq result (mm-url-insert-file-contents url))) + (setq done t))) result)) (defun mm-url-decode-entities () ＠＠ -477,4 +451,5 ＠＠ spaces. Die Die Die." (provide 'mm-url) +;;; arch-tag: 0594f9b3-417c-48b0-adc2-5082e1e7917f ;;; mm-url.el ends here Index: lisp/mm-util.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-util.el,v retrieving revision 1.5 diff -u -p -u -r1.5 mm-util.el --- lisp/mm-util.el 28 Sep 2004 02:21:14 -0000 1.5 +++ lisp/mm-util.el 13 Mar 2005 00:11:56 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; mm-util.el --- Utility functions for Mule and low level things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -123,13 +123,16 ＠＠ (defun mm-coding-system-p (cs) "Return non-nil if CS is a symbol naming a coding system. -In XEmacs, also return non-nil if CS is a coding system object." +In XEmacs, also return non-nil if CS is a coding system object. +If CS is available, return CS itself in Emacs, and return a coding +system object in XEmacs." (if (fboundp 'find-coding-system) (find-coding-system cs) (if (fboundp 'coding-system-p) - (coding-system-p cs) + (when (coding-system-p cs) + cs) ;; Is this branch ever actually useful? - (memq cs (mm-get-coding-system-list))))) + (car (memq cs (mm-get-coding-system-list)))))) (defvar mm-charset-synonym-alist `( ＠＠ -219,12 +222,12 ＠＠ In XEmacs, also return non-nil if CS is (big5 chinese-big5-1 chinese-big5-2) (tibetan tibetan) (thai-tis620 thai-tis620) + (windows-1251 cyrillic-iso8859-5) (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - katakana-jisx0201) + korean-ksc5601 japanese-jisx0212) (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 ＠＠ -239,6 +242,9 ＠＠ In XEmacs, also return non-nil if CS is chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7) + (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 + japanese-jisx0213-1 japanese-jisx0213-2) + (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case (charsetp 'unicode-a) (not (mm-coding-system-p 'mule-utf-8))) ＠＠ -249,24 +255,47 ＠＠ In XEmacs, also return non-nil if CS is (coding-system-get 'mule-utf-8 'safe-charsets))))) "Alist of MIME-charset/MULE-charsets.") -;; Correct by construction, but should be unnecessary: -;; XEmacs hates it. -(when (and (not (featurep 'xemacs)) - (fboundp 'coding-system-list) - (fboundp 'sort-coding-systems)) - (setq mm-mime-mule-charset-alist - (apply - 'nconc - (mapcar - (lambda (cs) - (when (and (or (coding-system-get cs :mime-charset) ; Emacs 22 - (coding-system-get cs 'mime-charset)) - (not (eq t (coding-system-get cs 'safe-charsets)))) - (list (cons (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset)) - (delq 'ascii - (coding-system-get cs 'safe-charsets)))))) - (sort-coding-systems (coding-system-list 'base-only)))))) +(defun mm-enrich-utf-8-by-mule-ucs () + "Make the `utf-8' MIME charset usable by the Mule-UCS package. +This function will run when the `un-define' module is loaded under +XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist' +with Mule charsets. It is completely useless for Emacs." + (unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs) + (assoc "un-define" after-load-alist))) + (setq after-load-alist + (delete '("un-define") after-load-alist))) + (when (boundp 'unicode-basic-translation-charset-order-list) + (condition-case nil + (let ((val (delq + 'ascii + (copy-sequence + (symbol-value + 'unicode-basic-translation-charset-order-list)))) + (elem (assq 'utf-8 mm-mime-mule-charset-alist))) + (if elem + (setcdr elem val) + (setq mm-mime-mule-charset-alist + (nconc mm-mime-mule-charset-alist + (list (cons 'utf-8 val)))))) + (error)))) + +;; Correct by construction, but should be unnecessary for Emacs: +(if (featurep 'xemacs) + (eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs)) + (when (and (fboundp 'coding-system-list) + (fboundp 'sort-coding-systems)) + (let ((css (sort-coding-systems (coding-system-list 'base-only))) + cs mime mule alist) + (while css + (setq cs (pop css) + mime (or (coding-system-get cs :mime-charset) ; Emacs 22 + (coding-system-get cs 'mime-charset))) + (when (and mime + (not (eq t (setq mule + (coding-system-get cs 'safe-charsets)))) + (not (assq mime alist))) + (push (cons mime (delq 'ascii mule)) alist))) + (setq mm-mime-mule-charset-alist (nreverse alist))))) (defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) "A list of special charsets. ＠＠ -302,9 +331,10 ＠＠ Valid elements include: (if (boundp 'current-language-environment) (let ((lang (symbol-value 'current-language-environment))) (cond ((string= lang "Japanese") - ;; Japanese users may prefer iso-2022-jp to shift-jis. - '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis - iso-latin-1 utf-8))))) + ;; Japanese users prefer iso-2022-jp to euc-japan or + ;; shift_jis, however iso-8859-1 should be used when + ;; there are only ASCII text and Latin-1 characters. + '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8))))) "Preferred coding systems for encoding outgoing messages. More than one suitable coding system may be found for some text. ＠＠ -331,16 +361,20 ＠＠ mail with multiple parts is preferred to "Return the MIME charset corresponding to the given Mule CHARSET." (if (and (fboundp 'find-coding-systems-for-charsets) (fboundp 'sort-coding-systems)) - (let (mime) - (dolist (cs (sort-coding-systems - (copy-sequence - (find-coding-systems-for-charsets (list charset))))) - (unless mime - (when cs - (setq mime (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset)))))) + (let ((css (sort (sort-coding-systems + (find-coding-systems-for-charsets (list charset))) + 'mm-sort-coding-systems-predicate)) + cs mime) + (while (and (not mime) + css) + (when (setq cs (pop css)) + (setq mime (or (coding-system-get cs :mime-charset) + (coding-system-get cs 'mime-charset))))) mime) - (let ((alist mm-mime-mule-charset-alist) + (let ((alist (mapcar (lambda (cs) + (assq cs mm-mime-mule-charset-alist)) + (sort (mapcar 'car mm-mime-mule-charset-alist) + 'mm-sort-coding-systems-predicate))) out) (while alist (when (memq charset (cdar alist)) ＠＠ -533,11 +567,91 ＠＠ This affects whether coding conversion s (let ((priorities (mapcar (lambda (cs) ;; Note: invalid entries are dropped silently - (and (coding-system-p cs) + (and (setq cs (mm-coding-system-p cs)) (coding-system-base cs))) mm-coding-system-priorities))) - (> (length (memq a priorities)) - (length (memq b priorities))))) + (and (setq a (mm-coding-system-p a)) + (if (setq b (mm-coding-system-p b)) + (> (length (memq (coding-system-base a) priorities)) + (length (memq (coding-system-base b) priorities))) + t)))) + +(eval-when-compile + (autoload 'latin-unity-massage-name "latin-unity") + (autoload 'latin-unity-maybe-remap "latin-unity") + (autoload 'latin-unity-representations-feasible-region "latin-unity") + (autoload 'latin-unity-representations-present-region "latin-unity") + (defvar latin-unity-coding-systems) + (defvar latin-unity-ucs-list)) + +(defun mm-xemacs-find-mime-charset-1 (begin end) + "Determine which MIME charset to use to send region as message. +This uses the XEmacs-specific latin-unity package to better handle the +case where identical characters from diverse ISO-8859-? character sets +can be encoded using a single one of the corresponding coding systems. + +It treats `mm-coding-system-priorities' as the list of preferred +coding systems; a useful example setting for this list in Western +Europe would be '(iso-8859-1 iso-8859-15 utf-8), which would default +to the very standard Latin 1 coding system, and only move to coding +systems that are less supported as is necessary to encode the +characters that exist in the buffer. + +Latin Unity doesn't know about those non-ASCII Roman characters that +are available in various East Asian character sets. As such, its +behavior if you have a JIS 0212 LATIN SMALL LETTER A WITH ACUTE in a +buffer and it can otherwise be encoded as Latin 1, won't be ideal. +But this is very much a corner case, so don't worry about it." + (let ((systems mm-coding-system-priorities) csets psets curset) + + ;; Load the Latin Unity library, if available. + (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity")) + (require 'latin-unity)) + + ;; Now, can we use it? + (if (featurep 'latin-unity) + (progn + (setq csets (latin-unity-representations-feasible-region begin end) + psets (latin-unity-representations-present-region begin end)) + + (catch 'done + + ;; Pass back the first coding system in the preferred list + ;; that can encode the whole region. + (dolist (curset systems) + (setq curset (latin-unity-massage-name 'buffer-default curset)) + + ;; If the coding system is a universal coding system, then + ;; it can certainly encode all the characters in the region. + (if (memq curset latin-unity-ucs-list) + (throw 'done (list curset))) + + ;; If a coding system isn't universal, and isn't in + ;; the list that latin unity knows about, we can't + ;; decide whether to use it here. Leave that until later + ;; in `mm-find-mime-charset-region' function, whence we + ;; have been called. + (unless (memq curset latin-unity-coding-systems) + (throw 'done nil)) + + ;; Right, we know about this coding system, and it may + ;; conceivably be able to encode all the characters in + ;; the region. + (if (latin-unity-maybe-remap begin end curset csets psets t) + (throw 'done (list curset)))) + + ;; Can't encode using anything from the + ;; `mm-coding-system-priorities' list. + ;; Leave `mm-find-mime-charset' to do most of the work. + nil)) + + ;; Right, latin unity isn't available; let `mm-find-charset-region' + ;; take its default action, which equally applies to GNU Emacs. + nil))) + +(defmacro mm-xemacs-find-mime-charset (begin end) + (when (featurep 'xemacs) + `(mm-xemacs-find-mime-charset-1 ,begin ,end))) (defun mm-find-mime-charset-region (b e &optional hack-charsets) "Return the MIME charsets needed to encode the region between B and E. ＠＠ -580,8 +694,12 ＠＠ charset, and a longer list means no appr (setq systems nil charsets (list cs)))))) charsets)) - ;; Otherwise we're not multibyte, we're XEmacs, or a single - ;; coding system won't cover it. + ;; If we're XEmacs, and some coding system is appropriate, + ;; mm-xemacs-find-mime-charset will return an appropriate list. + ;; Otherwise, we'll get nil, and the next setq will get invoked. + (setq charsets (mm-xemacs-find-mime-charset b e)) + + ;; We're not multibyte, or a single coding system won't cover it. (setq charsets (mm-delete-duplicates (mapcar 'mm-mime-charset ＠＠ -783,7 +901,7 ＠＠ If INHIBIT is non-nil, inhibit `mm-inhib (file-directory-p (setq dir (concat (file-name-directory (directory-file-name path)) - "etc/" (or package "gnus/"))))) + "etc/images/" (or package "gnus/"))))) (push dir result)) (push path result)))) Index: lisp/mm-uu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-uu.el,v retrieving revision 1.4 diff -u -p -u -r1.4 mm-uu.el --- lisp/mm-uu.el 28 Sep 2004 02:21:14 -0000 1.4 +++ lisp/mm-uu.el 13 Mar 2005 00:11:56 -0000 ＠＠ -80,6 +80,7 ＠＠ This can be either \"inline\" or \"attac (defcustom mm-uu-diff-groups-regexp "gnus\\.commits" "*Regexp matching diff groups." +:version "22.1" :type 'regexp :group 'gnus-article-mime) Index: lisp/mm-view.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-view.el,v retrieving revision 1.4 diff -u -p -u -r1.4 mm-view.el --- lisp/mm-view.el 28 Sep 2004 02:21:14 -0000 1.4 +++ lisp/mm-view.el 13 Mar 2005 00:11:56 -0000 ＠＠ -199,13 +199,14 ＠＠ (setq w3m-display-inline-images mm-inline-text-html-with-images)) (defun mm-w3m-cid-retrieve-1 (url handle) - (if (mm-multiple-handles handle) - (dolist (elem handle) - (mm-w3m-cid-retrieve-1 url elem)) - (when (and (listp handle) - (equal url (mm-handle-id handle))) - (mm-insert-part handle) - (throw 'found-handle (mm-handle-media-type handle))))) + (dolist (elem handle) + (when (listp elem) + (if (equal url (mm-handle-id elem)) + (progn + (mm-insert-part elem) + (throw 'found-handle (mm-handle-media-type elem)))) + (if (equal "multipart" (mm-handle-media-supertype elem)) + (mm-w3m-cid-retrieve-1 url elem))))) (defun mm-w3m-cid-retrieve (url &rest args) "Insert a content pointed by URL if it has the cid: scheme." ＠＠ -465,8 +466,12 ＠＠ (progn (buffer-disable-undo) (mm-insert-part handle) - (funcall mode) (require 'font-lock) + ;; Inhibit font-lock this time (*-mode-hook might run + ;; `turn-on-font-lock') so that jit-lock may not turn off + ;; font-lock immediately after this. + (let ((font-lock-mode t)) + (funcall mode)) (let ((font-lock-verbose nil)) ;; I find font-lock a bit too verbose. (font-lock-fontify-buffer)) Index: lisp/mml-sec.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml-sec.el,v retrieving revision 1.3 diff -u -p -u -r1.3 mml-sec.el --- lisp/mml-sec.el 28 Sep 2004 02:21:14 -0000 1.3 +++ lisp/mml-sec.el 13 Mar 2005 00:11:56 -0000 ＠＠ -43,6 +43,7 ＠＠ (defcustom mml-default-sign-method "pgpmime" "Default sign method. The string must have an entry in `mml-sign-alist'." +:version "22.1" :type '(choice (const "smime") (const "pgp") (const "pgpauto") ＠＠ -60,6 +61,7 ＠＠ The string must have an entry in `mml-si (defcustom mml-default-encrypt-method "pgpmime" "Default encryption method. The string must have an entry in `mml-encrypt-alist'." +:version "22.1" :type '(choice (const "smime") (const "pgp") (const "pgpauto") ＠＠ -83,6 +85,7 ＠＠ Note that the output generated by using understood by all PGP implementations, in particular PGP version 2 does not support it! See Info node `(message)Security' for details." +:version "22.1" :group 'message :type '(repeat (list (choice (const :tag "S/MIME" "smime") (const :tag "PGP" "pgp") ＠＠ -113,7 +116,7 ＠＠ You can also customize or set `mml-signe (setf (second style-item) style) ;; otherwise, just return the current value (second style-item)) - (gnus-message 3 "Warning, attempt to set invalid signencrypt-style")))) + (message "Warning, attempt to set invalid signencrypt style")))) ;;; Security functions Index: lisp/mml-smime.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml-smime.el,v retrieving revision 1.5 diff -u -p -u -r1.5 mml-smime.el --- lisp/mml-smime.el 28 Sep 2004 02:21:14 -0000 1.5 +++ lisp/mml-smime.el 13 Mar 2005 00:11:56 -0000 ＠＠ -25,9 +25,12 ＠＠ ;;; Code: +(eval-when-compile (require 'cl)) + (require 'smime) (require 'mm-decode) (autoload 'message-narrow-to-headers "message") +(autoload 'message-fetch-field "message") (defun mml-smime-sign (cont) (when (null smime-keys) Index: lisp/mml.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml.el,v retrieving revision 1.4 diff -u -p -u -r1.4 mml.el --- lisp/mml.el 28 Sep 2004 02:21:15 -0000 1.4 +++ lisp/mml.el 13 Mar 2005 00:11:57 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; mml.el --- A package for parsing and validating MML documents -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ＠＠ -44,7 +44,7 ＠＠ '(name access-type expiration size permission format) "*A list of acceptable parameters in MML tag. These parameters are generated in Content-Type header if exists." -:version "21.4" +:version "22.1" :type '(repeat (symbol :tag "Parameter")) :group 'message) ＠＠ -52,14 +52,14 ＠＠ These parameters are generated in Conten '(filename creation-date modification-date read-date) "*A list of acceptable parameters in MML tag. These parameters are generated in Content-Disposition header if exists." -:version "21.4" +:version "22.1" :type '(repeat (symbol :tag "Parameter")) :group 'message) (defcustom mml-insert-mime-headers-always nil "If non-nil, always put Content-Type: text/plain at top of empty parts. It is necessary to work against a bug in certain clients." -:version "21.4" +:version "22.1" :type 'boolean :group 'message) ＠＠ -472,7 +472,9 ＠＠ If MML is non-nil, return the buffer up (mm-with-unibyte-buffer (cond ((cdr (assq 'buffer cont)) - (insert-buffer-substring (cdr (assq 'buffer cont)))) + (insert (with-current-buffer (cdr (assq 'buffer cont)) + (mm-with-unibyte-current-buffer + (buffer-string))))) ((and (setq filename (cdr (assq 'filename cont))) (not (equal (cdr (assq 'nofile cont)) "yes"))) (let ((coding-system-for-read mm-binary-coding-system)) ＠＠ -708,7 +710,8 ＠＠ If HANDLES is non-nil, use it instead re ;; First decode the head. (save-restriction (message-narrow-to-head) - (mail-decode-encoded-word-region (point-min) (point-max))) + (let ((rfc2047-quote-decoded-words-containing-tspecials t)) + (mail-decode-encoded-word-region (point-min) (point-max)))) (unless handles (setq handles (mm-dissect-buffer t))) (goto-char (point-min)) ＠＠ -946,8 +949,7 ＠＠ See Info node `(emacs-mime)Composing'. "attachment"))) (disposition (completing-read "Disposition: " '(("attachment") ("inline") ("")) - nil - nil))) + nil t))) (if (not (equal disposition "")) disposition default))) ＠＠ -1078,9 +1080,9 ＠＠ If RAW, don't highlight the article." (message-fetch-field "Newsgroups"))) message-posting-charset))) (message-options-set-recipient) - (switch-to-buffer (generate-new-buffer - (concat (if raw "*Raw MIME preview of " - "*MIME preview of ") (buffer-name)))) + (pop-to-buffer (generate-new-buffer + (concat (if raw "*Raw MIME preview of " + "*MIME preview of ") (buffer-name)))) (when (boundp 'gnus-buffers) (push (current-buffer) gnus-buffers)) (erase-buffer) Index: lisp/mml2015.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml2015.el,v retrieving revision 1.4 diff -u -p -u -r1.4 mml2015.el --- lisp/mml2015.el 28 Sep 2004 02:21:15 -0000 1.4 +++ lisp/mml2015.el 13 Mar 2005 00:11:57 -0000 ＠＠ -83,6 +83,7 ＠＠ ("TRUST_FULLY" . t) ("TRUST_ULTIMATE" . t)) "Map GnuPG trust output values to a boolean saying if you trust the key." +:version "22.1" :group 'mime-security :type '(repeat (cons (regexp :tag "GnuPG output regexp") (boolean :tag "Trust key")))) ＠＠ -584,7 +585,7 ＠＠ ;; set up a function to call the correct gpg encrypt routine ;; with the right arguments. (FIXME: this should be done ;; differently.) - (flet ((gpg-encrypt-func + (flet ((gpg-encrypt-func (sign plaintext ciphertext result recipients &optional passphrase sign-with-key armor textmode) (if sign ＠＠ -655,7 +656,7 ＠＠ (if (condition-case err (prog1 (pgg-decrypt-region (point-min) (point-max)) - (setq decrypt-status + (setq decrypt-status (with-current-buffer mml2015-result-buffer (buffer-string))) (mm-set-handle-multipart-parameter ＠＠ -739,7 +740,7 ＠＠ (mm-insert-part signature)) (if (condition-case err (prog1 - (pgg-verify-region (point-min) (point-max) + (pgg-verify-region (point-min) (point-max) signature-file t) (goto-char (point-min)) (while (search-forward "\r\n" nil t) Index: lisp/nnagent.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnagent.el,v retrieving revision 1.3 diff -u -p -u -r1.3 nnagent.el --- lisp/nnagent.el 28 Sep 2004 02:21:15 -0000 1.3 +++ lisp/nnagent.el 13 Mar 2005 00:11:57 -0000 ＠＠ -103,7 +103,7 ＠＠ (defun nnagent-request-type (group article) (unless (stringp article) - (let ((gnus-plugged t)) + (let ((gnus-agent nil)) (if (not (gnus-check-backend-function 'request-type (car gnus-command-method))) 'unknown ＠＠ -122,9 +122,14 ＠＠ (deffoo nnagent-request-set-mark (group action server) (with-temp-buffer - (insert (format "(%s-request-set-mark \"%s\" '%s \"%s\")\n" - (nth 0 gnus-command-method) group action - (or server (nth 1 gnus-command-method)))) + (insert "(gnus-agent-synchronize-group-flags \"" + group + "\" '") + (gnus-pp action) + (insert " \"" + (gnus-method-to-server gnus-command-method) + "\"") + (insert ")\n") (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) nil) Index: lisp/nndiary.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nndiary.el,v retrieving revision 1.3 diff -u -p -u -r1.3 nndiary.el --- lisp/nndiary.el 28 Sep 2004 02:21:15 -0000 1.3 +++ lisp/nndiary.el 13 Mar 2005 00:11:59 -0000 ＠＠ -223,6 +223,7 ＠＠ (defgroup nndiary nil "The Gnus Diary backend." +:version "22.1" :group 'gnus-diary) (defcustom nndiary-mail-sources ＠＠ -759,7 +760,7 ＠＠ all. This may very well take some time. (when (nndiary-schedule) (let (result) (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"))) (if (stringp group) Index: lisp/nnfolder.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnfolder.el,v retrieving revision 1.4 diff -u -p -u -r1.4 nnfolder.el --- lisp/nnfolder.el 28 Sep 2004 02:21:16 -0000 1.4 +++ lisp/nnfolder.el 13 Mar 2005 00:11:59 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; nnfolder.el --- mail folder access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon(a)josefsson.org> (adding MARKS) ＠＠ -370,10 +370,11 ＠＠ the group. Then the marks file will be (deffoo nnfolder-request-create-group (group &optional server args) (nnfolder-possibly-change-group nil server) (nnmail-activate 'nnfolder) - (when group - (unless (assoc group nnfolder-group-alist) - (push (list group (cons 1 0)) nnfolder-group-alist) - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) + (when (and group + (not (assoc group nnfolder-group-alist))) + (push (list group (cons 1 0)) nnfolder-group-alist) + (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) + (save-current-buffer (nnfolder-read-folder group))) t) ＠＠ -872,7 +873,7 ＠＠ deleted. Point is left where the delete (buffer (set-buffer (let ((nnheader-file-coding-system nnfolder-file-coding-system)) - (nnheader-find-file-noselect file))))) + (nnheader-find-file-noselect file t))))) (mm-enable-multibyte) ;; Use multibyte buffer for future copying. (if (equal (cadr (assoc group nnfolder-scantime-alist)) (nth 5 (file-attributes file))) ＠＠ -1174,7 +1175,7 ＠＠ This command does not work if you use sh (let ((range (nth 0 action)) (what (nth 1 action)) (marks (nth 2 action))) - (assert (or (eq what 'add) (eq what 'del)) t + (assert (or (eq what 'add) (eq what 'del)) nil "Unknown request-set-mark action: %s" what) (dolist (mark marks) (setq nnfolder-marks (gnus-update-alist-soft ＠＠ -1240,7 +1241,7 ＠＠ This command does not work if you use sh nnfolder-marks-modtime)) (error (or (gnus-yes-or-no-p (format "Could not write to %s (%s). Continue? " file err)) - (error "Cannot write to %s (%s)" err)))))) + (error "Cannot write to %s (%s)" file err)))))) (defun nnfolder-open-marks (group server) (let ((file (nnfolder-group-marks-pathname group))) Index: lisp/nnheader.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnheader.el,v retrieving revision 1.5 diff -u -p -u -r1.5 nnheader.el --- lisp/nnheader.el 28 Sep 2004 02:21:16 -0000 1.5 +++ lisp/nnheader.el 13 Mar 2005 00:11:59 -0000 ＠＠ -74,7 +74,15 ＠＠ Integer values will in effect be rounded (defvar nnheader-read-timeout (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" (symbol-name system-type)) - 1.0 ; why? + ;; http://thread.gmane.org/v9655t3pjo.fsf＠marauder.physik.uni-ulm.de + ;; + ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS. + ;; + ;; There should probably be a runtime test to determine the timing + ;; resolution, or a primitive to report it. I don't know off-hand + ;; what's possible. Perhaps better, maybe the Windows/DOS primitive + ;; could round up non-zero timeouts to a minimum of 1.0? + 1.0 0.1) "How long nntp should wait between checking for the end of output. Shorter values mean quicker response, but are more CPU intensive.") ＠＠ -943,6 +951,8 ＠＠ find-file-hooks, etc. (nnheader-insert-file-contents file))))))) (defun nnheader-find-file-noselect (&rest args) + "Open a file with some variables bound. +See `find-file-noselect' for the arguments." (let ((format-alist nil) (auto-mode-alist (mm-auto-mode-alist)) (default-major-mode 'fundamental-mode) Index: lisp/nnimap.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnimap.el,v retrieving revision 1.4 diff -u -p -u -r1.4 nnimap.el --- lisp/nnimap.el 28 Sep 2004 02:21:16 -0000 1.4 +++ lisp/nnimap.el 13 Mar 2005 00:12:00 -0000 ＠＠ -1,5 +1,5 ＠＠ ;;; nnimap.el --- imap backend for Gnus -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Simon Josefsson <jas(a)pdc.kth.se> ＠＠ -211,7 +211,7 ＠＠ variable is the symbol `default' the def used (which currently is nil, unless you use a statistical spam.el test); if this variable is another non-nil value bodies will be downloaded." -:version "21.4" +:version "22.1" :group 'nnimap :type '(choice (const :tag "Let system decide" deault) boolean)) ＠＠ -223,7 +223,7 ＠＠ will be downloaded." This means that errors caught by nnimap when closing the mailbox will not prevent Gnus from updating the group status, which may be harmful. However, it increases speed." -:version "21.4" +:version "22.1" :type 'boolean :group 'nnimap) ＠＠ -232,7 +232,7 ＠＠ However, it increases speed." This increases the speed of closing mailboxes (quiting group) but may decrease the speed of selecting another mailbox later. Re-selecting the same mailbox will be faster though." -:version "21.4" +:version "22.1" :type 'boolean :group 'nnimap) ＠＠ -245,7 +245,7 ＠＠ more carefully for new mail. In summary, the default is O((1-p)*k+p*n) and changing it to nil makes it O(n). If p is small, then the default is probably faster." -:version "21.4" +:version "22.1" :type 'boolean :group 'nnimap) ＠＠ -409,7 +409,11 ＠＠ If this is 'imap-mailbox-lsub, then use restrict visible folders.") (defcustom nnimap-debug nil - "If non-nil, random debug spews are placed in *nnimap-debug* buffer." + "If non-nil, random debug spews are placed in *nnimap-debug* buffer. +Note that username, passwords and other privacy sensitive +information (such as e-mail) may be stored in the *nnimap-debug* +buffer. It is not written to disk, however. Do not enable this +variable unless you are comfortable with that." :group 'nnimap :type 'boolean) ＠＠ -661,6 +665,8 ＠＠ If EXAMINE is non-nil the group is selec (if (imap-capability 'IMAP4rev1) (format "BODY.PEEK[HEADER.FIELDS %s])" headers) (format "RFC822.HEADER.LINES %s)" headers))))) + (with-current-buffer nntp-server-buffer + (sort-numeric-fields 1 (point-min) (point-max))) (and (numberp nnmail-large-newsgroup) (> nnimap-length nnmail-large-newsgroup) (nnheader-message 6 "nnimap: Retrieving headers...done"))))) ＠＠ -826,7 +832,7 ＠＠ function is generally only called when G (defun nnimap-make-callback (article gnus-callback buffer) "Return a callback function." - `(lambda () + `(lambda () (nnimap-callback ,article ,gnus-callback ,buffer))) (defun nnimap-callback (article gnus-callback buffer) ＠＠ -876,8 +882,8 ＠＠ function is generally only called when G (imap-error-text nnimap-server-buffer)) (cons group article))) (add-hook 'imap-fetch-data-hook - (nnimap-make-callback article - nnheader-callback-function + (nnimap-make-callback article + nnheader-callback-function nntp-server-buffer)) (imap-fetch-asynch article part nil nnimap-server-buffer) (cons group article)))))) ＠＠ -930,7 +936,7 ＠＠ function is generally only called when G "Update the unseen count in `nnimap-mailbox-info'." (gnus-sethash (gnus-group-prefixed-name group server) - (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server) + (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server) nnimap-mailbox-info))) (list (nth 0 old) (nth 1 old) (imap-mailbox-status group 'unseen nnimap-server-buffer) ＠＠ -1043,7 +1049,7 ＠＠ function is generally only called when G 'asyncgroups 'slowgroups) (list group (imap-mailbox-status-asynch - group '(uidvalidity uidnext unseen) + group '(uidvalidity uidnext unseen) nnimap-server-buffer)))) (dolist (asyncgroup asyncgroups) (let ((group (nth 0 asyncgroup)) ＠＠ -1054,7 +1060,7 ＠＠ function is generally only called when G (nth 0 (gnus-gethash (gnus-group-prefixed-name group server) nnimap-mailbox-info)) - (imap-mailbox-get 'uidvalidity group + (imap-mailbox-get 'uidvalidity group nnimap-server-buffer))) (not (string= (nth 1 (gnus-gethash (gnus-group-prefixed-name ＠＠ -1310,7 +1316,7 ＠＠ function is generally only called when G (let (msgid) (and (setq msgid (nnmail-fetch-field "message-id")) - (nnmail-cache-insert msgid + (nnmail-cache-insert msgid to-group (nnmail-fetch-field "subject")))))) ;; Add the group-art list to the history list. ＠＠ -1418,12 +1424,12 ＠＠ function is generally only called when G nnmail-expiry-wait))) (cond ((or force (eq days 'immediate)) (let ((oldarts (imap-search - (concat "UID " + (concat "UID " (imap-range-to-message-set artseq))))) (when oldarts (nnimap-expiry-target oldarts group server) (when (imap-message-flags-add - (imap-range-to-message-set + (imap-range-to-message-set (gnus-compress-sequence oldarts)) "\\Deleted") (setq articles (gnus-set-difference articles oldarts)))))) ＠＠ -1437,9 +1443,9 ＠＠ function is generally only called when G (when oldarts (nnimap-expiry-target oldarts group server) (when (imap-message-flags-add - (imap-range-to-message-set + (imap-range-to-message-set (gnus-compress-sequence oldarts)) "\\Deleted") - (setq articles (gnus-set-difference + (setq articles (gnus-set-difference articles oldarts))))))))))) ;; return articles not deleted articles) Index: lisp/nnmail.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnmail.el,v retrieving revision 1.4 diff -u -p -u -r1.4 nnmail.el --- lisp/nnmail.el 28 Sep 2004 02:21:17 -0000 1.4 +++ lisp/nnmail.el 13 Mar 2005 00:12:01 -0000 ＠＠ -119,6 +119,7 ＠＠ If nil, the first match found will be us (defcustom nnmail-split-fancy-with-parent-ignore-groups nil "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'. This can also be a list of regexps." +:version "22.1" :group 'nnmail-split :type '(choice (const :tag "none" nil) (regexp :value ".*") ＠＠ -127,6 +128,7 ＠＠ This can also be a list of regexps." (defcustom nnmail-cache-ignore-groups nil "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert'). This can also be a list of regexps." +:version "22.1" :group 'nnmail-split :type '(choice (const :tag "none" nil) (regexp :value ".*") ＠＠ -224,7 +226,7 ＠＠ From header will be expired to the group articles containing the sting \"IMPORTANT\" in the Subject header will be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and everything else will be expired to \"nnfolder:Archive-YYYY\"." -:version "21.4" +:version "22.1" :group 'nnmail-expire :type '(repeat (list (choice :tag "Match against" (string :tag "Header") ＠＠ -353,6 +355,7 ＠＠ discarded after running the split proces (defcustom nnmail-spool-hook nil "*A hook called when a new article is spooled." +:version "22.1" :group 'nnmail :type 'hook) ＠＠ -367,14 +370,14 ＠＠ messages will be shown to indicate the c (define-widget 'nnmail-lazy 'default "Base widget for recursive datastructures. -This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility." +This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility." :format "%{%t%}: %v" :convert-widget 'widget-value-convert-widget :value-create (lambda (widget) (let ((value (widget-get widget :value)) (type (widget-get widget :type))) - (widget-put widget :children - (list (widget-create-child-value + (widget-put widget :children + (list (widget-create-child-value widget (widget-convert type) value))))) :value-delete 'widget-children-value-delete :value-get (lambda (widget) ＠＠ -406,7 +409,7 ＠＠ This is copy of the `lazy' widget in Ema (list :tag "Function with fixed arguments (:)" :value (: nil) (const :format "" :value :) - function + function (editable-list :inline t (sexp :tag "Arg")) ) (list :tag "Function with split arguments (!)" ＠＠ -414,11 +417,11 ＠＠ This is copy of the `lazy' widget in Ema (const :format "" !) function (editable-list :inline t nnmail-split-fancy)) - (list :tag "Field match" - (choice :tag "Field" + (list :tag "Field match" + (choice :tag "Field" regexp symbol) (choice :tag "Match" - regexp + regexp (symbol :value mail)) (repeat :inline t :tag "Restrictions" ＠＠ -551,7 +554,7 ＠＠ parameter. It should return nil, `warn' :group 'nnmail :type '(repeat symbol)) -(defcustom nnmail-split-header-length-limit 512 +(defcustom nnmail-split-header-length-limit 2048 "Header lines longer than this limit are excluded from the split function." :version "21.1" :group 'nnmail ＠＠ -559,13 +562,13 ＠＠ parameter. It should return nil, `warn' (defcustom nnmail-mail-splitting-charset nil "Default charset to be used when splitting incoming mail." -:version "21.4" +:version "22.1" :group 'nnmail :type 'symbol) (defcustom nnmail-mail-splitting-decodes nil "Whether the nnmail splitting functionality should MIME decode headers." -:version "21.4" +:version "22.1" :group 'nnmail :type 'boolean) ＠＠ -575,6 +578,7 ＠＠ Normally, regexes given in `nnmail-split by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\ surrounded by anything." +:version "22.1" :group 'nnmail :type 'boolean) ＠＠ -582,6 +586,7 ＠＠ by anything." "Whether to lowercase expanded entries (i.e. \\N) when splitting mails. This avoids the creation of multiple groups when users send to an address using different case (i.e. mailing-list＠domain vs Mailing-List＠Domain)." +:version "22.1" :group 'nnmail :type 'boolean) ＠＠ -1575,7 +1580,7 ＠＠ See the documentation for the variable ` (when (stringp id) ;; this will handle cases like `B r' where the group is nil (let ((grp (or grp gnus-newsgroup-name "UNKNOWN"))) - (run-hook-with-args 'nnmail-spool-hook + (run-hook-with-args 'nnmail-spool-hook id grp subject sender)) (when nnmail-treat-duplicates ;; Store some information about the group this message is written ＠＠ -1598,7 +1603,7 ＠＠ See the documentation for the variable ` (unless (and regexp (string-match regexp grp)) (insert id "\t" grp "\n"))) (insert id "\n")))))) - + (defun nnmail-cache-primary-mail-backend () (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) (be nil) Index: lisp/nnml.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnml.el,v retrieving revision 1.4 diff -u -p -u -r1.4 nnml.el --- lisp/nnml.el 28 Sep 2004 02:21:18 -0000 1.4 +++ lisp/nnml.el 13 Mar 2005 00:12:01 -0000 ＠＠ -923,7 +923,7 ＠＠ Use the nov database for the current gro (let ((range (nth 0 action)) (what (nth 1 action)) (marks (nth 2 action))) - (assert (or (eq what 'add) (eq what 'del)) t + (assert (or (eq what 'add) (eq what 'del)) nil "Unknown request-set-mark action: %s" what) (dolist (mark marks) (setq nnml-marks (gnus-update-alist-soft ＠＠ -984,7 +984,7 ＠＠ Use the nov database for the current gro nnml-marks-modtime)) (error (or (gnus-yes-or-no-p (format "Could not write to %s (%s). Continue? " file err)) - (error "Cannot write to %s (%s)" err)))))) + (error "Cannot write to %s (%s)" file err)))))) (defun nnml-open-marks (group server) (let ((file (expand-file-name Index: lisp/nnrss.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnrss.el,v retrieving revision 1.4 diff -u -p -u -r1.4 nnrss.el --- lisp/nnrss.el 28 Sep 2004 02:21:19 -0000 1.4 +++ lisp/nnrss.el 13 Mar 2005 00:12:01 -0000 ＠＠ -82,6 +82,12 ＠＠ ARTICLE is the article number of the cur ;;; Interface functions +(eval-when-compile + (defmacro nnrss-string-as-multibyte (string) + (if (featurep 'xemacs) + string + `(string-as-multibyte ,string)))) + (deffoo nnrss-retrieve-headers (articles &optional group server fetch-old) (nnrss-possibly-change-group group server) (let (e) ＠＠ -409,10 +415,6 ＠＠ ARTICLE is the article number of the cur (buffer-string)))) (defalias 'nnrss-insert 'nnrss-insert-w3) - -(if (featurep 'xemacs) - (defalias 'nnrss-string-as-multibyte 'identity) - (defalias 'nnrss-string-as-multibyte 'string-as-multibyte)) ;;; Snarf functions Index: lisp/nnspool.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnspool.el,v retrieving revision 1.4 diff -u -p -u -r1.4 nnspool.el --- lisp/nnspool.el 28 Sep 2004 02:21:19 -0000 1.4 +++ lisp/nnspool.el 13 Mar 2005 00:12:01 -0000 ＠＠ -44,7 +44,10 ＠＠ This is most commonly `inews' or `injnew "Switches for nnspool-request-post to pass to `inews' for posting news. If you are using Cnews, you probably should set this variable to nil.") -(defvoo nnspool-spool-directory (file-name-as-directory news-path) +(defvoo nnspool-spool-directory + (file-name-as-directory (if (boundp 'news-directory) + (symbol-value 'news-directory) + news-path)) "Local news spool directory.") (defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/") Index: lisp/nnweb.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnweb.el,v retrieving revision 1.4 diff -u -p -u -r1.4 nnweb.el --- lisp/nnweb.el 28 Sep 2004 02:21:20 -0000 1.4 +++ lisp/nnweb.el 13 Mar 2005 00:12:01 -0000 ＠＠ -54,11 +54,12 ＠＠ Valid types include `google', `dejanews' (defvar nnweb-type-definition '((google (article . ignore) - (id . "http://groups.google.com/groups?selm=%s&output=gplain") + (id . "http://groups.google.de/groups?selm=%s&output=gplain") (reference . identity) (map . nnweb-google-create-mapping) (search . nnweb-google-search) - (address . "http://groups.google.com/groups") + (address . "http://groups.google.de/groups") + (base . "http://groups.google.de") (identifier . nnweb-google-identity)) (dejanews ;; alias of google (article . ignore) ＠＠ -67,6 +68,7 ＠＠ Valid types include `google', `dejanews' (map . nnweb-google-create-mapping) (search . nnweb-google-search) (address . "http://groups.google.com/groups") + (base . "http://groups.google.com") (identifier . nnweb-google-identity)) (gmane (article . nnweb-gmane-wash-article) ＠＠ -349,7 +351,7 ＠＠ Valid types include `google', `dejanews' "a href=/groups\$\\?[^ \">]*selm=\\([^ &\">]+\$\\)" nil t) (setq mid (match-string 2) url (format - "http://groups.google.com/groups?selm=%s&output=gplain" mid)) + (nnweb-definition 'id) mid)) (narrow-to-region (search-forward ">" nil t) (search-forward "</a>" nil t)) (mm-url-remove-markup) ＠＠ -420,7 +422,7 ＠＠ Valid types include `google', `dejanews' (>= i nnweb-max-hits)) (setq more nil) ;; Yup, there are more articles - (setq more (concat "http://groups.google.com" (match-string 1))) + (setq more (concat (nnweb-definition 'base) (match-string 1))) (when more (erase-buffer) (mm-url-insert more)))) ＠＠ -435,9 +437,9 ＠＠ Valid types include `google', `dejanews' "?" (mm-url-encode-www-form-urlencoded `(("q" . ,search) - ("num". "100") + ("num" . "100") ("hq" . "") - ("hl" . "") + ("hl" . "en") ("lr" . "") ("safe" . "off") ("sites" . "groups"))))) Index: lisp/rfc2047.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/rfc2047.el,v retrieving revision 1.5 diff -u -p -u -r1.5 rfc2047.el --- lisp/rfc2047.el 28 Sep 2004 02:21:20 -0000 1.5 +++ lisp/rfc2047.el 13 Mar 2005 00:12:02 -0000 ＠＠ -1,5 +1,7 ＠＠ ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc. + +;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, 2005 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org> ;; MORIOKA Tomohiko <morioka(a)jaist.ac.jp> ＠＠ -50,6 +52,7 ＠＠ Value is what BODY returns." (require 'qp) (require 'mm-util) +(require 'ietf-drums) ;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus. (require 'mail-prsvr) (require 'base64) ＠＠ -71,7 +74,7 ＠＠ Value is what BODY returns." '(("Newsgroups" . nil) ("Followup-To" . nil) ("Message-ID" . nil) - ("\$Resent-\$?\$From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\ + ("\\(Resent-\$?\$From\\|Cc\\|To\\|Bcc\\|\\(In-\$?Reply-To\\|Sender\ \\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime) (t . mime)) "*Header/encoding method alist. ＠＠ -639,6 +642,9 ＠＠ By default, the region is treated as con "=\\?\$[^][\000-\040()<>＠,\;:\\\"/?.=]+\$\\?\$B\\|Q\$\ \\?\$[!->＠-~ +]*\$\\?=")) +(defvar rfc2047-quote-decoded-words-containing-tspecials nil + "If non-nil, quote decoded words containing special characters.") + ;; Fixme: This should decode in place, not cons intermediate strings. ;; Also check whether it needs to worry about delimiting fields like ;; encoding. ＠＠ -673,14 +679,66 ＠＠ By default, the region is treated as con (insert (rfc2047-parse-and-decode (prog1 (match-string 0) - (delete-region (match-beginning 0) (match-end 0))))) - ;; Remove newlines between decoded words, though such things - ;; essentially must not be there. + (delete-region e (match-end 0))))) + (while (looking-at rfc2047-encoded-word-regexp) + (insert (rfc2047-parse-and-decode + (prog1 + (match-string 0) + (delete-region (point) (match-end 0)))))) (save-restriction (narrow-to-region e (point)) (goto-char e) + ;; Remove newlines between decoded words, though such + ;; things essentially must not be there. (while (re-search-forward "[\n\r]+" nil t) (replace-match " ")) + ;; Quote decoded words if there are special characters + ;; which might violate RFC2822. + (when (and rfc2047-quote-decoded-words-containing-tspecials + (let ((regexp (car (rassq + 'address-mime + rfc2047-header-encoding-alist)))) + (when regexp + (save-restriction + (widen) + (beginning-of-line) + (while (and (memq (char-after) '(? ?\t)) + (zerop (forward-line -1)))) + (looking-at regexp))))) + (let (quoted) + (goto-char e) + (skip-chars-forward " \t") + (setq start (point)) + (setq quoted (eq (char-after) ?\")) + (goto-char (point-max)) + (skip-chars-backward " \t") + (if (setq quoted (and quoted + (> (point) (1+ start)) + (eq (char-before) ?\"))) + (progn + (backward-char) + (setq start (1+ start) + end (point-marker))) + (setq end (point-marker))) + (goto-char start) + (while (search-forward "\"" end t) + (when (prog2 + (backward-char) + (zerop (% (skip-chars-backward "\\\\") 2)) + (goto-char (match-beginning 0))) + (insert "\\")) + (forward-char)) + (when (and (not quoted) + (progn + (goto-char start) + (re-search-forward + (concat "[" ietf-drums-tspecials "]") + end t))) + (goto-char start) + (insert "\"") + (goto-char end) + (insert "\"")) + (set-marker end nil))) (goto-char (point-max))) (when (and (mm-multibyte-p) mail-parse-charset Index: lisp/rfc2231.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/rfc2231.el,v retrieving revision 1.4 diff -u -p -u -r1.4 rfc2231.el --- lisp/rfc2231.el 28 Sep 2004 02:21:20 -0000 1.4 +++ lisp/rfc2231.el 13 Mar 2005 00:12:02 -0000 ＠＠ -88,7 +88,6 ＠＠ The list will be on the form (point) (progn (forward-sexp 1) (point)))))) (error "Invalid header: %s" string)) (setq c (char-after)) - (setq encoded nil) (when (eq c ?*) (forward-char 1) (setq c (char-after)) ＠＠ -126,16 +125,22 ＠＠ The list will be on the form (point) (progn (forward-sexp) (point))))) (t (error "Invalid header: %s" string))) - (when encoded - (setq value (rfc2231-decode-encoded-string value))) (if number (setq prev-attribute attribute prev-value (concat prev-value value)) - (push (cons attribute value) parameters)))) + (push (cons attribute + (if encoded + (rfc2231-decode-encoded-string value) + value)) + parameters)))) ;; Take care of any final continuations. (when prev-attribute - (push (cons prev-attribute prev-value) parameters)) + (push (cons prev-attribute + (if encoded + (rfc2231-decode-encoded-string prev-value) + prev-value)) + parameters)) (when type `(,type ,＠(nreverse parameters))))))) Index: lisp/smiley.el.upstream =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/smiley.el.upstream,v retrieving revision 1.2 diff -u -p -u -r1.2 smiley.el.upstream --- lisp/smiley.el.upstream 4 Jan 2004 22:49:26 -0000 1.2 +++ lisp/smiley.el.upstream 13 Mar 2005 00:12:02 -0000 ＠＠ -44,7 +44,7 ＠＠ :group 'gnus-visual) ;; Maybe this should go. -(defcustom smiley-data-directory (nnheader-find-etc-directory "smilies") +(defcustom smiley-data-directory (nnheader-find-etc-directory "images/smilies") "*Location of the smiley faces files." :type 'directory :group 'smiley) ＠＠ -78,6 +78,7 ＠＠ regexp to replace with IMAGE. IMAGE is (push "xpm" types)) types) "*List of suffixes on picon file names to try." +:version "22.1" :type '(repeat string) :group 'smiley) ＠＠ -167,4 +168,5 ＠＠ With arg, turn displaying on if and only (provide 'smiley) +;;; arch-tag: 5beb161b-4321-40af-8ac9-876afb8ee818 ;;; smiley.el ends here Index: lisp/smime.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/smime.el,v retrieving revision 1.5 diff -u -p -u -r1.5 smime.el --- lisp/smime.el 28 Sep 2004 02:21:21 -0000 1.5 +++ lisp/smime.el 13 Mar 2005 00:12:02 -0000 ＠＠ -150,7 +150,7 ＠＠ certificate." (defcustom smime-CA-file nil "*Files containing certificates for CAs you trust. File should contain certificates in PEM format." -:version "21.4" +:version "22.1" :type '(choice (const :tag "none" nil) file) :group 'smime) ＠＠ -178,7 +178,7 ＠＠ and the files themself should be in PEM (defcustom smime-encrypt-cipher "-des3" "*Cipher algorithm used for encryption." -:version "21.4" +:version "22.1" :type '(choice (const :tag "Triple DES" "-des3") (const :tag "DES" "-des") (const :tag "RC2 40 bits" "-rc2-40") ＠＠ -210,7 +210,7 ＠＠ At least OpenSSL version 0.9.7 is requir (defcustom smime-dns-server nil "*DNS server to query certificates from. If nil, use system defaults." -:version "21.4" +:version "22.1" :type '(choice (const :tag "System defaults") string) :group 'smime) ＠＠ -332,16 +332,17 ＠＠ is expected to contain of a PEM encoded KEYFILE should contain a PEM encoded key and certificate." (interactive) (with-current-buffer (or buffer (current-buffer)) - (smime-sign-region - (point-min) (point-max) - (if keyfile - keyfile - (smime-get-key-with-certs-by-email - (completing-read - (concat "Sign using which key? " - (if smime-keys (concat "(default " (caar smime-keys) ") ") - "")) - smime-keys nil nil (car-safe (car-safe smime-keys)))))))) + (unless (smime-sign-region + (point-min) (point-max) + (if keyfile + keyfile + (smime-get-key-with-certs-by-email + (completing-read + (concat "Sign using which key? " + (if smime-keys (concat "(default " (caar smime-keys) ") ") + "")) + smime-keys nil nil (car-safe (car-safe smime-keys)))))) + (error "Signing failed")))) (defun smime-encrypt-buffer (&optional certfiles buffer) "S/MIME encrypt BUFFER for recipients specified in CERTFILES. ＠＠ -350,11 +351,12 ＠＠ a PEM encoded key and certificate. Uses nil." (interactive) (with-current-buffer (or buffer (current-buffer)) - (smime-encrypt-region - (point-min) (point-max) - (or certfiles - (list (read-file-name "Recipient's S/MIME certificate: " - smime-certificate-directory nil)))))) + (unless (smime-encrypt-region + (point-min) (point-max) + (or certfiles + (list (read-file-name "Recipient's S/MIME certificate: " + smime-certificate-directory nil)))) + (error "Encryption failed")))) ;; Verify+decrypt region Index: lisp/spam-report.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/spam-report.el,v retrieving revision 1.4 diff -u -p -u -r1.4 spam-report.el --- lisp/spam-report.el 28 Sep 2004 02:21:21 -0000 1.4 +++ lisp/spam-report.el 13 Mar 2005 00:12:02 -0000 ＠＠ -43,7 +43,7 ＠＠ If you are using spam.el, consider setti or the gnus-group-spam-exit-processor-report-gmane group/topic parameter instead." :type '(radio (const nil) - (regexp :format "%t: %v\n" :size 0 :value "^nntp\+.*:gmane\.")) + (regexp :value "^nntp\+.*:gmane\.")) :group 'spam-report) (defcustom spam-report-gmane-spam-header Index: lisp/spam-stat.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/spam-stat.el,v retrieving revision 1.3 diff -u -p -u -r1.3 spam-stat.el --- lisp/spam-stat.el 28 Sep 2004 02:21:21 -0000 1.3 +++ lisp/spam-stat.el 13 Mar 2005 00:12:03 -0000 ＠＠ -128,6 +128,7 ＠＠ Use the functions to build a dictionary of words and their statistical distribution in spam and non-spam mails. Then use a function to determine whether a buffer contains spam or not." +:version "22.1" :group 'gnus) (defcustom spam-stat-file "~/.spam-stat.el" ＠＠ -593,6 +594,8 ＠＠ COUNT defaults to 5" 'spam-stat-store-current-buffer) (remove-hook 'gnus-select-article-hook 'spam-stat-store-gnus-article-buffer)) + +(add-hook 'spam-stat-unload-hook 'spam-stat-unload-hook) (provide 'spam-stat) Index: lisp/spam.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/spam.el,v retrieving revision 1.4 diff -u -p -u -r1.4 spam.el --- lisp/spam.el 28 Sep 2004 02:21:21 -0000 1.4 +++ lisp/spam.el 13 Mar 2005 00:12:04 -0000 ＠＠ -76,9 +76,10 ＠＠ ;;; Main parameters. (defgroup spam nil - "Spam configuration.") + "Spam configuration." +:version "22.1") -(defcustom spam-directory "~/News/spam/" +(defcustom spam-directory (nnheader-concat gnus-directory "spam/") "Directory for spam whitelists and blacklists." :type 'directory :group 'spam) ＠＠ -294,11 +295,22 ＠＠ All unmarked article in such group recei (defcustom spam-blackhole-good-server-regex nil "String matching IP addresses that should not be checked in the blackholes." -:type '(radio (const nil) - (regexp :format "%t: %v\n" :size 0)) +:type '(radio (const nil) regexp) :group 'spam) -(defcustom spam-face 'gnus-splash-face +(defface spam-face + '((((class color) (type tty) (background dark)) + (:foreground "gray80" :background "gray50")) + (((class color) (type tty) (background light)) + (:foreground "gray50" :background "gray80")) + (((class color) (background dark)) + (:foreground "ivory2")) + (((class color) (background light)) + (:foreground "ivory4")) + (t :inverse-video t)) + "Face for spam-marked articles.") + +(defcustom spam-face 'spam-face "Face for spam-marked articles." :type 'face :group 'spam) ＠＠ -1256,6 +1268,9 ＠＠ functions") ;;;; Hashcash. +(eval-when-compile + (autoload 'mail-check-payment "hashcash")) + (condition-case nil (progn (require 'hashcash) ＠＠ -1264,9 +1279,7 ＠＠ functions") "Check the headers for hashcash payments." (mail-check-payment))) ;mail-check-payment returns a boolean - (file-error (progn - (defalias 'mail-check-payment 'ignore) - (defalias 'spam-check-hashcash 'ignore)))) + (file-error)) ;;;; BBDB ＠＠ -1275,66 +1288,67 ＠＠ functions") ;; all this is done inside a condition-case to trap errors -(condition-case nil - (progn - (require 'bbdb) - (require 'bbdb-com) +(eval-when-compile + (autoload 'bbdb-buffer "bbdb") + (autoload 'bbdb-create-internal "bbdb") + (autoload 'bbdb-search-simple "bbdb")) - (defun spam-enter-ham-BBDB (addresses &optional remove) - "Enter an address into the BBDB; implies ham (non-spam) sender" - (dolist (from addresses) - (when (stringp from) - (let* ((parsed-address (gnus-extract-address-components from)) - (name (or (nth 0 parsed-address) "Ham Sender")) - (remove-function (if remove - 'bbdb-delete-record-internal - 'ignore)) - (net-address (nth 1 parsed-address)) - (record (and net-address - (bbdb-search-simple nil net-address)))) - (when net-address - (gnus-message 5 "%s address %s %s BBDB" - (if remove "Deleting" "Adding") - from - (if remove "from" "to")) - (if record - (funcall remove-function record) - (bbdb-create-internal name nil net-address nil nil - "ham sender added by spam.el"))))))) - - (defun spam-BBDB-register-routine (articles &optional unregister) - (let (addresses) - (dolist (article articles) - (when (stringp (spam-fetch-field-from-fast article)) - (push (spam-fetch-field-from-fast article) addresses))) - ;; now do the register/unregister action - (spam-enter-ham-BBDB addresses unregister))) - - (defun spam-BBDB-unregister-routine (articles) - (spam-BBDB-register-routine articles t)) - - (defun spam-check-BBDB () - "Mail from people in the BBDB is classified as ham or non-spam" - (let ((who (nnmail-fetch-field "from")) - (spam-split-group (if spam-split-symbolic-return - 'spam - spam-split-group))) - (when who - (setq who (nth 1 (gnus-extract-address-components who))) - (if (bbdb-search-simple nil who) - t - (if spam-use-BBDB-exclusive - spam-split-group - nil)))))) - - (file-error (progn - (defalias 'bbdb-search-simple 'ignore) - (defalias 'spam-check-BBDB 'ignore) - (defalias 'spam-BBDB-register-routine 'ignore) - (defalias 'spam-enter-ham-BBDB 'ignore) - (defalias 'bbdb-create-internal 'ignore) - (defalias 'bbdb-delete-record-internal 'ignore) - (defalias 'bbdb-records 'ignore)))) +(eval-and-compile + (when (condition-case nil + (progn + (require 'bbdb) + (require 'bbdb-com)) + (file-error + (defalias 'spam-BBDB-register-routine 'ignore) + (defalias 'spam-enter-ham-BBDB 'ignore) + nil)) + + (defun spam-enter-ham-BBDB (addresses &optional remove) + "Enter an address into the BBDB; implies ham (non-spam) sender" + (dolist (from addresses) + (when (stringp from) + (let* ((parsed-address (gnus-extract-address-components from)) + (name (or (nth 0 parsed-address) "Ham Sender")) + (remove-function (if remove + 'bbdb-delete-record-internal + 'ignore)) + (net-address (nth 1 parsed-address)) + (record (and net-address + (bbdb-search-simple nil net-address)))) + (when net-address + (gnus-message 5 "%s address %s %s BBDB" + (if remove "Deleting" "Adding") + from + (if remove "from" "to")) + (if record + (funcall remove-function record) + (bbdb-create-internal name nil net-address nil nil + "ham sender added by spam.el"))))))) + + (defun spam-BBDB-register-routine (articles &optional unregister) + (let (addresses) + (dolist (article articles) + (when (stringp (spam-fetch-field-from-fast article)) + (push (spam-fetch-field-from-fast article) addresses))) + ;; now do the register/unregister action + (spam-enter-ham-BBDB addresses unregister))) + + (defun spam-BBDB-unregister-routine (articles) + (spam-BBDB-register-routine articles t)) + + (defun spam-check-BBDB () + "Mail from people in the BBDB is classified as ham or non-spam" + (let ((who (nnmail-fetch-field "from")) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when who + (setq who (nth 1 (gnus-extract-address-components who))) + (if (bbdb-search-simple nil who) + t + (if spam-use-BBDB-exclusive + spam-split-group + nil))))))) ;;;; ifile ＠＠ -1410,66 +1424,63 ＠＠ Uses `gnus-newsgroup-name' if category i ;;;; spam-stat -(condition-case nil - (progn - (let ((spam-stat-install-hooks nil)) - (require 'spam-stat)) +(eval-when-compile + (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat") + (autoload 'spam-stat-buffer-change-to-spam "spam-stat") + (autoload 'spam-stat-buffer-is-non-spam "spam-stat") + (autoload 'spam-stat-buffer-is-spam "spam-stat") + (autoload 'spam-stat-load "spam-stat") + (autoload 'spam-stat-save "spam-stat") + (autoload 'spam-stat-split-fancy "spam-stat")) - (defun spam-check-stat () - "Check the spam-stat backend for the classification of this message" - (let ((spam-split-group (if spam-split-symbolic-return - 'spam - spam-split-group)) - (spam-stat-split-fancy-spam-group spam-split-group) ; override - (spam-stat-buffer (buffer-name)) ; stat the current buffer - category return) - (spam-stat-split-fancy))) +(eval-and-compile + (when (condition-case nil + (let ((spam-stat-install-hooks nil)) + (require 'spam-stat)) + (file-error + (defalias 'spam-stat-register-ham-routine 'ignore) + (defalias 'spam-stat-register-spam-routine 'ignore) + nil)) + + (defun spam-check-stat () + "Check the spam-stat backend for the classification of this message" + (let ((spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group)) + (spam-stat-split-fancy-spam-group spam-split-group) ; override + (spam-stat-buffer (buffer-name)) ; stat the current buffer + category return) + (spam-stat-split-fancy))) - (defun spam-stat-register-spam-routine (articles &optional unregister) - (dolist (article articles) - (let ((article-string (spam-get-article-as-string article))) - (with-temp-buffer - (insert article-string) - (if unregister - (spam-stat-buffer-change-to-non-spam) + (defun spam-stat-register-spam-routine (articles &optional unregister) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (with-temp-buffer + (insert article-string) + (if unregister + (spam-stat-buffer-change-to-non-spam) (spam-stat-buffer-is-spam)))))) - (defun spam-stat-unregister-spam-routine (articles) - (spam-stat-register-spam-routine articles t)) + (defun spam-stat-unregister-spam-routine (articles) + (spam-stat-register-spam-routine articles t)) - (defun spam-stat-register-ham-routine (articles &optional unregister) - (dolist (article articles) - (let ((article-string (spam-get-article-as-string article))) - (with-temp-buffer - (insert article-string) - (if unregister - (spam-stat-buffer-change-to-spam) + (defun spam-stat-register-ham-routine (articles &optional unregister) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (with-temp-buffer + (insert article-string) + (if unregister + (spam-stat-buffer-change-to-spam) (spam-stat-buffer-is-non-spam)))))) - (defun spam-stat-unregister-ham-routine (articles) - (spam-stat-register-ham-routine articles t)) - - (defun spam-maybe-spam-stat-load () - (when spam-use-stat (spam-stat-load))) + (defun spam-stat-unregister-ham-routine (articles) + (spam-stat-register-ham-routine articles t)) - (defun spam-maybe-spam-stat-save () - (when spam-use-stat (spam-stat-save)))) + (defun spam-maybe-spam-stat-load () + (when spam-use-stat (spam-stat-load))) - (file-error (progn - (defalias 'spam-stat-load 'ignore) - (defalias 'spam-stat-save 'ignore) - (defalias 'spam-maybe-spam-stat-load 'ignore) - (defalias 'spam-maybe-spam-stat-save 'ignore) - (defalias 'spam-stat-register-ham-routine 'ignore) - (defalias 'spam-stat-unregister-ham-routine 'ignore) - (defalias 'spam-stat-register-spam-routine 'ignore) - (defalias 'spam-stat-unregister-spam-routine 'ignore) - (defalias 'spam-stat-buffer-is-spam 'ignore) - (defalias 'spam-stat-buffer-change-to-spam 'ignore) - (defalias 'spam-stat-buffer-is-non-spam 'ignore) - (defalias 'spam-stat-buffer-change-to-non-spam 'ignore) - (defalias 'spam-stat-split-fancy 'ignore) - (defalias 'spam-check-stat 'ignore)))) + (defun spam-maybe-spam-stat-save () + (when spam-use-stat (spam-stat-save))))) ＠＠ -1746,7 +1757,7 ＠＠ REMOVE not nil, remove the ADDRESSES." (goto-char (point-min)) (when (re-search-forward "^X-Spam: yes;" nil t) spam-split-group)) - (error "Error running spamoracle" status)))))))) + (error "Error running spamoracle: %s" status)))))))) (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister) "Run spamoracle in training mode." ＠＠ -1768,8 +1779,8 ＠＠ REMOVE not nil, remove the ADDRESSES." `("-f" ,spam-spamoracle-database "add" ,arg) `("add" ,arg))))) - (when (not (eq 0 status)) - (error "Error running spamoracle" status))))))) + (unless (eq 0 status) + (error "Error running spamoracle: %s" status))))))) (defun spam-spamoracle-learn-ham (articles &optional unregister) (spam-spamoracle-learn articles nil unregister)) ＠＠ -1814,12 +1825,10 ＠＠ REMOVE not nil, remove the ADDRESSES." (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening) (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam)) +(add-hook 'spam-unload-hook 'spam-unload-hook) + (when spam-install-hooks (spam-initialize)) - -(provide 'spam) - -;;; spam.el ends here. (provide 'spam) Index: lisp/utf7.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/utf7.el,v retrieving revision 1.3 diff -u -p -u -r1.3 utf7.el --- lisp/utf7.el 28 Sep 2004 02:21:21 -0000 1.3 +++ lisp/utf7.el 13 Mar 2005 00:12:04 -0000 ＠＠ -59,7 +59,7 ＠＠ ;; $ echo "a+£"|iconv -f iso-8859-1 -t utf-7 ;; a+-+AKM ;; -;; -- fx +;; -- fx ;;; Code: ＠＠ -78,7 +78,7 ＠＠ (defconst utf7-utf-16-coding-system (cond ((mm-coding-system-p 'utf-16-be-no-signature) ; Mule-UCS 'utf-16-be-no-signature) - ((and (mm-coding-system-p 'utf-16-be) ; Emacs 21.4 (?), Emacs 22 + ((and (mm-coding-system-p 'utf-16-be) ; Emacs 22.1 ;; Avoid versions with BOM. (= 2 (length (encode-coding-string "a" 'utf-16-be)))) 'utf-16-be) Index: texi/ChangeLog.upstream =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/ChangeLog.upstream,v retrieving revision 1.5 diff -u -p -u -r1.5 ChangeLog.upstream --- texi/ChangeLog.upstream 28 Sep 2004 02:21:30 -0000 1.5 +++ texi/ChangeLog.upstream 13 Mar 2005 00:12:05 -0000 ＠＠ -1,8 +1,70 ＠＠ - * sieve.texi (Manage Sieve API): nil -> ＠code{nil}. - * pgg.texi (User Commands, Backend methods): do. - * gnus.texi: Markup fixes. - (Setting Process Marks): Fix `M P a' entry. - * emacs-mime: Fixes. +2005-03-03 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus.texi (Slow/Expensive Connection): Don't abbreviate "very". + +2005-01-28 Lars Magne Ingebrigtsen <larsi(a)gnus.org> + + * gnus.texi: Some edits based on comments from David Abrahams. + +2005-01-24 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * gnus.texi (RSS): Fix the keystroke. + +2005-01-16 Xavier Maillard <zedek(a)gnu-rox.org> (tiny change) + + * gnus-faq.texi ([4.1]): Typo. + +2005-01-06 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * message.texi (Reply): `message-reply-to-function' should return + a list. Suggested by ARISAWA Akihiro <ari(a)mbf.ocn.co.jp>. + +2004-12-08 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-faq.texi ([5.1]): Added missing bracket. + + * gnus.texi (Filtering Spam Using The Spam ELisp Package): Index + `spam-initialize'. + +2004-11-22 Reiner Steib <Reiner.Steib(a)gmx.de> + + * message.texi (Various Message Variables): Mention that all mail + file variables are derived from `message-directory'. + + * gnus.texi (Splitting Mail): Clarify bogus group. + +2004-11-02 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * emacs-mime.texi (Encoding Customization): Fix + mm-coding-system-priorities entry. + +2004-10-15 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus.texi (New Features): Add 5.11. + + * message.texi (Resending): Remove wrong default value. + + * gnus.texi (Mail Source Specifiers): Describe possible problems + of `pop3-leave-mail-on-server'. Add `pop3-movemail' and + `pop3-leave-mail-on-server' to the index. + +2004-10-15 Katsumi Yamaoka <yamaoka(a)jpl.org> + + * message.texi (Canceling News): Add how to set a password. + +2004-10-10 Juri Linkov <juri(a)jurta.org> + + * gnus.texi (Top, Marking Articles): Join two menus in one node + because a node can have only one menu. + +2004-10-09 Juri Linkov <juri(a)jurta.org> + + * gnus.texi (Fancy Mail Splitting): Remove backslash in the + example of nnmail-split-fancy. + +2004-10-12 Reiner Steib <Reiner.Steib(a)gmx.de> + + * gnus-faq.texi ([5.9]): Improve code for reply-in-news. 2004-09-23 Reiner Steib <Reiner.Steib(a)gmx.de> Index: texi/bk-a4.tex =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/bk-a4.tex,v retrieving revision 1.1 diff -u -p -u -r1.1 bk-a4.tex --- texi/bk-a4.tex 2 May 2003 00:27:32 -0000 1.1 +++ texi/bk-a4.tex 13 Mar 2005 00:12:05 -0000 ＠＠ -18,3 +18,5 ＠＠ \small%\footnotesize \input{booklet} \end{document} + +% arch-tag: 95490708-a858-4d01-99fe-888f0c8a58a2 Index: texi/bk-lt.tex =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/bk-lt.tex,v retrieving revision 1.1 diff -u -p -u -r1.1 bk-lt.tex --- texi/bk-lt.tex 2 May 2003 00:27:32 -0000 1.1 +++ texi/bk-lt.tex 13 Mar 2005 00:12:05 -0000 ＠＠ -18,3 +18,5 ＠＠ \small%\footnotesize \input{booklet} \end{document} + +% arch-tag: fd94e3e8-a8ef-48e8-ba5e-6c8b0a293dc1 Index: texi/booklet.tex =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/booklet.tex,v retrieving revision 1.1 diff -u -p -u -r1.1 booklet.tex --- texi/booklet.tex 2 May 2003 00:27:32 -0000 1.1 +++ texi/booklet.tex 13 Mar 2005 00:12:05 -0000 ＠＠ -170,3 +170,5 ＠＠ %% \thispagestyle{empty} %% \vspace*{\fill} %% \CopyRight + +% arch-tag: e030ead9-7440-42b3-ae58-bac80a79debd Index: texi/doclicense.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/doclicense.texi,v retrieving revision 1.1 diff -u -p -u -r1.1 doclicense.texi --- texi/doclicense.texi 27 Mar 2003 08:20:25 -0000 1.1 +++ texi/doclicense.texi 13 Mar 2005 00:12:05 -0000 ＠＠ -366,3 +366,7 ＠＠ If your document contains nontrivial exa recommend releasing these examples in parallel under your choice of free software license, such as the GNU General Public License, to permit their use in free software. + +＠ignore + arch-tag: 261f9376-a0f0-4e90-ba5b-06a297b6053d +＠end ignore Index: texi/emacs-mime.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/emacs-mime.texi,v retrieving revision 1.4 diff -u -p -u -r1.4 emacs-mime.texi --- texi/emacs-mime.texi 28 Sep 2004 02:21:30 -0000 1.4 +++ texi/emacs-mime.texi 13 Mar 2005 00:12:05 -0000 ＠＠ -814,12 +814,12 ＠＠ by using the ＠code{encoding} ＠acronym{MM ＠vindex mm-coding-system-priorities Prioritize coding systems to use for outgoing messages. The default is ＠code{nil}, which means to use the defaults in Emacs. It is a list of -coding system symbols (aliases of coding systems does not work, use -＠kbd{M-x describe-coding-system} to make sure you are not specifying -an alias in this variable). For example, if you have configured Emacs +coding system symbols (aliases of coding systems are also allowed, use +＠kbd{M-x describe-coding-system} to make sure you are specifying correct +coding system names). For example, if you have configured Emacs to prefer UTF-8, but wish that outgoing messages should be sent in ISO-8859-1 if possible, you can set this variable to -＠code{(iso-latin-1)}. You can override this setting on a per-message +＠code{(iso-8859-1)}. You can override this setting on a per-message basis by using the ＠code{charset} ＠acronym{MML} tag (＠pxref{MML Definition}). ＠item mm-content-transfer-encoding-defaults Index: texi/gnus-faq.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/gnus-faq.texi,v retrieving revision 1.4 diff -u -p -u -r1.4 gnus-faq.texi --- texi/gnus-faq.texi 28 Sep 2004 02:21:30 -0000 1.4 +++ texi/gnus-faq.texi 13 Mar 2005 00:12:07 -0000 ＠＠ -1,6 +1,6 ＠＠＠c Insert "\input texinfo" at 1st line before texing this file alone. ＠c -*-texinfo-*- -＠c Copyright (C) 1995, 2001, 2003, 2004 Free Software Foundation, Inc. +＠c Copyright (C) 1995, 2001, 2003, 2004, 2005 Free Software Foundation, Inc. ＠setfilename gnus-faq.info ＠c Frequently Asked Questions, FAQ - Introduction, Emacs for Heathens, Top ＠＠ -857,7 +857,7 ＠＠ Answer: If you enter the group by saying ＠samp{RET} - in summary buffer with point over the group, only unread and ticked messages are loaded. Say + in group buffer with point over the group, only unread and ticked messages are loaded. Say ＠samp{C-u RET} instead to load all available messages. If you want only the e.g. 300 newest say ＠samp{C-u 300 RET} ＠＠ -1414,7 +1414,7 ＠＠ Answer: message. For a follow up to a newsgroup, it's ＠samp{f} and ＠samp{F} (analog to ＠samp{r} and - ＠samp{R}. + ＠samp{R}). Enter new headers above the line saying "--text follows ＠＠ -1776,11 +1776,14 ＠＠ Answer: ＠example -(defadvice gnus-summary-reply (around reply-in-news activate) +(eval-after-load "gnus-msg" + '(unless (boundp 'gnus-confirm-mail-reply-to-news) + (defadvice gnus-summary-reply (around reply-in-news activate) + "Request confirmation when replying to news." (interactive) - (when (or (not (gnus-news-group-p gnus-newsgroup-name)) - (y-or-n-p "Really reply? ")) - ad-do-it)) + (when (or (not (gnus-news-group-p gnus-newsgroup-name)) + (y-or-n-p "Really reply by mail to article author? ")) + ad-do-it)))) ＠end example ＠ifnottex Index: texi/gnus.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/gnus.texi,v retrieving revision 1.7 diff -u -p -u -r1.7 gnus.texi --- texi/gnus.texi 28 Sep 2004 02:21:31 -0000 1.7 +++ texi/gnus.texi 13 Mar 2005 00:12:19 -0000 ＠＠ -391,25 +391,25 ＠＠ the program. ＠end iftex ＠menu -* Starting Up:: Finding news can be a pain. -* Group Buffer:: Selecting, subscribing and killing groups. -* Summary Buffer:: Reading, saving and posting articles. -* Article Buffer:: Displaying and handling articles. -* Composing Messages:: Information on sending mail and news. -* Select Methods:: Gnus reads all messages from various select methods. -* Scoring:: Assigning values to articles. -* Various:: General purpose settings. -* The End:: Farewell and goodbye. -* Appendices:: Terminology, Emacs intro, ＠acronym{FAQ}, History, Internals. -* Index:: Variable, function and concept index. -* Key Index:: Key Index. +* Starting Up:: Finding news can be a pain. +* Group Buffer:: Selecting, subscribing and killing groups. +* Summary Buffer:: Reading, saving and posting articles. +* Article Buffer:: Displaying and handling articles. +* Composing Messages:: Information on sending mail and news. +* Select Methods:: Gnus reads all messages from various select methods. +* Scoring:: Assigning values to articles. +* Various:: General purpose settings. +* The End:: Farewell and goodbye. +* Appendices:: Terminology, Emacs intro, ＠acronym{FAQ}, History, Internals. +* Index:: Variable, function and concept index. +* Key Index:: Key Index. Other related manuals -* Message:(message). Composing messages. -* Emacs-MIME:(emacs-mime). Composing messages; ＠acronym{MIME}-specific parts. -* Sieve:(sieve). Managing Sieve scripts in Emacs. -* PGG:(pgg). ＠acronym{PGP/MIME} with Gnus. +* Message:(message). Composing messages. +* Emacs-MIME:(emacs-mime). Composing messages; ＠acronym{MIME}-specific parts. +* Sieve:(sieve). Managing Sieve scripts in Emacs. +* PGG:(pgg). ＠acronym{PGP/MIME} with Gnus. ＠detailmenu --- The Detailed Node Listing --- ＠＠ -535,12 +535,9 ＠＠ Marking Articles * Unread Articles:: Marks for unread articles. * Read Articles:: Marks for read articles. * Other Marks:: Marks that do not affect readedness. - -Marking Articles - -* Setting Marks:: How to set and remove marks. -* Generic Marking Commands:: How to customize the marking. -* Setting Process Marks:: How to mark articles for later processing. +* Setting Marks:: How to set and remove marks. +* Generic Marking Commands:: How to customize the marking. +* Setting Process Marks:: How to mark articles for later processing. Threading ＠＠ -888,7 +885,7 ＠＠ New Features * Red Gnus:: Third time best---Gnus 5.4/5.5. * Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7. * Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9. -* Oort Gnus:: It's big. It's far out. Gnus 5.10. +* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11. Customization ＠＠ -954,17 +951,16 ＠＠ If you puzzle at any terms used in this terminology section (＠pxref{Terminology}). ＠menu -* Finding the News:: Choosing a method for getting news. -* The First Time:: What does Gnus do the first time you start it? -* The Server is Down:: How can I read my mail then? -* Slave Gnusae:: You can have more than one Gnus active at a time. -* Fetching a Group:: Starting Gnus just to read a group. -* New Groups:: What is Gnus supposed to do with new groups? -* Changing Servers:: You may want to move from one server to another. -* Startup Files:: Those pesky startup files---(a)file{.newsrc}. -* Auto Save:: Recovering from a crash. -* The Active File:: Reading the active file over a slow line Takes Time. -* Startup Variables:: Other variables you might change. +* Finding the News:: Choosing a method for getting news. +* The First Time:: What does Gnus do the first time you start it? +* The Server is Down:: How can I read my mail then? +* Slave Gnusae:: You can have more than one Gnus active at a time. +* New Groups:: What is Gnus supposed to do with new groups? +* Changing Servers:: You may want to move from one server to another. +* Startup Files:: Those pesky startup files---(a)file{.newsrc}. +* Auto Save:: Recovering from a crash. +* The Active File:: Reading the active file over a slow line Takes Time. +* Startup Variables:: Other variables you might change. ＠end menu ＠＠ -995,7 +991,8 ＠＠ If you want to read directly from the lo If you can use a local spool, you probably should, as it will almost certainly be much faster. But do not use the local spool if your -server is running Leafnode; in this case, use ＠code{(nntp "localhost")}. +server is running Leafnode (which is a simple, standalone private news +server); in this case, use ＠code{(nntp "localhost")}. ＠vindex gnus-nntpserver-file ＠cindex NNTPSERVER ＠＠ -1054,8 +1051,8 ＠＠ you would typically set this variable to ＠section The First Time ＠cindex first time usage -If no startup files exist, Gnus will try to determine what groups should -be subscribed by default. +If no startup files exist (＠pxref{Startup Files}), Gnus will try to +determine what groups should be subscribed by default. ＠vindex gnus-default-subscribed-newsgroups If the variable ＠code{gnus-default-subscribed-newsgroups} is set, Gnus ＠＠ -1142,16 +1139,6 ＠＠ file. If you answer ``yes'', the unsave incorporated into the slave. If you answer ``no'', the slave may see some messages as unread that have been read in the master. -＠node Fetching a Group -＠section Fetching a Group -＠cindex fetching a group - -＠findex gnus-fetch-group -It is sometimes convenient to be able to just say ``I want to read this -group and I don't care whether Gnus has been started or not''. This is -perhaps more useful for people who write code than for users, but the -command ＠code{gnus-fetch-group} provides this functionality in any case. -It takes the group name as a parameter. ＠node New Groups ＠＠ -1403,8 +1390,10 ＠＠ cache for all groups). ＠cindex .newsrc.el ＠cindex .newsrc.eld -Now, you all know about the ＠file{.newsrc} file. All subscription -information is traditionally stored in this file. +Most common Unix news readers use a shared startup file called +(a)file{.newsrc}. This file contains all the information about what +groups are subscribed, and which articles in these groups have been +read. Things got a bit more complicated with ＠sc{gnus}. In addition to keeping the ＠file{.newsrc} file updated, it also used a file called ＠＠ -1429,8 +1418,10 ＠＠ the file and save some space, as well as However, this will make it impossible to use other newsreaders than Gnus. But hey, who would want to, right? Similarly, setting ＠code{gnus-read-newsrc-file} to ＠code{nil} makes Gnus ignore the -(a)file{.newsrc} file and any ＠file{.newsrc-SERVER} files, which is -convenient if you have a tendency to use Netscape once in a while. +(a)file{.newsrc} file and any ＠file{.newsrc-SERVER} files, which can be +convenient if you use a different news reader occasionally, and you +want to read a different subset of the available groups with that +news reader. ＠vindex gnus-save-killed-list If ＠code{gnus-save-killed-list} (default ＠code{t}) is ＠code{nil}, Gnus ＠＠ -5686,20 +5677,17 ＠＠ neologism ohoy!) of the article. Alphab In addition, you also have marks that do not affect readedness. -＠menu -* Unread Articles:: Marks for unread articles. -* Read Articles:: Marks for read articles. -* Other Marks:: Marks that do not affect readedness. -＠end menu - ＠ifinfo -There's a plethora of commands for manipulating these marks: +There's a plethora of commands for manipulating these marks. ＠end ifinfo ＠menu -* Setting Marks:: How to set and remove marks. -* Generic Marking Commands:: How to customize the marking. -* Setting Process Marks:: How to mark articles for later processing. +* Unread Articles:: Marks for unread articles. +* Read Articles:: Marks for read articles. +* Other Marks:: Marks that do not affect readedness. +* Setting Marks:: How to set and remove marks. +* Generic Marking Commands:: How to customize the marking. +* Setting Process Marks:: How to mark articles for later processing. ＠end menu ＠＠ -13250,14 +13238,16 ＠＠ called narrowed to the headers with the argument. It should return a non-＠code{nil} value if it thinks that the mail belongs in that group. +＠cindex ＠samp{bogus} group The last of these groups should always be a general one, and the regular -expression should ＠emph{always} be ＠samp{*} so that it matches any mails +expression should ＠emph{always} be ＠samp{""} so that it matches any mails that haven't been matched by any of the other regexps. (These rules are -processed from the beginning of the alist toward the end. The first -rule to make a match will ``win'', unless you have crossposting enabled. -In that case, all matching rules will ``win''.) When new groups are -created by splitting mail, you may want to run -＠code{gnus-group-find-new-groups} to see the new groups. +processed from the beginning of the alist toward the end. The first rule +to make a match will ``win'', unless you have crossposting enabled. In +that case, all matching rules will ``win''.) If no rule matched, the mail +will end up in the ＠samp{bogus} group. When new groups are created by +splitting mail, you may want to run ＠code{gnus-group-find-new-groups} to +see the new groups. This also applies to the ＠samp{bogus} group. If you like to tinker with this yourself, you can set this variable to a function of your choice. This function will be called without any ＠＠ -13274,7 +13264,7 ＠＠ some add ＠code{X-Gnus-Group} headers; mo The mail back ends all support cross-posting. If several regexps match, the mail will be ``cross-posted'' to all those groups. ＠code{nnmail-crosspost} says whether to use this mechanism or not. Note -that no articles are crossposted to the general (＠samp{*}) group. +that no articles are crossposted to the general (＠samp{""}) group. ＠vindex nnmail-crosspost-link-function ＠cindex crosspost ＠＠ -13544,10 +13534,16 ＠＠ and says what authentication scheme to u ＠end table +＠vindex pop3-movemail +＠vindex pop3-leave-mail-on-server If the ＠code{:program} and ＠code{:function} keywords aren't specified, ＠code{pop3-movemail} will be used. If the ＠code{pop3-leave-mail-on-server} is non-＠code{nil} the mail is to be -left on the POP server after fetching. +left on the ＠acronym{POP} server after fetching when using +＠code{pop3-movemail}. Note that POP servers maintain no state +information between sessions, so what the client believes is there and +what is actually there may not match up. If they do not, then the whole +thing can fall apart and leave you with a corrupt mailbox. Here are some examples. Fetch from the default ＠acronym{POP} server, using the default user name, and default fetcher: ＠＠ -14002,7 +13998,7 ＠＠ Let's look at an example value of this v ;; ＠r{the bugs- list, but allow cross-posting when the} ;; ＠r{message was really cross-posted.} (any "bugs-mypackage＠＠somewhere" "mypkg.bugs") - (any "mypackage＠＠somewhere\" - "bugs-mypackage" "mypkg.list") + (any "mypackage＠＠somewhere" - "bugs-mypackage" "mypkg.list") ;; ＠r{People＠dots{}} (any "larsi＠(a)ifi\\.uio\\.no" "people.Lars_Magne_Ingebrigtsen")) ;; ＠r{Unmatched mail goes to the catch all group.} ＠＠ -15882,7 +15878,7 ＠＠ Use ＠kbd{G R} from the summary buffer to will be prompted for the location of the feed. An easy way to get started with ＠code{nnrss} is to say something like -the following in the group buffer: ＠kbd{B nnrss RET y}, then +the following in the group buffer: ＠kbd{B nnrss RET RET y}, then subscribe to groups. The following ＠code{nnrss} variables can be altered: ＠＠ -20605,6 +20601,7 ＠＠ four days, Gnus will decay the scores fo * Undo:: Some actions can be undone. * Predicate Specifiers:: Specifying predicates. * Moderation:: What to do if you're a moderator. +* Fetching a Group:: Starting Gnus just to read a group. * Image Enhancements:: Modern versions of Emacs/XEmacs can display images. * Fuzzy Matching:: What's the big fuzz? * Thwarting Email Spam:: A how-to on avoiding unsolicited commercial email. ＠＠ -21876,6 +21873,18 ＠＠ To use moderation mode in these two grou ＠end lisp +＠node Fetching a Group +＠section Fetching a Group +＠cindex fetching a group + +＠findex gnus-fetch-group +It is sometimes convenient to be able to just say ``I want to read this +group and I don't care whether Gnus has been started or not''. This is +perhaps more useful for people who write code than for users, but the +command ＠code{gnus-fetch-group} provides this functionality in any case. +It takes the group name as a parameter. + + ＠node Image Enhancements ＠section Image Enhancements ＠＠ -22601,6 +22610,7 ＠＠ filters new mail, and it analyzes mail k ＠dfn{Ham} is the name used throughout ＠file{spam.el} to indicate non-spam messages. +＠cindex spam-initialize First of all, you ＠strong{must} run the function ＠code{spam-initialize} to autoload ＠code{spam.el} and to install the ＠code{spam.el} hooks. There is one exception: if you use the ＠＠ -25056,7 +25066,7 ＠＠ actually are people who are using Gnus. * Red Gnus:: Third time best---Gnus 5.4/5.5. * Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7. * Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9. -* Oort Gnus:: It's big. It's far out. Gnus 5.10. +* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11. ＠end menu These lists are, of course, just ＠emph{short} overviews of the ＠＠ -26572,6 +26582,12 ＠＠ The act of asking the server for info on number of unread articles is called ＠dfn{activating the group}. Un-activated groups are listed with ＠samp{*} in the group buffer. +＠item spool +＠cindex spool +News servers store their articles locally in one fashion or other. +One old-fashioned storage method is to have just one file per +article. That's called a ``traditional spool''. + ＠item server ＠cindex server A machine one can connect to and get news (or mail) from. ＠＠ -26672,7 +26688,7 ＠＠ Gnus has to get from the ＠acronym{NNTP} ＠item gnus-read-active-file Set this to ＠code{nil}, which will inhibit Gnus from requesting the -entire active file from the server. This file is often v. large. You +entire active file from the server. This file is often very large. You also have to set ＠code{gnus-check-new-newsgroups} and ＠code{gnus-check-bogus-newsgroups} to ＠code{nil} to make sure that Gnus doesn't suddenly decide to fetch the active file anyway. Index: texi/gnusref.tex =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/gnusref.tex,v retrieving revision 1.4 diff -u -p -u -r1.4 gnusref.tex --- texi/gnusref.tex 4 Jan 2004 22:49:32 -0000 1.4 +++ texi/gnusref.tex 13 Mar 2005 00:12:20 -0000 ＠＠ -1180,3 +1180,5 ＠＠ %%% mode: latex %%% TeX-master: "refcard.tex" %%% End: + +% arch-tag: be438b0e-6832-4afb-8c56-5f84743e5cd1 Index: texi/message.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/message.texi,v retrieving revision 1.5 diff -u -p -u -r1.5 message.texi --- texi/message.texi 28 Sep 2004 02:21:32 -0000 1.5 +++ texi/message.texi 13 Mar 2005 00:12:20 -0000 ＠＠ -146,16 +146,15 ＠＠ If you want the replies to go to the ＠co This function will be called narrowed to the head of the article that is being replied to. -As you can see, this function should return a string if it has an -opinion as to what the To header should be. If it does not, it should -just return ＠code{nil}, and the normal methods for determining the To -header will be used. - -This function can also return a list. In that case, each list element -should be a cons, where the ＠sc{car} should be the name of a header -(e.g. ＠code{Cc}) and the ＠sc{cdr} should be the header value -(e.g. ＠samp{larsi＠(a)ifi.uio.no}). All these headers will be inserted into -the head of the outgoing mail. +As you can see, this function should return a list. In this case, it +returns ＠code{((To . "Whom"))} if it has an opinion as to what the To +header should be. If it does not, it should just return ＠code{nil}, and +the normal methods for determining the To header will be used. + +Each list element should be a cons, where the ＠sc{car} should be the +name of a header (e.g. ＠code{Cc}) and the ＠sc{cdr} should be the header +value (e.g. ＠samp{larsi＠(a)ifi.uio.no}). All these headers will be +inserted into the head of the outgoing mail. ＠node Wide Reply ＠＠ -224,7 +223,13 ＠＠ only you can cancel your own messages, w is that if you lose your ＠file{.emacs} file (which is where Gnus stores the secret cancel lock password (which is generated automatically the first time you use this feature)), you won't be -able to cancel your message. +able to cancel your message. If you want to manage a password yourself, +you can put something like the following in your ＠file{~/.gnus.el} file: + +＠lisp +(setq canlock-password "geheimnis" + canlock-password-for-verify canlock-password) +＠end lisp Whether to insert the header or not is controlled by the ＠code{message-insert-canlock} variable. ＠＠ -309,8 +314,7 ＠＠ and resend the message in the current bu ＠vindex message-ignored-resent-headers Headers that match the ＠code{message-ignored-resent-headers} regexp will -be removed before sending the message. The default is -＠samp{^Return-receipt}. +be removed before sending the message. ＠node Bouncing ＠＠ -1862,6 +1866,7 ＠＠ follows this line--} by default. ＠item message-directory ＠vindex message-directory Directory used by many mailey things. The default is ＠file{~/Mail/}. +All other mail file variables are derived from ＠code{message-directory}. ＠item message-auto-save-directory ＠vindex message-auto-save-directory Index: texi/pagestyle.sty =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/pagestyle.sty,v retrieving revision 1.2 diff -u -p -u -r1.2 pagestyle.sty --- texi/pagestyle.sty 2 May 2003 00:27:34 -0000 1.2 +++ texi/pagestyle.sty 13 Mar 2005 00:12:20 -0000 ＠＠ -81,3 +81,4 ＠＠ \setcounter{tocdepth}{3} \setcounter{secnumdepth}{3} +% arch-tag: 49bd5922-1cc7-4614-87b7-53f34f669c5c Index: texi/pixidx.sty =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/pixidx.sty,v retrieving revision 1.1 diff -u -p -u -r1.1 pixidx.sty --- texi/pixidx.sty 27 Mar 2003 08:20:26 -0000 1.1 +++ texi/pixidx.sty 13 Mar 2005 00:12:20 -0000 ＠＠ -227,3 +227,5 ＠＠ \flushbottom \endinput + +% arch-tag: 286974d6-3578-4aa9-b298-f6a03b13f0bd Index: texi/postamble.tex =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/postamble.tex,v retrieving revision 1.2 diff -u -p -u -r1.2 postamble.tex --- texi/postamble.tex 2 May 2003 00:27:34 -0000 1.2 +++ texi/postamble.tex 13 Mar 2005 00:12:20 -0000 ＠＠ -48,3 +48,5 ＠＠ Graphics by Luis Fernandes. \gnususefon %%% mode: latex %%% TeX-master: t %%% End: + +% arch-tag: 5e771934-0d03-4dbc-898f-10eb429ad992 Index: texi/refcard.tex =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/refcard.tex,v retrieving revision 1.3 diff -u -p -u -r1.3 refcard.tex --- texi/refcard.tex 4 Jan 2004 22:49:32 -0000 1.3 +++ texi/refcard.tex 13 Mar 2005 00:12:20 -0000 ＠＠ -184,3 +184,5 ＠＠ %%% Local Variables: %%% mode: latex %%% End: + +% arch-tag: 242dca59-0d4d-4c5c-9427-3503d78cf848 Index: texi/splitindex =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/splitindex,v retrieving revision 1.1 diff -u -p -u -r1.1 splitindex --- texi/splitindex 2 May 2003 00:27:34 -0000 1.1 +++ texi/splitindex 13 Mar 2005 00:12:20 -0000 ＠＠ -4,3 +4,5 ＠＠ fun='\{gnus-|\{nn.*-|\{grouplens-' egrep "$match" gnus.idx > gnus.kidx egrep "$fun" gnus.idx > gnus.gidx egrep -v "$match|$fun" gnus.idx > gnus.cidx + +# arch-tag: 2e32a8e5-4eae-46dd-a3d0-90f514ba27d7 -- |---<Steve Youngs>---------------<GnuPG KeyID: A94B3003>---| | I am Dyslexic of Borg. | | Fusistance is retile. Your arse will be laminated. | |------------------------------------<steve(a)sxemacs.org>---|

1 participants
0 comments

[PATCH] Incremental selection transfer fix, 21.4 20 years

Aidan Kehoe

This is mostly for Steve’s, and SXEmacs’, benefit, but it would be a reasonable bug fix to apply to 21.4. ChangeLog addition: 2005-03-12 Aidan Kehoe <kehoea(a)parhasard.net> * configure: Regenerate. * configure.in (XE_COMPUTE_RUNPATH): Check XtRegisterDrawable availability. src/ChangeLog addition: 2005-03-12 Aidan Kehoe <kehoea(a)parhasard.net> * config.h.in: Make HAVE_XTREGISTERDRAWABLE available. * select-x.c (x_reply_selection_request): Use it; fix the bug we were seeing with incremental selection transfer failing. XEmacs Stable source patch: Diff command: cvs -q diff -u Files affected: src/select-x.c src/config.h.in configure.in configure Index: configure =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure,v retrieving revision 1.147.2.32 diff -u -u -r1.147.2.32 configure --- configure 2005/01/31 03:06:14 1.147.2.32 +++ configure 2005/03/12 21:33:14 ＠＠ -6847,7 +6847,7 ＠＠ esac fi - for ac_func in XConvertCase + for ac_func in XConvertCase XtRegisterDrawable do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 echo "configure:6854: checking for $ac_func" >&5 Index: configure.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.in,v retrieving revision 1.151.2.31 diff -u -u -r1.151.2.31 configure.in --- configure.in 2005/01/31 02:54:47 1.151.2.31 +++ configure.in 2005/03/12 21:33:18 ＠＠ -2913,7 +2913,7 ＠＠ esac fi - AC_CHECK_FUNCS(XConvertCase) + AC_CHECK_FUNCS(XConvertCase XtRegisterDrawable) AC_CHECK_HEADERS(X11/Xlocale.h) Index: src/config.h.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/config.h.in,v retrieving revision 1.61.2.7 diff -u -u -r1.61.2.7 config.h.in --- src/config.h.in 2003/08/18 01:42:10 1.61.2.7 +++ src/config.h.in 2005/03/12 21:33:22 ＠＠ -205,6 +205,7 ＠＠ #undef THIS_IS_X11R6 #undef HAVE_XCONVERTCASE +#undef HAVE_XTREGISTERDRAWABLE #undef HAVE_BALLOON_HELP Index: src/select-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/select-x.c,v retrieving revision 1.2.2.2 diff -u -u -r1.2.2.2 select-x.c --- src/select-x.c 2005/01/31 02:55:31 1.2.2.2 +++ src/select-x.c 2005/03/12 21:33:23 ＠＠ -509,14 +509,41 ＠＠ } else { +#ifndef HAVE_XTREGISTERDRAWABLE + invalid_operation("Copying that much data requires X11R6.", Qunbound); +#else /* Send an INCR selection. */ int prop_id; + Widget widget = FRAME_X_TEXT_WIDGET (XFRAME(DEVICE_SELECTED_FRAME(d))); if (x_window_to_frame (d, window)) /* #### debug */ error ("attempt to transfer an INCR to ourself!"); #if 0 stderr_out ("\nINCR %d\n", bytes_remaining); #endif + /* Tell Xt not to drop PropertyNotify events that arrive for the + target window, rather, pass them to us. This would be a hack, but + the Xt selection routines are broken for our purposes--we can't + pass them callbacks from Lisp, for example. Let's call it a + workaround. + + The call to wait_for_property_change means we can break out of that + function, switch to another frame on the same display (which will + be another Xt widget), select a huge amount of text, and have the + same (foreign) app ask for another incremental selection + transfer. Programming like X11 made sense, would mean that, in that + case, XtRegisterDrawable is called twice with different widgets. + + Since the results of calling XtRegisterDrawable when the drawable + is already registered with another widget are undefined, we want to + avoid that--so, only call it when XtWindowToWidget returns NULL, + which it will only do with a valid Window if it's not already + registered. */ + if (NULL == XtWindowToWidget(display, window)) + { + XtRegisterDrawable(display, (Drawable)window, widget); + } + prop_id = expect_property_change (display, window, reply.property, PropertyDelete); ＠＠ -560,10 +587,14 ＠＠ stderr_out (" INCR done\n"); #endif if (! waiting_for_other_props_on_window (display, window)) - XSelectInput (display, window, 0L); + { + XSelectInput (display, window, 0L); + XtUnregisterDrawable(display, (Drawable)window); + } XChangeProperty (display, window, reply.property, type, format, PropModeReplace, data, 0); +#endif /* HAVE_XTREGISTERDRAWABLE */ } } -- “I, for instance, am gung-ho about open source because my family is being held hostage in Rob Malda’s basement. But who fact-checks me, or Enderle, when we say something in public? No-one!” -- Danny O’Brien

1 participants
0 comments

[PACKAGES (re-builder)] drop fsf-compat dependence + small bug fix 20 years

Steve Youngs

I'm a firm believer in XEmacs packages using XEmacs features. Here's another package that needed very little tweaking to get rid of its dependence on fsf-compat. And as an added bonus, there's a bug fix too. `reb-color-display-p' would _always_ return nil on XEmacs. re-builder patch: ChangeLog files diff command: cvs -q diff -U 0 Files affected: ChangeLog Source files diff command: cvs -q diff -uN Files affected: re-builder.el Makefile Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/re-builder/ChangeLog,v retrieving revision 1.2 diff -u -p -U0 -r1.2 ChangeLog --- ChangeLog 9 Mar 2005 20:23:20 -0000 1.2 +++ ChangeLog 10 Mar 2005 09:33:55 -0000 ＠＠ -0,0 +1,12 ＠＠ +2005-03-10 Steve Youngs <steve(a)sxemacs.org> + + * Makefile (REQUIRES): Remove fsf-compat. This package uses + extents natively now. + + * re-builder.el: Set up better extent/overlay compatibility. + (reb-delete-overlays): Use it here. + (reb-update-overlays): Ditto. + + (reb-color-display-p): Call `device-class' in + XEmacs so this function will DTRT in XEmacs. + Index: Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/re-builder/Makefile,v retrieving revision 1.2 diff -u -p -u -r1.2 Makefile --- Makefile 9 Mar 2005 20:23:20 -0000 1.2 +++ Makefile 10 Mar 2005 09:33:45 -0000 ＠＠ -25,7 +25,7 ＠＠ AUTHOR_VERSION = 1.20 MAINTAINER = Aidan Kehoe <aidan(a)xemacs.org> PACKAGE = re-builder PKG_TYPE = regular -REQUIRES = fsf-compat +REQUIRES = CATEGORY = standard STANDARD_DOCS = t Index: re-builder.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/re-builder/re-builder.el,v retrieving revision 1.1 diff -u -p -u -r1.1 re-builder.el --- re-builder.el 4 Mar 2005 20:29:56 -0000 1.1 +++ re-builder.el 10 Mar 2005 09:33:45 -0000 ＠＠ -110,9 +110,17 ＠＠ ;;; Code: -;; On XEmacs, load the overlay compatibility library -(if (not (fboundp 'make-overlay)) - (require 'overlay)) +;; Extent/overlay compatibility +(if (featurep 'xemacs) + ;; (S)XEmacs + (progn + (defalias 'reb-delete-overlay 'delete-extent) + (defalias 'reb-make-overlay 'make-extent) + (defalias 'reb-overlay-put 'set-extent-property)) + ;; GNU/Emacs + (defalias 'reb-delete-overlay 'delete-overlay) + (defalias 'reb-make-overlay 'make-overlay) + (defalias 'reb-overlay-put 'overlay-put)) ;; User costomizable variables (defgroup re-builder nil ＠＠ -320,7 +328,7 ＠＠ Except for Lisp syntax this is the same ;; emacs/xemacs compatibility (if (fboundp 'frame-parameter) (frame-parameter (selected-frame) 'display-type) - (frame-property (selected-frame) 'display-type)))) + (device-class (frame-device (selected-frame)))))) (defsubst reb-lisp-syntax-p () "Return non-nil if RE Builder uses a Lisp syntax." ＠＠ -532,7 +540,7 ＠＠ optional fourth argument FORCE is non-ni "Delete all RE Builder overlays in the `reb-target-buffer' buffer." (if (buffer-live-p reb-target-buffer) (with-current-buffer reb-target-buffer - (mapcar 'delete-overlay reb-overlays) + (mapcar 'reb-delete-overlay reb-overlays) (setq reb-overlays nil)))) (defun reb-assert-buffer-in-window () ＠＠ -661,25 +669,25 ＠＠ If SUBEXP is non-nil mark only the corre (or (not reb-auto-match-limit) (< matches reb-auto-match-limit))) (if (= 0 (length (match-string 0))) - (error "Empty regular expression!")) + (error "Empty regular expression!")) (let ((i 0)) (setq matches (1+ matches)) (while (<= i subexps) (if (and (or (not subexp) (= subexp i)) (match-beginning i)) - (let ((overlay (make-overlay (match-beginning i) - (match-end i))) + (let ((overlay (reb-make-overlay (match-beginning i) + (match-end i))) (face-name (format "reb-match-%d" i))) (if (not firstmatch) (setq firstmatch (match-data))) (setq reb-overlays (cons overlay reb-overlays) submatches (1+ submatches)) - (overlay-put + (reb-overlay-put overlay 'face (or (intern-soft face-name) (error "Too many subexpressions - face `%s' not defined" face-name ))) - (overlay-put overlay 'priority i))) + (reb-overlay-put overlay 'priority i))) (setq i (1+ i)))))) (let ((count (if subexp submatches matches))) (message "%s %smatch%s%s" -- |---<Steve Youngs>---------------<GnuPG KeyID: A94B3003>---| | I am Dyslexic of Borg. | | Fusistance is retile. Your arse will be laminated. | |------------------------------------<steve(a)sxemacs.org>---|

2 participants
2 comments

2025

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches March 2005