From d75ad5fcb4dd6888ea4fd12cd17f27aac131ad53 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Wed, 19 Mar 1997 19:56:24 +0000 Subject: [PATCH] *** empty log message *** --- lisp/ChangeLog | 38 ++ lisp/gnus-msg.el | 6 +- lisp/gnus-start.el | 1 - lisp/gnus-sum.el | 46 ++- lisp/gnus.el | 21 +- lisp/message.el | 3 + lisp/nnbabyl.el | 4 + lisp/nnfolder.el | 9 +- lisp/nnmail.el | 13 +- lisp/nnmbox.el | 4 + lisp/nnmh.el | 25 +- lisp/nnml.el | 4 + lisp/pop3.el | 865 +++++++++++++++++++++++---------------------- texi/ChangeLog | 5 + texi/gnus.texi | 23 +- texi/message.texi | 10 +- 16 files changed, 608 insertions(+), 469 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 010bacff8..1f53982d1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,41 @@ +Wed Mar 19 20:53:34 1997 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.31 is released. + +Wed Mar 19 14:29:26 1997 Lars Magne Ingebrigtsen + + * nnmh.el (nnmh-request-accept-article): Ditto. + + * nnbabyl.el (nnbabyl-request-accept-article): Ditto. + + * nnmbox.el (nnmbox-request-accept-article): Ditto. + + * nnfolder.el (nnfolder-request-accept-article): Ditto. + + * nnml.el (nnml-request-accept-article): Cache or not. + + * gnus-sum.el (gnus-summary-read-group): Don't recurse. + (gnus-summary-ignore-duplicates): New variable. + (gnus-get-newsgroup-headers): Use it. + (gnus-nov-parse-line): Ditto. + + * message.el (message-reply): Remove excessive white space in + headers. + + * nnfolder.el (nnfolder-read-folder): Work when ignoring active + file. + + * nnmail.el (nnmail-process-unix-mail-format): Narrow to the right + portion. + (nnmail-process-mmdf-mail-format): Ditto. + + * gnus.el (gnus-group-remove-parameter): New function. + (gnus-group-set-parameter): Use it. + (gnus-group-add-parameter): Ditto. + + * gnus-msg.el (gnus-post-news): Check first whether + to-list/to-address exists before adding. + Tue Mar 18 23:54:17 1997 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.4.30 is released. diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 38f99e80d..013eed8fd 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -404,8 +404,10 @@ header line with the old Message-ID." (message-mail (or to-address to-list)) ;; Arrange for mail groups that have no `to-address' to ;; get that when the user sends off the mail. - (push (list 'gnus-inews-add-to-address pgroup) - message-send-actions)) + (when (and (not to-list) + (not to-address)) + (push (list 'gnus-inews-add-to-address pgroup) + message-send-actions))) (set-buffer gnus-article-copy) (message-wide-reply to-address))) (when yank diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 49672ac5c..7c5483b26 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -943,7 +943,6 @@ the server for new groups." gnus-active-hashtb) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups)) - ;; Suggested by Per Abrahamsen . (if (> groups 0) (gnus-message 5 "%d new newsgroup%s arrived." groups (if (> groups 1) "s have" " has")) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 98a56f88f..6aeb5795d 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -288,6 +288,11 @@ and non-`vertical', do both horizontal and vertical recentering." :group 'gnus-article-headers :type 'boolean) +(defcustom gnus-summary-ignore-duplicates nil + "*If non-nil, ignore articles with identical Message-ID headers." + :group 'gnus-summary + :type 'boolean) + (defcustom gnus-single-article-buffer t "*If non-nil, display all articles in the same buffer. If nil, each group will get its own article buffer." @@ -2465,9 +2470,10 @@ If NO-DISPLAY, don't generate a summary buffer." (let (result) (while (and group (null (setq result - (gnus-summary-read-group-1 - group show-all no-article - kill-buffer no-display))) + (let ((gnus-auto-select-next nil)) + (gnus-summary-read-group-1 + group show-all no-article + kill-buffer no-display)))) (eq gnus-auto-select-next 'quietly)) (set-buffer gnus-group-buffer) (if (not (equal group (gnus-group-group-name))) @@ -4196,9 +4202,20 @@ The resulting hash table is returned, or nil if no Xrefs were found." (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) - ;; An article with this Message-ID has already been seen, - ;; so we rename the Message-ID. - (progn + ;; An article with this Message-ID has already been seen. + (if gnus-summary-ignore-duplicates + ;; We ignore this one, except we add + ;; any additional Xrefs (in case the two articles + ;; came from different servers). + (progn + (mail-header-set-xref + (car (symbol-value id-dep)) + (concat (or (mail-header-xref + (car (symbol-value id-dep))) + "") + (or (mail-header-xref header) ""))) + (setq header nil)) + ;; We rename the Message-ID. (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) @@ -4285,9 +4302,20 @@ The resulting hash table is returned, or nil if no Xrefs were found." (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) - ;; An article with this Message-ID has already been seen, - ;; so we rename the Message-ID. - (progn + ;; An article with this Message-ID has already been seen. + (if gnus-summary-ignore-duplicates + ;; We ignore this one, except we add any additional + ;; Xrefs (in case the two articles came from different + ;; servers. + (progn + (mail-header-set-xref + (car (symbol-value id-dep)) + (concat (or (mail-header-xref + (car (symbol-value id-dep))) + "") + (or (mail-header-xref header) ""))) + (setq header nil)) + ;; We rename the Message-ID. (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) diff --git a/lisp/gnus.el b/lisp/gnus.el index 9493abf4c..81944747d 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -226,7 +226,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.4.30" +(defconst gnus-version-number "5.4.31" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -2244,8 +2244,8 @@ If SYMBOL, return the value of that symbol in the group parameters." (defun gnus-group-add-parameter (group param) "Add parameter PARAM to GROUP." (let ((info (gnus-get-info group))) - (if (not info) - () ; This is a dead group. We just ignore it. + (when info + (gnus-group-remove-parameter group (if (consp param) (car param) param)) ;; Cons the new param to the old one and update. (gnus-group-set-info (cons param (gnus-info-params info)) group 'params)))) @@ -2253,8 +2253,8 @@ If SYMBOL, return the value of that symbol in the group parameters." (defun gnus-group-set-parameter (group name value) "Set parameter NAME to VALUE in GROUP." (let ((info (gnus-get-info group))) - (if (not info) - () ; This is a dead group. We just ignore it. + (when info + (gnus-group-remove-parameter group name) (let ((old-params (gnus-info-params info)) (new-params (list (cons name value)))) (while old-params @@ -2264,6 +2264,17 @@ If SYMBOL, return the value of that symbol in the group parameters." (setq old-params (cdr old-params))) (gnus-group-set-info new-params group 'params))))) +(defun gnus-group-remove-parameter (group name) + "Remove parameter NAME from GROUP." + (let ((info (gnus-get-info group))) + (when info + (let ((params (gnus-info-params info))) + (when params + (setq params (delq name params)) + (while (assq name params) + (setq params (delq (assq name params) params))) + (gnus-info-set-params info params)))))) + (defun gnus-group-add-score (group &optional score) "Add SCORE to the GROUP score. If SCORE is nil, add 1 to the score of GROUP." diff --git a/lisp/message.el b/lisp/message.el index 4347677f3..b7e1a1bc0 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -3007,6 +3007,9 @@ Headers already prepared in the buffer are not modified." (insert (if (bolp) "" ", ") (or to "")) (insert (if mct (concat (if (bolp) "" ", ") mct) "")) (insert (if cc (concat (if (bolp) "" ", ") cc) "")) + (goto-char (point-min)) + (while (re-search-forward "[ \t]+" nil t) + (replace-match " " t t)) ;; Remove addresses that match `rmail-dont-reply-to-names'. (insert (prog1 (rmail-dont-reply-to (buffer-string)) (erase-buffer))) diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index 7334b9488..4c0da2b63 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -333,6 +333,8 @@ (save-excursion (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (car (nnbabyl-save-mail (if (stringp group) (list (cons group (nnbabyl-active-number group))) @@ -343,6 +345,8 @@ (goto-char (match-end 0)) (insert-buffer-substring buf) (when last + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (save-buffer) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) result)))) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 60ad4289b..b81b8709e 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -375,6 +375,8 @@ time saver for large mailboxes.") (forward-line -1) (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (car (nnfolder-save-mail (if (stringp group) @@ -384,7 +386,9 @@ time saver for large mailboxes.") (when last (save-excursion (nnfolder-possibly-change-folder (or (caar art-group) group)) - (nnfolder-save-buffer)))) + (nnfolder-save-buffer) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close))))) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (unless result (nnheader-report 'nnfolder "Couldn't store article")) @@ -643,7 +647,8 @@ time saver for large mailboxes.") (let ((delim (concat "^" message-unix-mail-delimiter)) (marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") - (active (cadr (assoc group nnfolder-group-alist))) + (active (or (cadr (assoc group nnfolder-group-alist)) + (cons 1 0))) (scantime (assoc group nnfolder-scantime-alist)) (minid (lsh -1 -1)) maxid start end newscantime diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 8446cbb4c..84393fa8f 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -160,6 +160,11 @@ Eg.: :type '(choice (const :tag "nnmail-expiry-wait" nil) (function :format "%v" nnmail-))) +(defcustom nnmail-cache-accepted-message-ids nil + "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache." + :group nnmail + :type boolean) + (defcustom nnmail-spool-file (or (getenv "MAIL") (concat "/usr/spool/mail/" (user-login-name))) @@ -853,8 +858,8 @@ is a spool. If not using procmail, return GROUP." ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) - (forward-line 1) - (point)))) + (forward-line 1)) + (point))) ;; Find the Message-ID header. (goto-char (point-min)) (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t) @@ -937,8 +942,8 @@ is a spool. If not using procmail, return GROUP." ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) - (forward-line 1) - (point)))) + (forward-line 1)) + (point))) ;; Find the Message-ID header. (goto-char (point-min)) (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t) diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index 069ed7f6f..b20efdd61 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -304,6 +304,8 @@ (forward-line -1) (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (nnmbox-save-mail (if (stringp group) (list (cons group (nnmbox-active-number group))) @@ -313,6 +315,8 @@ (goto-char (point-max)) (insert-buffer-substring buf) (when last + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)) (nnmail-save-active nnmbox-group-alist nnmbox-active-file) (save-buffer)))) (car result))) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index cf0b6c51b..7aed234b0 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -290,16 +290,21 @@ (deffoo nnmh-request-accept-article (group &optional server last noinsert) (nnmh-possibly-change-directory group server) (nnmail-check-syntax) - (if (stringp group) - (and - (nnmail-activate 'nnmh) - (car (nnmh-save-mail - (list (cons group (nnmh-active-number group))) - noinsert))) - (and - (nnmail-activate 'nnmh) - (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number) - noinsert))))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) + (prog1 + (if (stringp group) + (and + (nnmail-activate 'nnmh) + (car (nnmh-save-mail + (list (cons group (nnmh-active-number group))) + noinsert))) + (and + (nnmail-activate 'nnmh) + (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number) + noinsert)))) + (when (and last nnmail-cache-accepted-message-ids) + (nnmail-cache-close)))) (deffoo nnmh-request-replace-article (article group buffer) (nnmh-possibly-change-directory group) diff --git a/lisp/nnml.el b/lisp/nnml.el index ed631eb80..0d2f4a9a1 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -313,6 +313,8 @@ all. This may very well take some time.") (nnml-possibly-change-directory group server) (nnmail-check-syntax) (let (result) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (if (stringp group) (and (nnmail-activate 'nnml) @@ -327,6 +329,8 @@ all. This may very well take some time.") (nnmail-article-group 'nnml-active-number)))) (when last (nnmail-save-active nnml-group-alist nnml-active-file) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)) (nnml-save-nov)))) result)) diff --git a/lisp/pop3.el b/lisp/pop3.el index 43d1e8d7d..16fa1fc8e 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -1,430 +1,435 @@ -;;; pop3.el --- Post Office Protocol (RFC 1460) interface - -;; Copyright (C) 1996, Free Software Foundation, Inc. - -;; Author: Richard L. Pieri -;; Keywords: mail, pop3 -;; Version: 1.3 - -;; 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: - -;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands -;; are implemented. The LIST command has not been implemented due to lack -;; of actual usefulness. -;; The optional POP3 command TOP has not been implemented. - -;; This program was inspired by Kyle E. Jones's vm-pop program. - -;;; Code: - -(require 'mail-utils) -(provide 'pop3) - -(eval-and-compile - (if (not (fboundp 'md5)) (autoload 'md5 "md5"))) - -(defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil) - "*POP3 maildrop.") -(defvar pop3-mailhost (or (getenv "MAILHOST") nil) - "*POP3 mailhost.") -(defvar pop3-port 110 - "*POP3 port.") - -(defvar pop3-password-required t - "*Non-nil if a password is required when connecting to POP server.") -(defvar pop3-password nil - "*Password to use when connecting to POP server.") - -(defvar pop3-authentication-scheme 'pass - "*POP3 authentication scheme. Defaults to 'pass, for the standard -USER/PASS authentication. Other valid values are 'apop.") - -(defvar pop3-timestamp nil - "Timestamp returned when initially connected to the POP server. -Used for APOP authentication.") - -(defvar pop3-read-point nil) -(defvar pop3-debug nil) - -(defun pop3-movemail (&optional crashbox) - "Transfer contents of a maildrop to the specified CRASHBOX." - (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) - (let* ((process (pop3-open-server pop3-mailhost pop3-port)) - (crashbuf (get-buffer-create " *pop3-retr*")) - (n 1) - message-count) - ;; for debugging only - (if pop3-debug (switch-to-buffer (process-buffer process))) - (cond ((equal 'apop pop3-authentication-scheme) - (pop3-apop process pop3-maildrop)) - ((equal 'pass pop3-authentication-scheme) - (pop3-user process pop3-maildrop) - (pop3-pass process)) - (t (error "Invalid POP3 authentication scheme."))) - (setq message-count (car (pop3-stat process))) - (while (<= n message-count) - (message (format "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost)) - (pop3-retr process n crashbuf) - (save-excursion - (set-buffer crashbuf) - (append-to-file (point-min) (point-max) crashbox)) - (pop3-dele process n) - (setq n (+ 1 n))) - (pop3-quit process) - (kill-buffer crashbuf) - ) - ) - -(defun pop3-open-server (mailhost port) - "Open TCP connection to MAILHOST. -Returns the process associated with the connection." - (let ((process-buffer - (get-buffer-create (format "trace of POP session to %s" mailhost))) - (process)) - (save-excursion - (set-buffer process-buffer) - (erase-buffer)) - (setq process - (open-network-stream "POP" process-buffer mailhost port)) - (setq pop3-read-point (point-min)) - (let ((response (pop3-read-response process t))) - (setq pop3-timestamp - (substring response (or (string-match "<" response) 0) - (+ 1 (or (string-match ">" response) -1))))) - process - )) - -;; Support functions - -(defun pop3-process-filter (process output) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert output))) - -(defun pop3-send-command (process command) - (set-buffer (process-buffer process)) - (goto-char (point-max)) -;; (if (= (aref command 0) ?P) -;; (insert "PASS \r\n") -;; (insert command "\r\n")) - (setq pop3-read-point (point)) - (goto-char (point-max)) - (process-send-string process command) - (process-send-string process "\r\n") - ) - -(defun pop3-read-response (process &optional return) - "Read the response from the server. -Return the response string if optional second argument is non-nil." - (let ((case-fold-search nil) - match-end) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char pop3-read-point) - (while (not (search-forward "\r\n" nil t)) - (accept-process-output process) - (goto-char pop3-read-point)) - (setq match-end (point)) - (goto-char pop3-read-point) - (if (looking-at "-ERR") - (error (buffer-substring (point) (- match-end 2))) - (if (not (looking-at "+OK")) - (progn (setq pop3-read-point match-end) nil) - (setq pop3-read-point match-end) - (if return - (buffer-substring (point) match-end) - t) - ))))) - -(defun pop3-string-to-list (string &optional regexp) - "Chop up a string into a list." - (let ((list) - (regexp (or regexp " ")) - (string (if (string-match "\r" string) - (substring string 0 (match-beginning 0)) - string))) - (store-match-data nil) - (while string - (if (string-match regexp string) - (setq list (cons (substring string 0 (- (match-end 0) 1)) list) - string (substring string (match-end 0))) - (setq list (cons string list) - string nil))) - (nreverse list))) - -(defvar pop3-read-passwd nil) -(defun pop3-read-passwd (prompt) - (if (not pop3-read-passwd) - (if (load "passwd" t) - (setq pop3-read-passwd 'read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp") - (setq pop3-read-passwd 'ange-ftp-read-passwd))) - (funcall pop3-read-passwd prompt)) - -(defun pop3-clean-region (start end) - (setq end (set-marker (make-marker) end)) - (save-excursion - (goto-char start) - (while (and (< (point) end) (search-forward "\r\n" end t)) - (replace-match "\n" t t)) - (goto-char start) - (while (and (< (point) end) (re-search-forward "^\\." end t)) - (replace-match "" t t) - (forward-char))) - (set-marker end nil)) - -(defun pop3-munge-message-separator (start end) - "Check to see if a message separator exists. If not, generate one." - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (if (not (or (looking-at "From .?") ; Unix mail - (looking-at "\001\001\001\001\n") ; MMDF - (looking-at "BABYL OPTIONS:") ; Babyl - )) - (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) - (date (pop3-string-to-list (mail-fetch-field "Date"))) - (From_)) - ;; sample date formats I have seen - ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) - ;; Date: 08 Jul 1996 23:22:24 -0400 - ;; should be - ;; Tue Jul 9 09:04:21 1996 - (setq date - (cond ((string-match "[A-Z]" (nth 0 date)) - (format "%s %s %s %s %s" - (nth 0 date) (nth 2 date) (nth 1 date) - (nth 4 date) (nth 3 date))) - (t - ;; this really needs to be better but I don't feel - ;; like writing a date to day converter. - (format "Sun %s %s %s %s" - (nth 1 date) (nth 0 date) - (nth 3 date) (nth 2 date))) - )) - (setq From_ (format "From %s %s\n" from date)) - (while (string-match "," From_) - (setq From_ (concat (substring From_ 0 (match-beginning 0)) - (substring From_ (match-end 0))))) - (goto-char (point-min)) - (insert From_)))))) - -;; The Command Set - -;; AUTHORIZATION STATE - -(defun pop3-user (process user) - "Send USER information to POP3 server." - (pop3-send-command process (format "USER %s" user)) - (let ((response (pop3-read-response process t))) - (if (not (and response (string-match "+OK" response))) - (error (format "USER %s not valid." user))))) - -(defun pop3-pass (process) - "Send authentication information to the server." - (let ((pass pop3-password)) - (if (and pop3-password-required (not pass)) - (setq pass - (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) - (if pass - (progn - (pop3-send-command process (format "PASS %s" pass)) - (let ((response (pop3-read-response process t))) - (if (not (and response (string-match "+OK" response))) - (pop3-quit process))))) - )) - -(defun pop3-apop (process user) - "Send alternate authentication information to the server." - (if (not (fboundp 'md5)) (autoload 'md5 "md5")) - (let ((pass pop3-password)) - (if (and pop3-password-required (not pass)) - (setq pass - (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) - (if pass - (let ((hash (md5 (concat pop3-timestamp pass)))) - (pop3-send-command process (format "APOP %s %s" user hash)) - (let ((response (pop3-read-response process t))) - (if (not (and response (string-match "+OK" response))) - (pop3-quit process))))) - )) - -;; TRANSACTION STATE - -(defun pop3-stat (process) - "Return a list of the number of messages in the maildrop and the size -of the maildrop." - (pop3-send-command process "STAT") - (let ((response (pop3-read-response process t))) - (list (string-to-int (nth 1 (pop3-string-to-list response))) - (string-to-int (nth 2 (pop3-string-to-list response)))) - )) - -(defun pop3-list (process &optional msg) - "Scan listing of available messages. -This function currently does nothing.") - -(defun pop3-retr (process msg crashbuf) - "Retrieve message-id MSG from the server and place the contents in -buffer CRASHBUF." - (pop3-send-command process (format "RETR %s" msg)) - (pop3-read-response process) - (let ((start pop3-read-point) end) - (save-excursion - (set-buffer (process-buffer process)) - (while (not (re-search-forward "^\\.\r\n" nil t)) - (accept-process-output process) - ;; bill@att.com ... to save wear and tear on the heap - (if (> (buffer-size) 20000) (sleep-for 1)) - (if (> (buffer-size) 50000) (sleep-for 1)) - (if (> (buffer-size) 100000) (sleep-for 1)) - (if (> (buffer-size) 200000) (sleep-for 1)) - (if (> (buffer-size) 500000) (sleep-for 1)) - ;; bill@att.com - (goto-char start)) - (setq pop3-read-point (point-marker)) - (goto-char (match-beginning 0)) - (setq end (point-marker)) - (pop3-clean-region start end) - (pop3-munge-message-separator start end) - (save-excursion - (set-buffer crashbuf) - (erase-buffer)) - (copy-to-buffer crashbuf start end) - (delete-region start end) - ))) - -(defun pop3-dele (process msg) - "Mark message-id MSG as deleted." - (pop3-send-command process (format "DELE %s" msg)) - (pop3-read-response process)) - -(defun pop3-noop (process msg) - "No-operation." - (pop3-send-command process "NOOP") - (pop3-read-response process)) - -(defun pop3-last (process) - "Return highest accessed message-id number for the session." - (pop3-send-command process "LAST") - (let ((response (pop3-read-response process t))) - (string-to-int (nth 1 (pop3-string-to-list response))) - )) - -(defun pop3-rset (process) - "Remove all delete marks from current maildrop." - (pop3-send-command process "RSET") - (pop3-read-response process)) - -;; UPDATE - -(defun pop3-quit (process) - "Tell server to remove all messages marked as deleted, unlock the -maildrop, and close the connection." - (pop3-send-command process "QUIT") - (pop3-read-response process t) - (if process - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (delete-process process)))) - -;; Summary of POP3 (Post Office Protocol version 3) commands and responses - -;;; AUTHORIZATION STATE - -;; Initial TCP connection -;; Arguments: none -;; Restrictions: none -;; Possible responses: -;; +OK [POP3 server ready] - -;; USER name -;; Arguments: a server specific user-id (required) -;; Restrictions: authorization state [after unsuccessful USER or PASS -;; Possible responses: -;; +OK [valid user-id] -;; -ERR [invalid user-id] - -;; PASS string -;; Arguments: a server/user-id specific password (required) -;; Restrictions: authorization state, after successful USER -;; Possible responses: -;; +OK [maildrop locked and ready] -;; -ERR [invalid password] -;; -ERR [unable to lock maildrop] - -;;; TRANSACTION STATE - -;; STAT -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK nn mm [# of messages, size of maildrop] - -;; LIST [msg] -;; Arguments: a message-id (optional) -;; Restrictions: transaction state; msg must not be deleted -;; Possible responses: -;; +OK [scan listing follows] -;; -ERR [no such message] - -;; RETR msg -;; Arguments: a message-id (required) -;; Restrictions: transaction state; msg must not be deleted -;; Possible responses: -;; +OK [message contents follow] -;; -ERR [no such message] - -;; DELE msg -;; Arguments: a message-id (required) -;; Restrictions: transaction state; msg must not be deleted -;; Possible responses: -;; +OK [message deleted] -;; -ERR [no such message] - -;; NOOP -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK - -;; LAST -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK nn [highest numbered message accessed] - -;; RSET -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK [all delete marks removed] - -;;; UPDATE STATE - -;; QUIT -;; Arguments: none -;; Restrictions: none -;; Possible responses: -;; +OK [TCP connection closed] +;;; pop3.el --- Post Office Protocol (RFC 1460) interface + +;; Copyright (C) 1996, Free Software Foundation, Inc. + +;; Author: Richard L. Pieri +;; Keywords: mail, pop3 +;; Version: 1.3c + +;; 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: + +;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands +;; are implemented. The LIST command has not been implemented due to lack +;; of actual usefulness. +;; The optional POP3 command TOP has not been implemented. + +;; This program was inspired by Kyle E. Jones's vm-pop program. + +;;; Code: + +(require 'mail-utils) +(provide 'pop3) + +(defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil) + "*POP3 maildrop.") +(defvar pop3-mailhost (or (getenv "MAILHOST") nil) + "*POP3 mailhost.") +(defvar pop3-port 110 + "*POP3 port.") + +(defvar pop3-password-required t + "*Non-nil if a password is required when connecting to POP server.") +(defvar pop3-password nil + "*Password to use when connecting to POP server.") + +(defvar pop3-authentication-scheme 'pass + "*POP3 authentication scheme. +Defaults to 'pass, for the standard USER/PASS authentication. Other valid +values are 'apop.") + +(defvar pop3-timestamp nil + "Timestamp returned when initially connected to the POP server. +Used for APOP authentication.") + +(defvar pop3-read-point nil) +(defvar pop3-debug nil) + +(defun pop3-movemail (&optional crashbox) + "Transfer contents of a maildrop to the specified CRASHBOX." + (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) + (let* ((process (pop3-open-server pop3-mailhost pop3-port)) + (crashbuf (get-buffer-create " *pop3-retr*")) + (n 1) + message-count) + ;; for debugging only + (if pop3-debug (switch-to-buffer (process-buffer process))) + (cond ((equal 'apop pop3-authentication-scheme) + (pop3-apop process pop3-maildrop)) + ((equal 'pass pop3-authentication-scheme) + (pop3-user process pop3-maildrop) + (pop3-pass process)) + (t (error "Invalid POP3 authentication scheme."))) + (setq message-count (car (pop3-stat process))) + (while (<= n message-count) + (message (format "Retrieving message %d of %d from %s..." + n message-count pop3-mailhost)) + (pop3-retr process n crashbuf) + (save-excursion + (set-buffer crashbuf) + (append-to-file (point-min) (point-max) crashbox) + (set-buffer (process-buffer process)) + (while (> (buffer-size) 5000) + (goto-char (point-min)) + (forward-line 50) + (delete-region (point-min) (point)))) + (pop3-dele process n) + (setq n (+ 1 n)) + (if pop3-debug (sit-for 1) (sit-for 0.1)) + ) + (pop3-quit process) + (kill-buffer crashbuf) + ) + ) + +(defun pop3-open-server (mailhost port) + "Open TCP connection to MAILHOST. +Returns the process associated with the connection." + (let ((process-buffer + (get-buffer-create (format "trace of POP session to %s" mailhost))) + (process)) + (save-excursion + (set-buffer process-buffer) + (erase-buffer)) + (setq process + (open-network-stream "POP" process-buffer mailhost port)) + (setq pop3-read-point (point-min)) + (let ((response (pop3-read-response process t))) + (setq pop3-timestamp + (substring response (or (string-match "<" response) 0) + (+ 1 (or (string-match ">" response) -1))))) + process + )) + +;; Support functions + +(defun pop3-process-filter (process output) + (save-excursion + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (insert output))) + +(defun pop3-send-command (process command) + (set-buffer (process-buffer process)) + (goto-char (point-max)) +;; (if (= (aref command 0) ?P) +;; (insert "PASS \r\n") +;; (insert command "\r\n")) + (setq pop3-read-point (point)) + (goto-char (point-max)) + (process-send-string process command) + (process-send-string process "\r\n") + ) + +(defun pop3-read-response (process &optional return) + "Read the response from the server. +Return the response string if optional second argument is non-nil." + (let ((case-fold-search nil) + match-end) + (save-excursion + (set-buffer (process-buffer process)) + (goto-char pop3-read-point) + (while (not (search-forward "\r\n" nil t)) + (accept-process-output process) + (goto-char pop3-read-point)) + (setq match-end (point)) + (goto-char pop3-read-point) + (if (looking-at "-ERR") + (error (buffer-substring (point) (- match-end 2))) + (if (not (looking-at "+OK")) + (progn (setq pop3-read-point match-end) nil) + (setq pop3-read-point match-end) + (if return + (buffer-substring (point) match-end) + t) + ))))) + +(defun pop3-string-to-list (string &optional regexp) + "Chop up a string into a list." + (let ((list) + (regexp (or regexp " ")) + (string (if (string-match "\r" string) + (substring string 0 (match-beginning 0)) + string))) + (store-match-data nil) + (while string + (if (string-match regexp string) + (setq list (cons (substring string 0 (- (match-end 0) 1)) list) + string (substring string (match-end 0))) + (setq list (cons string list) + string nil))) + (nreverse list))) + +(defvar pop3-read-passwd nil) +(defun pop3-read-passwd (prompt) + (if (not pop3-read-passwd) + (if (load "passwd" t) + (setq pop3-read-passwd 'read-passwd) + (autoload 'ange-ftp-read-passwd "ange-ftp") + (setq pop3-read-passwd 'ange-ftp-read-passwd))) + (funcall pop3-read-passwd prompt)) + +(defun pop3-clean-region (start end) + (setq end (set-marker (make-marker) end)) + (save-excursion + (goto-char start) + (while (and (< (point) end) (search-forward "\r\n" end t)) + (replace-match "\n" t t)) + (goto-char start) + (while (and (< (point) end) (re-search-forward "^\\." end t)) + (replace-match "" t t) + (forward-char))) + (set-marker end nil)) + +(defun pop3-munge-message-separator (start end) + "Check to see if a message separator exists. If not, generate one." + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (if (not (or (looking-at "From .?") ; Unix mail + (looking-at "\001\001\001\001\n") ; MMDF + (looking-at "BABYL OPTIONS:") ; Babyl + )) + (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) + (date (pop3-string-to-list (mail-fetch-field "Date"))) + (From_)) + ;; sample date formats I have seen + ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) + ;; Date: 08 Jul 1996 23:22:24 -0400 + ;; should be + ;; Tue Jul 9 09:04:21 1996 + (setq date + (cond ((string-match "[A-Z]" (nth 0 date)) + (format "%s %s %s %s %s" + (nth 0 date) (nth 2 date) (nth 1 date) + (nth 4 date) (nth 3 date))) + (t + ;; this really needs to be better but I don't feel + ;; like writing a date to day converter. + (format "Sun %s %s %s %s" + (nth 1 date) (nth 0 date) + (nth 3 date) (nth 2 date))) + )) + (setq From_ (format "From %s %s\n" from date)) + (while (string-match "," From_) + (setq From_ (concat (substring From_ 0 (match-beginning 0)) + (substring From_ (match-end 0))))) + (goto-char (point-min)) + (insert From_)))))) + +;; The Command Set + +;; AUTHORIZATION STATE + +(defun pop3-user (process user) + "Send USER information to POP3 server." + (pop3-send-command process (format "USER %s" user)) + (let ((response (pop3-read-response process t))) + (if (not (and response (string-match "+OK" response))) + (error (format "USER %s not valid." user))))) + +(defun pop3-pass (process) + "Send authentication information to the server." + (let ((pass pop3-password)) + (if (and pop3-password-required (not pass)) + (setq pass + (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) + (if pass + (progn + (pop3-send-command process (format "PASS %s" pass)) + (let ((response (pop3-read-response process t))) + (if (not (and response (string-match "+OK" response))) + (pop3-quit process))))) + )) + +(defun pop3-apop (process user) + "Send alternate authentication information to the server." + (if (not (fboundp 'md5)) (autoload 'md5 "md5")) + (let ((pass pop3-password)) + (if (and pop3-password-required (not pass)) + (setq pass + (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) + (if pass + (let ((hash (md5 (concat pop3-timestamp pass)))) + (pop3-send-command process (format "APOP %s %s" user hash)) + (let ((response (pop3-read-response process t))) + (if (not (and response (string-match "+OK" response))) + (pop3-quit process))))) + )) + +;; TRANSACTION STATE + +(defun pop3-stat (process) + "Return the number of messages in the maildrop and the maildrop's size." + (pop3-send-command process "STAT") + (let ((response (pop3-read-response process t))) + (list (string-to-int (nth 1 (pop3-string-to-list response))) + (string-to-int (nth 2 (pop3-string-to-list response)))) + )) + +(defun pop3-list (process &optional msg) + "Scan listing of available messages. +This function currently does nothing.") + +(defun pop3-retr (process msg crashbuf) + "Retrieve message-id MSG to buffer CRASHBUF." + (pop3-send-command process (format "RETR %s" msg)) + (pop3-read-response process) + (let ((start pop3-read-point) end) + (save-excursion + (set-buffer (process-buffer process)) + (while (not (re-search-forward "^\\.\r\n" nil t)) + (accept-process-output process) + ;; bill@att.com ... to save wear and tear on the heap + (if (> (buffer-size) 20000) (sleep-for 1)) + (if (> (buffer-size) 50000) (sleep-for 1)) + (if (> (buffer-size) 100000) (sleep-for 1)) + (if (> (buffer-size) 200000) (sleep-for 1)) + (if (> (buffer-size) 500000) (sleep-for 1)) + ;; bill@att.com + (goto-char start)) + (setq pop3-read-point (point-marker)) + (goto-char (match-beginning 0)) + (insert "\r\n") + (setq end (point-marker)) + (pop3-clean-region start end) + (pop3-munge-message-separator start end) + (save-excursion + (set-buffer crashbuf) + (erase-buffer)) + (copy-to-buffer crashbuf start end) + (delete-region start end) + ))) + +(defun pop3-dele (process msg) + "Mark message-id MSG as deleted." + (pop3-send-command process (format "DELE %s" msg)) + (pop3-read-response process)) + +(defun pop3-noop (process msg) + "No-operation." + (pop3-send-command process "NOOP") + (pop3-read-response process)) + +(defun pop3-last (process) + "Return highest accessed message-id number for the session." + (pop3-send-command process "LAST") + (let ((response (pop3-read-response process t))) + (string-to-int (nth 1 (pop3-string-to-list response))) + )) + +(defun pop3-rset (process) + "Remove all delete marks from current maildrop." + (pop3-send-command process "RSET") + (pop3-read-response process)) + +;; UPDATE + +(defun pop3-quit (process) + "Close connection to POP3 server. +Tell server to remove all messages marked as deleted, unlock the maildrop, +and close the connection." + (pop3-send-command process "QUIT") + (pop3-read-response process t) + (if process + (save-excursion + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (delete-process process)))) + +;; Summary of POP3 (Post Office Protocol version 3) commands and responses + +;;; AUTHORIZATION STATE + +;; Initial TCP connection +;; Arguments: none +;; Restrictions: none +;; Possible responses: +;; +OK [POP3 server ready] + +;; USER name +;; Arguments: a server specific user-id (required) +;; Restrictions: authorization state [after unsuccessful USER or PASS +;; Possible responses: +;; +OK [valid user-id] +;; -ERR [invalid user-id] + +;; PASS string +;; Arguments: a server/user-id specific password (required) +;; Restrictions: authorization state, after successful USER +;; Possible responses: +;; +OK [maildrop locked and ready] +;; -ERR [invalid password] +;; -ERR [unable to lock maildrop] + +;;; TRANSACTION STATE + +;; STAT +;; Arguments: none +;; Restrictions: transaction state +;; Possible responses: +;; +OK nn mm [# of messages, size of maildrop] + +;; LIST [msg] +;; Arguments: a message-id (optional) +;; Restrictions: transaction state; msg must not be deleted +;; Possible responses: +;; +OK [scan listing follows] +;; -ERR [no such message] + +;; RETR msg +;; Arguments: a message-id (required) +;; Restrictions: transaction state; msg must not be deleted +;; Possible responses: +;; +OK [message contents follow] +;; -ERR [no such message] + +;; DELE msg +;; Arguments: a message-id (required) +;; Restrictions: transaction state; msg must not be deleted +;; Possible responses: +;; +OK [message deleted] +;; -ERR [no such message] + +;; NOOP +;; Arguments: none +;; Restrictions: transaction state +;; Possible responses: +;; +OK + +;; LAST +;; Arguments: none +;; Restrictions: transaction state +;; Possible responses: +;; +OK nn [highest numbered message accessed] + +;; RSET +;; Arguments: none +;; Restrictions: transaction state +;; Possible responses: +;; +OK [all delete marks removed] + +;;; UPDATE STATE + +;; QUIT +;; Arguments: none +;; Restrictions: none +;; Possible responses: +;; +OK [TCP connection closed] diff --git a/texi/ChangeLog b/texi/ChangeLog index ef39ddeed..9c6c01e82 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,8 @@ +Wed Mar 19 15:45:17 1997 Lars Magne Ingebrigtsen + + * gnus.texi (Various Summary Stuff): Addition. + (Mail Backend Variables): Addition. + Tue Mar 18 14:43:32 1997 Lars Magne Ingebrigtsen * gnus.texi (Article Washing): Not addition. diff --git a/texi/gnus.texi b/texi/gnus.texi index 8951586ab..4d153a42c 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Gnus 5.4.30 Manual +@settitle Gnus 5.4.31 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -287,7 +287,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Gnus 5.4.30 Manual +@title Gnus 5.4.31 Manual @author by Lars Magne Ingebrigtsen @page @@ -323,7 +323,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Gnus 5.4.30 +This manual corresponds to Gnus 5.4.31. @end ifinfo @@ -6761,6 +6761,17 @@ Is is called after the summary buffer has been generated. You might use it to, for instance, highlight lines or modify the look of the buffer in some other ungodly manner. I don't care. +@vindex gnus-summary-ignore-duplicates +@item gnus-summary-ignore-duplicates +When Gnus discovers two articles that have the same @code{Message-ID}, +it has to do something drastic. No articles are allowed to have the +same @code{Message-ID}, but this may happen when reading mail from some +sources. Gnus allows you to customize what happens with this variable. +If it is @code{nil} (which is the default), Gnus will rename the +@code{Message-ID} (for display purposes only) and display the article as +any other article. If this variable is @code{t}, it won't display the +article---it'll be as if it never existed. + @end table @@ -8862,6 +8873,12 @@ names. Groups like @samp{mail.misc} will end up in directories like @findex delete-file Function called to delete files. It is @code{delete-file} by default. +@item nnmail-cache-accepted-message-ids +@vindex nnmail-cache-accepted-message-ids +If non-@code{nil}, put the @code{Message-ID}s of articles imported into +the backend (via @code{Gcc}, for instance) into the mail duplication +discovery cache. The default is @code{nil}. + @end table diff --git a/texi/message.texi b/texi/message.texi index 82e91bab5..7e932e701 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Message Manual +@settitle Message 5.4.31 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -12,7 +12,7 @@ @ifinfo -This file documents Messa, the Emacs message composition mode. +This file documents Message, the Emacs message composition mode. Copyright (C) 1996 Free Software Foundation, Inc. @@ -39,7 +39,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Message Manual +@title Message 5.4.31 Manual @author by Lars Magne Ingebrigtsen @page @@ -79,6 +79,10 @@ buffers. * Key Index:: List of Message mode keys. @end menu +This manual corresponds to Message 5.4.31. Message is distributed with +the Gnus distribution bearing the same version number as this manual +has. + @node Interface @chapter Interface -- 2.25.1