[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/nndb.el [emacs-unicode-2]
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/nndb.el [emacs-unicode-2] |
Date: |
Thu, 09 Sep 2004 06:03:11 -0400 |
Index: emacs/lisp/gnus/nndb.el
diff -c /dev/null emacs/lisp/gnus/nndb.el:1.2.2.1
*** /dev/null Thu Sep 9 09:38:15 2004
--- emacs/lisp/gnus/nndb.el Thu Sep 9 09:36:25 2004
***************
*** 0 ****
--- 1,331 ----
+ ;;; nndb.el --- nndb access for Gnus
+
+ ;; Copyright (C) 1997, 1998, 2000, 2003 Free Software Foundation, Inc.
+
+ ;; Author: Masanobu UMEDA <address@hidden>
+ ;; Kai Grossjohann <address@hidden>
+ ;; Joe Hildebrand <address@hidden>
+ ;; David Blacka <address@hidden>
+ ;; Keywords: news
+
+ ;; This file is part of GNU Emacs.
+
+ ;; GNU Emacs is free software; you can redistribute it and/or modify
+ ;; it under the terms of the GNU General Public License as published by
+ ;; the Free Software Foundation; either version 2, or (at your option)
+ ;; any later version.
+
+ ;; GNU Emacs is distributed in the hope that it will be useful,
+ ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ ;; GNU General Public License for more details.
+
+ ;; You should have received a copy of the GNU General Public License
+ ;; along with GNU Emacs; see the file COPYING. If not, write to the
+ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ ;; Boston, MA 02111-1307, USA.
+
+ ;;; Commentary:
+
+ ;;; This was based upon Kai Grossjohan's shamessly snarfed code and
+ ;;; further modified by Joe Hildebrand. It has been updated for Red
+ ;;; Gnus.
+
+ ;; TODO:
+ ;;
+ ;; * Fix bug where server connection can be lost and impossible to regain
+ ;; This hasn't happened to me in a while; think it was fixed in Rgnus
+ ;;
+ ;; * make it handle different nndb servers seemlessly
+ ;;
+ ;; * Optimize expire if FORCE
+ ;;
+ ;; * Optimize move (only expire once)
+ ;;
+ ;; * Deal with add/deletion of groups
+ ;;
+ ;; * make the backend TOUCH an article when marked as expireable (will
+ ;; make article expire 'expiry' days after that moment).
+
+ ;;-
+ ;; Register nndb with known select methods.
+
+ (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)
+
+ ;;; Code:
+
+ (require 'nnmail)
+ (require 'nnheader)
+ (require 'nntp)
+ (eval-when-compile (require 'cl))
+
+ (eval-and-compile
+ (unless (fboundp 'open-network-stream)
+ (require 'tcp)))
+
+ (eval-when-compile (require 'cl))
+
+ (eval-and-compile
+ (autoload 'news-setup "rnewspost")
+ (autoload 'news-reply-mode "rnewspost")
+ (autoload 'cancel-timer "timer")
+ (autoload 'telnet "telnet" nil t)
+ (autoload 'telnet-send-input "telnet" nil t)
+ (autoload 'gnus-declare-backend "gnus-start"))
+
+ ;; Declare nndb as derived from nntp
+
+ (nnoo-declare nndb nntp)
+
+ ;; Variables specific to nndb
+
+ ;;- currently not used but just in case...
+ (defvoo nndb-deliver-program "nndel"
+ "*The program used to put a message in an NNDB group.")
+
+ (defvoo nndb-server-side-expiry nil
+ "If t, expiry calculation will occur on the server side.")
+
+ (defvoo nndb-set-expire-date-on-mark nil
+ "If t, the expiry date for a given article will be set to the time
+ it was marked as expireable; otherwise the date will be the time the
+ article was posted to nndb")
+
+ ;; Variables copied from nntp
+
+ (defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
+ "Like nntp-server-opened-hook."
+ nntp-server-opened-hook)
+
+ (defvoo nndb-address "localhost"
+ "*The name of the NNDB server."
+ nntp-address)
+
+ (defvoo nndb-port-number 9000
+ "*Port number to connect to."
+ nntp-port-number)
+
+ ;; change to 'news if you are actually using nndb for news
+ (defvoo nndb-article-type 'mail)
+
+ (defvoo nndb-status-string nil "" nntp-status-string)
+
+
+
+ (defconst nndb-version "nndb 0.7"
+ "Version numbers of this version of NNDB.")
+
+
+ ;;; Interface functions.
+
+ (nnoo-define-basics nndb)
+
+ ;;------------------------------------------------------------------
+
+ ;; this function turns the lisp list into a string list. There is
+ ;; probably a more efficient way to do this.
+ (defun nndb-build-article-string (articles)
+ (let (art-string art)
+ (while articles
+ (setq art (pop articles))
+ (setq art-string (concat art-string art " ")))
+ art-string))
+
+ (defun nndb-build-expire-rest-list (total expire)
+ (let (art rest)
+ (while total
+ (setq art (pop total))
+ (if (memq art expire)
+ ()
+ (push art rest)))
+ rest))
+
+
+ ;;
+ (deffoo nndb-request-type (group &optional article)
+ nndb-article-type)
+
+ ;; nndb-request-update-info does not exist and is not needed
+
+ ;; nndb-request-update-mark does not exist; it should be used to TOUCH
+ ;; articles as they are marked exipirable
+ (defun nndb-touch-article (group article)
+ (nntp-send-command nil "X-TOUCH" article))
+
+ (deffoo nndb-request-update-mark
+ (group article mark)
+ "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'"
+ (if (and nndb-set-expire-date-on-mark (string-equal mark "E"))
+ (nndb-touch-article group article))
+ mark)
+
+ ;; nndb-request-create-group -- currently this isn't necessary; nndb
+ ;; creates groups on demand.
+
+ ;; todo -- use some other time than the creation time of the article
+ ;; best is time since article has been marked as expirable
+
+ (defun nndb-request-expire-articles-local
+ (articles &optional group server force)
+ "Let gnus do the date check and issue the delete commands."
+ (let (msg art delete-list (num-delete 0) rest)
+ (nntp-possibly-change-group group server)
+ (while articles
+ (setq art (pop articles))
+ (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art)
+ (setq msg (nndb-status-message))
+ (if (string-match "^423" msg)
+ ()
+ (or (string-match "'\\(.+\\)'" msg)
+ (error "Not a valid response for X-DATE command: %s"
+ msg))
+ (if (nnmail-expired-article-p
+ group
+ (date-to-time (substring msg (match-beginning 1) (match-end 1)))
+ force)
+ (progn
+ (setq delete-list (concat delete-list " " (int-to-string art)))
+ (setq num-delete (1+ num-delete)))
+ (push art rest))))
+ (if (> (length delete-list) 0)
+ (progn
+ (nnheader-message 5 "Deleting %s article(s) from %s"
+ (int-to-string num-delete) group)
+ (nntp-send-command "^[23].*\n" "X-DELETE" delete-list))
+ )
+
+ (nnheader-message 5 "")
+ (nconc rest articles)))
+
+ (defun nndb-get-remote-expire-response ()
+ (let (list)
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (if (looking-at "^[34]")
+ ;; x-expire returned error--presume no articles were expirable)
+ (setq list nil)
+ ;; otherwise, pull all of the following numbers into the list
+ (re-search-forward "follows\r?\n?" nil t)
+ (while (re-search-forward "^[0-9]+$" nil t)
+ (push (string-to-int (match-string 0)) list)))
+ list))
+
+ (defun nndb-request-expire-articles-remote
+ (articles &optional group server force)
+ "Let the nndb backend expire articles"
+ (let (days art-string delete-list (num-delete 0))
+ (nntp-possibly-change-group group server)
+
+ ;; first calculate the wait period in days
+ (setq days (or (and nnmail-expiry-wait-function
+ (funcall nnmail-expiry-wait-function group))
+ nnmail-expiry-wait))
+ ;; now handle the special cases
+ (cond (force
+ (setq days 0))
+ ((eq days 'never)
+ ;; This isn't an expirable group.
+ (setq days -1))
+ ((eq days 'immediate)
+ (setq days 0)))
+
+
+ ;; build article string
+ (setq art-string (concat days " " (nndb-build-article-string articles)))
+ (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string)
+
+ (setq delete-list (nndb-get-remote-expire-response))
+ (setq num-delete (length delete-list))
+ (if (> num-delete 0)
+ (nnheader-message 5 "Deleting %s article(s) from %s"
+ (int-to-string num-delete) group))
+
+ (nndb-build-expire-rest-list articles delete-list)))
+
+ (deffoo nndb-request-expire-articles
+ (articles &optional group server force)
+ "Expires ARTICLES from GROUP on SERVER.
+ If FORCE, delete regardless of exiration date, otherwise use normal
+ expiry mechanism."
+ (if nndb-server-side-expiry
+ (nndb-request-expire-articles-remote articles group server force)
+ (nndb-request-expire-articles-local articles group server force)))
+
+ (deffoo nndb-request-move-article
+ (article group server accept-form &optional last)
+ "Move ARTICLE (a number) from GROUP on SERVER.
+ Evals ACCEPT-FORM in current buffer, where the article is.
+ Optional LAST is ignored."
+ ;; we guess that the second arg in accept-form is the new group,
+ ;; which it will be for nndb, which is all that matters anyway
+ (let ((new-group (nth 1 accept-form)) result)
+ (nntp-possibly-change-group group server)
+
+ ;; use the move command for nndb-to-nndb moves
+ (if (string-match "^nndb" new-group)
+ (let ((new-group-name (gnus-group-real-name new-group)))
+ (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name)
+ (cons new-group article))
+ ;; else move normally
+ (let ((artbuf (get-buffer-create " *nndb move*")))
+ (and
+ (nndb-request-article article group server artbuf)
+ (save-excursion
+ (set-buffer artbuf)
+ (insert-buffer-substring nntp-server-buffer)
+ (setq result (eval accept-form))
+ (kill-buffer (current-buffer))
+ result)
+ (nndb-request-expire-articles (list article)
+ group
+ server
+ t))
+ result)
+ )))
+
+ (deffoo nndb-request-accept-article (group server &optional last)
+ "The article in the current buffer is put into GROUP."
+ (nntp-possibly-change-group group server)
+ (let (art msg)
+ (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
+ (nnheader-insert "")
+ (nntp-send-buffer "^[23].*\n"))
+
+ (set-buffer nntp-server-buffer)
+ (setq msg (buffer-string))
+ (or (string-match "^\\([0-9]+\\)" msg)
+ (error "nndb: %s" msg))
+ (setq art (substring msg (match-beginning 1) (match-end 1)))
+ (nnheader-message 5 "nndb: accepted %s" art)
+ (list art)))
+
+ (deffoo nndb-request-replace-article (article group buffer)
+ "ARTICLE is the number of the article in GROUP to be replaced with the
contents of the BUFFER."
+ (set-buffer buffer)
+ (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article))
+ (nnheader-insert "")
+ (nntp-send-buffer "^[23.*\n")
+ (list (int-to-string article))))
+
+ ; nndb-request-delete-group does not exist
+ ; todo -- maybe later
+
+ ; nndb-request-rename-group does not exist
+ ; todo -- maybe later
+
+ ;; -- standard compatability functions
+
+ (deffoo nndb-status-message (&optional server)
+ "Return server status as a string."
+ (set-buffer nntp-server-buffer)
+ (buffer-string))
+
+ ;; Import stuff from nntp
+
+ (nnoo-import nndb
+ (nntp))
+
+ (provide 'nndb)
+
+ ;;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a
+ ;;; nndb.el ends here
- [Emacs-diffs] Changes to emacs/lisp/gnus/nndb.el [emacs-unicode-2],
Miles Bader <=