From: Dave Love Date: Fri, 27 Oct 2000 19:48:50 +0000 (+0000) Subject: 2000-10-27 Simon Josefsson X-Git-Tag: emacs-pretest-21.0.90~484 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=03f20b4797dd0a48aee18775bdfe78f7b2db1cee;p=emacs.git 2000-10-27 Simon Josefsson * gnus-agent.el (gnus-agent-possibly-do-gcc): (gnus-agent-restore-gcc): (gnus-agent-possibly-save-gcc): New functions. Asks the user to synch flags with server when you plug in. * gnus-agent.el (gnus-agent-synchronize-flags): New variable. (gnus-agent-possibly-synchronize-flags-server): New function, use it. (gnus-agent-toggle-plugged): Call it. (gnus-agent-synchronize-flags): Renamed from `gnus-agent-synchronize'. (gnus-agent-group-mode-map): `g-a-s' -> `g-a-s-flags'. (gnus-agent-possibly-synchronize-flags): New function. (gnus-agent-possibly-synchronize-flags-server): New function. 2000-10-27 ShengHuo ZHU * gnus.el (gnus-xmas-define): Defalias gnus-overlay-buffer, gnus-overlay-start. * gnus.el (gnus-agent-fetching): New variable. * gnus-agent.el (gnus-agent-with-fetch): Bind it. * gnus-agent.el (gnus-agent-fetch-session): Catch quit. (gnus-agent-fetch-group-1): Score-param could be nil. (gnus-agent-any-covered-gcc): New function. (gnus-agent-possibly-save-gcc): Use it. (gnus-agent-possibly-do-gcc): Ditto. * gnus-agent.el: Revoke Mike McEwan's 1998-09-05 patch due to the GNU assignment issue. (gnus-agent-fetch-group-1): Reimplement Mike McEwan's proposal. * gnus-agent.el: timer vs. itimer. --- diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 759680f3cd4..5c232105809 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,10 +1,79 @@ -2000-09-24 Simon Josefsson +2000-10-27 Dave Love + + * gnus.el: Don't require custom. Don't require message at top + level. + (gnus-message-archive-method): Require message here. + +2000-10-27 Kai Gro,A_(Bjohann + + * gnus-sum.el (gnus-get-split-value): Use first match only (Ed L + Cashin ). + +2000-10-27 Simon Josefsson + + * gnus-agent.el (gnus-agent-possibly-do-gcc): + (gnus-agent-restore-gcc): + (gnus-agent-possibly-save-gcc): New functions. + + Asks the user to synch flags with server when you plug in. + + * gnus-agent.el (gnus-agent-synchronize-flags): New variable. + (gnus-agent-possibly-synchronize-flags-server): New function, use it. + (gnus-agent-toggle-plugged): Call it. + (gnus-agent-synchronize-flags): Renamed from `gnus-agent-synchronize'. + (gnus-agent-group-mode-map): `g-a-s' -> `g-a-s-flags'. + (gnus-agent-possibly-synchronize-flags): New function. + (gnus-agent-possibly-synchronize-flags-server): New function. + + * nnheader.el (nnheader-parse-head): Try both "from:" and "from: ". + + * gnus-sum.el (gnus-get-newsgroup-headers): Ditto. * gnus-group.el (gnus-group-nnimap-edit-acl): Check if server support ACL's. 2000-10-27 ShengHuo ZHU + * gnus.el (gnus-xmas-define): Defalias gnus-overlay-buffer, + gnus-overlay-start. + * gnus.el (gnus-agent-fetching): New variable. + * gnus-agent.el (gnus-agent-with-fetch): Bind it. + + * gnus-agent.el (gnus-agent-fetch-session): Catch quit. + (gnus-agent-fetch-group-1): Score-param could be nil. + (gnus-agent-any-covered-gcc): New function. + (gnus-agent-possibly-save-gcc): Use it. + (gnus-agent-possibly-do-gcc): Ditto. + * gnus-agent.el: Revoke Mike McEwan's 1998-09-05 patch due to + the GNU assignment issue. + (gnus-agent-fetch-group-1): Reimplement Mike McEwan's proposal. + * gnus-agent.el: timer vs. itimer. + + * webmail.el (webmail-type-definition): Fix my-deja open url. + (webmail-hotmail-list): Fix. + (webmail-netscape-open, webmail-hotmail-article, + webmail-hotmail-list): Update. + (webmail-my-deja-*): Rewrite. + + * gnus-sum.el (gnus-refer-article-methods): The second could be + a named method. + (gnus-cache-write-active): Auto load. + (gnus-summary-display-article): Enable multibyte. + (gnus-summary-select-article): Don't enable multibyte here. + (gnus-summary-goto-article): Ditto. + (gnus-summary-enter-digest-group): Decode to-address. + + * mm-util.el (mm-multibyte-p): Test (featurep 'xemacs). + (mm-with-unibyte-current-buffer-mule4): New function. + (mm-enable-multibyte-mule4): New. + (mm-disable-multibyte-mule4): New. + + * mm-util.el (mm-enable-multibyte-mule4): New. + (mm-disable-multibyte-mule4): New. + * gnus-sum.el (gnus-summary-mode): Use it. + (gnus-summary-select-article): Ditto. + (gnus-summary-goto-article): Use enable multibyte. + * nnkiboze.el (nnkiboze-generate-group): Use it. Inhibit list groups. (nnkiboze-enter-nov): Fix it when there is no xref. (nnkiboze-generate-groups): List groups. @@ -26,15 +95,14 @@ (message-default-charset): Set default value in non-MULE XEmacsen as iso-8859-1. -2000-10-27 Emerick Rogul - - * message.el (message-setup-fill-variables): New variable. - (message-mode): Use it. - 2000-10-27 Bjorn Torkelsson * message.el: xemacs cleanup (use featurep ' xemacs) + * nnheader.el: ditto + + * mm-util.el: ditto + 2000-10-27 Stanislav Shalunov * message.el (message-make-in-reply-to): In-Reply-To is message-id diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 3a4d4bb81f6..39f1dde08c4 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2,6 +2,7 @@ ;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Maintainer: bugs@gnus.org ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify @@ -27,10 +28,12 @@ (require 'gnus-cache) (require 'nnvirtual) (require 'gnus-sum) +(require 'gnus-score) (eval-when-compile - (require 'timer) - (require 'cl) - (require 'gnus-score)) + (if (featurep 'xemacs) + (require 'itimer) + (require 'timer)) + (require 'cl)) (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/") "Where the Gnus agent will store its files." @@ -83,6 +86,14 @@ If nil, only read articles will be expired." :group 'gnus-agent :type 'function) +(defcustom gnus-agent-synchronize-flags 'ask + "Indicate if flags are synchronized when you plug in. +If this is `ask' the hook will query the user." + :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) @@ -100,10 +111,6 @@ If nil, only read articles will be expired." (defvar gnus-agent-send-mail-function nil) (defvar gnus-agent-file-coding-system 'raw-text) -(defconst gnus-agent-scoreable-headers - '("subject" "from" "date" "message-id" "references" "chars" "lines" "xref") - "Headers that are considered when scoring articles for download via the Agent.") - ;; Dynamic variables (defvar gnus-headers) (defvar gnus-score) @@ -186,7 +193,7 @@ If nil, only read articles will be expired." (defmacro gnus-agent-with-fetch (&rest forms) "Do FORMS safely." `(unwind-protect - (progn + (let ((gnus-agent-fetching t)) (gnus-agent-start-fetch) ,@forms) (gnus-agent-stop-fetch))) @@ -233,7 +240,7 @@ If nil, only read articles will be expired." "Jc" gnus-enter-category-buffer "Jj" gnus-agent-toggle-plugged "Js" gnus-agent-fetch-session - "JY" gnus-agent-synchronize + "JY" gnus-agent-synchronize-flags "JS" gnus-group-send-drafts "Ja" gnus-agent-add-group "Jr" gnus-agent-remove-group) @@ -290,6 +297,7 @@ If nil, only read articles will be expired." (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) " Plugged")) (gnus-agent-close-connections) @@ -371,6 +379,43 @@ be a select method." (while (search-backward "\n" nil t) (replace-match "\\n" t t)))) +(defun gnus-agent-restore-gcc () + "Restore GCC field from saved header." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward (concat gnus-agent-gcc-header ":") nil t) + (replace-match "Gcc:" 'fixedcase)))) + +(defun gnus-agent-any-covered-gcc () + (save-restriction + (message-narrow-to-headers) + (let* ((gcc (mail-fetch-field "gcc" nil t)) + (methods (and gcc + (mapcar 'gnus-inews-group-method + (message-unquote-tokens + (message-tokenize-header + gcc " ,"))))) + covered) + (while (and (not covered) methods) + (setq covered + (member (car methods) gnus-agent-covered-methods) + methods (cdr methods))) + covered))) + +(defun gnus-agent-possibly-save-gcc () + "Save GCC if Gnus is unplugged." + (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc)) + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search t)) + (while (re-search-forward "^gcc:" nil t) + (replace-match (concat gnus-agent-gcc-header ":") 'fixedcase)))))) + +(defun gnus-agent-possibly-do-gcc () + "Do GCC if Gnus is plugged." + (when (or gnus-plugged (not (gnus-agent-any-covered-gcc))) + (gnus-inews-do-gcc))) + ;;; ;;; Group mode commands ;;; @@ -425,27 +470,49 @@ be a select method." (setf (cadddr c) (delete group (cadddr c)))))) (gnus-category-write))) -(defun gnus-agent-synchronize () - "Synchronize local, unplugged, data with backend. -Currently sends flag setting requests, if any." +(defun gnus-agent-synchronize-flags () + "Synchronize unplugged flags with servers." + (interactive) + (save-excursion + (dolist (gnus-command-method gnus-agent-covered-methods) + (when (file-exists-p (gnus-agent-lib-file "flags")) + (gnus-agent-synchronize-flags-server gnus-command-method))))) + +(defun gnus-agent-possibly-synchronize-flags () + "Synchronize flags according to `gnus-agent-synchronize-flags'." (interactive) (save-excursion (dolist (gnus-command-method gnus-agent-covered-methods) (when (file-exists-p (gnus-agent-lib-file "flags")) - (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) - (erase-buffer) - (nnheader-insert-file-contents (gnus-agent-lib-file "flags")) - (if (null (gnus-check-server gnus-command-method)) - (message "Couldn't open server %s" (nth 1 gnus-command-method)) - (while (not (eobp)) - (if (null (eval (read (current-buffer)))) - (progn (forward-line) - (kill-line -1)) - (write-file (gnus-agent-lib-file "flags")) - (error "Couldn't set flags from file %s" - (gnus-agent-lib-file "flags")))) - (write-file (gnus-agent-lib-file "flags"))) - (kill-buffer nil))))) + (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) + +(defun gnus-agent-synchronize-flags-server (method) + "Synchronize flags set when unplugged for server." + (let ((gnus-command-method method)) + (when (file-exists-p (gnus-agent-lib-file "flags")) + (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) + (erase-buffer) + (nnheader-insert-file-contents (gnus-agent-lib-file "flags")) + (if (null (gnus-check-server gnus-command-method)) + (message "Couldn't open server %s" (nth 1 gnus-command-method)) + (while (not (eobp)) + (if (null (eval (read (current-buffer)))) + (progn (forward-line) + (kill-line -1)) + (write-file (gnus-agent-lib-file "flags")) + (error "Couldn't set flags from file %s" + (gnus-agent-lib-file "flags")))) + (delete-file (gnus-agent-lib-file "flags"))) + (kill-buffer nil)))) + +(defun gnus-agent-possibly-synchronize-flags-server (method) + "Synchronize flags for server according to `gnus-agent-synchronize-flags'." + (when (or (and gnus-agent-synchronize-flags + (not (eq gnus-agent-synchronize-flags 'ask))) + (and (eq gnus-agent-synchronize-flags 'ask) + (gnus-y-or-n-p (format "Synchronize flags on server `%s'? " + (cadr method))))) + (gnus-agent-synchronize-flags-server method))) ;;; ;;; Server mode commands @@ -1034,7 +1101,11 @@ the actual number of articles toggled is returned." (error (unless (funcall gnus-agent-confirmation-function (format "Error (%s). Continue? " err)) - (error "Cannot fetch articles into the Gnus agent.")))) + (error "Cannot fetch articles into the Gnus agent."))) + (quit + (unless (funcall gnus-agent-confirmation-function + (format "Quit (%s). Continue? " err)) + (signal 'quit "Cannot fetch articles into the Gnus agent.")))) (pop methods)) (gnus-message 6 "Finished fetching articles into the Gnus agent")))) @@ -1057,17 +1128,13 @@ the actual number of articles toggled is returned." ;; Fetch headers. (when (and (or (gnus-active group) (gnus-activate-group group)) (setq articles (gnus-agent-fetch-headers group)) - (progn + (let ((nntp-server-buffer gnus-agent-overview-buffer)) ;; Parse them and see which articles we want to fetch. (setq gnus-newsgroup-dependencies (make-vector (length articles) 0)) - ;; No need to call `gnus-get-newsgroup-headers-xover' with - ;; the entire .overview for group as we still have the just - ;; downloaded headers in `gnus-agent-overview-buffer'. - (let ((nntp-server-buffer gnus-agent-overview-buffer)) - (setq gnus-newsgroup-headers - (gnus-get-newsgroup-headers-xover articles nil nil - group))) + (setq gnus-newsgroup-headers + (gnus-get-newsgroup-headers-xover articles nil nil + group)) ;; `gnus-agent-overview-buffer' may be killed for ;; timeout reason. If so, recreate it. (gnus-agent-create-buffer))) @@ -1076,45 +1143,24 @@ the actual number of articles toggled is returned." (gnus-get-predicate (or (gnus-group-find-parameter group 'agent-predicate t) (cadr category)))) - ;; Do we want to download everything, or nothing? - (if (or (eq (caaddr predicate) 'gnus-agent-true) - (eq (caaddr predicate) 'gnus-agent-false)) - ;; Yes. - (setq arts (symbol-value - (cadr (assoc (caaddr predicate) - '((gnus-agent-true articles) - (gnus-agent-false nil)))))) - ;; No, we need to decide what we want. + (if (memq (caaddr predicate) '(gnus-agent-true gnus-agent-false)) + ;; Simple implementation + (setq arts + (and (eq (caaddr predicate) 'gnus-agent-true) articles)) + (setq arts nil) (setq score-param - (let ((score-method - (or - (gnus-group-find-parameter group 'agent-score t) - (caddr category)))) - (when score-method - (require 'gnus-score) - (if (eq score-method 'file) - (let ((entries - (gnus-score-load-files - (gnus-all-score-files group))) - list score-file) - (while (setq list (car entries)) - (push (car list) score-file) - (setq list (cdr list)) - (while list - (when (member (caar list) - gnus-agent-scoreable-headers) - (push (car list) score-file)) - (setq list (cdr list))) - (setq score-param - (append score-param (list (nreverse score-file))) - score-file nil entries (cdr entries))) - (list score-param)) - (if (stringp (car score-method)) - score-method - (list (list score-method))))))) + (or (gnus-group-get-parameter group 'agent-score t) + (caddr category))) + ;; Translate score-param into real one + (cond + ((not score-param)) + ((eq score-param 'file) + (setq score-param (gnus-all-score-files group))) + ((stringp (car score-param))) + (t + (setq score-param (list (list score-param))))) (when score-param (gnus-score-headers score-param)) - (setq arts nil) (while (setq gnus-headers (pop gnus-newsgroup-headers)) (setq gnus-score (or (cdr (assq (mail-header-number gnus-headers)