From f309f11e6f2b7335fc4306aef04545c2a40f6e42 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 24 Jan 2001 23:05:39 +0000 Subject: [PATCH] Synch with Oort Gnus. --- lisp/ChangeLog | 24 ++++++++++++++++++++++++ lisp/gnus-agent.el | 2 ++ lisp/gnus-int.el | 2 +- lisp/gnus-score.el | 10 +++++----- lisp/gnus-srvr.el | 39 +++++++++++++++++++++++---------------- lisp/mail-source.el | 33 +++++++++++++++++++-------------- lisp/mm-util.el | 4 ++-- lisp/nntp.el | 16 ++++++++-------- texi/ChangeLog | 5 +++++ texi/gnus-ja.texi | 24 ++++++++++++++++++++++++ texi/gnus.texi | 27 ++++++++++++++++++++++++++- 11 files changed, 139 insertions(+), 47 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8f93a64..64da0f2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,27 @@ +2001-01-24 17:00:00 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-add-server): Redraw the line. + (gnus-agent-remove-server): Ditto. + + * gnus-srvr.el (gnus-server-line-format): Add %a. + (gnus-server-line-format-alist): Add gnus-tmp-agent. + (gnus-server-insert-server-line): Use it. + +2001-01-24 09:00:00 ShengHuo ZHU + + * mm-util.el (mm-mime-mule-charset-alist): Preferred MIME names + GB2312 and Big5. + +2001-01-24 Simon Josefsson + + * mail-source.el (mail-sources): Add :program specifier to IMAP + mail source. + (mail-source-fetch-imap): Map :program to `imap-shell-program'. + +2001-01-24 08:00:00 ShengHuo ZHU + + * gnus-score.el (gnus-score-lower-thread): Fix a doc typo. + 2001-01-24 12:22:47 Lars Magne Ingebrigtsen * nntp.el (nntp-wait-for): Return the success code. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 902d1b5..87e29af 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -555,6 +555,7 @@ be a select method." (when (member method gnus-agent-covered-methods) (error "Server already in the agent program")) (push method gnus-agent-covered-methods) + (gnus-server-update-server server) (gnus-agent-write-servers) (message "Entered %s into the Agent" server))) @@ -568,6 +569,7 @@ be a select method." (error "Server not in the agent program")) (setq gnus-agent-covered-methods (delete method gnus-agent-covered-methods)) + (gnus-server-update-server server) (gnus-agent-write-servers) (message "Removed %s from the agent" server))) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 0a78cbe..a5021bd 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -1,5 +1,5 @@ ;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index dc617df..a70d9ff 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1,5 +1,5 @@ ;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen @@ -1526,7 +1526,7 @@ EXTRA is the possible non-standard header." (gnus-message 5 "Scoring...done")))))) (defun gnus-score-lower-thread (thread score-adjust) - "Lower the socre on THREAD with SCORE-ADJUST. + "Lower the score on THREAD with SCORE-ADJUST. THREAD is expected to contain a list of the form `(PARENT [CHILD1 CHILD2 ...])' where PARENT is a header array and each CHILD is a list of the same form as THREAD. The empty list `nil' is valid. For each @@ -1784,7 +1784,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." ;; gnus-score-index is used as a free variable. alike last this art entries alist articles new news) - + ;; Change score file to the adaptive score file. All entries that ;; this function makes will be put into this file. (save-excursion @@ -1794,7 +1794,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." (gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix)))) - (setq gnus-scores-articles (sort gnus-scores-articles + (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) articles gnus-scores-articles) @@ -1863,7 +1863,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." (push new news))))) ;; Update expire date (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) + ((and found gnus-update-score-entry-dates) ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 8182382..6f619e1 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -1,5 +1,5 @@ ;;; gnus-srvr.el --- virtual server support for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -37,7 +37,7 @@ (defvar gnus-server-mode-hook nil "Hook run in `gnus-server-mode' buffers.") -(defconst gnus-server-line-format " {%(%h:%w%)} %s\n" +(defconst gnus-server-line-format " {%(%h:%w%)} %s%a\n" "Format of server lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -47,7 +47,8 @@ The following specs are understood: %h backend %n name %w address -%s status") +%s status +%a agent covered") (defvar gnus-server-mode-line-format "Gnus: %%b" "The format specification for the server mode line.") @@ -66,7 +67,8 @@ The following specs are understood: `((?h gnus-tmp-how ?s) (?n gnus-tmp-name ?s) (?w gnus-tmp-where ?s) - (?s gnus-tmp-status ?s))) + (?s gnus-tmp-status ?s) + (?a gnus-tmp-agent ?s))) (defvar gnus-server-mode-line-format-alist `((?S gnus-tmp-news-server ?s) @@ -141,7 +143,7 @@ The following specs are understood: "n" next-line "p" previous-line - + "g" gnus-server-regenerate-server "\C-c\C-i" gnus-info-find-node @@ -183,7 +185,12 @@ The following commands are available: (eq (nth 1 elem) 'ok)) "(opened)") (t - "(closed)")))) + "(closed)"))) + (gnus-tmp-agent (if (and gnus-agent + (member method + gnus-agent-covered-methods)) + "(agent)" + ""))) (beginning-of-line) (gnus-add-text-properties (point) @@ -603,9 +610,9 @@ The following commands are available: (goto-char (point-min)) (unless (string= gnus-ignored-newsgroups "") (delete-matching-lines gnus-ignored-newsgroups)) - (while (not (eobp)) + (while (not (eobp)) (ignore-errors - (push (cons + (push (cons (if (eq (char-after) ?\") (read cur) (let ((p (point)) (name "")) @@ -627,16 +634,16 @@ The following commands are available: (string< (car l1) (car l2))))) (if gnus-server-browse-in-group-buffer (let* ((gnus-select-method orig-select-method) - (gnus-group-listed-groups - (mapcar (lambda (group) + (gnus-group-listed-groups + (mapcar (lambda (group) (let ((name - (gnus-group-prefixed-name + (gnus-group-prefixed-name (car group) method))) (gnus-set-active name (cdr group)) name)) groups))) (gnus-configure-windows 'group) - (funcall gnus-group-prepare-function + (funcall gnus-group-prepare-function gnus-level-killed 'ignore 1 'ingore)) (gnus-get-buffer-create gnus-browse-buffer) (when gnus-carpal @@ -658,13 +665,13 @@ The following commands are available: (point) (prog1 (1+ (point)) (insert - (format "%c%7d: %s\n" + (format "%c%7d: %s\n" (let ((level (let ((gnus-select-method orig-select-method)) (gnus-group-level - (gnus-group-prefixed-name (car group) + (gnus-group-prefixed-name (car group) method))))) - (cond + (cond ((<= level gnus-level-subscribed) ? ) ((<= level gnus-level-unsubscribed) ?U) ((= level gnus-level-zombie) ?Z) @@ -791,7 +798,7 @@ buffer. nil nil (if (gnus-server-equal gnus-browse-current-method "native") nil - (gnus-method-simplify + (gnus-method-simplify gnus-browse-current-method))) gnus-level-default-subscribed (gnus-group-level group) (and (car (nth 1 gnus-newsrc-alist)) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 7154b6a..e4df22c 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -1,5 +1,5 @@ ;;; mail-source.el --- functions for fetching mail -;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -93,12 +93,12 @@ See Info node `(gnus)Mail Source Specifiers'." (const :format "" pop) (checklist :tag "Options" :greedy t (group :inline t - (const :format "" :value :server) + (const :format "" :value :server) (string :tag "Server")) (group :inline t - (const :format "" :value :port) + (const :format "" :value :port) (choice :tag "Port" - :value "pop3" + :value "pop3" (number :format "%v") (string :format "%v"))) (group :inline t @@ -120,7 +120,7 @@ See Info node `(gnus)Mail Source Specifiers'." (const :format "" :value :function) (function :tag "Function")) (group :inline t - (const :format "" + (const :format "" :value :authentication) (choice :tag "Authentication" :value apop @@ -146,8 +146,8 @@ See Info node `(gnus)Mail Source Specifiers'." (string :tag "Server")) (group :inline t (const :format "" :value :port) - (choice :tag "Port" - :value 143 + (choice :tag "Port" + :value 143 number string)) (group :inline t (const :format "" :value :user) @@ -161,6 +161,9 @@ See Info node `(gnus)Mail Source Specifiers'." :value network ,@mail-source-imap-streams)) (group :inline t + (const :format "" :value :program) + (string :tag "Program")) + (group :inline t (const :format "" :value :authenticator) (choice :tag "Authenticator" @@ -172,7 +175,7 @@ See Info node `(gnus)Mail Source Specifiers'." :value "INBOX")) (group :inline t (const :format "" :value :predicate) - (string :tag "Predicate" + (string :tag "Predicate" :value "UNSEEN UNDELETED")) (group :inline t (const :format "" :value :fetchflag) @@ -188,7 +191,7 @@ See Info node `(gnus)Mail Source Specifiers'." (cons :tag "Webmail server" (const :format "" webmail) (checklist :tag "Options" :greedy t - (group :inline t + (group :inline t (const :format "" :value :subtype) ;; Should be generated from ;; `webmail-type-definition', but we @@ -301,6 +304,7 @@ Common keywords should be listed here.") (:server (getenv "MAILHOST")) (:port) (:stream) + (:program) (:authentication) (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) (:password) @@ -752,7 +756,7 @@ If ARGS, PROMPT is used as an argument to `format'." (defvar mail-source-report-new-mail-timer nil) (defvar mail-source-report-new-mail-idle-timer nil) -(eval-when-compile +(eval-when-compile (if (featurep 'xemacs) (require 'itimer) (require 'timer))) @@ -838,7 +842,7 @@ This only works when `display-time' is enabled." (goto-char (point-min)) ;;; ;; Unix mail format ;;; (unless (looking-at "\n*From ") -;;; (insert "From maildir " +;;; (insert "From maildir " ;;; (current-time-string) "\n")) ;;; (while (re-search-forward "^From " nil t) ;;; (replace-match ">From ")) @@ -875,6 +879,7 @@ This only works when `display-time' is enabled." (buf (get-buffer-create (format " *imap source %s:%s:%s *" server user mailbox))) (mail-source-string (format "imap:%s:%s" server mailbox)) + (imap-shell-program (or (list program) imap-shell-program)) remove) (if (and (imap-open server port stream authentication buf) (imap-authenticate @@ -935,14 +940,14 @@ This only works when `display-time' is enabled." (when (eq authentication 'password) (setq password (or password - (cdr (assoc (format "webmail:%s:%s" subtype user) + (cdr (assoc (format "webmail:%s:%s" subtype user) mail-source-password-cache)) (mail-source-read-passwd (format "Password for %s at %s: " user subtype)))) (when (and password - (not (assoc (format "webmail:%s:%s" subtype user) + (not (assoc (format "webmail:%s:%s" subtype user) mail-source-password-cache))) - (push (cons (format "webmail:%s:%s" subtype user) password) + (push (cons (format "webmail:%s:%s" subtype user) password) mail-source-password-cache))) (webmail-fetch mail-source-crash-box subtype user password) (mail-source-callback callback (symbol-name subtype))))) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 6c7d104..c3d237a 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -49,8 +49,8 @@ (viscii vietnamese-viscii-lower) (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978) (euc-kr korean-ksc5601) - (cn-gb-2312 chinese-gb2312) - (cn-big5 chinese-big5-1 chinese-big5-2) + (gb2312 chinese-gb2312) + (big5 chinese-big5-1 chinese-big5-2) (tibetan tibetan) (thai-tis620 thai-tis620) (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) diff --git a/lisp/nntp.el b/lisp/nntp.el index b07b4b9..140bc5b 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,6 +1,6 @@ ;;; nntp.el --- nntp access for Gnus ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000 +;; 1997, 1998, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -389,8 +389,8 @@ noticing asynchronous data.") (wait-for (nntp-wait-for process wait-for buffer decode)) (t t))) - (error - (nnheader-report 'nntp "Couldn't open connection to %s: %s" + (error + (nnheader-report 'nntp "Couldn't open connection to %s: %s" address err)) (quit (message "Quit retrieving data from nntp") @@ -572,7 +572,7 @@ noticing asynchronous data.") ;; Wait for the reply from the final command. (unless (gnus-buffer-live-p buf) - (error + (error (nnheader-report 'nntp "Connection to %s is closed." server))) (set-buffer buf) (goto-char (point-max)) @@ -584,13 +584,13 @@ noticing asynchronous data.") (goto-char (point-max)) (if (not nntp-server-list-active-group) (not (re-search-backward "\r?\n" (- (point) 3) t)) - (not (re-search-backward "^\\.\r?\n" + (not (re-search-backward "^\\.\r?\n" (- (point) 4) t))))) (nntp-accept-response))) ;; Now all replies are received. We remove CRs. (unless (gnus-buffer-live-p buf) - (error + (error (nnheader-report 'nntp "Connection to %s is closed." server))) (set-buffer buf) (goto-char (point-min)) @@ -1263,7 +1263,7 @@ password contained in '~/.nntp-authinfo'." (while (and (cdr articles) (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) (setq articles (cdr articles))) - + (setq in-process-buffer-p (stringp nntp-server-xover)) (nntp-send-xover-command first (car articles)) (setq articles (cdr articles)) @@ -1271,7 +1271,7 @@ password contained in '~/.nntp-authinfo'." (when (and nntp-server-xover in-process-buffer-p) ;; Don't count tried request. (setq count (1+ count)) - + ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. (when (or (null articles) ;All requests have been sent. diff --git a/texi/ChangeLog b/texi/ChangeLog index 0938488..409159c 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,8 @@ +2001-01-24 Simon Josefsson + + * gnus.texi (Mail Source Specifiers): Add IMAP :program, fix POP + :program typo. + 2001-01-15 16:15:20 Lars Magne Ingebrigtsen * gnus.texi (The Active File): Only old versionf of leafnode diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 1e15aed..7ebfb0b 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -10971,6 +10971,30 @@ IMAP サーバーに渡すパスワードです。指定されていないときは、利用者は入力 は、@samp{kerberos4}, @samp{cram-md5}, @samp{anonymous} か初期値 の @samp{login} になります。 +@item :program +:stream に `shell' が設定されているときは、この値が変 +数 `imap-shell-program' に割り当てられます。これは @code{format} ふうの +文字列 (または文字列のリスト) でなければなりません。例を示しましょう。 + +@example +ssh %s imapd +@end example + +有効な format 指示子は以下の通りです。 + +@table @samp +@item s +サーバーの名前。 + +@item l +`imap-default-user' で設定されたユーザ名。 + +@item p +サーバーのポート番号。 +@end table + +これらの指定に使われる値は、対応するキーワードに与えた値から取ってきます。 + @item :mailbox メールを取得するメールボックスの名前。初期値は @samp{INBOX} で、これは普 通は入ってくるメールを受け取るメールボックスです。 diff --git a/texi/gnus.texi b/texi/gnus.texi index 06d7962..04c77a7 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -11314,7 +11314,7 @@ The password to give to the POP server. If not specified, the user is prompted. @item :program -The program to use to fetch mail from the POP server. This is should be +The program to use to fetch mail from the POP server. This should be a @code{format}-like string. Here's an example: @example @@ -11459,6 +11459,31 @@ of the symbols in @code{imap-authenticator-alist}. Right now, this means @samp{kerberos4}, @samp{cram-md5}, @samp{anonymous} or the default @samp{login}. +@item :program +When using the `shell' :stream, the contents of this variable is +mapped into the `imap-shell-program' variable. This should be a +@code{format}-like string (or list of strings). Here's an example: + +@example +ssh %s imapd +@end example + +The valid format specifier characters are: + +@table @samp +@item s +The name of the server. + +@item l +User name from `imap-default-user'. + +@item p +The port number of the server. +@end table + +The values used for these specs are taken from the values you give the +corresponding keywords. + @item :mailbox The name of the mailbox to get mail from. The default is @samp{INBOX} which normally is the mailbox which receive incoming mail. -- 1.7.10.4