From 698ed2619a929421f8746a12f278be996a9472f8 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Tue, 15 Jan 2002 02:04:26 +0000 Subject: [PATCH] Synch with Oort Gnus. --- ChangeLog | 8 ++ GNUS-NEWS | 19 +++- lisp/ChangeLog | 147 ++++++++++++++++++++++++++ lisp/flow-fill.el | 47 ++++++++- lisp/gnus-agent.el | 284 +++++++++++++++++++++++++++++++++++++++++++++----- lisp/gnus-art.el | 63 +++++++---- lisp/gnus-fun.el | 4 +- lisp/gnus-logic.el | 39 ++++--- lisp/gnus-msg.el | 17 +-- lisp/gnus-picon.el | 23 ++-- lisp/gnus-spec.el | 6 +- lisp/gnus-sum.el | 48 +++++---- lisp/gnus.el | 13 ++- lisp/imap.el | 4 +- lisp/message.el | 20 ++-- lisp/mm-view.el | 3 +- lisp/mml.el | 50 +++++++-- lisp/nnheader.el | 14 ++- lisp/nnimap.el | 43 +++++--- lisp/nnmail.el | 4 +- lisp/nntp.el | 21 ++-- lisp/nnvirtual.el | 17 +-- texi/ChangeLog | 23 ++++ texi/emacs-mime.texi | 27 ++++- texi/gnus-faq.texi | 2 +- texi/gnus-ja.texi | 46 ++++++-- texi/gnus.texi | 55 +++++++--- texi/message-ja.texi | 117 ++++++++++++++++++++- texi/message.texi | 116 ++++++++++++++++++++- 29 files changed, 1082 insertions(+), 198 deletions(-) diff --git a/ChangeLog b/ChangeLog index 15ab3ea..53e14d1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2002-01-15 Katsumi Yamaoka + + * lisp/nntp.el (nntp-send-buffer): Bind `mc-flag' to nil. + + * lisp/nnheader.el (mm-with-unibyte-buffer): Alias to + `nnheader-with-unibyte-buffer'. + (nnheader-with-unibyte-buffer): New macro. + 2002-01-12 Katsuhiro Hermit Endo * texi/gnus-ja.texi (Article Date): Update Japanese translation. diff --git a/GNUS-NEWS b/GNUS-NEWS index 1305042..4026b65 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -8,13 +8,30 @@ For older news, see Gnus info node "New Features". * Changes in Oort Gnus +** message-ignored-news-headers and message-ignored-mail-headers + +X-Draft-From and X-Gnus-Agent-Meta-Information have been added into +these two variables. If you customized those, perhaps you need add +those two headers too. + +** Gnus reads the NOV and articles in the Agent if plugged. + +If one reads an article while plugged, and the article already exists +in the Agent, it won't get downloaded once more. (setq +gnus-agent-cache nil) reverts to the old behavior. + +** Gnus supports the "format=flowed" (RFC 2646) parameter. + +On composing messages, it is enabled by `use-hard-newlines'. Decoding +format=flowed was present but not documented in earlier versions. + ** Gnus supports the generation of RFC 2298 Disposition Notification requests. This is invoked with the C-c M-n key binding from message mode. ** Gnus supports Maildir groups. -Gnus includes a new backend nnmaildir.el, by Paul Jarc. +Gnus includes a new backend nnmaildir.el. ** Printing capabilities are enhanced. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7afb59b..fc4282e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,150 @@ +2002-01-14 ShengHuo ZHU + + * gnus.el: We don't need gnus-article-show-all-headers. + + * gnus-art.el (article-show-all, gnus-article-show-all-header): + Ditto. + + * gnus-sum.el (gnus-summary-select-article): Don't call + show-all-headers, because hidden headers are not hidden text any + more. + +2002-01-13 Simon Josefsson + + * message.el (message-newline-and-reformat): Use `newline' instead + of inserting \n, so that the newline is marked as hard. + + * gnus-spec.el (gnus-pad-form): Don't evaluate EL multiple times. + From Jesper Harder . + +2002-01-12 ShengHuo ZHU + + * imap.el (imap-close): Keep going if quit. + + * gnus-agent.el (gnus-agent-retrieve-headers): Erase + nntp-server-buffer. + +2002-01-12 Lars Magne Ingebrigtsen + + * mm-view.el (mm-display-inline-fontify): Require font-lock to + avoid unbinding shadowed variables. + + * gnus-art.el (gnus-picon-databases): Moved here. + (gnus-picons-installed-p): Moved here. + (gnus-article-reply-with-original): Use `mark'. + + * gnus.el (gnus-picon): Moved here and renamed. + + * gnus-art.el (gnus-treat-from-picon): Only be on if picons are + installed. + (gnus-treat-mail-picon): Ditto. + (gnus-treat-newsgroups-picon): Ditto. + + * gnus-picon.el (gnus-picons-installed-p): New function. + +2002-01-12 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-go-online): Fix doc. + +2002-01-12 Simon Josefsson + + * nnimap.el (nnimap-need-unselect-to-notice-new-mail) + (nnimap-before-find-minmax-bugworkaround): Use it. + (nnimap-find-minmax-uid): Don't reselect current mailbox. + (nnimap-dont-close): New variable. + (nnimap-close-group): Use it. + +2002-01-12 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-reply-with-original): Use + `mark-active'. + + * gnus-msg.el (gnus-summary-reply): Don't bug out on regions. + + * gnus-logic.el (gnus-advanced-score-rule): Thinko fix. + (gnus-score-advanced): Clean up. + (gnus-score-advanced): Accept a multiple of the score. + +2002-01-12 Simon Josefsson + + * flow-fill.el (fill-flowed-display-column) + (fill-flowed-encode-columnq): New variables. Suggested by + Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,A_(Bjohann). + (fill-flowed-encode, fill-flowed): Use them. + + * message.el (message-send-news, message-send-mail): Use + m-b-s-n-p-e-h-n. + + * mml.el (autoload): Autoload fill-flowed-encode. + (mml-buffer-substring-no-properties-except-hard-newlines): New + function. + (mml-read-part): Use it. + (mml-generate-mime-1): Encode format=flowed if appropriate. + (mml-insert-mime-headers): Insert format=flowed. + + * flow-fill.el (fill-flowed-encode): New function. + (fill-flowed): Bind fill-column to window width. + +2002-01-12 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-buffer-name): Return the dead name if + it exists. + (gnus-summary-setup-buffer): Wake up dead summary buffers. + (gnus-summary-buffer-name): Don't return the dead name after all. + (gnus-summary-setup-buffer): Kill the dead buffer. + + * gnus-art.el (gnus-article-followup-with-original): Store the + value of the mark before deactivating it. + +2002-01-11 ShengHuo ZHU + + * gnus-fun.el (gnus-display-x-face-in-from): Fake it. + From: Karl Kleinpaste + + * gnus-art.el (article-display-x-face): Ditto. + (gnus-article-reply-with-original): Use gnus-region-active-p. + (gnus-article-followup-with-original): Ditto. + + * gnus-sum.el (gnus-summary-read-group-1): Don't select + downloadable article either. + +2002-01-11 ShengHuo ZHU + + * gnus-art.el (article-display-x-face): Insert From:. + + * gnus-sum.el (gnus-summary-move-article): Don't draw the + article. Bind gnus-display-mime-function and + gnus-article-prepare-hook. + + * gnus-agent.el (gnus-agent-retrieve-headers): Load agentview. + (gnus-agent-toggle-plugged): Use gnus-agent-go-online. Move + gnus-agent-possibly-synchronize-flags to the last. + (gnus-agent-go-online): New function. New variable. + +2002-01-11 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-regenerate-group): Add clean option. + (gnus-agent-regenerate): Ditto. + +2002-01-11 ShengHuo ZHU + + * message.el (message-ignored-news-headers) + (message-ignored-mail-headers): Add X-Gnus-Agent-Meta-Information:. + Suggested by ARISAWA Akihiro + + * gnus.el (gnus-gethash-safe): New macro. + + * gnus-agent.el (gnus-agent-regenerate-history): New function. + (gnus-agent-regenerate): Show messages. + +2002-01-11 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-regenerate-group): New function. + (gnus-agent-regenerate): New function. + (gnus-agent-save-alist): Sort. + (gnus-agent-copy-nov-line): Test eobp. + (gnus-agent-retrieve-headers): Erase buffer. + 2002-01-10 ShengHuo ZHU * mm-util.el (mm-charset-to-coding-system): Change charset to cs. diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el index bf9839d..dfe09c2 100644 --- a/lisp/flow-fill.el +++ b/lisp/flow-fill.el @@ -1,6 +1,6 @@ ;;; flow-fill.el --- interprete RFC2646 "flowed" text -;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: mail @@ -35,7 +35,7 @@ ;; paragraph and we let `fill-region' fill the long line into several ;; lines with the quote prefix as `fill-prefix'. -;; Todo: encoding, implement basic `fill-region' (Emacs and XEmacs +;; Todo: implement basic `fill-region' (Emacs and XEmacs ;; implementations differ..) ;;; History: @@ -46,11 +46,29 @@ ;; 2000-03-26 commited to gnus cvs ;; 2000-10-23 don't flow "-- " lines, make "quote-depth wins" rule ;; work when first line is at level 0. +;; 2002-01-12 probably incomplete encoding support ;;; Code: (eval-when-compile (require 'cl)) +(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." + :type '(choice (const :tag "Standard `fill-column'" fill-column) + (const :tag "Fit Window" (- (window-width) 5)) + (sexp) + (integer))) + +(defcustom fill-flowed-encode-column 66 + "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." + :type '(choice (const :tag "Standard fill-column" fill-column) + (const :tag "RFC 2646 default (66)" 66) + (sexp) + (integer))) + (eval-and-compile (defalias 'fill-flowed-point-at-bol (if (fboundp 'point-at-bol) @@ -62,6 +80,27 @@ 'point-at-eol 'line-end-position))) +(defun fill-flowed-encode (&optional buffer) + (with-current-buffer (or buffer (current-buffer)) + ;; No point in doing this unless hard newlines is used. + (when use-hard-newlines + (let ((start (point-min)) end) + ;; Go through each paragraph, filling it and adding SPC + ;; as the last character on each line. + (while (setq end (text-property-any start (point-max) 'hard 't)) + (let ((fill-column (eval fill-flowed-encode-column))) + (fill-region start end t 'nosqueeze 'to-eop)) + (goto-char start) + ;; `fill-region' probably distorted end. + (setq end (text-property-any start (point-max) 'hard 't)) + (while (and (< (point) end) + (re-search-forward "$" (1- end) t)) + (insert " ") + (setq end (1+ end)) + (forward-char)) + (goto-char (setq start (1+ end))))) + t))) + (defun fill-flowed (&optional buffer) (save-excursion (set-buffer (or (current-buffer) buffer)) @@ -79,6 +118,7 @@ (beginning-of-line) (when (> (skip-chars-forward ">") 0) (insert " ")))) + ;; XXX slightly buggy handling of "-- " (while (and (save-excursion (ignore-errors (backward-char 3)) (setq sig (looking-at "-- ")) @@ -94,7 +134,8 @@ (backward-delete-char -1) (end-of-line)) (unless sig - (let ((fill-prefix (when quote (concat quote " ")))) + (let ((fill-prefix (when quote (concat quote " "))) + (fill-column (eval fill-flowed-display-column))) (fill-region (fill-flowed-point-at-bol) (min (1+ (fill-flowed-point-at-eol)) (point-max)) 'left 'nosqueeze)))))))) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 80f70dc..dddf2b1 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -130,6 +130,15 @@ If this is `ask' the hook will query the user." (const :tag "Ask" ask)) :group 'gnus-agent) +(defcustom gnus-agent-go-online 'ask + "Indicate if offline servers go online when you plug in. +If this is `ask' the hook will query the user." + :version "21.1" + :type '(choice (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "Ask" ask)) + :group 'gnus-agent) + ;;; Internal variables (defvar gnus-agent-history-buffers nil) @@ -343,12 +352,13 @@ If this is `ask' the hook will query the user." (if plugged (progn (setq gnus-plugged plugged) - (gnus-agent-possibly-synchronize-flags) (gnus-run-hooks 'gnus-agent-plugged-hook) (setcar (cdr gnus-agent-mode-status) (gnus-agent-make-mode-line-string " Plugged" 'mouse-2 - 'gnus-agent-toggle-plugged))) + 'gnus-agent-toggle-plugged)) + (gnus-agent-go-online gnus-agent-go-online) + (gnus-agent-possibly-synchronize-flags)) (gnus-agent-close-connections) (setq gnus-plugged plugged) (gnus-run-hooks 'gnus-agent-unplugged-hook) @@ -1057,14 +1067,15 @@ the actual number of articles toggled is returned." (defsubst gnus-agent-copy-nov-line (article) (let (b e) (set-buffer gnus-agent-overview-buffer) - (setq b (point)) - (if (eq article (read (current-buffer))) - (setq e (progn (forward-line 1) (point))) - (progn - (beginning-of-line) - (setq e b))) - (set-buffer nntp-server-buffer) - (insert-buffer-substring gnus-agent-overview-buffer b e))) + (unless (eobp) + (setq b (point)) + (if (eq article (read (current-buffer))) + (setq e (progn (forward-line 1) (point))) + (progn + (beginning-of-line) + (setq e b))) + (set-buffer nntp-server-buffer) + (insert-buffer-substring gnus-agent-overview-buffer b e)))) (defun gnus-agent-braid-nov (group articles file) (set-buffer gnus-agent-overview-buffer) @@ -1115,15 +1126,17 @@ the actual number of articles toggled is returned." "Save the article-state alist for GROUP." (let ((file-name-coding-system nnmail-pathname-coding-system) (pathname-coding-system nnmail-pathname-coding-system) - print-level print-length) + print-level print-length item) + (dolist (art articles) + (if (setq item (memq art gnus-agent-article-alist)) + (setcdr item state) + (push (cons art state) gnus-agent-article-alist))) + (setq gnus-agent-article-alist + (sort gnus-agent-article-alist 'car-less-than-car)) (with-temp-file (if dir (expand-file-name ".agentview" dir) (gnus-agent-article-name ".agentview" group)) - (princ (setq gnus-agent-article-alist - (nconc gnus-agent-article-alist - (mapcar (lambda (article) (cons article state)) - articles))) - (current-buffer)) + (princ gnus-agent-article-alist (current-buffer)) (insert "\n")))) (defun gnus-agent-article-name (article group) @@ -1757,9 +1770,10 @@ The following commands are available: (gnus-range-add (nth 2 info) (cons 1 (- (caar gnus-agent-article-alist) 1))))) - ;; Maybe everything has been expired from `gnus-article-alist' - ;; and so the above marking as read could not be conducted, - ;; or there are expired article within the range of the alist. + ;; Maybe everything has been expired from + ;; `gnus-article-alist' and so the above marking as + ;; read could not be conducted, or there are + ;; expired article within the range of the alist. (when (and info expired (or (not (caar gnus-agent-article-alist)) @@ -1804,33 +1818,38 @@ The following commands are available: (file (gnus-agent-article-name ".overview" group)) cached-articles uncached-articles) (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file) t)) + (file-name-directory file) t)) (when (file-exists-p file) (with-current-buffer gnus-agent-overview-buffer (erase-buffer) - (nnheader-insert-file-contents file) - (goto-char (point-min)) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file)) + (goto-char (point-min)) (while (not (eobp)) (when (looking-at "[0-9]") (push (read (current-buffer)) cached-articles)) (forward-line 1)) (setq cached-articles (sort cached-articles '<)))) - (when (setq uncached-articles + (when (setq uncached-articles (gnus-set-difference articles cached-articles)) + (set-buffer nntp-server-buffer) + (erase-buffer) (let (gnus-agent-cache) - (unless (eq 'nov - (gnus-retrieve-headers + (unless (eq 'nov + (gnus-retrieve-headers uncached-articles group fetch-old)) (nnvirtual-convert-headers))) + (set-buffer gnus-agent-overview-buffer) + (erase-buffer) (set-buffer nntp-server-buffer) - (with-current-buffer gnus-agent-overview-buffer - (erase-buffer)) (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) (when (and uncached-articles (file-exists-p file)) (gnus-agent-braid-nov group uncached-articles file)) (write-region-as-coding-system gnus-agent-file-coding-system (point-min) (point-max) file nil 'silent) + (gnus-agent-load-alist group) (gnus-agent-save-alist group uncached-articles nil) (gnus-agent-open-history) (setq gnus-agent-current-history (gnus-agent-history-buffer)) @@ -1840,6 +1859,7 @@ The following commands are available: (time-to-days (current-time))) (gnus-agent-save-history))) (set-buffer nntp-server-buffer) + (erase-buffer) (insert-buffer-substring gnus-agent-overview-buffer) (if (and fetch-old (not (numberp fetch-old))) @@ -1865,6 +1885,216 @@ The following commands are available: (insert-file-contents-as-coding-system gnus-cache-coding-system file) t))) +(defun gnus-agent-regenerate-group (group &optional clean) + "Regenerate GROUP." + (let ((dir (concat (gnus-agent-directory) + (gnus-agent-group-path group) "/")) + (file (gnus-agent-article-name ".overview" group)) + n point arts alist header new-alist changed) + (when (file-exists-p dir) + (setq arts + (sort (mapcar (lambda (name) (string-to-int name)) + (directory-files dir nil "^[0-9]+$" t)) + '<))) + (gnus-make-directory (nnheader-translate-file-chars + (file-name-directory file) t)) + (mm-with-unibyte-buffer + (if (file-exists-p file) + (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file))) + (goto-char (point-min)) + (while (not (eobp)) + (while (not (or (eobp) (looking-at "[0-9]"))) + (setq point (point)) + (forward-line 1) + (delete-region point (point))) + (unless (eobp) + (setq n (read (current-buffer))) + (when (and arts (> n (car arts))) + (beginning-of-line) + (while (and arts (> n (car arts))) + (message "Regenerating NOV %s %d..." group (car arts)) + (mm-with-unibyte-buffer + (nnheader-insert-file-contents + (concat dir (number-to-string (car arts)))) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (delete-region (point) (point-max)) + (goto-char (point-max))) + (setq header (nnheader-parse-head t))) + (mail-header-set-number header (car arts)) + (nnheader-insert-nov header) + (setq changed t) + (push (cons (car arts) t) alist) + (pop arts))) + (if (and arts (= n (car arts))) + (progn + (push (cons n t) alist) + (pop arts)) + (push (cons n nil) alist)) + (forward-line 1))) + (if changed + (write-region-as-coding-system gnus-agent-file-coding-system + (point-min) (point-max) + file nil 'silent))) + (setq gnus-agent-article-alist nil) + (unless clean + (gnus-agent-load-alist group)) + (setq alist (sort alist 'car-less-than-car)) + (setq gnus-agent-article-alist (sort gnus-agent-article-alist + 'car-less-than-car)) + (while (and alist gnus-agent-article-alist) + (cond + ((< (caar alist) (caar gnus-agent-article-alist)) + (push (pop alist) new-alist)) + ((> (caar alist) (caar gnus-agent-article-alist)) + (push (list (car (pop gnus-agent-article-alist))) new-alist)) + (t + (pop gnus-agent-article-alist) + (while (and gnus-agent-article-alist + (= (caar alist) (caar gnus-agent-article-alist))) + (pop gnus-agent-article-alist)) + (push (pop alist) new-alist)))) + (while alist + (push (pop alist) new-alist)) + (while gnus-agent-article-alist + (push (list (car (pop gnus-agent-article-alist))) new-alist)) + (setq gnus-agent-article-alist (nreverse new-alist)) + (gnus-agent-save-alist group))) + +(defun gnus-agent-regenerate-history (group article) + (let ((file (concat (gnus-agent-directory) + (gnus-agent-group-path group) "/" + (number-to-string article))) id) + (mm-with-unibyte-buffer + (nnheader-insert-file-contents file) + (message-narrow-to-head) + (goto-char (point-min)) + (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t)) + (setq id "No-Message-ID-in-article") + (setq id (buffer-substring (match-beginning 1) (match-end 1)))) + (gnus-agent-enter-history + id (list (cons group article)) + (time-to-days (nth 5 (file-attributes file))))))) + +;;;###autoload +(defun gnus-agent-regenerate (&optional clean) + "Regenerate all agent covered files. +If CLEAN, don't read existing active and agentview files." + (interactive "P") + (message "Regenerating Gnus agent files...") + (dolist (gnus-command-method gnus-agent-covered-methods) + (let ((active-file (gnus-agent-lib-file "active")) + history-hashtb active-hashtb active-changed + history-changed point) + (gnus-make-directory (file-name-directory active-file)) + (if clean + (setq active-hashtb (gnus-make-hashtable 1000)) + (mm-with-unibyte-buffer + (if (file-exists-p active-file) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-file-contents active-file)) + (setq active-changed t)) + (gnus-active-to-gnus-format + nil (setq active-hashtb + (gnus-make-hashtable + (count-lines (point-min) (point-max))))))) + (gnus-agent-open-history) + (setq history-hashtb (gnus-make-hashtable 1000)) + (with-current-buffer + (setq gnus-agent-current-history (gnus-agent-history-buffer)) + (goto-char (point-min)) + (forward-line 1) + (while (not (eobp)) + (if (looking-at + "\\([^\t\n]+\\)\t[0-9]+\t\\([^ \n]+\\) \\([0-9]+\\)") + (progn + (unless (string= (match-string 1) + "last-header-fetched-for-session") + (gnus-sethash (match-string 2) + (cons (string-to-number (match-string 3)) + (gnus-gethash-safe (match-string 2) + history-hashtb)) + history-hashtb)) + (forward-line 1)) + (setq point (point)) + (forward-line 1) + (delete-region point (point)) + (setq history-changed t)))) + (dolist (group (gnus-groups-from-server gnus-command-method)) + (gnus-agent-regenerate-group group clean) + (let ((min (or (caar gnus-agent-article-alist) 1)) + (max (or (caar (last gnus-agent-article-alist)) 0)) + (active (gnus-gethash-safe (gnus-group-real-name group) + active-hashtb))) + (if (not active) + (progn + (setq active (cons min max) + active-changed t) + (gnus-sethash group active active-hashtb)) + (when (> (car active) min) + (setcar active min) + (setq active-changed t)) + (when (< (cdr active) max) + (setcdr active max) + (setq active-changed t)))) + (let ((arts (sort (gnus-gethash-safe group history-hashtb) '<)) + n) + (gnus-sethash group arts history-hashtb) + (while (and arts gnus-agent-article-alist) + (cond + ((> (car arts) (caar gnus-agent-article-alist)) + (when (cdar gnus-agent-article-alist) + (gnus-agent-regenerate-history + group (caar gnus-agent-article-alist)) + (setq history-changed t)) + (setq n (car (pop gnus-agent-article-alist))) + (while (and gnus-agent-article-alist + (= n (caar gnus-agent-article-alist))) + (pop gnus-agent-article-alist))) + ((< (car arts) (caar gnus-agent-article-alist)) + (setq n (pop arts)) + (while (and arts (= n (car arts))) + (pop arts))) + (t + (setq n (car (pop gnus-agent-article-alist))) + (while (and gnus-agent-article-alist + (= n (caar gnus-agent-article-alist))) + (pop gnus-agent-article-alist)) + (setq n (pop arts)) + (while (and arts (= n (car arts))) + (pop arts))))) + (while gnus-agent-article-alist + (when (cdar gnus-agent-article-alist) + (gnus-agent-regenerate-history + group (caar gnus-agent-article-alist)) + (setq history-changed t)) + (pop gnus-agent-article-alist)))) + (when history-changed + (message "Regenerate the history file of %s:%s" + (car gnus-command-method) + (cadr gnus-command-method)) + (gnus-agent-save-history)) + (gnus-agent-close-history) + (when active-changed + (message "Regenerate %s" active-file) + (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system)) + (gnus-write-active-file active-file active-hashtb))))) + (message "Regenerating Gnus agent files...done")) + +(defun gnus-agent-go-online (&optional force) + "Switch servers into online status." + (interactive (list t)) + (dolist (server gnus-opened-servers) + (when (eq (nth 1 server) 'offline) + (if (if (eq force 'ask) + (gnus-y-or-n-p + (format "Switch %s:%s into online status? " + (caar server) (cadar server))) + force) + (setcar (nthcdr 1 server) 'close))))) + (provide 'gnus-agent) ;;; gnus-agent.el ends here diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 233d66f..e7e1e8c 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -753,6 +753,21 @@ be controlled by `gnus-treat-body-boundary'." :type '(choice (item :tag "None" :value nil) string)) +(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces") + "*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" + :type 'directory + :group 'gnus-picon) + +(defun gnus-picons-installed-p () + "Say whether picons are installed on your machine." + (let ((installed nil)) + (dolist (database gnus-picon-databases) + (when (file-exists-p database) + (setq installed t))) + installed)) + (defcustom gnus-article-mime-part-function nil "Function called with a MIME handle as the argument. This is meant for people who want to do something automatic based @@ -1160,7 +1175,8 @@ See Info node `(gnus)Customizing Articles' and Info node (put 'gnus-treat-display-smileys 'highlight t) (defcustom gnus-treat-from-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in the From header. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -1171,7 +1187,8 @@ See Info node `(gnus)Customizing Articles' and Info node (put 'gnus-treat-from-picon 'highlight t) (defcustom gnus-treat-mail-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in To and Cc headers. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -1182,7 +1199,8 @@ See Info node `(gnus)Customizing Articles' and Info node (put 'gnus-treat-mail-picon 'highlight t) (defcustom gnus-treat-newsgroups-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in the Newsgroups and Followup-To headers. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -2021,6 +2039,9 @@ unfolded." (when xpm (setq image (gnus-create-image xpm 'xpm t)) (gnus-article-goto-header "from") + (when (bobp) + (insert "From: [no `from' set]\n") + (forward-char -17)) (gnus-add-wash-type 'xface) (gnus-add-image 'xface image) (gnus-put-image image))) @@ -2869,15 +2890,15 @@ This format is defined by the `gnus-article-time-format' variable." (interactive (list t)) (article-date-ut 'iso8601 highlight)) -(defun article-show-all () - "Show all hidden text in the article buffer." - (interactive) - (save-excursion - (widen) - (let ((buffer-read-only nil)) - (gnus-article-unhide-text (point-min) (point-max)) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next)))) +;; (defun article-show-all () +;; "Show all hidden text in the article buffer." +;; (interactive) +;; (save-excursion +;; (widen) +;; (let ((buffer-read-only nil)) +;; (gnus-article-unhide-text (point-min) (point-max)) +;; (gnus-remove-text-with-property 'gnus-prev) +;; (gnus-remove-text-with-property 'gnus-next)))) (defun article-show-all-headers () "Show all hidden headers in the article buffer." @@ -3396,7 +3417,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-treat-dumbquotes article-normalize-headers (article-show-all-headers . gnus-article-show-all-headers) - (article-show-all . gnus-article-show-all)))) +;; (article-show-all . gnus-article-show-all) + ))) ;;; ;;; Gnus article mode @@ -5115,30 +5137,33 @@ Argument LINES specifies lines to be scrolled down." The text in the region will be yanked. If the region isn't active, the entire article will be yanked." (interactive "P") - (let ((article (cdr gnus-article-current))) - (if (not mark-active) + (let ((article (cdr gnus-article-current)) cont) + (if (not (mark)) (gnus-summary-reply (list (list article)) wide) + (setq cont (buffer-substring (point) (mark))) ;; Deactivate active regions. (when (and (boundp 'transient-mark-mode) transient-mark-mode) (setq mark-active nil)) (gnus-summary-reply - (list (list article (buffer-substring (point) (mark)))) wide)))) + (list (list article cont)) wide)))) (defun gnus-article-followup-with-original () "Compose a followup to the current article. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." (interactive) - (let ((article (cdr gnus-article-current))) - (if (not mark-active) + (let ((article (cdr gnus-article-current)) + cont) + (if (not (gnus-region-active-p)) (gnus-summary-followup (list (list article))) + (setq cont (buffer-substring (point) (mark))) ;; Deactivate active regions. (when (and (boundp 'transient-mark-mode) transient-mark-mode) (setq mark-active nil)) (gnus-summary-followup - (list (list article (buffer-substring (point) (mark)))))))) + (list (list article cont)))))) (defun gnus-article-hide (&optional arg force) "Hide all the gruft in the current article. diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el index 50139b9..5b32a8c 100644 --- a/lisp/gnus-fun.el +++ b/lisp/gnus-fun.el @@ -177,8 +177,8 @@ colors of the displayed X-Faces." (article-narrow-to-head) (gnus-article-goto-header "from") (when (bobp) - (insert "From: \n") - (forward-char -2)) + (insert "From: [no `from' set]\n") + (forward-char -17)) (gnus-add-image 'xface (gnus-put-image diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el index 13c9a20..77fc948 100644 --- a/lisp/gnus-logic.el +++ b/lisp/gnus-logic.el @@ -1,5 +1,5 @@ ;;; gnus-logic.el --- advanced scoring code for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -59,21 +59,21 @@ (defun gnus-score-advanced (rule &optional trace) "Apply advanced scoring RULE to all the articles in the current group." - (let ((headers gnus-newsgroup-headers) - gnus-advanced-headers score) - (while (setq gnus-advanced-headers (pop headers)) - (when (gnus-advanced-score-rule (car rule)) - ;; This rule was successful, so we add the score to - ;; this article. + (let (new-score score multiple) + (dolist (gnus-advanced-headers gnus-newsgroup-headers) + (when (setq multiple (gnus-advanced-score-rule (car rule))) + (setq new-score (or (nth 1 rule) + gnus-score-interactive-default-score)) + (when (numberp multiple) + (setq new-score (* multiple new-score))) + ;; This rule was successful, so we add the score to this + ;; article. (if (setq score (assq (mail-header-number gnus-advanced-headers) gnus-newsgroup-scored)) (setcdr score - (+ (cdr score) - (or (nth 1 rule) - gnus-score-interactive-default-score))) + (+ (cdr score) new-score)) (push (cons (mail-header-number gnus-advanced-headers) - (or (nth 1 rule) - gnus-score-interactive-default-score)) + new-score) gnus-newsgroup-scored) (when trace (push (cons "A file" rule) @@ -116,7 +116,7 @@ ;; 1- type redirection. (string-to-number (substring (symbol-name type) - (match-beginning 0) (match-end 0))) + (match-beginning 1) (match-end 1))) ;; ^^^ type redirection. (length (symbol-name type)))))) (when gnus-advanced-headers @@ -129,9 +129,8 @@ (error "Unknown advanced score type: %s" rule))))) (defun gnus-advanced-score-article (rule) - ;; `rule' is a semi-normal score rule, so we find out - ;; what function that's supposed to do the actual - ;; processing. + ;; `rule' is a semi-normal score rule, so we find out what function + ;; that's supposed to do the actual processing. (let* ((header (car rule)) (func (assoc (downcase header) gnus-advanced-index))) (if (not func) @@ -189,8 +188,8 @@ 'gnus-request-body) (t 'gnus-request-article))) ofunc article) - ;; Not all backends support partial fetching. In that case, - ;; we just fetch the entire article. + ;; Not all backends support partial fetching. In that case, we + ;; just fetch the entire article. (unless (gnus-check-backend-function (intern (concat "request-" header)) gnus-newsgroup-name) @@ -201,8 +200,8 @@ (when (funcall request-func article gnus-newsgroup-name) (goto-char (point-min)) ;; If just parts of the article is to be searched and the - ;; backend didn't support partial fetching, we just narrow - ;; to the relevant parts. + ;; backend didn't support partial fetching, we just narrow to + ;; the relevant parts. (when ofunc (if (eq ofunc 'gnus-request-head) (narrow-to-region diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 529b7dd..21a845e 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1035,14 +1035,15 @@ If VERY-WIDE, make a very wide reply." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1)))) - ;; Stripping headers should be specified with mail-yank-ignored-headers. - (when yank - (gnus-summary-goto-subject - (if (listp (car yank)) - (caar yank) - (car yank)))) - (let ((gnus-article-reply (or yank (gnus-summary-article-number))) - (headers "")) + (let* ((article + (if (listp (car yank)) + (caar yank) + (car yank))) + (gnus-article-reply (or article (gnus-summary-article-number))) + (headers "")) + ;; Stripping headers should be specified with mail-yank-ignored-headers. + (when yank + (gnus-summary-goto-subject article)) (gnus-setup-message (if yank 'reply-yank 'reply) (if (not very-wide) (gnus-summary-select-article) diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index e4e2529..0770899 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -46,32 +46,21 @@ ;;; User variables: -(defgroup picon nil - "Show pictures of people, domains, and newsgroups." - :group 'gnus-visual) - -(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces") - "*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" - :type 'directory - :group 'picon) - (defcustom gnus-picon-news-directories '("news") "*List of directories to search for newsgroups faces." :type '(repeat string) - :group 'picon) + :group 'gnus-picon) (defcustom gnus-picon-user-directories '("users" "usenix" "local" "misc") "*List of directories to search for user faces." :type '(repeat string) - :group 'picon) + :group 'gnus-picon) (defcustom gnus-picon-domain-directories '("domains") "*List of directories to search for domain faces. Some people may want to add \"unknown\" to this list." :type '(repeat string) - :group 'picon) + :group 'gnus-picon) (defcustom gnus-picon-file-types (let ((types (list "xbm"))) @@ -82,15 +71,15 @@ Some people may want to add \"unknown\" to this list." types) "*List of suffixes on picon file names to try." :type '(repeat string) - :group 'picon) + :group 'gnus-picon) (defface gnus-picon-xbm-face '((t (:foreground "black" :background "white"))) "Face to show xbm picon in." - :group 'picon) + :group 'gnus-picon) (defface gnus-picon-face '((t (:foreground "black" :background "white"))) "Face to show picon in." - :group 'picon) + :group 'gnus-picon) ;;; Internal variables: diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 9bf64e6..0e71016 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -404,12 +404,12 @@ characters when given a pad value." `(let* ((val (eval ,el)) (need (- ,pad (,(if gnus-use-correct-string-widths 'gnus-correct-length - 'length) ,el)))) + 'length) val)))) (if (> need 0) (concat ,(when side '(make-string need ?\ )) - ,el + val ,(when (not side) '(make-string need ?\ ))) - ,el))))) + val))))) (defun gnus-parse-format (format spec-alist &optional insert) ;; This function parses the FORMAT string with the help of the diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 5d0baf4..6fd381a 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -2825,7 +2825,12 @@ display only a single character." (defun gnus-summary-setup-buffer (group) "Initialize summary buffer." - (let ((buffer (gnus-summary-buffer-name group))) + (let ((buffer (gnus-summary-buffer-name group)) + (dead-name (concat "*Dead Summary " + (gnus-group-decoded-name group) "*"))) + ;; If a dead summary buffer exists, we kill it. + (when (gnus-buffer-live-p dead-name) + (gnus-kill-buffer dead-name)) (if (get-buffer buffer) (progn (set-buffer buffer) @@ -3314,7 +3319,8 @@ If SHOW-ALL is non-nil, already read articles are also listed." (progn (gnus-configure-windows 'summary) (let ((art (gnus-summary-article-number))) - (unless (memq art gnus-newsgroup-undownloaded) + (unless (or (memq art gnus-newsgroup-undownloaded) + (memq art gnus-newsgroup-downloadable)) (gnus-summary-goto-article art)))) ;; Don't select any articles. (gnus-summary-position-point) @@ -6281,17 +6287,20 @@ The state which existed when entering the ephemeral is reset." (set-buffer buffer) (gnus-kill-buffer gnus-article-buffer) (gnus-kill-buffer gnus-original-article-buffer))) - (cond (gnus-kill-summary-on-exit - (when (and gnus-use-trees - (gnus-buffer-exists-p buffer)) - (save-excursion - (set-buffer buffer) - (gnus-tree-close gnus-newsgroup-name))) - (gnus-kill-buffer buffer)) - ((gnus-buffer-exists-p buffer) - (save-excursion - (set-buffer buffer) - (gnus-deaden-summary)))))) + (cond + ;; Kill the buffer. + (gnus-kill-summary-on-exit + (when (and gnus-use-trees + (gnus-buffer-exists-p buffer)) + (save-excursion + (set-buffer buffer) + (gnus-tree-close gnus-newsgroup-name))) + (gnus-kill-buffer buffer)) + ;; Deaden the buffer. + ((gnus-buffer-exists-p buffer) + (save-excursion + (set-buffer buffer) + (gnus-deaden-summary)))))) (defun gnus-summary-wake-up-the-dead (&rest args) "Wake up the dead summary buffer." @@ -6567,13 +6576,14 @@ be displayed." ;; The requested article is different from the current article. (progn (gnus-summary-display-article article all-headers) - (when (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers)) +;;; Hidden headers are not hidden text any more. +;; (when (or all-headers gnus-show-all-headers) +;; (gnus-article-show-all-headers)) (gnus-article-set-window-start (cdr (assq article gnus-newsgroup-bookmarks))) article) - (when (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers)) +;; (when (or all-headers gnus-show-all-headers) +;; (gnus-article-show-all-headers)) 'old)))) (defun gnus-summary-force-verify-and-decrypt () @@ -8365,7 +8375,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;; `gnus-read-move-group-name' an opportunity to suggest an ;; appropriate default. (unless (gnus-buffer-live-p gnus-original-article-buffer) - (gnus-summary-select-article nil nil nil (car articles))) + (let ((gnus-display-mime-function nil) + (gnus-article-prepare-hook nil)) + (gnus-summary-select-article nil nil nil (car articles)))) ;; Read the newsgroup name. (when (and (not to-newsgroup) (not select-method)) diff --git a/lisp/gnus.el b/lisp/gnus.el index 2853334..12ea662 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -144,6 +144,10 @@ :link '(custom-manual "(gnus)Summary Maneuvering") :group 'gnus-summary) +(defgroup gnus-picon nil + "Show pictures of people, domains, and newsgroups." + :group 'gnus-visual) + (defgroup gnus-summary-mail nil "Mail group commands." :link '(custom-manual "(gnus)Mail Group Commands") @@ -2182,7 +2186,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed - gnus-article-show-all-headers gnus-article-show-all + gnus-article-show-all-headers + ;; gnus-article-show-all gnus-article-edit-mode gnus-article-edit-article gnus-article-edit-done article-decode-encoded-words gnus-start-date-timer gnus-stop-date-timer @@ -2361,6 +2366,12 @@ See (gnus)Formatting Variables." "Get hash value of STRING in HASHTABLE." `(symbol-value (intern-soft ,string ,hashtable))) +(defmacro gnus-gethash-safe (string hashtable) + "Get hash value of STRING in HASHTABLE. +Return nil if not defined." + `(let ((sym (intern-soft ,string ,hashtable))) + (and (boundp sym) (symbol-value sym)))) + (defmacro gnus-sethash (string value hashtable) "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." `(set (intern ,string ,hashtable) ,value)) diff --git a/lisp/imap.el b/lisp/imap.el index 1aa9265..0164f85 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -1017,7 +1017,9 @@ password is remembered in the buffer." If BUFFER is nil, the current buffer is used." (with-current-buffer (or buffer (current-buffer)) (when (imap-opened) - (imap-send-command-wait "LOGOUT")) + (condition-case nil + (imap-send-command-wait "LOGOUT") + (quit nil))) (when (and imap-process (memq (process-status imap-process) '(open run))) (delete-process imap-process)) diff --git a/lisp/message.el b/lisp/message.el index 2118617..84e9df9 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -247,14 +247,14 @@ included. Organization, Lines and User-Agent are optional." :type 'sexp) (defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:" + "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news :group 'message-headers :type 'regexp) (defcustom message-ignored-mail-headers - "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:" + "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" "*Regexp of headers to be removed unconditionally before mailing." :group 'message-mail :group 'message-headers @@ -2340,10 +2340,14 @@ Prefix arg means justify as well." (if not-break (setq point nil) (if bolp - (insert "\n") - (insert "\n\n")) + (newline) + (newline) + (newline)) (setq point (point)) - (insert "\n\n") + ;; (newline 2) doesn't mark both newline's as hard, so call + ;; newline twice. -jas + (newline) + (newline) (delete-region (point) (re-search-forward "[ \t]*")) (when (and quoted (not bolp)) (insert quoted leading-space))) @@ -3003,7 +3007,7 @@ It should typically alter the sending method in some way or other." (save-excursion (set-buffer message-encoding-buffer) (erase-buffer) - ;; ;; Avoid copying text props. + ;; ;; Avoid copying text props (except hard newlines). ;; T-gnus change: copy all text props from the editing buffer ;; into the encoding buffer. (insert-buffer message-edit-buffer) @@ -3313,6 +3317,9 @@ This sub function is for exclusive use of `message-send-mail'." (save-excursion (set-buffer tembuf) (erase-buffer) + ;; ;; Avoid copying text props (except hard newlines). + ;; T-gnus change: copy all text props from the editing buffer + ;; into the encoding buffer. (insert-buffer message-encoding-buffer) ;; Remove some headers. (save-restriction @@ -3321,7 +3328,6 @@ This sub function is for exclusive use of `message-send-mail'." ;; ;; We (re)generate the Lines header. ;; (when (memq 'Lines message-required-mail-headers) ;; (message-generate-headers '(Lines))) - ;; Remove some headers. (message-remove-header message-ignored-mail-headers t)) (goto-char (point-max)) ;; require one newline at the end. diff --git a/lisp/mm-view.el b/lisp/mm-view.el index af5386f..192b94f 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -1,5 +1,5 @@ ;;; mm-view.el --- functions for viewing MIME objects -;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -296,6 +296,7 @@ (buffer-disable-undo) (mm-insert-part handle) (funcall mode) + (require 'font-lock) (let ((font-lock-verbose nil)) ;; I find font-lock a bit too verbose. (font-lock-fontify-buffer)) diff --git a/lisp/mml.el b/lisp/mml.el index 2cd66ba..1a94898 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -35,6 +35,7 @@ (autoload 'gnus-setup-posting-charset "gnus-msg") (autoload 'gnus-add-minor-mode "gnus-ems") (autoload 'message-fetch-field "message") + (autoload 'fill-flowed-encode "flow-fill") (autoload 'message-posting-charset "message")) (defcustom mml-content-type-parameters @@ -286,6 +287,15 @@ A message part needs to be split into %d charset parts. Really send? " (setq contents (append (list (cons 'tag-location orig-point)) contents)) (cons (intern name) (nreverse contents)))) +(defun mml-buffer-substring-no-properties-except-hard-newlines (start end) + (let ((str (buffer-substring-no-properties start end)) + (bufstart start) tmp) + (while (setq tmp (text-property-any start end 'hard 't)) + (set-text-properties (- tmp bufstart) (- tmp bufstart -1) + '(hard t) str) + (setq start (1+ tmp))) + str)) + (defun mml-read-part (&optional mml) "Return the buffer up till the next part, multipart or closing part or multipart. If MML is non-nil, return the buffer up till the correspondent mml tag." @@ -299,19 +309,22 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (if (re-search-forward "<#\\(/\\)?mml." nil t) (setq count (+ count (if (match-beginning 1) -1 1))) (goto-char (point-max)))) - (buffer-substring-no-properties beg (if (> count 0) - (point) - (match-beginning 0)))) + (mml-buffer-substring-no-properties-except-hard-newlines + beg (if (> count 0) + (point) + (match-beginning 0)))) (if (re-search-forward "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) (prog1 - (buffer-substring-no-properties beg (match-beginning 0)) + (mml-buffer-substring-no-properties-except-hard-newlines + beg (match-beginning 0)) (if (or (not (match-beginning 1)) (equal (match-string 2) "multipart")) (goto-char (match-beginning 0)) (when (looking-at "[ \t]*\n") (forward-line 1)))) - (buffer-substring-no-properties beg (goto-char (point-max))))))) + (mml-buffer-substring-no-properties-except-hard-newlines + beg (goto-char (point-max))))))) (defvar mml-boundary nil) (defvar mml-base-boundary "-=-=") @@ -340,7 +353,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (cond ((or (eq (car cont) 'part) (eq (car cont) 'mml)) (let ((raw (cdr (assq 'raw cont))) - coded encoding charset filename type) + coded encoding charset filename type flowed) (setq type (or (cdr (assq 'type cont)) "text/plain")) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) @@ -387,8 +400,24 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (setq charset (mm-encode-body charset)) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont)))))) + ;; Only perform format=flowed filling on text/plain + ;; parts where there either isn't a format parameter + ;; in the mml tag or it says "flowed" and there + ;; actually are hard newlines in the text. + (let (use-hard-newlines) + (when (and (string= type "text/plain") + (or (null (assq 'format cont)) + (string= (assq 'format cont) "flowed")) + (setq use-hard-newlines + (text-property-any + (point-min) (point-max) 'hard 't))) + (fill-flowed-encode) + ;; Indicate that `mml-insert-mime-headers' should + ;; insert a "; format=flowed" string unless the + ;; user has already specified it. + (setq flowed (null (assq 'format cont))))) (setq coded (buffer-string))) - (mml-insert-mime-headers cont type charset encoding) + (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (mm-with-unibyte-buffer @@ -403,7 +432,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (insert (cdr (assq 'contents cont))))) (setq encoding (mm-encode-buffer type) coded (mm-string-as-multibyte (buffer-string)))) - (mml-insert-mime-headers cont type charset encoding) + (mml-insert-mime-headers cont type charset encoding nil) (insert "\n") (mm-with-unibyte-current-buffer (insert coded))))) @@ -523,13 +552,14 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." "") mml-base-boundary)) -(defun mml-insert-mime-headers (cont type charset encoding) +(defun mml-insert-mime-headers (cont type charset encoding flowed) (let (parameters disposition description) (setq parameters (mml-parameter-string cont mml-content-type-parameters)) (when (or charset parameters + flowed (not (equal type mml-generate-default-type))) (when (consp charset) (error @@ -538,6 +568,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (when charset (insert "; " (mail-header-encode-parameter "charset" (symbol-name charset)))) + (when flowed + (insert "; format=flowed")) (when parameters (mml-insert-parameter-string cont mml-content-type-parameters)) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 9756937..afa0959 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1223,7 +1223,19 @@ find-file-hooks, etc. "Detect MIME charset of the text in the region between START and END." (coding-system-to-mime-charset (nnheader-detect-coding-region start end))) - (defalias 'mm-detect-mime-charset-region 'nnheader-detect-mime-charset-region)) + (defalias 'mm-detect-mime-charset-region + 'nnheader-detect-mime-charset-region) + + (defmacro nnheader-with-unibyte-buffer (&rest forms) + "Create a temporary buffer, and evaluate FORMS there like `progn'. +Use unibyte mode for this." + `(let (default-enable-multibyte-characters mc-flag) + (with-temp-buffer ,@forms))) + (put 'nnheader-with-unibyte-buffer 'lisp-indent-function 0) + (put 'nnheader-with-unibyte-buffer 'edebug-form-spec '(body)) + (put 'mm-with-unibyte-buffer 'lisp-indent-function 0) + (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) + (defalias 'mm-with-unibyte-buffer 'nnheader-with-unibyte-buffer)) ;; mail-parse stuff. (unless (featurep 'mail-parse) diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 6740e65..996e47c 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -196,6 +196,8 @@ RFC2060 section 6.4.4." :group 'nnimap :type 'sexp) +;; Performance / bug workaround variables + (defcustom nnimap-close-asynchronous nil "Close mailboxes asynchronously in `nnimap-close-group'. This means that errors cought by nnimap when closing the mailbox will @@ -204,6 +206,18 @@ However, it increases speed." :type 'boolean :group 'nnimap) +(defcustom nnimap-dont-close t + "Never close mailboxes. +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." + :type 'boolean + :group 'nnimap) + +(defvoo nnimap-need-unselect-to-notice-new-mail nil + "Unselect mailboxes before looking for new mail in them. +Some servers seem to need this under some circumstances.") + ;; Authorization / Privacy variables (defvoo nnimap-auth-method nil @@ -421,16 +435,18 @@ If SERVER is nil, uses the current server." (defun nnimap-before-find-minmax-bugworkaround () "Function called before iterating through mailboxes with `nnimap-find-minmax-uid'." - ;; XXX this is for UoW imapd problem, it doesn't notice new mail in - ;; currently selected mailbox without a re-select/examine. - (or (null (imap-current-mailbox nnimap-server-buffer)) - (imap-mailbox-unselect nnimap-server-buffer))) + (when nnimap-need-unselect-to-notice-new-mail + ;; XXX this is for UoW imapd problem, it doesn't notice new mail in + ;; currently selected mailbox without a re-select/examine. + (or (null (imap-current-mailbox nnimap-server-buffer)) + (imap-mailbox-unselect nnimap-server-buffer)))) (defun nnimap-find-minmax-uid (group &optional examine) "Find lowest and highest active article nummber in GROUP. If EXAMINE is non-nil the group is selected read-only." (with-current-buffer nnimap-server-buffer - (when (imap-mailbox-select group examine) + (when (or (string= group (imap-current-mailbox)) + (imap-mailbox-select group examine)) (let (minuid maxuid) (when (> (imap-mailbox-get 'exists) 0) (imap-fetch "1,*" "UID" nil 'nouidfetch) @@ -846,15 +862,16 @@ function is generally only called when Gnus is shutting down." (when (and (imap-opened) (nnimap-possibly-change-group group server)) (case nnimap-expunge-on-close - (always (imap-mailbox-expunge nnimap-close-asynchronous) - (imap-mailbox-close nnimap-close-asynchronous)) + (always (unless nnimap-dont-close + (imap-mailbox-expunge nnimap-close-asynchronous) + (imap-mailbox-close nnimap-close-asynchronous))) (ask (if (and (imap-search "DELETED") - (gnus-y-or-n-p (format - "Expunge articles in group `%s'? " - imap-current-mailbox))) - (progn (imap-mailbox-expunge nnimap-close-asynchronous) - (imap-mailbox-close nnimap-close-asynchronous)) - (imap-mailbox-unselect))) + (gnus-y-or-n-p (format "Expunge articles in group `%s'? " + imap-current-mailbox))) + (unless nnimap-dont-close + (imap-mailbox-expunge nnimap-close-asynchronous) + (imap-mailbox-close nnimap-close-asynchronous)) + (imap-mailbox-unselect))) (t (imap-mailbox-unselect))) (not imap-current-mailbox)))) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 7e85b91..96b294c 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -703,7 +703,7 @@ If SOURCE is a directory spec, try to return the group name component." (defsubst nnmail-search-unix-mail-delim () "Put point at the beginning of the next Unix mbox message." - ;; Algorithm used to find the the next article in the + ;; Algorithm used to find the next article in the ;; brain-dead Unix mbox format: ;; ;; 1) Search for "^From ". @@ -732,7 +732,7 @@ If SOURCE is a directory spec, try to return the group name component." (defun nnmail-search-unix-mail-delim-backward () "Put point at the beginning of the current Unix mbox message." - ;; Algorithm used to find the the next article in the + ;; Algorithm used to find the next article in the ;; brain-dead Unix mbox format: ;; ;; 1) Search for "^From ". diff --git a/lisp/nntp.el b/lisp/nntp.el index 4b9e4b1..583456e 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -432,9 +432,9 @@ noticing asynchronous data.") (set-buffer buffer) (goto-char pos) (if (looking-at (regexp-quote command)) - (delete-region pos (progn (forward-line 1) (gnus-point-at-bol)))) - ))) - )) + (delete-region pos (progn + (forward-line 1) + (gnus-point-at-bol))))))))) (defun nntp-send-command-nodelete (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." @@ -452,9 +452,9 @@ noticing asynchronous data.") (set-buffer buffer) (goto-char pos) (if (looking-at (regexp-quote command)) - (delete-region pos (progn (forward-line 1) (gnus-point-at-bol)))) - ))) - )) + (delete-region pos (progn + (forward-line 1) + (gnus-point-at-bol))))))))) (defun nntp-send-command-and-decode (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." @@ -477,10 +477,9 @@ noticing asynchronous data.") (set-buffer buffer) (goto-char pos) (if (looking-at (regexp-quote command)) - (delete-region pos (progn (forward-line 1) (gnus-point-at-bol)))) - ))) - )) - + (delete-region pos (progn + (forward-line 1) + (gnus-point-at-bol))))))))) (defun nntp-send-buffer (wait-for) "Send the current buffer to server and wait until WAIT-FOR returns." @@ -494,7 +493,7 @@ noticing asynchronous data.") (symbol-value 'enable-multibyte-characters)))) (unwind-protect ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro. - (let (default-enable-multibyte-characters) + (let (default-enable-multibyte-characters mc-flag) ;; `set-buffer-multibyte' will be provided by APEL for all Emacsen. (set-buffer-multibyte nil) (process-send-region (nntp-find-connection nntp-server-buffer) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index c19bfb6..43cd7f6 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -522,14 +522,15 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." ;;; We map between virtual articles and real articles in a manner -;;; which keeps the size of the virtual active list the same as -;;; the sum of the component active lists. -;;; To achieve fair mixing of the groups, the last article in -;;; each of N component groups will be in the the last N articles -;;; in the virtual group. - -;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and 6-7 -;;; resprectively, then the virtual article numbers look like: +;;; which keeps the size of the virtual active list the same as the +;;; sum of the component active lists. + +;;; To achieve fair mixing of the groups, the last article in each of +;;; N component groups will be in the last N articles in the virtual +;;; group. + +;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and +;;; 6-7 resprectively, then the virtual article numbers look like: ;;; ;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7 diff --git a/texi/ChangeLog b/texi/ChangeLog index 45bc03f..ad18e66 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,26 @@ +2002-01-15 Tue Jari Aalto + + * gnus.texi (Really Various Summary Commands): Added commands how + to create nnvirtual group and and how to modify the nnvirtual + regexp + +2002-01-12 ShengHuo ZHU + + * gnus.texi (Agent Caveats): Add agent cache. + (Agent Variables): Addition. + +2002-01-12 Simon Josefsson + + * gnus.texi (Conformity): Fix typo. + + * emacs-mime.texi (Flowed text, Standards): Add. + +2002-01-11 ShengHuo ZHU + + * message.texi (Mailing Lists): Addition. + * gnus.texi (Group Parameters): Addition. + From Sriram Karra . + 2002-01-10 Colin Marquardt * gnus.texi (Changing Servers): Addition. diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index 16ed3f8..12a4862 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -18,7 +18,7 @@ This file documents the Emacs MIME interface functionality. -Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.1 or @@ -1116,6 +1116,7 @@ string containing the @sc{mime} message. * Advanced MML Example:: Another example MML document. * Charset Translation:: How charsets are mapped from @sc{mule} to MIME. * Conversion:: Going from @sc{mime} to MML and vice versa. +* Flowed text:: Soft and hard newlines. @end menu @@ -1428,6 +1429,27 @@ other. The resulting contents of the message should remain equivalent, if not identical. +@node Flowed text +@section Flowed text +@cindex format=flowed + +The Emacs @sc{mime} library will respect the @code{use-hard-newlines} +variable (@pxref{Hard and Soft Newlines, ,Hard and Soft Newlines, +emacs, Emacs Manual}) when encoding a message, and the +``format=flowed'' Content-Type parameter when decoding a message. + +On encoding text, lines terminated by soft newline characters are +filled together and wrapped after the column decided by +@code{fill-flowed-encode-column}. This variable controls how the text +will look in a client that does not support flowed text, the default +is to wrap after 66 characters. If hard newline characters are not +present in the buffer, no flow encoding occurs. + +On decoding flowed text, lines with soft newline characters are filled +together and wrapped after the column decided by +@code{fill-flowed-display-column}. The default is to wrap after +@code{fill-column}. + @node Standards @chapter Standards @@ -1481,6 +1503,9 @@ Administrative Messages Communicating Presentation Information in Internet Messages: The Content-Disposition Header Field +@item RFC2646 +Documentation of the text/plain format parameter for flowed text. + @end table diff --git a/texi/gnus-faq.texi b/texi/gnus-faq.texi index 5bf8977..d6b5fb0 100644 --- a/texi/gnus-faq.texi +++ b/texi/gnus-faq.texi @@ -1,6 +1,6 @@ @c Insert "\input texinfo" at 1st line before texing this file alone. @c -*-texinfo-*- -@c Copyright (C) 1995, 2001 Free Software Foundation, Inc. +@c Copyright (C) 1995, 2001, 2002 Free Software Foundation, Inc. @setfilename gnus-faq.info @node Frequently Asked Questions diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 4c5dc31..14540d0 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -287,7 +287,7 @@ \thispagestyle{empty} -Copyright \copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001 +Copyright \copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. @@ -335,7 +335,7 @@ This file documents gnus, the GNU Emacs newsreader. $B$3$N%U%!%$%k$O(B GNU Emacs $B$N%K%e!<%9%j!<%@$G$"$k(B gnus $B$K4X$9$k@bL@=q$G$9!#(B -Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document @@ -383,7 +383,7 @@ license to the document, as described in section 6 of the license. @page @vskip 0pt plus 1filll -Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001 +Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document @@ -2780,6 +2780,17 @@ kiboze $B%0%k!<%W$r:n@.$7$^$9!#%W%m%s%W%H$GL>A0$H!"(Bkiboze $B%0%k!<%W$K!V4^$ @code{gnus-parameter-to-list-alist} $B$b;2>H$7$F2<$5$$!#(B +@item subscribed +@cindex subscribed +$B$b$7$3$N%Q%i%a!<%?$,(B @code{t} $B$K@_Dj$5$l$F$$$k$H!"(Bgnus $B$O$"$J$?$,$3$N%0(B +$B%k!<%W$r(B to-address $B$H(B to-list $B%Q%i%a!<%?$N%"%I%l%9$G9XFI$7$F$$$k%a!<%j(B +$B%s%0%j%9%H$G$"$k$H2rpJs$r(B gnus $B$KM?$($k$3$H$O!"$"$J$?$,$=(B +$B$l$i$N%a!<%j%s%0%j%9%H$KEj9F$9$k$H$-$K!"@5$7$$(B Mail-Followup-To $B%X%C%@!<(B +$B$r@8@.$9$kLr$KN)$A$^$9!#(B + +@code{gnus-find-subscribed-addresses} $B$b;2>H$7$F2<$5$$!#$3$N4X?t$O$3$N%0(B +$B%k!<%W%Q%i%a!<%?$rD>@\$K;H$$$^$9!#(B + @item visible @cindex visible $B%0%k!<%W%Q%i%a!<%?$N%j%9%HCf$K(B @code{(visible . t)} $B$H$$$&MWAG$,$"$l$P!"(B @@ -15136,6 +15147,10 @@ nnvirtual $B%0%k!<%W(B (@dfn{nnvirtual group}) $B$O$N%0%k!<%W$N=89g0J>e $B$l$^$9!#$D$^$j!"$b$72>A[%0%k!<%WFb$G5-;v$K2D;k5-;v$N0u$r$D$1$k$H!"$=$N5-(B $B;v$O$b$H$b$H$N9=@.%0%k!<%W$NCf$G$b2D;k5-;v$K$J$j$^$9!#(B($B$=$7$F5U$b@.$jN)(B $B$A$^$9(B --- $B9=@.%0%k!<%WFb$GIU$1$?0u$O2>A[%0%k!<%WFb$G$bI=<($5$l$^$9!#(B) +$B6u$N2>A[%0%k!<%W$r:n$k$K$O!"%0%k!<%W%P%C%U%!$G(B @kbd{G V} +(@code{gnus-group-make-empty-virtual}) $B$rl=j!#=i4|@_DjCM(B @item gnus-agent-fetched-hook @vindex gnus-agent-fetched-hook $B5-;v$ruBV$N%5!<%P!<$r%*%s%i%$%s>uBV$K$7$^$;$s!#(B@code{ask} $B$@$C$?$i!"$=$l(B +$B$,%G%#%U%)%k%H$G$9$,!"%(!<%8%'%s%H$O:F@\B3$9$k$H$-$K%*%U%i%$%s>uBV$N%5!<(B +$B%P!<$r%*%s%i%$%s>uBV$K$9$k$+$I$&$+$r?R$M$^$9!#$=$l0J30$NCM$@$C$?$i!"%*%U(B +$B%i%$%s>uBV$N%5!<%P!<$O<+F0E*$K%*%s%i%$%s>uBV$K$J$j$^$9!#(B @end table @node Example Setup @@ -16235,16 +16263,18 @@ Gnus Agent $B$O$h$/$"$kB>$N%*%U%i%$%s%K%e!<%9%j!<%@!<$N$h$&$K$OF0:n$7$^$;(B @table @dfn @item $B@\B3$5$l$F$$$k$H$-$K5-;v$rFI$s$@$i!"$=$l$O(B Agent $B$KF~$k$N$G$9$+(B? -@strong{$B$$$$$(!#(B} +@strong{$B$$$$$((B}$B!#(B @item $B@\B3$5$l$F$$$k$H$-$K5-;v$rFI$s$G!"(BAgent $B$K5-;v$,B8:_$7$F$$$k>l9g!"(B $B$b$&0l2s%@%&%s%m!<%I$5$l$k$N$G$9$+(B? -@strong{$B$O$$!#(B} +@strong{$B$$$$$((B}$B!"$?$@$7(B @code{gnus-agent-cache} $B$,(B `nil' $B$G$J$+$C$?$i!"(B +$B$G$9$,!#(B @end table -$BMWLs$9$k$H!"(Bgnus $B$,@Z$jN%$5$l$F$$$k$H$-$O!"%m!<%+%k$KJ]B8$5$l$?5-;v$r8+(B -$B$k$@$1$G$9!#@\B3$5$l$F$$$k$H$-$O!"(BISP $B$HOC$9$@$1$G$9!#(B +$BMWLs$9$k$H!"(Bgnus $B$,@Z$jN%$5$l$F$$$k$H$-$O%m!<%+%k$KJ]B8$5$l$?5-;v$r8+$k(B +$B$@$1$G$9!#@\B3$5$l$F$$$k$H$-$O(B ISP $B$HOC$9$@$1$G!"$+$D%m!<%+%k$K;}$C$F$$(B +$B$k5-;v$r;H$$$^$9!#(B @node Scoring @chapter $B%9%3%"(B @@ -20262,7 +20292,7 @@ RFC 1036 $B$N8e7Q$H$7$F=q$$$F$$$k$b$N$G$9!#%K%e!<%95-;v$NMM<0$KBP$7$F!"$$(B @cindex MIME MIME $B4XO"$N$9$Y$F$N(B RFC $B$,%5%]!<%H$5$l$F$$$^$9!#(B -@item Disposition Notifications - RFC 2289 +@item Disposition Notifications - RFC 2298 Message Mode $B$OJ}(B) $B$O%a%C%;!< * Forwarding:: $B%a%C%;!<%8$r%K%e!<%9$b$7$/$O%a!<%k$GE>Aw$9$k(B * Resending:: $B%a!<%k%a%C%;!<%8$r:FAw$9$k(B * Bouncing:: $B%a!<%k%a%C%;!<%8$N<:GT$r:FAw$9$k(B +* Mailing Lists:: $B%a!<%j%s%0%j%9%H$K%a!<%k$rAw$k(B @end menu @node New Mail Message @@ -305,6 +306,120 @@ Message $B$O%U%)%m!<%"%C%W$,$I$3$K9T$/$+$rIaDL$NJ}K!$r;H$C$F7hDj$7$^$9$,!"(B $B%U%!$r:n$j>e$2$kA0$K