-;;; 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 <larsi@gnus.org>
(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)))))
;; 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))
(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 <ichikawa@hv.epson.co.jp>
- (goto-char (point-min))
- (while (not (eobp))
- (goto-char (point-at-eol))
- (insert "\t")
- (forward-line 1))
- ;; Tatsuya Ichikawa <ichikawa@hv.epson.co.jp>
- ;; 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)
(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."
(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))
(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))
(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"))
(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."
;;; 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."
projects / elisp / gnus.git- / commitdiff