cgit.sxemacs.org Git - gnus/blob - lisp/nndigest.el

   1 ;;; nndigest.el --- digest access for Gnus
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;; Keywords: news
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (require 'nnheader)
  28
  29 \f
  30
  31 (defconst nndigest-version "nndigest 0.0"
  32   "nndigest version.")
  33
  34 (defvar nndigest-current-buffer nil
  35   "Current digest "group" buffer.")
  36
  37 (defvar nndigest-status-string "")
  38
  39 (defvar nndigest-group-alist nil)
  40
  41 (defconst nndigest-separator "------------------------------[\n \t]*\n[^ ]+: ")
  42
  43 \f
  44
  45 ;;; Interface functions.
  46
  47 (defun nndigest-retrieve-headers (sequence &optional newsgroup server)
  48   "Retrieve the headers for the articles in SEQUENCE.
  49 Newsgroup must be selected before calling this function."
  50   (save-excursion
  51     (set-buffer nntp-server-buffer)
  52     (erase-buffer)
  53     (let ((file nil)
  54           (number (length sequence))
  55           (count 0)
  56           range
  57           beg article)
  58       (nndigest-possibly-change-buffer newsgroup)
  59       (while sequence
  60         (setq article (car sequence))
  61         (if (setq range (nndigest-narrow-to-article article))
  62             (progn
  63               (insert (format "221 %d Article retrieved.\n" article))
  64               (setq beg (point))
  65               (insert-buffer-substring nndigest-current-buffer
  66                                        (car range) (cdr range))
  67               (goto-char beg)
  68               (if (search-forward "\n\n" nil t)
  69                   (forward-char -1)
  70                 (goto-char (point-max))
  71                 (insert "\n\n"))
  72               (insert (format "Lines: %d\n" (count-lines (point) (point-max))))
  73               (insert ".\n")
  74               (delete-region (point) (point-max))))
  75         (setq sequence (cdr sequence)))
  76
  77       ;; Fold continuation lines.
  78       (goto-char 1)
  79       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
  80         (replace-match " " t t))
  81       'headers)))
  82
  83 (defun nndigest-open-server (host &optional service)
  84   "Open news server on HOST."
  85   (setq nndigest-status-string "")
  86   (nnheader-init-server-buffer))
  87
  88 (defun nndigest-close-server (&optional server)
  89   "Close news server."
  90   t)
  91
  92 (defun nndigest-server-opened (&optional server)
  93   "Return server process status, T or NIL."
  94   (and nntp-server-buffer
  95        (get-buffer nntp-server-buffer)))
  96
  97 (defun nndigest-status-message ()
  98   "Return server status response as string."
  99   nndigest-status-string)
 100
 101 (defun nndigest-request-article (id &optional newsgroup server buffer)
 102   "Select article by message ID (or number)."
 103   (nndigest-possibly-change-buffer newsgroup)
 104   (let ((range (nndigest-narrow-to-article id)))
 105     (and range
 106          (save-excursion
 107            (set-buffer (or buffer nntp-server-buffer))
 108            (erase-buffer)
 109            (insert-buffer-substring
 110             nndigest-current-buffer (car range) (cdr range))
 111            t))))
 112
 113 (defun nndigest-request-group (group &optional server dont-check)
 114   "Select news GROUP."
 115   (let ((entry (assoc group nndigest-group-alist)))
 116     (and entry (setq nndigest-group-alist (delq entry nndigest-group-alist))))
 117   (let ((buffer (get-buffer-create (concat " *nndigest " group "*"))))
 118     (setq nndigest-group-alist
 119           (cons (cons group buffer) nndigest-group-alist))
 120     (save-excursion
 121       (set-buffer buffer)
 122       (erase-buffer)
 123       (insert-buffer-substring server)))
 124   (nndigest-possibly-change-buffer group)
 125   (let ((num 0))
 126     (save-excursion
 127       (set-buffer nndigest-current-buffer)
 128       (widen)
 129       (goto-char (point-min))
 130       (while (re-search-forward nndigest-separator nil t)
 131         (setq num (1+ num)))
 132       (set-buffer nntp-server-buffer)
 133       (erase-buffer)
 134       (insert (format "211 %d %d %d %s\n" num 1 num group))
 135       t)))
 136
 137 (defun nndigest-close-group (group &optional server)
 138   (nndigest-possibly-change-buffer group)
 139   (kill-buffer nndigest-current-buffer)
 140   (setq nndigest-group-alist (delq (assoc group nndigest-group-alist)
 141                                    nndigest-group-alist))
 142   (setq nndigest-current-buffer nil)
 143   t)
 144
 145 (defun nndigest-request-list (&optional server)
 146   "List active newsgoups."
 147   (save-excursion
 148     (set-buffer nntp-server-buffer)
 149     (erase-buffer)
 150     t))
 151
 152 (defun nndigest-request-newgroups (date &optional server)
 153   "List groups created after DATE."
 154   (save-excursion
 155     (set-buffer nntp-server-buffer)
 156     (erase-buffer)
 157     t))
 158
 159 (defun nndigest-request-list-newsgroups (&optional server)
 160   "List newsgroups (defined in NNTP2)."
 161   (save-excursion
 162     (set-buffer nntp-server-buffer)
 163     (erase-buffer)
 164     t))
 165
 166 (defun nndigest-request-post (&optional server)
 167   "Post a new news in current buffer."
 168   (mail-send-and-exit nil))
 169
 170 (fset 'nndigest-request-post-buffer 'nnmail-request-post-buffer)
 171
 172 \f
 173
 174 ;;; Internal functions
 175
 176 (defun nndigest-possibly-change-buffer (group)
 177   (and group
 178        (not (equal (cdr (assoc group nndigest-group-alist))
 179                    nndigest-current-buffer))
 180        (setq nndigest-current-buffer
 181              (cdr (assoc group nndigest-group-alist)))))
 182
 183 (defun nndigest-narrow-to-article (article)
 184   (save-excursion
 185     (set-buffer nndigest-current-buffer)
 186     (widen)
 187     (goto-char (point-min))
 188     (while (and (not (zerop article))
 189                 (re-search-forward nndigest-separator nil t))
 190       (setq article (1- article)))
 191     (if (zerop article)
 192         (progn
 193           (goto-char (match-end 0))
 194           (beginning-of-line)
 195           (narrow-to-region
 196            (point)
 197            (or (and (re-search-forward nndigest-separator nil t)
 198                     (match-beginning 0))
 199                (point-max)))
 200           (cons (point-min) (point-max)))
 201       nil)))
 202
 203
 204 (provide 'nndigest)
 205
 206 ;;; nndigest.el ends here