CVS update by crestani MODIFIED: xemacs/src ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: crestani
Date: 05/03/13 12:35:39
Modified: xemacs/src ChangeLog alloc.c
Log:
Adjust KKCC_BT_STACK_SIZE.
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.
Revision Changes Path
1.812 +5 -0 XEmacs/xemacs/src/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.811
retrieving revision 1.812
diff -u -r1.811 -r1.812
--- ChangeLog 2005/03/13 09:20:58 1.811
+++ ChangeLog 2005/03/13 11:35:21 1.812
＠＠ -1,5 +1,10 ＠＠
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.
+
+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
1.110 +1 -1 XEmacs/xemacs/src/alloc.c
Index: alloc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v
retrieving revision 1.109
retrieving revision 1.110
diff -u -r1.109 -r1.110
--- alloc.c 2005/03/13 09:21:04 1.109
+++ alloc.c 2005/03/13 11:35:27 1.110
＠＠ -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
{
- 1 participants
- 0 comments
CVS update by crestani MODIFIED: xemacs/src ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: crestani
Date: 05/03/13 10:21:14
Modified: xemacs/src ChangeLog alloc.c intl-win32.c
Log:
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.
Revision Changes Path
1.811 +7 -0 XEmacs/xemacs/src/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.810
retrieving revision 1.811
diff -u -r1.810 -r1.811
--- ChangeLog 2005/03/12 11:00:20 1.810
+++ ChangeLog 2005/03/13 09:20:58 1.811
＠＠ -1,3 +1,10 ＠＠
+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.
+
2005-03-11 David Robinow <drobinow(a)yahoo.com>
* syssignal.h: Configure always sets HAVE_DECL_SYS_SIGLIST. Test
1.109 +1 -1 XEmacs/xemacs/src/alloc.c
Index: alloc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v
retrieving revision 1.108
retrieving revision 1.109
diff -u -r1.108 -r1.109
--- alloc.c 2005/03/11 08:42:36 1.108
+++ alloc.c 2005/03/13 09:21:04 1.109
＠＠ -349,7 +349,7 ＠＠
#else /* ERROR_CHECK_MALLOC */
-#define MALLOC_BEGIN(block)
+#define MALLOC_BEGIN()
#define FREE_OR_REALLOC_BEGIN(block)
#define MALLOC_END()
1.15 +3 -2 XEmacs/xemacs/src/intl-win32.c
Index: intl-win32.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/intl-win32.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- intl-win32.c 2005/01/24 23:34:00 1.14
+++ intl-win32.c 2005/03/13 09:21:04 1.15
＠＠ -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;
- 1 participants
- 0 comments
CVS update by youngs MODIFIED: packages/xemacs-packages/net-utils, package-info.in ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: youngs
Date: 05/03/13 03:55:47
Modified: packages/xemacs-packages/net-utils ChangeLog Makefile
package-info.in
Added: packages/xemacs-packages/net-utils dns-mode.el
Log:
2005-03-13 Steve Youngs <steve(a)sxemacs.org>
* dns-mode.el: New file.
Revision Changes Path
1.69 +4 -0 XEmacs/packages/xemacs-packages/net-utils/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/ChangeLog,v
retrieving revision 1.68
retrieving revision 1.69
diff -u -r1.68 -r1.69
--- ChangeLog 2004/10/04 12:07:49 1.68
+++ ChangeLog 2005/03/13 02:55:39 1.69
＠＠ -1,3 +1,7 ＠＠
+2005-03-13 Steve Youngs <steve(a)sxemacs.org>
+
+ * dns-mode.el: New file.
+
2004-09-29 Steve Youngs <steve(a)youngs.au.com>
* Makefile (REQUIRES): Add ecrypto.
1.57 +1 -1 XEmacs/packages/xemacs-packages/net-utils/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/Makefile,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -r1.56 -r1.57
--- Makefile 2004/10/04 12:07:49 1.56
+++ Makefile 2005/03/13 02:55:40 1.57
＠＠ -23,7 +23,7 ＠＠
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
1.8 +3 -1 XEmacs/packages/xemacs-packages/net-utils/package-info.in
Index: package-info.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/package-info.in,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- package-info.in 2004/01/05 00:10:54 1.7
+++ package-info.in 2005/03/13 02:55:41 1.8
＠＠ -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
))
1.1 XEmacs/packages/xemacs-packages/net-utils/dns-mode.el
Index: dns-mode.el
===================================================================
;;; 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
- 1 participants
- 0 comments
CVS update by youngs MODIFIED: packages/xemacs-packages/gnus/lisp ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: youngs
Date: 05/03/13 03:20:48
Modified: packages/xemacs-packages/gnus/lisp gnus-util.el
Log:
2005-03-13 Steve Youngs <steve(a)sxemacs.org>
* lisp/gnus-util.el (gnus-emacs-version): Support SXEmacs in
`gnus-extended-version'.
Revision Changes Path
1.86 +5 -0 XEmacs/packages/xemacs-packages/gnus/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/ChangeLog,v
retrieving revision 1.85
retrieving revision 1.86
diff -u -r1.85 -r1.86
--- ChangeLog 2005/03/13 01:39:15 1.85
+++ ChangeLog 2005/03/13 02:20:37 1.86
＠＠ -1,5 +1,10 ＠＠
2005-03-13 Steve Youngs <steve(a)sxemacs.org>
+ * lisp/gnus-util.el (gnus-emacs-version): Support SXEmacs in
+ `gnus-extended-version'.
+
+2005-03-13 Steve Youngs <steve(a)sxemacs.org>
+
* lisp/gnus.el: Don't try and mark `gnus-agent-save-groups' as an
autoloaded function.
From: Andrey Slusar <anrays(a)gmail.com>.
1.9 +16 -17 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-util.el
Index: gnus-util.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-util.el,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- gnus-util.el 2005/03/13 00:23:30 1.8
+++ gnus-util.el 2005/03/13 02:20:46 1.9
＠＠ -1506,7 +1506,8 ＠＠
(nconc (nreverse res) list1 list2))))
(eval-when-compile
- (defvar xemacs-codename))
+ (defvar xemacs-codename)
+ (defvar sxemacs-codename)
(defun gnus-emacs-version ()
"Stringified Emacs version."
＠＠ -1525,22 +1526,20 ＠＠
(if system-v
(concat " (" system-v ")")
"")))
- ((string-match
- "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
- emacs-version)
- (concat
- (match-string 1 emacs-version)
- (format "/%d.%d" emacs-major-version emacs-minor-version)
- (if (match-beginning 3)
- (match-string 3 emacs-version)
- "")
- (if (boundp 'xemacs-codename)
- (concat
- " (" xemacs-codename
- (if system-v
- (concat ", " system-v ")")
- ")"))
- "")))
+ ((featurep 'sxemacs)
+ (concat "SXEmacs/" emacs-program-version
+ (when system-v
+ (concat " ("
+ (when sxemacs-codename
+ (concat sxemacs-codename ", "))
+ system-v ")"))))
+ ((featurep 'xemacs)
+ (concat "XEmacs/" emacs-program-version
+ (when system-v
+ (concat " ("
+ (when xemacs-codename
+ (concat xemacs-codename ", "))
+ system-v ")"))))
(t emacs-version))))
(defun gnus-rename-file (old-path new-path &optional trim)
- 1 participants
- 0 comments
CVS update by youngs ADDED: packages/xemacs-packages/gnus/lisp gnus-util.el.upstream REMOVED: packages/xemacs-packages/gnus/lisp mm-url.el.upstream
19 years, 1 month
CVS Monitor
CVS Monitor
User: youngs
Date: 05/03/13 03:17:28
Added: packages/xemacs-packages/gnus/lisp gnus-util.el.upstream
Removed: packages/xemacs-packages/gnus/lisp mm-url.el.upstream
Log:
A little housekeeping
Revision Changes Path
1.1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-util.el.upstream
Index: gnus-util.el.upstream
===================================================================
;;; gnus-util.el --- utility functions for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi(a)gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 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:
;; Nothing in this file depends on any other parts of Gnus -- all
;; functions and macros in this file are utility functions that are
;; used by Gnus and may be used by any other package without loading
;; Gnus first.
;; [Unfortunately, it does depend on other parts of Gnus, e.g. the
;; autoloads below...]
;;; Code:
(require 'custom)
(eval-when-compile
(require 'cl)
;; Fixme: this should be a gnus variable, not nnmail-.
(defvar nnmail-pathname-coding-system)
;; Inappropriate references to other parts of Gnus.
(defvar gnus-emphasize-whitespace-regexp)
)
(require 'time-date)
(require 'netrc)
(eval-and-compile
(autoload 'message-fetch-field "message")
(autoload 'gnus-get-buffer-window "gnus-win")
(autoload 'rmail-insert-rmail-file-header "rmail")
(autoload 'rmail-count-new-messages "rmail")
(autoload 'rmail-show-message "rmail")
(autoload 'nnheader-narrow-to-headers "nnheader")
(autoload 'nnheader-replace-chars-in-string "nnheader"))
(eval-and-compile
(cond
((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)
"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)))
(setq string (replace-match newtext nil literal string))
(setq start (- (length string) tail))))
string))))
;;; bring in the netrc functions as aliases
(defalias 'gnus-netrc-get 'netrc-get)
(defalias 'gnus-netrc-machine 'netrc-machine)
(defalias 'gnus-parse-netrc 'netrc-parse)
(defun gnus-boundp (variable)
"Return non-nil if VARIABLE is bound and non-nil."
(and (boundp variable)
(symbol-value variable)))
(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
"Pop to BUFFER, evaluate FORMS, and then return to the original window."
(let ((tempvar (make-symbol "GnusStartBufferWindow"))
(w (make-symbol "w"))
(buf (make-symbol "buf")))
`(let* ((,tempvar (selected-window))
(,buf ,buffer)
(,w (gnus-get-buffer-window ,buf 'visible)))
(unwind-protect
(progn
(if ,w
(progn
(select-window ,w)
(set-buffer (window-buffer ,w)))
(pop-to-buffer ,buf))
,＠forms)
(select-window ,tempvar)))))
(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
(defmacro gnus-intern-safe (string hashtable)
"Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
`(let ((symbol (intern ,string ,hashtable)))
(or (boundp symbol)
(set symbol nil))
symbol))
;; Added by Geoffrey T. Dairiki <dairiki(a)u.washington.edu>. A safe way
;; to limit the length of a string. This function is necessary since
;; `(substr "abc" 0 30)' pukes with "Args out of range".
;; Fixme: Why not `truncate-string-to-width'?
(defsubst gnus-limit-string (str width)
(if (> (length str) width)
(substring str 0 width)
str))
(defsubst gnus-goto-char (point)
(and point (goto-char point)))
(defmacro gnus-buffer-exists-p (buffer)
`(let ((buffer ,buffer))
(when buffer
(funcall (if (stringp buffer) 'get-buffer 'buffer-name)
buffer))))
(defalias 'gnus-point-at-bol
(if (fboundp 'point-at-bol)
'point-at-bol
'line-beginning-position))
(defalias 'gnus-point-at-eol
(if (fboundp 'point-at-eol)
'point-at-eol
'line-end-position))
;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and
;; XEmacs. In Emacs we don't need to call `make-local-hook' first.
;; It's harmless, though, so the main purpose of this alias is to shut
;; up the byte compiler.
(defalias 'gnus-make-local-hook
(if (eq (get 'make-local-hook 'byte-compile)
'byte-compile-obsolete)
'ignore ; Emacs
'make-local-hook)) ; XEmacs
(defun gnus-delete-first (elt list)
"Delete by side effect the first occurrence of ELT as a member of LIST."
(if (equal (car list) elt)
(cdr list)
(let ((total list))
(while (and (cdr list)
(not (equal (cadr list) elt)))
(setq list (cdr list)))
(when (cdr list)
(setcdr list (cddr list)))
total)))
;; Delete the current line (and the next N lines).
(defmacro gnus-delete-line (&optional n)
`(delete-region (gnus-point-at-bol)
(progn (forward-line ,(or n 1)) (point))))
(defun gnus-byte-code (func)
"Return a form that can be `eval'ed based on FUNC."
(let ((fval (indirect-function func)))
(if (byte-code-function-p fval)
(let ((flist (append fval nil)))
(setcar flist 'byte-code)
flist)
(cons 'progn (cddr fval)))))
(defun gnus-extract-address-components (from)
"Extract address components from a From header.
Given an RFC-822 address FROM, extract full name and canonical address.
Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). Much more simple
solution than `mail-extract-address-components', which works much better, but
is slower."
(let (name address)
;; First find the address - the thing with the ＠ in it. This may
;; not be accurate in mail addresses, but does the trick most of
;; the time in news messages.
(when (string-match "\\b[^＠ \t<>]+[!＠][^＠ \t<>]+\\b" from)
(setq address (substring from (match-beginning 0) (match-end 0))))
;; Then we check whether the "name <address>" format is used.
(and address
;; Linear white space is not required.
(string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
(and (setq name (substring from 0 (match-beginning 0)))
;; Strip any quotes from the name.
(string-match "^\".*\"$" name)
(setq name (substring name 1 (1- (match-end 0))))))
;; If not, then "address (name)" is used.
(or name
(and (string-match "(.+)" from)
(setq name (substring from (1+ (match-beginning 0))
(1- (match-end 0)))))
(and (string-match "()" from)
(setq name address))
;; XOVER might not support folded From headers.
(and (string-match "(.*" from)
(setq name (substring from (1+ (match-beginning 0))
(match-end 0)))))
(list (if (string= name "") nil name) (or address from))))
(defun gnus-fetch-field (field)
"Return the value of the header FIELD of current article."
(save-excursion
(save-restriction
(let ((case-fold-search t)
(inhibit-point-motion-hooks t))
(nnheader-narrow-to-headers)
(message-fetch-field field)))))
(defun gnus-fetch-original-field (field)
"Fetch FIELD from the original version of the current article."
(with-current-buffer gnus-original-article-buffer
(gnus-fetch-field field)))
(defun gnus-goto-colon ()
(beginning-of-line)
(let ((eol (gnus-point-at-eol)))
(goto-char (or (text-property-any (point) eol 'gnus-position t)
(search-forward ":" eol t)
(point)))))
(defun gnus-decode-newsgroups (newsgroups group &optional method)
(let ((method (or method (gnus-find-method-for-group group))))
(mapconcat (lambda (group)
(gnus-group-name-decode group (gnus-group-name-charset
method group)))
(message-tokenize-header newsgroups)
",")))
(defun gnus-remove-text-with-property (prop)
"Delete all text in the current buffer with text property PROP."
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(while (get-text-property (point) prop)
(delete-char 1))
(goto-char (next-single-property-change (point) prop nil (point-max))))))
(defun gnus-newsgroup-directory-form (newsgroup)
"Make hierarchical directory name from NEWSGROUP name."
(let* ((newsgroup (gnus-newsgroup-savable-name newsgroup))
(idx (string-match ":" newsgroup)))
(concat
(if idx (substring newsgroup 0 idx))
(if idx "/")
(nnheader-replace-chars-in-string
(if idx (substring newsgroup (1+ idx)) newsgroup)
?. ?/))))
(defun gnus-newsgroup-savable-name (group)
;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
;; with dots.
(nnheader-replace-chars-in-string group ?/ ?.))
(defun gnus-string> (s1 s2)
(not (or (string< s1 s2)
(string= s1 s2))))
;;; Time functions.
(defun gnus-file-newer-than (file date)
(let ((fdate (nth 5 (file-attributes file))))
(or (> (car fdate) (car date))
(and (= (car fdate) (car date))
(> (nth 1 fdate) (nth 1 date))))))
;;; Keymap macros.
(defmacro gnus-local-set-keys (&rest plist)
"Set the keys in PLIST in the current keymap."
`(gnus-define-keys-1 (current-local-map) ',plist))
(defmacro gnus-define-keys (keymap &rest plist)
"Define all keys in PLIST in KEYMAP."
`(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
(defmacro gnus-define-keys-safe (keymap &rest plist)
"Define all keys in PLIST in KEYMAP without overwriting previous definitions."
`(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
(put 'gnus-define-keys 'lisp-indent-function 1)
(put 'gnus-define-keys-safe 'lisp-indent-function 1)
(put 'gnus-local-set-keys 'lisp-indent-function 1)
(defmacro gnus-define-keymap (keymap &rest plist)
"Define all keys in PLIST in KEYMAP."
`(gnus-define-keys-1 ,keymap (quote ,plist)))
(put 'gnus-define-keymap 'lisp-indent-function 1)
(defun gnus-define-keys-1 (keymap plist &optional safe)
(when (null keymap)
(error "Can't set keys in a null keymap"))
(cond ((symbolp keymap)
(setq keymap (symbol-value keymap)))
((keymapp keymap))
((listp keymap)
(set (car keymap) nil)
(define-prefix-command (car keymap))
(define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
(setq keymap (symbol-value (car keymap)))))
(let (key)
(while plist
(when (symbolp (setq key (pop plist)))
(setq key (symbol-value key)))
(if (or (not safe)
(eq (lookup-key keymap key) 'undefined))
(define-key keymap key (pop plist))
(pop plist)))))
(defun gnus-completing-read-with-default (default prompt &rest args)
;; Like `completing-read', except that DEFAULT is the default argument.
(let* ((prompt (if default
(concat prompt " (default " default ") ")
(concat prompt " ")))
(answer (apply 'completing-read prompt args)))
(if (or (null answer) (zerop (length answer)))
default
answer)))
;; Two silly functions to ensure that all `y-or-n-p' questions clear
;; the echo area.
(defun gnus-y-or-n-p (prompt)
(prog1
(y-or-n-p prompt)
(message "")))
(defun gnus-yes-or-no-p (prompt)
(prog1
(yes-or-no-p prompt)
(message "")))
;; By Frank Schmitt <ich(a)Frank-Schmitt.net>. Allows to have
;; age-depending date representations. (e.g. just the time if it's
;; from today, the day of the week if it's within the last 7 days and
;; the full date if it's older)
(defun gnus-seconds-today ()
"Return the number of seconds passed today."
(let ((now (decode-time (current-time))))
(+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600))))
(defun gnus-seconds-month ()
"Return the number of seconds passed this month."
(let ((now (decode-time (current-time))))
(+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
(* (- (car (nthcdr 3 now)) 1) 3600 24))))
(defun gnus-seconds-year ()
"Return the number of seconds passed this year."
(let ((now (decode-time (current-time)))
(days (format-time-string "%j" (current-time))))
(+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
(* (- (string-to-number days) 1) 3600 24))))
(defvar gnus-user-date-format-alist
'(((gnus-seconds-today) . "%k:%M")
(604800 . "%a %k:%M") ;;that's one week
((gnus-seconds-month) . "%a %d")
((gnus-seconds-year) . "%b %d")
(t . "%b %d '%y")) ;;this one is used when no
;;other does match
"Specifies date format depending on age of article.
This is an alist of items (AGE . FORMAT). AGE can be a number (of
seconds) or a Lisp expression evaluating to a number. When the age of
the article is less than this number, then use `format-time-string'
with the corresponding FORMAT for displaying the date of the article.
If AGE is not a number or a Lisp expression evaluating to a
non-number, then the corresponding FORMAT is used as a default value.
Note that the list is processed from the beginning, so it should be
sorted by ascending AGE. Also note that items following the first
non-number AGE will be ignored.
You can use the functions `gnus-seconds-today', `gnus-seconds-month'
and `gnus-seconds-year' in the AGE spec. They return the number of
seconds passed since the start of today, of this month, of this year,
respectively.")
(defun gnus-user-date (messy-date)
"Format the messy-date according to gnus-user-date-format-alist.
Returns \" ? \" if there's bad input or if an other error occurs.
Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
(condition-case ()
(let* ((messy-date (time-to-seconds (safe-date-to-time messy-date)))
(now (time-to-seconds (current-time)))
;;If we don't find something suitable we'll use this one
(my-format "%b %d '%y"))
(let* ((difference (- now messy-date))
(templist gnus-user-date-format-alist)
(top (eval (caar templist))))
(while (if (numberp top) (< top difference) (not top))
(progn
(setq templist (cdr templist))
(setq top (eval (caar templist)))))
(if (stringp (cdr (car templist)))
(setq my-format (cdr (car templist)))))
(format-time-string (eval my-format) (seconds-to-time messy-date)))
(error " ? ")))
(defun gnus-dd-mmm (messy-date)
"Return a string like DD-MMM from a big messy string."
(condition-case ()
(format-time-string "%d-%b" (safe-date-to-time messy-date))
(error " - ")))
(defmacro gnus-date-get-time (date)
"Convert DATE string to Emacs time.
Cache the result as a text property stored in DATE."
;; Either return the cached value...
`(let ((d ,date))
(if (equal "" d)
'(0 0)
(or (get-text-property 0 'gnus-time d)
;; or compute the value...
(let ((time (safe-date-to-time d)))
;; and store it back in the string.
(put-text-property 0 1 'gnus-time time d)
time)))))
(defsubst gnus-time-iso8601 (time)
"Return a string of TIME in YYYYMMDDTHHMMSS format."
(format-time-string "%Y%m%dT%H%M%S" time))
(defun gnus-date-iso8601 (date)
"Convert the DATE to YYYYMMDDTHHMMSS."
(condition-case ()
(gnus-time-iso8601 (gnus-date-get-time date))
(error "")))
(defun gnus-mode-string-quote (string)
"Quote all \"%\"'s in STRING."
(gnus-replace-in-string string "%" "%%"))
;; Make a hash table (default and minimum size is 256).
;; Optional argument HASHSIZE specifies the table size.
(defun gnus-make-hashtable (&optional hashsize)
(make-vector (if hashsize (max (gnus-create-hash-size hashsize) 256) 256) 0))
;; Make a number that is suitable for hashing; bigger than MIN and
;; equal to some 2^x. Many machines (such as sparcs) do not have a
;; hardware modulo operation, so they implement it in software. On
;; many sparcs over 50% of the time to intern is spent in the modulo.
;; Yes, it's slower than actually computing the hash from the string!
;; So we use powers of 2 so people can optimize the modulo to a mask.
(defun gnus-create-hash-size (min)
(let ((i 1))
(while (< i min)
(setq i (* 2 i)))
i))
(defcustom gnus-verbose 7
"*Integer that says how verbose Gnus should be.
The higher the number, the more messages Gnus will flash to say what
it's doing. At zero, Gnus will be totally mute; at five, Gnus will
display most important messages; and at ten, Gnus will keep on
jabbering all the time."
:group 'gnus-start
:type 'integer)
(defun gnus-message (level &rest args)
"If LEVEL is lower than `gnus-verbose' print ARGS using `message'.
Guideline for numbers:
1 - error messages, 3 - non-serious error messages, 5 - messages for things
that take a long time, 7 - not very important messages on stuff, 9 - messages
inside loops."
(if (<= level gnus-verbose)
(apply 'message args)
;; We have to do this format thingy here even if the result isn't
;; shown - the return value has to be the same as the return value
;; from `message'.
(apply 'format args)))
(defun gnus-error (level &rest args)
"Beep an error if LEVEL is equal to or less than `gnus-verbose'."
(when (<= (floor level) gnus-verbose)
(apply 'message args)
(ding)
(let (duration)
(when (and (floatp level)
(not (zerop (setq duration (* 10 (- level (floor level)))))))
(sit-for duration))))
nil)
(defun gnus-split-references (references)
"Return a list of Message-IDs in REFERENCES."
(let ((beg 0)
ids)
(while (string-match "<[^<]+[^< \t]" references beg)
(push (substring references (match-beginning 0) (setq beg (match-end 0)))
ids))
(nreverse ids)))
(defsubst gnus-parent-id (references &optional n)
"Return the last Message-ID in REFERENCES.
If N, return the Nth ancestor instead."
(when (and references
(not (zerop (length references))))
(if n
(let ((ids (inline (gnus-split-references references))))
(while (nthcdr n ids)
(setq ids (cdr ids)))
(car ids))
(when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references)
(match-string 1 references)))))
(defun gnus-buffer-live-p (buffer)
"Say whether BUFFER is alive or not."
(and buffer
(get-buffer buffer)
(buffer-name (get-buffer buffer))))
(defun gnus-horizontal-recenter ()
"Recenter the current buffer horizontally."
(if (< (current-column) (/ (window-width) 2))
(set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0)
(let* ((orig (point))
(end (window-end (gnus-get-buffer-window (current-buffer) t)))
(max 0))
(when end
;; Find the longest line currently displayed in the window.
(goto-char (window-start))
(while (and (not (eobp))
(< (point) end))
(end-of-line)
(setq max (max max (current-column)))
(forward-line 1))
(goto-char orig)
;; Scroll horizontally to center (sort of) the point.
(if (> max (window-width))
(set-window-hscroll
(gnus-get-buffer-window (current-buffer) t)
(min (- (current-column) (/ (window-width) 3))
(+ 2 (- max (window-width)))))
(set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0))
max))))
(defun gnus-read-event-char (&optional prompt)
"Get the next event."
(let ((event (read-event prompt)))
;; should be gnus-characterp, but this can't be called in XEmacs anyway
(cons (and (numberp event) event) event)))
(defun gnus-sortable-date (date)
"Make string suitable for sorting from DATE."
(gnus-time-iso8601 (date-to-time date)))
(defun gnus-copy-file (file &optional to)
"Copy FILE to TO."
(interactive
(list (read-file-name "Copy file: " default-directory)
(read-file-name "Copy file to: " default-directory)))
(unless to
(setq to (read-file-name "Copy file to: " default-directory)))
(when (file-directory-p to)
(setq to (concat (file-name-as-directory to)
(file-name-nondirectory file))))
(copy-file file to))
(defvar gnus-work-buffer " *gnus work*")
(defun gnus-set-work-buffer ()
"Put point in the empty Gnus work buffer."
(if (get-buffer gnus-work-buffer)
(progn
(set-buffer gnus-work-buffer)
(erase-buffer))
(set-buffer (gnus-get-buffer-create gnus-work-buffer))
(kill-all-local-variables)
(mm-enable-multibyte)))
(defmacro gnus-group-real-name (group)
"Find the real name of a foreign newsgroup."
`(let ((gname ,group))
(if (string-match "^[^:]+:" gname)
(substring gname (match-end 0))
gname)))
(defun gnus-make-sort-function (funs)
"Return a composite sort condition based on the functions in FUNS."
(cond
;; Just a simple function.
((functionp funs) funs)
;; No functions at all.
((null funs) funs)
;; A list of functions.
((or (cdr funs)
(listp (car funs)))
(gnus-byte-compile
`(lambda (t1 t2)
,(gnus-make-sort-function-1 (reverse funs)))))
;; A list containing just one function.
(t
(car funs))))
(defun gnus-make-sort-function-1 (funs)
"Return a composite sort condition based on the functions in FUNS."
(let ((function (car funs))
(first 't1)
(last 't2))
(when (consp function)
(cond
;; Reversed spec.
((eq (car function) 'not)
(setq function (cadr function)
first 't2
last 't1))
((functionp function)
;; Do nothing.
)
(t
(error "Invalid sort spec: %s" function))))
(if (cdr funs)
`(or (,function ,first ,last)
(and (not (,function ,last ,first))
,(gnus-make-sort-function-1 (cdr funs))))
`(,function ,first ,last))))
(defun gnus-turn-off-edit-menu (type)
"Turn off edit menu in `gnus-TYPE-mode-map'."
(define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
[menu-bar edit] 'undefined))
(defmacro gnus-bind-print-variables (&rest forms)
"Bind print-* variables and evaluate FORMS.
This macro is used with `prin1', `pp', etc. in order to ensure printed
Lisp objects are loadable. Bind `print-quoted' and `print-readably'
to t, and `print-escape-multibyte', `print-escape-newlines',
`print-escape-nonascii', `print-length', `print-level' and
`print-string-length' to nil."
`(let ((print-quoted t)
(print-readably t)
;;print-circle
;;print-continuous-numbering
print-escape-multibyte
print-escape-newlines
print-escape-nonascii
;;print-gensym
print-length
print-level
print-string-length)
,＠forms))
(defun gnus-prin1 (form)
"Use `prin1' on FORM in the current buffer.
Bind `print-quoted' and `print-readably' to t, and `print-length' and
`print-level' to nil. See also `gnus-bind-print-variables'."
(gnus-bind-print-variables (prin1 form (current-buffer))))
(defun gnus-prin1-to-string (form)
"The same as `prin1'.
Bind `print-quoted' and `print-readably' to t, and `print-length' and
`print-level' to nil. See also `gnus-bind-print-variables'."
(gnus-bind-print-variables (prin1-to-string form)))
(defun gnus-pp (form)
"Use `pp' on FORM in the current buffer.
Bind `print-quoted' and `print-readably' to t, and `print-length' and
`print-level' to nil. See also `gnus-bind-print-variables'."
(gnus-bind-print-variables (pp form (current-buffer))))
(defun gnus-pp-to-string (form)
"The same as `pp-to-string'.
Bind `print-quoted' and `print-readably' to t, and `print-length' and
`print-level' to nil. See also `gnus-bind-print-variables'."
(gnus-bind-print-variables (pp-to-string form)))
(defun gnus-make-directory (directory)
"Make DIRECTORY (and all its parents) if it doesn't exist."
(require 'nnmail)
(let ((file-name-coding-system nnmail-pathname-coding-system))
(when (and directory
(not (file-exists-p directory)))
(make-directory directory t)))
t)
(defun gnus-write-buffer (file)
"Write the current buffer's contents to FILE."
;; Make sure the directory exists.
(gnus-make-directory (file-name-directory file))
(let ((file-name-coding-system nnmail-pathname-coding-system))
;; Write the buffer.
(write-region (point-min) (point-max) file nil 'quietly)))
(defun gnus-delete-file (file)
"Delete FILE if it exists."
(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)
(setq string (replace-match "" t t string)))
string)
(defsubst gnus-put-text-property-excluding-newlines (beg end prop val)
"The same as `put-text-property', but don't put this prop on any newlines in the region."
(save-match-data
(save-excursion
(save-restriction
(goto-char beg)
(while (re-search-forward gnus-emphasize-whitespace-regexp end 'move)
(gnus-put-text-property beg (match-beginning 0) prop val)
(setq beg (point)))
(gnus-put-text-property beg (point) prop val)))))
(defsubst gnus-put-overlay-excluding-newlines (beg end prop val)
"The same as `put-text-property', but don't put this prop on any newlines in the region."
(save-match-data
(save-excursion
(save-restriction
(goto-char beg)
(while (re-search-forward gnus-emphasize-whitespace-regexp end 'move)
(gnus-overlay-put
(gnus-make-overlay beg (match-beginning 0))
prop val)
(setq beg (point)))
(gnus-overlay-put (gnus-make-overlay beg (point)) prop val)))))
(defun gnus-put-text-property-excluding-characters-with-faces (beg end
prop val)
"The same as `put-text-property', but don't put props on characters with the `gnus-face' property."
(let ((b beg))
(while (/= b end)
(when (get-text-property b 'gnus-face)
(setq b (next-single-property-change b 'gnus-face nil end)))
(when (/= b end)
(inline
(gnus-put-text-property
b (setq b (next-single-property-change b 'gnus-face nil end))
prop val))))))
(defmacro gnus-faces-at (position)
"Return a list of faces at POSITION."
(if (featurep 'xemacs)
`(let ((pos ,position))
(mapcar-extents 'extent-face
nil (current-buffer) pos pos nil 'face))
`(let ((pos ,position))
(delq nil (cons (get-text-property pos 'face)
(mapcar
(lambda (overlay)
(overlay-get overlay 'face))
(overlays-at pos)))))))
;;; Protected and atomic operations. dmoore(a)ucsd.edu 21.11.1996
;;; The primary idea here is to try to protect internal datastructures
;;; from becoming corrupted when the user hits C-g, or if a hook or
;;; similar blows up. Often in Gnus multiple tables/lists need to be
;;; updated at the same time, or information can be lost.
(defvar gnus-atomic-be-safe t
"If t, certain operations will be protected from interruption by C-g.")
(defmacro gnus-atomic-progn (&rest forms)
"Evaluate FORMS atomically, which means to protect the evaluation
from being interrupted by the user. An error from the forms themselves
will return without finishing the operation. Since interrupts from
the user are disabled, it is recommended that only the most minimal
operations are performed by FORMS. If you wish to assign many
complicated values atomically, compute the results into temporary
variables and then do only the assignment atomically."
`(let ((inhibit-quit gnus-atomic-be-safe))
,＠forms))
(put 'gnus-atomic-progn 'lisp-indent-function 0)
(defmacro gnus-atomic-progn-assign (protect &rest forms)
"Evaluate FORMS, but insure that the variables listed in PROTECT
are not changed if anything in FORMS signals an error or otherwise
non-locally exits. The variables listed in PROTECT are updated atomically.
It is safe to use gnus-atomic-progn-assign with long computations.
Note that if any of the symbols in PROTECT were unbound, they will be
set to nil on a successful assignment. In case of an error or other
non-local exit, it will still be unbound."
(let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
(concat (symbol-name x)
"-tmp"))
x))
protect))
(sym-temp-map (mapcar (lambda (x) (list (cadr x) (car x)))
temp-sym-map))
(temp-sym-let (mapcar (lambda (x) (list (car x)
`(and (boundp ',(cadr x))
,(cadr x))))
temp-sym-map))
(sym-temp-let sym-temp-map)
(temp-sym-assign (apply 'append temp-sym-map))
(sym-temp-assign (apply 'append sym-temp-map))
(result (make-symbol "result-tmp")))
`(let (,＠temp-sym-let
,result)
(let ,sym-temp-let
(setq ,result (progn ,＠forms))
(setq ,＠temp-sym-assign))
(let ((inhibit-quit gnus-atomic-be-safe))
(setq ,＠sym-temp-assign))
,result)))
(put 'gnus-atomic-progn-assign 'lisp-indent-function 1)
;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body))
(defmacro gnus-atomic-setq (&rest pairs)
"Similar to setq, except that the real symbols are only assigned when
there are no errors. And when the real symbols are assigned, they are
done so atomically. If other variables might be changed via side-effect,
see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq
with potentially long computations."
(let ((tpairs pairs)
syms)
(while tpairs
(push (car tpairs) syms)
(setq tpairs (cddr tpairs)))
`(gnus-atomic-progn-assign ,syms
(setq ,＠pairs))))
;(put 'gnus-atomic-setq 'edebug-form-spec '(body))
;;; Functions for saving to babyl/mail files.
(eval-when-compile
(condition-case nil
(progn
(require 'rmail)
(autoload 'rmail-update-summary "rmailsum"))
(error
(define-compiler-macro rmail-select-summary (&rest body)
;; Rmail of the XEmacs version is supplied by the package, and
;; requires tm and apel packages. However, there may be those
;; who haven't installed those packages. This macro helps such
;; people even if they install those packages later.
`(eval '(rmail-select-summary ,＠body)))
;; If there's rmail but there's no tm (or there's apel of the
;; mainstream, not the XEmacs version), loading rmail of the XEmacs
;; version fails halfway, however it provides the rmail-select-summary
;; macro which uses the following functions:
(autoload 'rmail-summary-displayed "rmail")
(autoload 'rmail-maybe-display-summary "rmail")))
(defvar rmail-default-rmail-file)
(defvar mm-text-coding-system))
(defun gnus-output-to-rmail (filename &optional ask)
"Append the current article to an Rmail file named FILENAME."
(require 'rmail)
(require 'mm-util)
;; Most of these codes are borrowed from rmailout.el.
(setq filename (expand-file-name filename))
(setq rmail-default-rmail-file filename)
(let ((artbuf (current-buffer))
(tmpbuf (get-buffer-create " *Gnus-output*")))
(save-excursion
(or (get-file-buffer filename)
(file-exists-p filename)
(if (or (not ask)
(gnus-yes-or-no-p
(concat "\"" filename "\" does not exist, create it? ")))
(let ((file-buffer (create-file-buffer filename)))
(save-excursion
(set-buffer file-buffer)
(rmail-insert-rmail-file-header)
(let ((require-final-newline nil)
(coding-system-for-write mm-text-coding-system))
(gnus-write-buffer filename)))
(kill-buffer file-buffer))
(error "Output file does not exist")))
(set-buffer tmpbuf)
(erase-buffer)
(insert-buffer-substring artbuf)
(gnus-convert-article-to-rmail)
;; Decide whether to append to a file or to an Emacs buffer.
(let ((outbuf (get-file-buffer filename)))
(if (not outbuf)
(let ((file-name-coding-system nnmail-pathname-coding-system))
(mm-append-to-file (point-min) (point-max) filename))
;; File has been visited, in buffer OUTBUF.
(set-buffer outbuf)
(let ((buffer-read-only nil)
(msg (and (boundp 'rmail-current-message)
(symbol-value 'rmail-current-message))))
;; If MSG is non-nil, buffer is in RMAIL mode.
(when msg
(widen)
(narrow-to-region (point-max) (point-max)))
(insert-buffer-substring tmpbuf)
(when msg
(goto-char (point-min))
(widen)
(search-backward "\n\^_")
(narrow-to-region (point) (point-max))
(rmail-count-new-messages t)
(when (rmail-summary-exists)
(rmail-select-summary
(rmail-update-summary)))
(rmail-count-new-messages t)
(rmail-show-message msg))
(save-buffer)))))
(kill-buffer tmpbuf)))
(defun gnus-output-to-mail (filename &optional ask)
"Append the current article to a mail file named FILENAME."
(setq filename (expand-file-name filename))
(let ((artbuf (current-buffer))
(tmpbuf (get-buffer-create " *Gnus-output*")))
(save-excursion
;; Create the file, if it doesn't exist.
(when (and (not (get-file-buffer filename))
(not (file-exists-p filename)))
(if (or (not ask)
(gnus-y-or-n-p
(concat "\"" filename "\" does not exist, create it? ")))
(let ((file-buffer (create-file-buffer filename)))
(save-excursion
(set-buffer file-buffer)
(let ((require-final-newline nil)
(coding-system-for-write mm-text-coding-system))
(gnus-write-buffer filename)))
(kill-buffer file-buffer))
(error "Output file does not exist")))
(set-buffer tmpbuf)
(erase-buffer)
(insert-buffer-substring artbuf)
(goto-char (point-min))
(if (looking-at "From ")
(forward-line 1)
(insert "From nobody " (current-time-string) "\n"))
(let (case-fold-search)
(while (re-search-forward "^From " nil t)
(beginning-of-line)
(insert ">")))
;; Decide whether to append to a file or to an Emacs buffer.
(let ((outbuf (get-file-buffer filename)))
(if (not outbuf)
(let ((buffer-read-only nil))
(save-excursion
(goto-char (point-max))
(forward-char -2)
(unless (looking-at "\n\n")
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
(insert "\n"))
(goto-char (point-max))
(let ((file-name-coding-system nnmail-pathname-coding-system))
(mm-append-to-file (point-min) (point-max) filename))))
;; File has been visited, in buffer OUTBUF.
(set-buffer outbuf)
(let ((buffer-read-only nil))
(goto-char (point-max))
(unless (eobp)
(insert "\n"))
(insert "\n")
(insert-buffer-substring tmpbuf)))))
(kill-buffer tmpbuf)))
(defun gnus-convert-article-to-rmail ()
"Convert article in current buffer to Rmail message format."
(let ((buffer-read-only nil))
;; Convert article directly into Babyl format.
(goto-char (point-min))
(insert "\^L\n0, unseen,,\n*** EOOH ***\n")
(while (search-forward "\n\^_" nil t) ;single char
(replace-match "\n^_" t t)) ;2 chars: "^" and "_"
(goto-char (point-max))
(insert "\^_")))
(defun gnus-map-function (funs arg)
"Apply the result of the first function in FUNS to the second, and so on.
ARG is passed to the first function."
(while funs
(setq arg (funcall (pop funs) arg)))
arg)
(defun gnus-run-hooks (&rest funcs)
"Does the same as `run-hooks', but saves the current buffer."
(save-current-buffer
(apply 'run-hooks funcs)))
;;; Various
(defvar gnus-group-buffer) ; Compiler directive
(defun gnus-alive-p ()
"Say whether Gnus is running or not."
(and (boundp 'gnus-group-buffer)
(get-buffer gnus-group-buffer)
(save-excursion
(set-buffer gnus-group-buffer)
(eq major-mode 'gnus-group-mode))))
(defun gnus-remove-duplicates (list)
(let (new)
(while list
(or (member (car list) new)
(setq new (cons (car list) new)))
(setq list (cdr list)))
(nreverse new)))
(defun gnus-remove-if (predicate list)
"Return a copy of LIST with all items satisfying PREDICATE removed."
(let (out)
(while list
(unless (funcall predicate (car list))
(push (car list) out))
(setq list (cdr list)))
(nreverse out)))
(if (fboundp 'assq-delete-all)
(defalias 'gnus-delete-alist 'assq-delete-all)
(defun gnus-delete-alist (key alist)
"Delete from ALIST all elements whose car is KEY.
Return the modified alist."
(let (entry)
(while (setq entry (assq key alist))
(setq alist (delq entry alist)))
alist)))
(defmacro gnus-pull (key alist &optional assoc-p)
"Modify ALIST to be without KEY."
(unless (symbolp alist)
(error "Not a symbol: %s" alist))
(let ((fun (if assoc-p 'assoc 'assq)))
`(setq ,alist (delq (,fun ,key ,alist) ,alist))))
(defun gnus-globalify-regexp (re)
"Return a regexp that matches a whole line, iff RE matches a part of it."
(concat (unless (string-match "^\\^" re) "^.*")
re
(unless (string-match "\\$$" re) ".*$")))
(defun gnus-set-window-start (&optional point)
"Set the window start to POINT, or (point) if nil."
(let ((win (gnus-get-buffer-window (current-buffer) t)))
(when win
(set-window-start win (or point (point))))))
(defun gnus-annotation-in-region-p (b e)
(if (= b e)
(eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t)
(text-property-any b e 'gnus-undeletable t)))
(defun gnus-or (&rest elems)
"Return non-nil if any of the elements are non-nil."
(catch 'found
(while elems
(when (pop elems)
(throw 'found t)))))
(defun gnus-and (&rest elems)
"Return non-nil if all of the elements are non-nil."
(catch 'found
(while elems
(unless (pop elems)
(throw 'found nil)))
t))
(defun gnus-write-active-file (file hashtb &optional full-names)
(let ((coding-system-for-write nnmail-active-file-coding-system))
(with-temp-file file
(mapatoms
(lambda (sym)
(when (and sym
(boundp sym)
(symbol-value sym))
(insert (format "%S %d %d y\n"
(if full-names
sym
(intern (gnus-group-real-name (symbol-name sym))))
(or (cdr (symbol-value sym))
(car (symbol-value sym)))
(car (symbol-value sym))))))
hashtb)
(goto-char (point-max))
(while (search-backward "\\." nil t)
(delete-char 1)))))
;; Fixme: Why not use `with-output-to-temp-buffer'?
(defmacro gnus-with-output-to-file (file &rest body)
(let ((buffer (make-symbol "output-buffer"))
(size (make-symbol "output-buffer-size"))
(leng (make-symbol "output-buffer-length"))
(append (make-symbol "output-buffer-append")))
`(let* ((,size 131072)
(,buffer (make-string ,size 0))
(,leng 0)
(,append nil)
(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
,append t))))))
,＠body
(when (> ,leng 0)
(let ((coding-system-for-write 'no-conversion))
(write-region (substring ,buffer 0 ,leng) nil ,file
,append 'no-msg))))))
(put 'gnus-with-output-to-file 'lisp-indent-function 1)
(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
(if (fboundp 'union)
(defalias 'gnus-union 'union)
(defun gnus-union (l1 l2)
"Set union of lists L1 and L2."
(cond ((null l1) l2)
((null l2) l1)
((equal l1 l2) l1)
(t
(or (>= (length l1) (length l2))
(setq l1 (prog1 l2 (setq l2 l1))))
(while l2
(or (member (car l2) l1)
(push (car l2) l1))
(pop l2))
l1))))
(defun gnus-add-text-properties-when
(property value start end properties &optional object)
"Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE."
(let (point)
(while (and start
(< start end) ;; XEmacs will loop for every when start=end.
(setq point (text-property-not-all start end property value)))
(gnus-add-text-properties start point properties object)
(setq start (text-property-any point end property value)))
(if start
(gnus-add-text-properties start end properties object))))
(defun gnus-remove-text-properties-when
(property value start end properties &optional object)
"Like `remove-text-properties', only applied on where PROPERTY is VALUE."
(let (point)
(while (and start
(< start end)
(setq point (text-property-not-all start end property value)))
(remove-text-properties start point properties object)
(setq start (text-property-any point end property value)))
(if start
(remove-text-properties start end properties object))
t))
;; This might use `compare-strings' to reduce consing in the
;; case-insensitive case, but it has to cope with null args.
;; (`string-equal' uses symbol print names.)
(defun gnus-string-equal (x y)
"Like `string-equal', except it compares case-insensitively."
(and (= (length x) (length y))
(or (string-equal x y)
(string-equal (downcase x) (downcase y)))))
(defcustom gnus-use-byte-compile t
"If non-nil, byte-compile crucial run-time code.
Setting it to nil has no effect after the first time `gnus-byte-compile'
is run."
:type 'boolean
:version "22.1"
:group 'gnus-various)
(defun gnus-byte-compile (form)
"Byte-compile FORM if `gnus-use-byte-compile' is non-nil."
(if gnus-use-byte-compile
(progn
(condition-case nil
;; Work around a bug in XEmacs 21.4
(require 'byte-optimize)
(error))
(require 'bytecomp)
(defalias 'gnus-byte-compile
(lambda (form)
(let ((byte-compile-warnings '(unresolved callargs redefine)))
(byte-compile form))))
(gnus-byte-compile form))
form))
(defun gnus-remassoc (key alist)
"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 (gnus-remassoc key foo))' to be
sure of changing the value of `foo'."
(when alist
(if (equal key (caar alist))
(cdr alist)
(setcdr alist (gnus-remassoc key (cdr alist)))
alist)))
(defun gnus-update-alist-soft (key value alist)
(if value
(cons (cons key value) (gnus-remassoc key alist))
(gnus-remassoc key alist)))
(defun gnus-create-info-command (node)
"Create a command that will go to info NODE."
`(lambda ()
(interactive)
,(concat "Enter the info system at node " node)
(Info-goto-node ,node)
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
(defun gnus-not-ignore (&rest args)
t)
(defvar gnus-directory-sep-char-regexp "/"
"The regexp of directory separator character.
If you find some problem with the directory separator character, try
\"[/\\\\\]\" for some systems.")
(defun gnus-url-unhex (x)
(if (> x ?9)
(if (>= x ?a)
(+ 10 (- x ?a))
(+ 10 (- x ?A)))
(- x ?0)))
;; Fixme: Do it like QP.
(defun gnus-url-unhex-string (str &optional allow-newlines)
"Remove %XX, embedded spaces, etc in a url.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
decoding of carriage returns and line feeds in the string, which is normally
forbidden in URL encoding."
(let ((tmp "")
(case-fold-search t))
(while (string-match "%[0-9a-f][0-9a-f]" str)
(let* ((start (match-beginning 0))
(ch1 (gnus-url-unhex (elt str (+ start 1))))
(code (+ (* 16 ch1)
(gnus-url-unhex (elt str (+ start 2))))))
(setq tmp (concat
tmp (substring str 0 start)
(cond
(allow-newlines
(char-to-string code))
((or (= code ?\n) (= code ?\r))
" ")
(t (char-to-string code))))
str (substring str (match-end 0)))))
(setq tmp (concat tmp str))
tmp))
(defun gnus-make-predicate (spec)
"Transform SPEC into a function that can be called.
SPEC is a predicate specifier that contains stuff like `or', `and',
`not', lists and functions. The functions all take one parameter."
`(lambda (elem) ,(gnus-make-predicate-1 spec)))
(defun gnus-make-predicate-1 (spec)
(cond
((symbolp spec)
`(,spec elem))
((listp spec)
(if (memq (car spec) '(or and not))
`(,(car spec) ,＠(mapcar 'gnus-make-predicate-1 (cdr spec)))
(error "Invalid predicate specifier: %s" spec)))))
(defun gnus-local-map-property (map)
"Return a list suitable for a text property list specifying keymap MAP."
(cond
((featurep 'xemacs)
(list 'keymap map))
((>= emacs-major-version 21)
(list 'keymap map))
(t
(list 'local-map map))))
(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate
require-match initial-contents
history default)
"Like `completing-read', allowing for non-existent 7th arg in older XEmacsen."
`(completing-read ,prompt ,table ,predicate ,require-match
,initial-contents ,history
,＠(if (and (featurep 'xemacs) (< emacs-minor-version 2))
()
(list default))))
(defun gnus-completing-read (prompt table &optional predicate require-match
history)
(when (and history
(not (boundp history)))
(set history nil))
(gnus-completing-read-maybe-default
(if (symbol-value history)
(concat prompt " (" (car (symbol-value history)) "): ")
(concat prompt ": "))
table
predicate
require-match
nil
history
(car (symbol-value history))))
(defun gnus-graphic-display-p ()
(or (and (fboundp 'display-graphic-p)
(display-graphic-p))
;;;!!!This is bogus. Fixme!
(and (featurep 'xemacs)
t)))
(put 'gnus-parse-without-error 'lisp-indent-function 0)
(put 'gnus-parse-without-error 'edebug-form-spec '(body))
(defmacro gnus-parse-without-error (&rest body)
"Allow continuing onto the next line even if an error occurs."
`(while (not (eobp))
(condition-case ()
(progn
,＠body
(goto-char (point-max)))
(error
(gnus-error 4 "Invalid data on line %d"
(count-lines (point-min) (point)))
(forward-line 1)))))
(defun gnus-cache-file-contents (file variable function)
"Cache the contents of FILE in VARIABLE. The contents come from FUNCTION."
(let ((time (nth 5 (file-attributes file)))
contents value)
(if (or (null (setq value (symbol-value variable)))
(not (equal (car value) file))
(not (equal (nth 1 value) time)))
(progn
(setq contents (funcall function file))
(set variable (list file time contents))
contents)
(nth 2 value))))
(defun gnus-multiple-choice (prompt choice &optional idx)
"Ask user a multiple choice question.
CHOICE is a list of the choice char and help message at IDX."
(let (tchar buf)
(save-window-excursion
(save-excursion
(while (not tchar)
(message "%s (%s): "
prompt
(concat
(mapconcat (lambda (s) (char-to-string (car s)))
choice ", ") ", ?"))
(setq tchar (read-char))
(when (not (assq tchar choice))
(setq tchar nil)
(setq buf (get-buffer-create "*Gnus Help*"))
(pop-to-buffer buf)
(fundamental-mode) ; for Emacs 20.4+
(buffer-disable-undo)
(erase-buffer)
(insert prompt ":\n\n")
(let ((max -1)
(list choice)
(alist choice)
(idx (or idx 1))
(i 0)
n width pad format)
;; find the longest string to display
(while list
(setq n (length (nth idx (car list))))
(unless (> max n)
(setq max n))
(setq list (cdr list)))
(setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end
(setq n (/ (1- (window-width)) max)) ; items per line
(setq width (/ (1- (window-width)) n)) ; width of each item
;; insert `n' items, each in a field of width `width'
(while alist
(if (< i n)
()
(setq i 0)
(delete-char -1) ; the `\n' takes a char
(insert "\n"))
(setq pad (- width 3))
(setq format (concat "%c: %-" (int-to-string pad) "s"))
(insert (format format (caar alist) (nth idx (car alist))))
(setq alist (cdr alist))
(setq i (1+ i))))))))
(if (buffer-live-p buf)
(kill-buffer buf))
tchar))
(defun gnus-select-frame-set-input-focus (frame)
"Select FRAME, raise it, and set input focus, if possible."
(cond ((featurep 'xemacs)
(raise-frame frame)
(select-frame frame)
(focus-frame frame))
;; The function `select-frame-set-input-focus' won't set
;; the input focus under Emacs 21.2 and X window system.
;;((fboundp 'select-frame-set-input-focus)
;; (defalias 'gnus-select-frame-set-input-focus
;; 'select-frame-set-input-focus)
;; (select-frame-set-input-focus frame))
(t
(raise-frame frame)
(select-frame frame)
(cond ((and (eq window-system 'x)
(fboundp 'x-focus-frame))
(x-focus-frame frame))
((eq window-system 'w32)
(w32-focus-frame frame)))
(when focus-follows-mouse
(set-mouse-position frame (1- (frame-width frame)) 0)))))
(defun gnus-frame-or-window-display-name (object)
"Given a frame or window, return the associated display name.
Return nil otherwise."
(if (featurep 'xemacs)
(device-connection (dfw-device object))
(if (or (framep object)
(and (windowp object)
(setq object (window-frame object))))
(let ((display (frame-parameter object 'display)))
(if (and (stringp display)
;; Exclude invalid display names.
(string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'"
display))
display)))))
;; Fixme: This has only one use (in gnus-agent), which isn't worthwhile.
(defmacro gnus-mapcar (function seq1 &rest seqs2_n)
"Apply FUNCTION to each element of the sequences, and make a list of the results.
If there are several sequences, FUNCTION is called with that many arguments,
and mapping stops as soon as the shortest sequence runs out. With just one
sequence, this is like `mapcar'. With several, it is like the Common Lisp
`mapcar' function extended to arbitrary sequence types."
(if seqs2_n
(let* ((seqs (cons seq1 seqs2_n))
(cnt 0)
(heads (mapcar (lambda (seq)
(make-symbol (concat "head"
(int-to-string
(setq cnt (1+ cnt))))))
seqs))
(result (make-symbol "result"))
(result-tail (make-symbol "result-tail")))
`(let* ,(let* ((bindings (cons nil nil))
(heads heads))
(nconc bindings (list (list result '(cons nil nil))))
(nconc bindings (list (list result-tail result)))
(while heads
(nconc bindings (list (list (pop heads) (pop seqs)))))
(cdr bindings))
(while (and ,＠heads)
(setcdr ,result-tail (cons (funcall ,function
,＠(mapcar (lambda (h) (list 'car h))
heads))
nil))
(setq ,result-tail (cdr ,result-tail)
,＠(apply 'nconc (mapcar (lambda (h) (list h (list 'cdr h))) heads))))
(cdr ,result)))
`(mapcar ,function ,seq1)))
(if (fboundp 'merge)
(defalias 'gnus-merge 'merge)
;; Adapted from cl-seq.el
(defun gnus-merge (type list1 list2 pred)
"Destructively merge lists LIST1 and LIST2 to produce a new list.
Argument TYPE is for compatibility and ignored.
Ordering of the elements is preserved according to PRED, a `less-than'
predicate on the elements."
(let ((res nil))
(while (and list1 list2)
(if (funcall pred (car list2) (car list1))
(push (pop list2) res)
(push (pop list1) res)))
(nconc (nreverse res) list1 list2))))
(eval-when-compile
(defvar xemacs-codename))
(defun gnus-emacs-version ()
"Stringified Emacs version."
(let ((system-v
(cond
((eq gnus-user-agent 'emacs-gnus-config)
system-configuration)
((eq gnus-user-agent 'emacs-gnus-type)
(symbol-name system-type))
(t nil))))
(cond
((eq gnus-user-agent 'gnus)
nil)
((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
(concat "Emacs/" (match-string 1 emacs-version)
(if system-v
(concat " (" system-v ")")
"")))
((string-match
"\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
emacs-version)
(concat
(match-string 1 emacs-version)
(format "/%d.%d" emacs-major-version emacs-minor-version)
(if (match-beginning 3)
(match-string 3 emacs-version)
"")
(if (boundp 'xemacs-codename)
(concat
" (" xemacs-codename
(if system-v
(concat ", " system-v ")")
")"))
"")))
(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)
;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49
;;; gnus-util.el ends here
- 1 participants
- 0 comments
CVS update by youngs MODIFIED: packages/xemacs-packages/gnus/lisp ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: youngs
Date: 05/03/13 02:39:29
Modified: packages/xemacs-packages/gnus/lisp gnus.el
Log:
2005-03-13 Steve Youngs <steve(a)sxemacs.org>
* lisp/gnus.el: Don't try and mark `gnus-agent-save-groups' as an
autoloaded function.
From: Andrey Slusar <anrays(a)gmail.com>.
Revision Changes Path
1.85 +6 -0 XEmacs/packages/xemacs-packages/gnus/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/ChangeLog,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -r1.84 -r1.85
--- ChangeLog 2005/03/13 00:23:03 1.84
+++ ChangeLog 2005/03/13 01:39:15 1.85
＠＠ -1,5 +1,11 ＠＠
2005-03-13 Steve Youngs <steve(a)sxemacs.org>
+ * 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>
+
* Sync to upstream 5.10 branch.
See ChangeLog.upstream files for details.
1.8 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus.el
Index: gnus.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus.el,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- gnus.el 2005/03/13 00:23:31 1.7
+++ gnus.el 2005/03/13 01:39:27 1.8
＠＠ -2726,7 +2726,7 ＠＠
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)
- 1 participants
- 0 comments
CVS update by youngs MODIFIED: packages/xemacs-packages/gnus/texi, bk-a4.tex, emacs-mime.texi, message.texi, refcard.tex ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: youngs
Date: 05/03/13 01:26:07
Modified: packages/xemacs-packages/gnus/texi ChangeLog.upstream
bk-a4.tex bk-lt.tex booklet.tex doclicense.texi
emacs-mime.texi gnus-faq.texi gnus.texi gnusref.tex
message.texi pagestyle.sty pixidx.sty postamble.tex
refcard.tex splitindex
Added: packages/xemacs-packages/gnus/etc/gnus dead.xpm
reverse-smile.xpm
packages/xemacs-packages/gnus/lisp gnus-load.el
legacy-gnus-agent.el
Log:
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
Revision Changes Path
1.84 +7 -0 XEmacs/packages/xemacs-packages/gnus/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/ChangeLog,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -r1.83 -r1.84
--- ChangeLog 2004/10/01 08:39:19 1.83
+++ ChangeLog 2005/03/13 00:23:03 1.84
＠＠ -1,3 +1,10 ＠＠
+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
+
2004-10-01 Norbert Koch <viteno(a)xemacs.org>
* Makefile (VERSION): XEmacs package 1.82 released.
1.104 +1 -1 XEmacs/packages/xemacs-packages/gnus/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/Makefile,v
retrieving revision 1.103
retrieving revision 1.104
diff -u -r1.103 -r1.104
--- Makefile 2004/10/01 08:39:19 1.103
+++ Makefile 2005/03/13 00:23:03 1.104
＠＠ -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
1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/dead.xpm
Index: dead.xpm
===================================================================
/* XPM */
static char * dead_xpm[] = {
"13 14 3 1",
" c None",
". c #000000",
"+ c #FFDD00",
" ....... ",
" ..+++++.. ",
" .+++++++++. ",
".+++++++++++.",
".++.+.+.+.++.",
".+++.+++.+++.",
".++.+.+.+.++.",
".+++++++++++.",
".+++++++++++.",
".+.+++++++.+.",
".++.......++.",
" .+++++++++. ",
" ..+++++.. ",
" ....... "};
1.1 XEmacs/packages/xemacs-packages/gnus/etc/gnus/reverse-smile.xpm
Index: reverse-smile.xpm
===================================================================
/* XPM */
static char * reverse_smile_xpm[] = {
"13 14 3 1",
" c None",
". c #000000",
"+ c #FFDD00",
" ....... ",
" ..+++++.. ",
" .+++++++++. ",
".+++.....+++.",
".++.+++++.++.",
".++.+++++.++.",
".+++++++++++.",
".+++++++++++.",
".++..+++..++.",
".++..+++..++.",
".+++++++++++.",
" .+++++++++. ",
" ..+++++.. ",
" ....... "};
1.6 +1003 -31 XEmacs/packages/xemacs-packages/gnus/lisp/ChangeLog.upstream
Index: ChangeLog.upstream
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/ChangeLog.upstream,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- ChangeLog.upstream 2004/09/28 02:21:01 1.5
+++ ChangeLog.upstream 2005/03/13 00:23:21 1.6
＠＠ -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,Ax(Brgensen <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,Ax(Brgensen <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,Ax(Brgensen <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>
1.4 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/canlock.el
Index: canlock.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/canlock.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- canlock.el 2004/09/28 02:21:02 1.3
+++ canlock.el 2005/03/13 00:23:22 1.4
＠＠ -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
1.4 +14 -13 XEmacs/packages/xemacs-packages/gnus/lisp/deuglify.el
Index: deuglify.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/deuglify.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- deuglify.el 2004/09/28 02:21:02 1.3
+++ deuglify.el 2005/03/13 00:23:22 1.4
＠＠ -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)
1.3 +1 -29 XEmacs/packages/xemacs-packages/gnus/lisp/dgnushack-xemacs.el
Index: dgnushack-xemacs.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/dgnushack-xemacs.el,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- dgnushack-xemacs.el 2003/12/08 06:55:18 1.2
+++ dgnushack-xemacs.el 2005/03/13 00:23:22 1.3
＠＠ -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
1.6 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/dgnushack.el
Index: dgnushack.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/dgnushack.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- dgnushack.el 2004/09/28 02:21:02 1.5
+++ dgnushack.el 2005/03/13 00:23:22 1.6
＠＠ -202,6 +202,7 ＠＠
(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 ＠＠
(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 ()
1.5 +11 -11 XEmacs/packages/xemacs-packages/gnus/lisp/flow-fill.el
Index: flow-fill.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/flow-fill.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- flow-fill.el 2004/09/28 02:21:03 1.4
+++ flow-fill.el 2005/03/13 00:23:22 1.5
＠＠ -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 ＠＠
"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 ＠＠
'(
;; 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 ＠＠
")
; ("
;> foo
-;>
-;>
+;>
+;>
;> bar
;" . "
;> foo bar
1.7 +678 -496 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-agent.el
Index: gnus-agent.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-agent.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- gnus-agent.el 2004/09/28 02:21:03 1.6
+++ gnus-agent.el 2005/03/13 00:23:22 1.7
＠＠ -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 ＠＠
: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 ＠＠
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 ＠＠
"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 ＠＠
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 ＠＠
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 ＠＠
"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 ＠＠
"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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
;; 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 ＠＠
(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 ＠＠
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 ＠＠
;;; 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 ＠＠
;; 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 ＠＠
;; 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 ＠＠
(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,16 +1326,40 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
;; 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 ＠＠
(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,65 +1853,78 ＠＠
(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.
(eval-when-compile
＠＠ -1735,7 +1948,8 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(while (not (eobp))
(condition-case err
- (let (group
+ (let (group
min
max
(cur (current-buffer)))
＠＠ -1889,7 +2108,7 ＠＠
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 ＠＠
;; 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 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
(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 ＠＠
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 ＠＠
gnus-command-method))
(let* ((active
(gnus-gethash-safe expiring-group orig)))
-
+
(when active
(save-excursion
(gnus-agent-expire-group-1
＠＠ -3121,9 +3349,9 ＠＠
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 ＠＠
(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 ＠＠
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 ＠＠
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 ＠＠
(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 ＠＠
;; 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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
(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)
1.6 +176 -76 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-art.el
Index: gnus-art.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-art.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- gnus-art.el 2004/09/28 02:21:04 1.5
+++ gnus-art.el 2005/03/13 00:23:22 1.6
＠＠ -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 ＠＠
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 ＠＠
(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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
"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 ＠＠
"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 ＠＠
"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 ＠＠
"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 ＠＠
"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 ＠＠
"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 ＠＠
"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 ＠＠
"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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
"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 ＠＠
"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 ＠＠
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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 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 ＠＠
(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 ＠＠
"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 ＠＠
(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 ＠＠
"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 ＠＠
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 ＠＠
(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 ＠＠
"\\)")
"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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
("\\(<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 ＠＠
("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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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)))
1.4 +4 -0 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-async.el
Index: gnus-async.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-async.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- gnus-async.el 2004/09/28 02:21:04 1.3
+++ gnus-async.el 2005/03/13 00:23:23 1.4
＠＠ -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)
1.5 +40 -0 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cache.el
Index: gnus-cache.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cache.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gnus-cache.el 2004/09/28 02:21:04 1.4
+++ gnus-cache.el 2005/03/13 00:23:23 1.5
＠＠ -726,6 +726,46 ＠＠
(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
1.5 +3 -2 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cite.el
Index: gnus-cite.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-cite.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gnus-cite.el 2004/09/28 02:21:04 1.4
+++ gnus-cite.el 2005/03/13 00:23:23 1.5
＠＠ -124,6 +124,7 ＠＠
(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 ＠＠
"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 ＠＠
(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 ＠＠
(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 ＠＠
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)
1.3 +2 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-delay.el
Index: gnus-delay.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-delay.el,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- gnus-delay.el 2004/09/28 02:21:05 1.2
+++ gnus-delay.el 2005/03/13 00:23:24 1.3
＠＠ -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)
1.3 +3 -2 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-diary.el
Index: gnus-diary.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-diary.el,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- gnus-diary.el 2004/09/28 02:21:05 1.2
+++ gnus-diary.el 2005/03/13 00:23:24 1.3
＠＠ -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 ＠＠
(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
1.5 +41 -33 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-draft.el
Index: gnus-draft.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-draft.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gnus-draft.el 2004/09/28 02:21:05 1.4
+++ gnus-draft.el 2005/03/13 00:23:24 1.5
＠＠ -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."
1.5 +9 -6 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-fun.el
Index: gnus-fun.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-fun.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gnus-fun.el 2004/09/28 02:21:06 1.4
+++ gnus-fun.el 2005/03/13 00:23:24 1.5
＠＠ -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 ＠＠
"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)
1.5 +30 -27 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-group.el
Index: gnus-group.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-group.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gnus-group.el 2004/09/28 02:21:06 1.4
+++ gnus-group.el 2005/03/13 00:23:24 1.5
＠＠ -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 ＠＠
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 ＠＠
(?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 ＠＠
"\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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
;;; 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 ＠＠
(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 ＠＠
'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 ＠＠
;; 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 ＠＠
(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))
1.6 +41 -21 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-int.el
Index: gnus-int.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-int.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- gnus-int.el 2004/09/28 02:21:06 1.5
+++ gnus-int.el 2005/03/13 00:23:25 1.6
＠＠ -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 ＠＠
`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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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.
1.6 +19 -13 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-msg.el
Index: gnus-msg.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-msg.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- gnus-msg.el 2004/09/28 02:21:07 1.5
+++ gnus-msg.el 2005/03/13 00:23:25 1.6
＠＠ -142,7 +142,7 ＠＠
(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 ＠＠
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 ＠＠
"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 ＠＠
'(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 ＠＠
'(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 ＠＠
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 ＠＠
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 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 ＠＠
;; 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 ＠＠
;; 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 ＠＠
(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.
1.6 +2 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-picon.el
Index: gnus-picon.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-picon.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- gnus-picon.el 2004/09/28 02:21:07 1.5
+++ gnus-picon.el 2005/03/13 00:23:25 1.6
＠＠ -40,8 +40,9 ＠＠
;;
;;; Code:
+(eval-when-compile (require 'cl))
+
(require 'gnus)
-(require 'custom)
(require 'gnus-art)
;;; User variables:
1.4 +66 -1 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-range.el
Index: gnus-range.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-range.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- gnus-range.el 2004/09/28 02:21:07 1.3
+++ gnus-range.el 2005/03/13 00:23:26 1.4
＠＠ -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 ＠＠
(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 ＠＠
(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)
1.5 +44 -39 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-registry.el
Index: gnus-registry.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-registry.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gnus-registry.el 2004/09/28 02:21:07 1.4
+++ gnus-registry.el 2005/03/13 00:23:26 1.5
＠＠ -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 ＠＠
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 ＠＠
"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 ＠＠
"%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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
;; 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 ＠＠
"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 ＠＠
(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 ＠＠
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 ＠＠
(< 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 ＠＠
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 ＠＠
(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 ＠＠
(when word
(memq nil
(mapcar 'not
- (mapcar
+ (mapcar
(lambda (x)
(string-match x word))
list)))))
＠＠ -539,7 +540,7 ＠＠
;; 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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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)
1.5 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-score.el
Index: gnus-score.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-score.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gnus-score.el 2004/09/28 02:21:08 1.4
+++ gnus-score.el 2005/03/13 00:23:26 1.5
＠＠ -237,10 +237,10 ＠＠
(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."
1.5 +19 -21 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-spec.el
Index: gnus-spec.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-spec.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gnus-spec.el 2004/09/28 02:21:09 1.4
+++ gnus-spec.el 2005/03/13 00:23:27 1.5
＠＠ -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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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."
1.5 +10 -6 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-srvr.el
Index: gnus-srvr.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-srvr.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gnus-srvr.el 2004/09/28 02:21:09 1.4
+++ gnus-srvr.el 2005/03/13 00:23:27 1.5
＠＠ -71,7 +71,7 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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)))))))
1.6 +208 -92 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-start.el
Index: gnus-start.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-start.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- gnus-start.el 2004/09/28 02:21:09 1.5
+++ gnus-start.el 2005/03/13 00:23:27 1.6
＠＠ -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,9 +34,16 ＠＠
(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.
`.newsrc-SERVER' will be used instead if that exists."
＠＠ -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 ＠＠
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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
;; 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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
;; 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 ＠＠
(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,62 +1688,61 ＠＠
(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
((eq active 'ignore)
＠＠ -1734,8 +1768,8 ＠＠
(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 ＠＠
(setcdr range (1- article))
(setq modified t)
ranges))))))))
-
+
(when modified
(when (eq modified 'remove-null)
(setq r (delq nil r)))
＠＠ -1980,10 +2014,10 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
;; 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 ＠＠
(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)
1.6 +179 -88 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-sum.el
Index: gnus-sum.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-sum.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- gnus-sum.el 2004/09/28 02:21:09 1.5
+++ gnus-sum.el 2005/03/13 00:23:28 1.6
＠＠ -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 ＠＠
(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 ＠＠
"*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 ＠＠
"*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 ＠＠
(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 ＠＠
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 ＠＠
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 ＠＠
(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 ＠＠
(defcustom gnus-spam-mark ?$
"*Mark used for spam articles."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
＠＠ -495,12 +500,13 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
"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 ＠＠
["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 ＠＠
`("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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
;; 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 ＠＠
;; 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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
;;;!!!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 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 ＠＠
`(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 ＠＠
(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 ＠＠
;; coding: iso-8859-1
;; End:
-;;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
+;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
;;; gnus-sum.el ends here
1.8 +58 -5 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-util.el
Index: gnus-util.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-util.el,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- gnus-util.el 2004/09/28 02:21:10 1.7
+++ gnus-util.el 2005/03/13 00:23:30 1.8
＠＠ -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 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
"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 ＠＠
")"))
"")))
(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)
1.4 +2 -0 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-win.el
Index: gnus-win.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus-win.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- gnus-win.el 2004/09/28 02:21:10 1.3
+++ gnus-win.el 2005/03/13 00:23:31 1.4
＠＠ -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 ＠＠
(defcustom gnus-configure-windows-hook nil
"*A hook called when configuring windows."
+ :version "22.1"
:group 'gnus-windows
:type 'hook)
1.7 +72 -67 XEmacs/packages/xemacs-packages/gnus/lisp/gnus.el
Index: gnus.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gnus.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- gnus.el 2004/09/28 02:21:10 1.6
+++ gnus.el 2005/03/13 00:23:31 1.7
＠＠ -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 ＠＠
: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 ＠＠
(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 ＠＠
((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 ＠＠
(\"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 ＠＠
(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 ＠＠
"*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 ＠＠
(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 ＠＠
(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 ＠＠
: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 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
`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 ＠＠
(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 ＠＠
;; 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 ＠＠
(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 ＠＠
(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 ＠＠
(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))
1.6 +26 -9 XEmacs/packages/xemacs-packages/gnus/lisp/gpg.el
Index: gpg.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/gpg.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- gpg.el 2004/09/28 02:21:11 1.5
+++ gpg.el 2005/03/13 00:23:31 1.6
＠＠ -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 ＠＠
;;; 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 ＠＠
"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 ＠＠
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)
1.4 +94 -168 XEmacs/packages/xemacs-packages/gnus/lisp/html2text.el
Index: html2text.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/html2text.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- html2text.el 2004/09/28 02:21:11 1.3
+++ html2text.el 2005/03/13 00:23:31 1.4
＠＠ -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 ＠＠
"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 ＠＠
(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 ＠＠
"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 ＠＠
;; <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 ＠＠
;; <Functions related to attributes> i.e. <font size=+3>
;;
-(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 ＠＠
((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 ＠＠
((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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(let ((has-br-line)
(refill-start)
(refill-stop))
- (if (re-search-forward "<br>$" 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 "<br>" 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
- "<br>" ""
- refill-start (point))))
- ;; (message "Point = %s refill-stop = %s" (point) refill-stop)
- ;; (sleep-for 4)
- (fill-region refill-start refill-stop)
- )
- )
- )
- )
- )
- (html2text-replace-string "<br>" "" p1 p2)
- )
+ (when (re-search-forward "<br>$" 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 "<br>" 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
+ "<br>" ""
+ refill-start (point))))
+ ;; (message "Point = %s refill-stop = %s" (point) refill-stop)
+ ;; (sleep-for 4)
+ (fill-region refill-start refill-stop))))
+ (html2text-replace-string "<br>" "" p1 p2))
;;
;; This one is interactive ...
＠＠ -432,11 +373,11 ＠＠
"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 "^<br>$" "")
;; Removing lonely <br> 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 ＠＠
;;
(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 ＠＠
(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 ＠＠
;;
;; </Interactive functions>
;;
-
+(provide 'html2text)
;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e
;;; html2text.el ends here
1.5 +29 -15 XEmacs/packages/xemacs-packages/gnus/lisp/imap.el
Index: imap.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/imap.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- imap.el 2004/09/28 02:21:11 1.4
+++ imap.el 2005/03/13 00:23:32 1.5
＠＠ -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 ＠＠
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 ＠＠
: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 ＠＠
: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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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)))))
1.7 +2 -3 XEmacs/packages/xemacs-packages/gnus/lisp/lpath.el
Index: lpath.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/lpath.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- lpath.el 2004/09/28 02:21:11 1.6
+++ lpath.el 2005/03/13 00:23:32 1.7
＠＠ -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
1.6 +6 -6 XEmacs/packages/xemacs-packages/gnus/lisp/mail-source.el
Index: mail-source.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mail-source.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- mail-source.el 2004/09/28 02:21:12 1.5
+++ mail-source.el 2005/03/13 00:23:32 1.6
＠＠ -236,7 +236,7 ＠＠
"*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 ＠＠
: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 ＠＠
"*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 ＠＠
(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 ＠＠
(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 ＠＠
(eval-when-compile
(if (featurep 'xemacs)
- (require 'itimer)
+ (require 'timer-funcs)
(require 'timer)))
(defun mail-source-start-idle-timer ()
1.5 +6 -8 XEmacs/packages/xemacs-packages/gnus/lisp/mailcap.el
Index: mailcap.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mailcap.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- mailcap.el 2004/09/28 02:21:12 1.4
+++ mailcap.el 2005/03/13 00:23:33 1.5
＠＠ -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")
1.6 +112 -91 XEmacs/packages/xemacs-packages/gnus/lisp/message.el
Index: message.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/message.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- message.el 2004/09/28 02:21:12 1.5
+++ message.el 2005/03/13 00:23:33 1.6
＠＠ -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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
"*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 ＠＠
(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 ＠＠
: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 ＠＠
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 ＠＠
`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 ＠＠
`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 ＠＠
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 ＠＠
"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 ＠＠
"*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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
"*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 ＠＠
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 ＠＠
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 ＠＠
"*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 ＠＠
;; 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 ＠＠
(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 ＠＠
"*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 ＠＠
;;;###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 ＠＠
"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 ＠＠
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 ＠＠
"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 ＠＠
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 ＠＠
(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 ＠＠
"\\)")
"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 ＠＠
(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 ＠＠
;;; 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 ＠＠
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 ＠＠
;; 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 ＠＠
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 ＠＠
(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 ＠＠
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 ＠＠
;; 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 ＠＠
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 ＠＠
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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
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 ＠＠
`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 ＠＠
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 ＠＠
(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 ＠＠
(goto-char (point-max))))
(setq e (point))
(insert "<#/mml>\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 ＠＠
'("^\\(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 ＠＠
;; coding: iso-8859-1
;; End:
-;;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0
+;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0
;;; message.el ends here
1.6 +3 -2 XEmacs/packages/xemacs-packages/gnus/lisp/mm-bodies.el
Index: mm-bodies.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-bodies.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- mm-bodies.el 2004/09/28 02:21:13 1.5
+++ mm-bodies.el 2005/03/13 00:23:33 1.6
＠＠ -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 ＠＠
(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)
1.6 +23 -35 XEmacs/packages/xemacs-packages/gnus/lisp/mm-decode.el
Index: mm-decode.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-decode.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- mm-decode.el 2004/09/28 02:21:13 1.5
+++ mm-decode.el 2005/03/13 00:23:33 1.6
＠＠ -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 ＠＠
`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 ＠＠
"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 ＠＠
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 ＠＠
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 ＠＠
"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 ＠＠
(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 ＠＠
"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 ＠＠
"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 ＠＠
(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 ＠＠
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 ＠＠
'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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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."
1.4 +28 -53 XEmacs/packages/xemacs-packages/gnus/lisp/mm-url.el
Index: mm-url.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-url.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- mm-url.el 2004/01/04 22:49:25 1.3
+++ mm-url.el 2005/03/13 00:23:33 1.4
＠＠ -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 ＠＠
(defcustom mm-url-arguments nil
"The arguments for `mm-url-program'."
+ :version "22.1"
:type '(repeat string)
:group 'mm-url)
＠＠ -328,59 +330,31 ＠＠
(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 ＠＠
(provide 'mm-url)
+;;; arch-tag: 0594f9b3-417c-48b0-adc2-5082e1e7917f
;;; mm-url.el ends here
1.6 +160 -42 XEmacs/packages/xemacs-packages/gnus/lisp/mm-util.el
Index: mm-util.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-util.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- mm-util.el 2004/09/28 02:21:14 1.5
+++ mm-util.el 2005/03/13 00:23:34 1.6
＠＠ -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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
(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 ＠＠
"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 ＠＠
(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 ＠＠
(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 ＠＠
(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))))
1.5 +1 -0 XEmacs/packages/xemacs-packages/gnus/lisp/mm-uu.el
Index: mm-uu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-uu.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- mm-uu.el 2004/09/28 02:21:14 1.4
+++ mm-uu.el 2005/03/13 00:23:34 1.5
＠＠ -80,6 +80,7 ＠＠
(defcustom mm-uu-diff-groups-regexp "gnus\\.commits"
"*Regexp matching diff groups."
+ :version "22.1"
:type 'regexp
:group 'gnus-article-mime)
1.5 +13 -8 XEmacs/packages/xemacs-packages/gnus/lisp/mm-view.el
Index: mm-view.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mm-view.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- mm-view.el 2004/09/28 02:21:14 1.4
+++ mm-view.el 2005/03/13 00:23:34 1.5
＠＠ -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))
1.4 +4 -1 XEmacs/packages/xemacs-packages/gnus/lisp/mml-sec.el
Index: mml-sec.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml-sec.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- mml-sec.el 2004/09/28 02:21:14 1.3
+++ mml-sec.el 2005/03/13 00:23:34 1.4
＠＠ -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 ＠＠
(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 ＠＠
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 ＠＠
(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
1.6 +3 -0 XEmacs/packages/xemacs-packages/gnus/lisp/mml-smime.el
Index: mml-smime.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml-smime.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- mml-smime.el 2004/09/28 02:21:14 1.5
+++ mml-smime.el 2005/03/13 00:23:34 1.6
＠＠ -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)
1.5 +13 -11 XEmacs/packages/xemacs-packages/gnus/lisp/mml.el
Index: mml.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- mml.el 2004/09/28 02:21:15 1.4
+++ mml.el 2005/03/13 00:23:34 1.5
＠＠ -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 ＠＠
'(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 ＠＠
(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 ＠＠
;; 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 ＠＠
"attachment")))
(disposition (completing-read "Disposition: "
'(("attachment") ("inline") (""))
- nil
- nil)))
+ nil t)))
(if (not (equal disposition ""))
disposition
default)))
＠＠ -1078,9 +1080,9 ＠＠
(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)
1.5 +4 -3 XEmacs/packages/xemacs-packages/gnus/lisp/mml2015.el
Index: mml2015.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/mml2015.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- mml2015.el 2004/09/28 02:21:15 1.4
+++ mml2015.el 2005/03/13 00:23:35 1.5
＠＠ -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)
1.4 +9 -4 XEmacs/packages/xemacs-packages/gnus/lisp/nnagent.el
Index: nnagent.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnagent.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- nnagent.el 2004/09/28 02:21:15 1.3
+++ nnagent.el 2005/03/13 00:23:35 1.4
＠＠ -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)
1.4 +2 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nndiary.el
Index: nndiary.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nndiary.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- nndiary.el 2004/09/28 02:21:15 1.3
+++ nndiary.el 2005/03/13 00:23:35 1.4
＠＠ -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 ＠＠
(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)
1.5 +9 -8 XEmacs/packages/xemacs-packages/gnus/lisp/nnfolder.el
Index: nnfolder.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnfolder.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- nnfolder.el 2004/09/28 02:21:16 1.4
+++ nnfolder.el 2005/03/13 00:23:35 1.5
＠＠ -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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
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)))
1.6 +11 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnheader.el
Index: nnheader.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnheader.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- nnheader.el 2004/09/28 02:21:16 1.5
+++ nnheader.el 2005/03/13 00:23:35 1.6
＠＠ -74,7 +74,15 ＠＠
(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 ＠＠
(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)
1.5 +23 -17 XEmacs/packages/xemacs-packages/gnus/lisp/nnimap.el
Index: nnimap.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnimap.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- nnimap.el 2004/09/28 02:21:16 1.4
+++ nnimap.el 2005/03/13 00:23:35 1.5
＠＠ -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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 (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 ＠＠
(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 ＠＠
(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 ＠＠
"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 ＠＠
'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 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
(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)
1.5 +18 -13 XEmacs/packages/xemacs-packages/gnus/lisp/nnmail.el
Index: nnmail.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnmail.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- nnmail.el 2004/09/28 02:21:17 1.4
+++ nnmail.el 2005/03/13 00:23:35 1.5
＠＠ -119,6 +119,7 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
: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 ＠＠
(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 ＠＠
by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\
surrounded
by anything."
+ :version "22.1"
:group 'nnmail
:type 'boolean)
＠＠ -582,6 +586,7 ＠＠
"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 ＠＠
(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 ＠＠
(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)
1.5 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/nnml.el
Index: nnml.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnml.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- nnml.el 2004/09/28 02:21:18 1.4
+++ nnml.el 2005/03/13 00:23:36 1.5
＠＠ -923,7 +923,7 ＠＠
(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 ＠＠
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
1.5 +6 -4 XEmacs/packages/xemacs-packages/gnus/lisp/nnrss.el
Index: nnrss.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnrss.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- nnrss.el 2004/09/28 02:21:19 1.4
+++ nnrss.el 2005/03/13 00:23:36 1.5
＠＠ -82,6 +82,12 ＠＠
;;; 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 ＠＠
(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
1.5 +4 -1 XEmacs/packages/xemacs-packages/gnus/lisp/nnspool.el
Index: nnspool.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnspool.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- nnspool.el 2004/09/28 02:21:19 1.4
+++ nnspool.el 2005/03/13 00:23:36 1.5
＠＠ -44,7 +44,10 ＠＠
"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/")
1.5 +8 -6 XEmacs/packages/xemacs-packages/gnus/lisp/nnweb.el
Index: nnweb.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/nnweb.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- nnweb.el 2004/09/28 02:21:20 1.4
+++ nnweb.el 2005/03/13 00:23:36 1.5
＠＠ -54,11 +54,12 ＠＠
(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 ＠＠
(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 ＠＠
"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 ＠＠
(>= 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 ＠＠
"?"
(mm-url-encode-www-form-urlencoded
`(("q" . ,search)
- ("num". "100")
+ ("num" . "100")
("hq" . "")
- ("hl" . "")
+ ("hl" . "en")
("lr" . "")
("safe" . "off")
("sites" . "groups")))))
1.6 +63 -5 XEmacs/packages/xemacs-packages/gnus/lisp/rfc2047.el
Index: rfc2047.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/rfc2047.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- rfc2047.el 2004/09/28 02:21:20 1.5
+++ rfc2047.el 2005/03/13 00:23:37 1.6
＠＠ -1,6 +1,8 ＠＠
;;; 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>
;; This file is part of GNU Emacs.
＠＠ -50,6 +52,7 ＠＠
(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 ＠＠
'(("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 ＠＠
"=\\?\\([^][\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 ＠＠
(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
1.5 +10 -5 XEmacs/packages/xemacs-packages/gnus/lisp/rfc2231.el
Index: rfc2231.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/rfc2231.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- rfc2231.el 2004/09/28 02:21:20 1.4
+++ rfc2231.el 2005/03/13 00:23:37 1.5
＠＠ -88,7 +88,6 ＠＠
(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 ＠＠
(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)))))))
1.3 +3 -1 XEmacs/packages/xemacs-packages/gnus/lisp/smiley.el.upstream
Index: smiley.el.upstream
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/smiley.el.upstream,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- smiley.el.upstream 2004/01/04 22:49:26 1.2
+++ smiley.el.upstream 2005/03/13 00:23:37 1.3
＠＠ -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 ＠＠
(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 ＠＠
(provide 'smiley)
+;;; arch-tag: 5beb161b-4321-40af-8ac9-876afb8ee818
;;; smiley.el ends here
1.6 +20 -18 XEmacs/packages/xemacs-packages/gnus/lisp/smime.el
Index: smime.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/smime.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- smime.el 2004/09/28 02:21:21 1.5
+++ smime.el 2005/03/13 00:23:37 1.6
＠＠ -150,7 +150,7 ＠＠
(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 ＠＠
(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 ＠＠
(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 ＠＠
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 ＠＠
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
1.5 +1 -1 XEmacs/packages/xemacs-packages/gnus/lisp/spam-report.el
Index: spam-report.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/spam-report.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- spam-report.el 2004/09/28 02:21:21 1.4
+++ spam-report.el 2005/03/13 00:23:37 1.5
＠＠ -43,7 +43,7 ＠＠
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
1.4 +3 -0 XEmacs/packages/xemacs-packages/gnus/lisp/spam-stat.el
Index: spam-stat.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/spam-stat.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- spam-stat.el 2004/09/28 02:21:21 1.3
+++ spam-stat.el 2005/03/13 00:23:37 1.4
＠＠ -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 ＠＠
'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)
1.5 +134 -125 XEmacs/packages/xemacs-packages/gnus/lisp/spam.el
Index: spam.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/spam.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- spam.el 2004/09/28 02:21:21 1.4
+++ spam.el 2005/03/13 00:23:37 1.5
＠＠ -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 ＠＠
(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 ＠＠
;;;; Hashcash.
+(eval-when-compile
+ (autoload 'mail-check-payment "hashcash"))
+
(condition-case nil
(progn
(require 'hashcash)
＠＠ -1264,9 +1279,7 ＠＠
"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,67 +1288,68 ＠＠
;; 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 ＠＠
;;;; 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 ＠＠
(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 ＠＠
`("-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-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)
1.4 +2 -2 XEmacs/packages/xemacs-packages/gnus/lisp/utf7.el
Index: utf7.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/lisp/utf7.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- utf7.el 2004/09/28 02:21:21 1.3
+++ utf7.el 2005/03/13 00:23:37 1.4
＠＠ -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)
1.3 +6 -99 XEmacs/packages/xemacs-packages/gnus/lisp/gnus-load.el
Index: gnus-load.el
===================================================================
RCS file: gnus-load.el
diff -N gnus-load.el
--- /dev/null Sun Mar 13 01:25:11 2005
+++ /tmp/cvsAAA4dayUW Sun Mar 13 01:25:14 2005
＠＠ -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
1.1 XEmacs/packages/xemacs-packages/gnus/lisp/legacy-gnus-agent.el
Index: legacy-gnus-agent.el
===================================================================
(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
1.6 +67 -5 XEmacs/packages/xemacs-packages/gnus/texi/ChangeLog.upstream
Index: ChangeLog.upstream
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/ChangeLog.upstream,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- ChangeLog.upstream 2004/09/28 02:21:30 1.5
+++ ChangeLog.upstream 2005/03/13 00:25:33 1.6
＠＠ -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>
1.2 +2 -0 XEmacs/packages/xemacs-packages/gnus/texi/bk-a4.tex
Index: bk-a4.tex
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/bk-a4.tex,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- bk-a4.tex 2003/05/02 00:27:32 1.1
+++ bk-a4.tex 2005/03/13 00:25:33 1.2
＠＠ -18,3 +18,5 ＠＠
\small%\footnotesize
\input{booklet}
\end{document}
+
+% arch-tag: 95490708-a858-4d01-99fe-888f0c8a58a2
1.2 +2 -0 XEmacs/packages/xemacs-packages/gnus/texi/bk-lt.tex
Index: bk-lt.tex
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/bk-lt.tex,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- bk-lt.tex 2003/05/02 00:27:32 1.1
+++ bk-lt.tex 2005/03/13 00:25:33 1.2
＠＠ -18,3 +18,5 ＠＠
\small%\footnotesize
\input{booklet}
\end{document}
+
+% arch-tag: fd94e3e8-a8ef-48e8-ba5e-6c8b0a293dc1
1.2 +2 -0 XEmacs/packages/xemacs-packages/gnus/texi/booklet.tex
Index: booklet.tex
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/booklet.tex,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- booklet.tex 2003/05/02 00:27:32 1.1
+++ booklet.tex 2005/03/13 00:25:33 1.2
＠＠ -170,3 +170,5 ＠＠
%% \thispagestyle{empty}
%% \vspace*{\fill}
%% \CopyRight
+
+% arch-tag: e030ead9-7440-42b3-ae58-bac80a79debd
1.2 +4 -0 XEmacs/packages/xemacs-packages/gnus/texi/doclicense.texi
Index: doclicense.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/doclicense.texi,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- doclicense.texi 2003/03/27 08:20:25 1.1
+++ doclicense.texi 2005/03/13 00:25:33 1.2
＠＠ -366,3 +366,7 ＠＠
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
1.5 +4 -4 XEmacs/packages/xemacs-packages/gnus/texi/emacs-mime.texi
Index: emacs-mime.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/emacs-mime.texi,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- emacs-mime.texi 2004/09/28 02:21:30 1.4
+++ emacs-mime.texi 2005/03/13 00:25:34 1.5
＠＠ -814,12 +814,12 ＠＠
＠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
1.5 +10 -7 XEmacs/packages/xemacs-packages/gnus/texi/gnus-faq.texi
Index: gnus-faq.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/gnus-faq.texi,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gnus-faq.texi 2004/09/28 02:21:30 1.4
+++ gnus-faq.texi 2005/03/13 00:25:34 1.5
＠＠ -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 ＠＠
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 ＠＠
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 ＠＠
＠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
1.8 +89 -73 XEmacs/packages/xemacs-packages/gnus/texi/gnus.texi
Index: gnus.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/gnus.texi,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- gnus.texi 2004/09/28 02:21:31 1.7
+++ gnus.texi 2005/03/13 00:25:34 1.8
＠＠ -391,25 +391,25 ＠＠
＠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,13 +535,10 ＠＠
* 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.
-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.
-
Threading
* Customizing Threading:: Variables you can change to affect the threading.
＠＠ -888,7 +885,7 ＠＠
* 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 ＠＠
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 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 ＠＠
＠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 ＠＠
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 ＠＠
＠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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
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 ＠＠
＠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 ＠＠
;; ＠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 ＠＠
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 ＠＠
* 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 ＠＠
＠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 ＠＠
＠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 ＠＠
* 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 ＠＠
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 ＠＠
＠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.
1.5 +2 -0 XEmacs/packages/xemacs-packages/gnus/texi/gnusref.tex
Index: gnusref.tex
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/gnusref.tex,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- gnusref.tex 2004/01/04 22:49:32 1.4
+++ gnusref.tex 2005/03/13 00:25:40 1.5
＠＠ -1180,3 +1180,5 ＠＠
%%% mode: latex
%%% TeX-master: "refcard.tex"
%%% End:
+
+% arch-tag: be438b0e-6832-4afb-8c56-5f84743e5cd1
1.6 +18 -13 XEmacs/packages/xemacs-packages/gnus/texi/message.texi
Index: message.texi
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/message.texi,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- message.texi 2004/09/28 02:21:32 1.5
+++ message.texi 2005/03/13 00:25:40 1.6
＠＠ -146,16 +146,15 ＠＠
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,8 +223,14 ＠＠
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 ＠＠
＠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 ＠＠
＠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
1.3 +1 -0 XEmacs/packages/xemacs-packages/gnus/texi/pagestyle.sty
Index: pagestyle.sty
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/pagestyle.sty,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- pagestyle.sty 2003/05/02 00:27:34 1.2
+++ pagestyle.sty 2005/03/13 00:25:40 1.3
＠＠ -81,3 +81,4 ＠＠
\setcounter{tocdepth}{3}
\setcounter{secnumdepth}{3}
+% arch-tag: 49bd5922-1cc7-4614-87b7-53f34f669c5c
1.2 +2 -0 XEmacs/packages/xemacs-packages/gnus/texi/pixidx.sty
Index: pixidx.sty
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/pixidx.sty,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- pixidx.sty 2003/03/27 08:20:26 1.1
+++ pixidx.sty 2005/03/13 00:25:40 1.2
＠＠ -227,3 +227,5 ＠＠
\flushbottom
\endinput
+
+% arch-tag: 286974d6-3578-4aa9-b298-f6a03b13f0bd
1.3 +2 -0 XEmacs/packages/xemacs-packages/gnus/texi/postamble.tex
Index: postamble.tex
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/postamble.tex,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- postamble.tex 2003/05/02 00:27:34 1.2
+++ postamble.tex 2005/03/13 00:25:40 1.3
＠＠ -48,3 +48,5 ＠＠
%%% mode: latex
%%% TeX-master: t
%%% End:
+
+% arch-tag: 5e771934-0d03-4dbc-898f-10eb429ad992
1.4 +2 -0 XEmacs/packages/xemacs-packages/gnus/texi/refcard.tex
Index: refcard.tex
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/refcard.tex,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- refcard.tex 2004/01/04 22:49:32 1.3
+++ refcard.tex 2005/03/13 00:25:40 1.4
＠＠ -184,3 +184,5 ＠＠
%%% Local Variables:
%%% mode: latex
%%% End:
+
+% arch-tag: 242dca59-0d4d-4c5c-9427-3503d78cf848
1.2 +2 -0 XEmacs/packages/xemacs-packages/gnus/texi/splitindex
Index: splitindex
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/gnus/texi/splitindex,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- splitindex 2003/05/02 00:27:34 1.1
+++ splitindex 2005/03/13 00:25:41 1.2
＠＠ -4,3 +4,5 ＠＠
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
- 1 participants
- 0 comments
CVS update by viteno MODIFIED: xemacs ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: viteno
Date: 05/03/12 23:51:34
Modified: xemacs version.sh
Log:
Update xemacs_extra_name.
Revision Changes Path
1.1095 +1 -1 XEmacs/xemacs/version.sh
Index: version.sh
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/version.sh,v
retrieving revision 1.1094
retrieving revision 1.1095
diff -u -r1.1094 -r1.1095
--- version.sh 2005/03/11 22:52:28 1.1094
+++ version.sh 2005/03/12 22:51:30 1.1095
＠＠ -8,5 +8,5 ＠＠
infodock_major_version=4
infodock_minor_version=0
infodock_build_version=8
-xemacs_extra_name="(+CVS-20050311)"
+xemacs_extra_name="(+CVS-20050312)"
xemacs_release_date="2005-02-18"
- 1 participants
- 0 comments
CVS update by aidan MODIFIED: packages/xemacs-packages/re-builder, re-builder.el ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: aidan
Date: 05/03/12 22:59:02
Modified: packages/xemacs-packages/re-builder ChangeLog Makefile
re-builder.el
Log:
This is Steve Youngs change of microsoft-free.87vf7z6dqk.fsf(a)youngs.au.com ,
moving re-builder to using extents, and fixing a bug related to
reb-color-display-p.
Revision Changes Path
1.3 +12 -0 XEmacs/packages/xemacs-packages/re-builder/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/re-builder/ChangeLog,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- ChangeLog 2005/03/09 20:23:20 1.2
+++ ChangeLog 2005/03/12 21:59:00 1.3
＠＠ -1,3 +1,15 ＠＠
+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.
+
2005-03-09 Norbert Koch <viteno(a)xemacs.org>
* Makefile (VERSION): XEmacs package 1.01 released.
1.3 +1 -1 XEmacs/packages/xemacs-packages/re-builder/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/re-builder/Makefile,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Makefile 2005/03/09 20:23:20 1.2
+++ Makefile 2005/03/12 21:59:00 1.3
＠＠ -25,7 +25,7 ＠＠
MAINTAINER = Aidan Kehoe <aidan(a)xemacs.org>
PACKAGE = re-builder
PKG_TYPE = regular
-REQUIRES = fsf-compat
+REQUIRES =
CATEGORY = standard
STANDARD_DOCS = t
1.2 +18 -10 XEmacs/packages/xemacs-packages/re-builder/re-builder.el
Index: re-builder.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/re-builder/re-builder.el,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- re-builder.el 2005/03/04 20:29:56 1.1
+++ re-builder.el 2005/03/12 21:59:00 1.2
＠＠ -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 ＠＠
;; 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 ＠＠
"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 ＠＠
(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"
- 1 participants
- 0 comments
CVS update by aidan MODIFIED: xemacs/lisp ...
19 years, 1 month
CVS Monitor
CVS Monitor
User: aidan
Date: 05/03/12 21:57:48
Modified: xemacs/lisp ChangeLog select.el
Log:
Fabrice Popineau's select fix for win32, plus a logic error on my part.
Revision Changes Path
1.652 +8 -0 XEmacs/xemacs/lisp/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.651
retrieving revision 1.652
diff -u -r1.651 -r1.652
--- ChangeLog 2005/03/11 19:21:46 1.651
+++ ChangeLog 2005/03/12 20:57:40 1.652
＠＠ -1,3 +1,11 ＠＠
+2005-03-12 Fabrice Popineau <Fabrice.Popineau(a)supelec.fr>
+
+ * select.el (get-selection): As described in
+ u0nj9nvq.fsf(a)esemetz.metz.supelec.fr , get-selection-internal
+ returns nil instead of signalling a selection-conversion
+ error on win32. Also, Aidan had a logic error while traversing a
+ list.
+
2005-03-11 Stephen J. Turnbull <stephen(a)xemacs.org>
* XEmacs 21.5.20 "cilantro" is released.
1.15 +3 -2 XEmacs/xemacs/lisp/select.el
Index: select.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/select.el,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- select.el 2005/03/01 00:21:18 1.14
+++ select.el 2005/03/12 20:57:42 1.15
＠＠ -146,10 +146,11 ＠＠
(condition-case err
(progn
(setq res (get-selection-internal type (car data-type)))
- (throw 'converted res))
+ (if res (throw 'converted res)
+ (signal 'selection-conversion-error nil)))
(selection-conversion-error
(if (cdr data-type)
- (setq data-type (pop data-type))
+ (setq data-type (cdr data-type))
(signal (car err) (cdr err))))))))
(get-selection-internal type data-type)))
- 1 participants
- 0 comments