2000-10-27 Simon Josefsson <simon@josefsson.org>
* 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 <zsh@cs.rochester.edu> * 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.
This commit is contained in:
Dave Love
@@ -1,10 +1,79 @@
|
||||
2000-09-24 Simon Josefsson <simon@josefsson.org>
|
||||
2000-10-27 Dave Love <fx@gnu.org>
|
||||
|
||||
* 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 <Kai.Grossjohann@CS.Uni-Dortmund.DE>
|
||||
|
||||
* gnus-sum.el (gnus-get-split-value): Use first match only (Ed L
|
||||
Cashin <ecashin@coe.uga.edu>).
|
||||
|
||||
2000-10-27 Simon Josefsson <simon@josefsson.org>
|
||||
|
||||
* 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 <zsh@cs.rochester.edu>
|
||||
|
||||
* 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 <emerick@csa.bu.edu>
|
||||
|
||||
* message.el (message-setup-fill-variables): New variable.
|
||||
(message-mode): Use it.
|
||||
|
||||
2000-10-27 Bjorn Torkelsson <torkel@hpc2n.umu.se>
|
||||
|
||||
* message.el: xemacs cleanup (use featurep ' xemacs)
|
||||
|
||||
* nnheader.el: ditto
|
||||
|
||||
* mm-util.el: ditto
|
||||
|
||||
2000-10-27 Stanislav Shalunov <shalunov@internet2.edu>
|
||||
|
||||
* message.el (message-make-in-reply-to): In-Reply-To is message-id
|
||||
|
||||
@@ -2,6 +2,7 @@
|
||||
;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
;; 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"))
|
||||
(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-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"))
|
||||
(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)
|
||||
|
||||
Reference in New Issue
Block a user