From 7a633bd0088e166fd30ae93b716b79ffee689c7d Mon Sep 17 00:00:00 2001 From: ichikawa Date: Mon, 7 Sep 1998 13:47:14 +0000 Subject: [PATCH] lisp/gnus-draft.el (gnus-draft-setup): Do not use message mode. (gnus-draft-send): Ditto. gnus-draft-send-draft-buffer: New variable. lisp/gnus-agent.el : Use pGnus 0.17 gnus-agent.el --- ChangeLog | 11 ++++ lisp/gnus-agent.el | 152 ++++++++++++++++++++++++---------------------------- lisp/gnus-draft.el | 105 +++++++++++++++++++++++++----------- lisp/gnus-msg.el | 3 +- 4 files changed, 159 insertions(+), 112 deletions(-) diff --git a/ChangeLog b/ChangeLog index 6cfffe0..2fbdeaf 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +1998-09-07 Tatsuya Ichikawa + + * lisp/gnus-draft.el (gnus-draft-setup): Do not use message mode. + (gnus-draft-send): Ditto. + gnus-draft-send-draft-buffer: New variable. + + * lisp/gnus-msg.el (gnus-extended-version): Display original Gnus + version. + + * lisp/gnus-agent.el : Use pGnus 0.17 gnus-agent.el + 1998-09-07 Katsumi Yamaoka * lisp/gnus.el (gnus-continuum-version): Use `char-int' instead of diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index a9fe734..3c2df6e 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,4 +1,4 @@ -;;; gnus-agent.el --- unplugged support for Semi-gnus +;;; gnus-agent.el --- unplugged support for Gnus ;; Copyright (C) 1997,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -209,7 +209,8 @@ for download via the Agent.") (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map" buffer)))) minor-mode-map-alist)) - (gnus-agent-toggle-plugged gnus-plugged) + (when (eq major-mode 'gnus-group-mode) + (gnus-agent-toggle-plugged gnus-plugged)) (gnus-run-hooks 'gnus-agent-mode-hook (intern (format "gnus-agent-%s-mode-hook" buffer))))) @@ -649,7 +650,7 @@ the actual number of articles toggled is returned." ;; Prune off articles that we have already fetched. (while (and articles (cdr (assq (car articles) gnus-agent-article-alist))) - (pop articles)) + (pop articles)) (let ((arts articles)) (while (cdr arts) (if (cdr (assq (cadr arts) gnus-agent-article-alist)) @@ -755,47 +756,36 @@ the actual number of articles toggled is returned." (insert "\n")) (pop gnus-agent-group-alist)))) -(defun gnus-agent-fetch-headers (group articles &optional force) - (let ((articles (if (gnus-agent-load-alist group) - (gnus-sorted-intersection - (gnus-list-of-unread-articles group) - (gnus-uncompress-range - (cons (1+ (caar (last gnus-agent-article-alist))) - (cdr (gnus-active group))))) - (gnus-list-of-unread-articles group)))) +(defun gnus-agent-fetch-headers (group &optional force) + (let ((articles (if (gnus-agent-load-alist group) + (gnus-sorted-intersection + (gnus-list-of-unread-articles group) + (gnus-uncompress-range + (cons (1+ (caar (last gnus-agent-article-alist))) + (cdr (gnus-active group))))) + (gnus-list-of-unread-articles group)))) ;; Fetch them. (when articles (gnus-message 7 "Fetching headers for %s..." group) (save-excursion - (set-buffer nntp-server-buffer) - (unless (eq 'nov (gnus-retrieve-headers articles group)) - (nnvirtual-convert-headers)) - ;; - ;; To gnus-agent-expire work fine with no Xref field in .overview - ;; Tatsuya Ichikawa - (goto-char (point-min)) - (while (not (eobp)) - (goto-char (point-at-eol)) - (insert "\t") - (forward-line 1)) - ;; Tatsuya Ichikawa - ;; To gnus-agent-expire work fine with no Xref field in .overview - ;; - ;; Save these headers for later processing. - (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) - (let (file) - (when (file-exists-p - (setq file (gnus-agent-article-name ".overview" group))) - (gnus-agent-braid-nov group articles file)) - (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file))) - (write-region (point-min) (point-max) file nil 'silent) - (gnus-agent-save-alist group articles nil) - (gnus-agent-enter-history - "last-header-fetched-for-session" - (list (cons group (nth (- (length articles) 1) articles))) - (time-to-day (current-time))) - articles))))) + (set-buffer nntp-server-buffer) + (unless (eq 'nov (gnus-retrieve-headers articles group)) + (nnvirtual-convert-headers)) + ;; Save these headers for later processing. + (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) + (let (file) + (when (file-exists-p + (setq file (gnus-agent-article-name ".overview" group))) + (gnus-agent-braid-nov group articles file)) + (gnus-make-directory (nnheader-translate-file-chars + (file-name-directory file))) + (write-region (point-min) (point-max) file nil 'silent) + (gnus-agent-save-alist group articles nil) + (gnus-agent-enter-history + "last-header-fetched-for-session" + (list (cons group (nth (- (length articles) 1) articles))) + (time-to-day (current-time))) + articles))))) (defsubst gnus-agent-copy-nov-line (article) (let (b e) @@ -803,47 +793,48 @@ the actual number of articles toggled is returned." (setq b (point)) (if (eq article (read (current-buffer))) (setq e (progn (forward-line 1) (point))) - (setq e b)) + (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) - (let (beg end) - (set-buffer gnus-agent-overview-buffer) - (goto-char (point-min)) - (set-buffer nntp-server-buffer) - (erase-buffer) - (nnheader-insert-file-contents file) - (goto-char (point-max)) - (if (or (= (point-min) (point-max)) - (progn - (forward-line -1) - (< (read (current-buffer)) (car articles)))) - ;; We have only headers that are after the older headers, - ;; so we just append them. - (progn - (goto-char (point-max)) - (insert-buffer-substring gnus-agent-overview-buffer)) - ;; We do it the hard way. - (nnheader-find-nov-line (car articles)) - (gnus-agent-copy-nov-line (car articles)) - (pop articles) - (while (and articles - (not (eobp))) - (while (and (not (eobp)) - (< (read (current-buffer)) (car articles))) - (forward-line 1)) - (beginning-of-line) - (unless (eobp) - (gnus-agent-copy-nov-line (car articles)) - (setq articles (cdr articles)))) - (when articles - (let (b e) - (set-buffer gnus-agent-overview-buffer) - (setq b (point) - e (point-max)) - (set-buffer nntp-server-buffer) - (insert-buffer-substring gnus-agent-overview-buffer b e)))))) + (set-buffer gnus-agent-overview-buffer) + (goto-char (point-min)) + (set-buffer nntp-server-buffer) + (erase-buffer) + (nnheader-insert-file-contents file) + (goto-char (point-max)) + (if (or (= (point-min) (point-max)) + (progn + (forward-line -1) + (< (read (current-buffer)) (car articles)))) + ;; We have only headers that are after the older headers, + ;; so we just append them. + (progn + (goto-char (point-max)) + (insert-buffer-substring gnus-agent-overview-buffer)) + ;; We do it the hard way. + (nnheader-find-nov-line (car articles)) + (gnus-agent-copy-nov-line (car articles)) + (pop articles) + (while (and articles + (not (eobp))) + (while (and (not (eobp)) + (< (read (current-buffer)) (car articles))) + (forward-line 1)) + (beginning-of-line) + (unless (eobp) + (gnus-agent-copy-nov-line (car articles)) + (setq articles (cdr articles)))) + (when articles + (let (b e) + (set-buffer gnus-agent-overview-buffer) + (setq b (point) + e (point-max)) + (set-buffer nntp-server-buffer) + (insert-buffer-substring gnus-agent-overview-buffer b e))))) (defun gnus-agent-load-alist (group &optional dir) "Load the article-state alist for GROUP." @@ -854,7 +845,7 @@ the actual number of articles toggled is returned." (gnus-agent-article-name ".agentview" group))))) (defun gnus-agent-save-alist (group &optional articles state dir) - "Load the article-state alist for GROUP." + "Save the article-state alist for GROUP." (with-temp-file (if dir (concat dir ".agentview") (gnus-agent-article-name ".agentview" group)) @@ -904,12 +895,11 @@ the actual number of articles toggled is returned." (let ((gnus-command-method method) gnus-newsgroup-dependencies gnus-newsgroup-headers gnus-newsgroup-scored gnus-headers gnus-score - gnus-use-cache articles score arts + gnus-use-cache articles arts category predicate info marks score-param) ;; Fetch headers. (when (and (or (gnus-active group) (gnus-activate-group group)) - (setq articles (gnus-list-of-unread-articles group)) - (gnus-agent-fetch-headers group articles)) + (setq articles (gnus-agent-fetch-headers group))) ;; Parse them and see which articles we want to fetch. (setq gnus-newsgroup-dependencies (make-vector (length articles) 0)) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index fce8744..d3acc4d 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -115,6 +115,33 @@ (gnus-draft-send article gnus-newsgroup-name) (gnus-summary-mark-article article gnus-canceled-mark))))) +;;(defun gnus-draft-send (article &optional group) +;; "Send message ARTICLE." +;; (gnus-draft-setup article (or group "nndraft:queue")) +;; (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me) +;; message-send-hook type method) +;; ;; We read the meta-information that says how and where +;; ;; this message is to be sent. +;; (save-restriction +;; (message-narrow-to-head) +;; (when (re-search-forward +;; (concat "^" (regexp-quote gnus-agent-meta-information-header) ":") +;; nil t) +;; (setq type (ignore-errors (read (current-buffer))) +;; method (ignore-errors (read (current-buffer)))) +;; (message-remove-header gnus-agent-meta-information-header))) +;; ;; Then we send it. If we have no meta-information, we just send +;; ;; it and let Message figure out how. +;; (if type +;; (let ((message-this-is-news (eq type 'news)) +;; (message-this-is-mail (eq type 'mail)) +;; (gnus-post-method method) +;; (message-post-method method)) +;; (message-send-and-exit)) +;; (message-send-and-exit)))) + +;; For draft TEST +(defvar gnus-draft-send-draft-buffer " *send draft*") (defun gnus-draft-send (article &optional group) "Send message ARTICLE." (gnus-draft-setup article (or group "nndraft:queue")) @@ -132,13 +159,19 @@ (message-remove-header gnus-agent-meta-information-header))) ;; Then we send it. If we have no meta-information, we just send ;; it and let Message figure out how. - (if type - (let ((message-this-is-news (eq type 'news)) - (message-this-is-mail (eq type 'mail)) - (gnus-post-method method) - (message-post-method method)) - (message-send-and-exit)) - (message-send-and-exit)))) + (if (eq type 'mail) + (progn + (require 'smtp) + (let ((recipients (smtp-deduce-address-list + (current-buffer) + (goto-char (point-min)) (search-forward "\n\n")))) + (if (not (null recipients)) + (if (not (smtp-via-smtp user-mail-address recipients (current-buffer))) + (error "Sending failed: SMTP protocol error"))))) + (gnus-open-server method) + (gnus-request-post method))) + (kill-buffer gnus-draft-send-draft-buffer)) +;; For draft TEST (defun gnus-draft-send-all-messages () "Send all the sendable drafts." @@ -163,37 +196,49 @@ ;;; Utility functions -(defcustom gnus-draft-decoding-function - (function - (lambda () - (mime-edit-decode-buffer nil) - (eword-decode-header) - )) - "*Function called to decode the message from network representation." - :group 'gnus-agent - :type 'function) +;;(defcustom gnus-draft-decoding-function +;; (function +;; (lambda () +;; (mime-edit-decode-buffer nil) +;; (eword-decode-header) +;; )) +;; "*Function called to decode the message from network representation." +;; :group 'gnus-agent +;; :type 'function) ;;;!!!If this is byte-compiled, it fails miserably. ;;;!!!This is because `gnus-setup-message' uses uninterned symbols. ;;;!!!This has been fixed in recent versions of Emacs and XEmacs, ;;;!!!but for the time being, we'll just run this tiny function uncompiled. +;;(progn +;;(defun gnus-draft-setup (narticle group) +;; (gnus-setup-message 'forward +;; (let ((article narticle)) +;; (message-mail) +;; (erase-buffer) +;; (if (not (gnus-request-restore-buffer article group)) +;; (error "Couldn't restore the article") +;; ;; Insert the separator. +;; (funcall gnus-draft-decoding-function) +;; (goto-char (point-min)) +;; (search-forward "\n\n") +;; (forward-char -1) +;; (insert mail-header-separator) +;; (forward-line 1) +;; (message-set-auto-save-file-name)))))) +;; +;; For draft TEST (progn (defun gnus-draft-setup (narticle group) - (gnus-setup-message 'forward - (let ((article narticle)) - (message-mail) - (erase-buffer) - (if (not (gnus-request-restore-buffer article group)) - (error "Couldn't restore the article") - ;; Insert the separator. - (funcall gnus-draft-decoding-function) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - (forward-line 1) - (message-set-auto-save-file-name)))))) + (let ((article narticle)) + (get-buffer-create gnus-draft-send-draft-buffer) + (set-buffer gnus-draft-send-draft-buffer) + (erase-buffer) + (if (not (gnus-request-restore-buffer article group)) + (error "Couldn't restore the article") + )))) +;; For draft TEST (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable." diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 8df3249..1346ebe 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -192,7 +192,8 @@ Thank you for your help in stamping out bugs. (defun gnus-extended-version () "Stringified gnus version." (interactive) ; ??? - (concat gnus-product-name "/" gnus-version-number)) + (concat gnus-product-name "/" gnus-version-number " (based on " + gnus-original-product-name " " gnus-original-version-number ") ")) (defvar gnus-article-reply nil) (defmacro gnus-setup-message (config &rest forms) -- 1.7.10.4