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 (eval-and-compile
  30   (autoload 'mail-send-and-exit "sendmail"))
  31
  32 \f
  33
  34 (defconst nndigest-version "nndigest 0.0"
  35   "nndigest version.")
  36
  37 (defvar nndigest-current-buffer nil
  38   "Current digest "group" buffer.")
  39
  40 (defvar nndigest-status-string "")
  41
  42 (defvar nndigest-group-alist nil)
  43
  44 (defvar nndigest-separator
  45   "^------------------------------[\n \t]*\n[^ ]+: ")
  46
  47 (defvar nndigest-first-article-separator
  48   "^------------------------------*[\n \t]*\n[^ ]+: ")
  49
  50 \f
  51
  52 ;;; Interface functions.
  53
  54 (defun nndigest-retrieve-headers (sequence &optional newsgroup server)
  55   (save-excursion
  56     (set-buffer nntp-server-buffer)
  57     (erase-buffer)
  58     (let ((file nil)
  59           (number (length sequence))
  60           (count 0)
  61           range
  62           beg article)
  63       (nndigest-possibly-change-buffer newsgroup)
  64       (while sequence
  65         (setq article (car sequence))
  66         (if (setq range (nndigest-narrow-to-article article))
  67             (progn
  68               (insert (format "221 %d Article retrieved.\n" article))
  69               (setq beg (point))
  70               (insert-buffer-substring nndigest-current-buffer
  71                                        (car range) (cdr range))
  72               (goto-char beg)
  73               (if (search-forward "\n\n" nil t)
  74                   (forward-char -1)
  75                 (goto-char (point-max))
  76                 (insert "\n\n"))
  77               (insert (format "Lines: %d\n" (count-lines (point) (point-max))))
  78               (insert ".\n")
  79               (delete-region (point) (point-max))))
  80         (setq sequence (cdr sequence)))
  81
  82       ;; Fold continuation lines.
  83       (goto-char (point-min))
  84       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
  85         (replace-match " " t t))
  86       'headers)))
  87
  88 (defun nndigest-open-server (host &optional service)
  89   (setq nndigest-status-string "")
  90   (nnheader-init-server-buffer))
  91
  92 (defun nndigest-close-server (&optional server)
  93   t)
  94
  95 (defun nndigest-server-opened (&optional server)
  96   (and nntp-server-buffer
  97        (get-buffer nntp-server-buffer)))
  98
  99 (defun nndigest-status-message ()
 100   nndigest-status-string)
 101
 102 (defun nndigest-request-article (id &optional newsgroup server buffer)
 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   (let ((entry (assoc group nndigest-group-alist)))
 115     (and entry (setq nndigest-group-alist (delq entry nndigest-group-alist))))
 116   (let ((buffer (get-buffer-create (concat " *nndigest " group "*"))))
 117     (setq nndigest-group-alist
 118           (cons (cons group buffer) nndigest-group-alist))
 119     (save-excursion
 120       (set-buffer buffer)
 121       (erase-buffer)
 122       (insert-buffer-substring server)))
 123   (nndigest-possibly-change-buffer group)
 124   (let ((num 0))
 125     (save-excursion
 126       (set-buffer nndigest-current-buffer)
 127       (widen)
 128       (goto-char (point-min))
 129       (if (re-search-forward nndigest-first-article-separator nil t)
 130           (setq num 1))
 131       (while (re-search-forward nndigest-separator nil t)
 132         (setq num (1+ num)))
 133       (set-buffer nntp-server-buffer)
 134       (erase-buffer)
 135       (insert (format "211 %d %d %d %s\n" num 1 num group))
 136       t)))
 137
 138 (defun nndigest-close-group (group &optional server)
 139   (nndigest-possibly-change-buffer group)
 140   (kill-buffer nndigest-current-buffer)
 141   (setq nndigest-group-alist (delq (assoc group nndigest-group-alist)
 142                                    nndigest-group-alist))
 143   (setq nndigest-current-buffer nil)
 144   t)
 145
 146 (defun nndigest-request-list (&optional server)
 147   (save-excursion
 148     (set-buffer nntp-server-buffer)
 149     (erase-buffer)
 150     t))
 151
 152 (defun nndigest-request-newgroups (date &optional server)
 153   (save-excursion
 154     (set-buffer nntp-server-buffer)
 155     (erase-buffer)
 156     t))
 157
 158 (defun nndigest-request-list-newsgroups (&optional server)
 159   (save-excursion
 160     (set-buffer nntp-server-buffer)
 161     (erase-buffer)
 162     t))
 163
 164 (defun nndigest-request-post (&optional server)
 165   (mail-send-and-exit nil))
 166
 167 (fset 'nndigest-request-post-buffer 'nnmail-request-post-buffer)
 168
 169 \f
 170
 171 ;;; Internal functions
 172
 173 (defun nndigest-possibly-change-buffer (group)
 174   (and group
 175        (not (equal (cdr (assoc group nndigest-group-alist))
 176                    nndigest-current-buffer))
 177        (setq nndigest-current-buffer
 178              (cdr (assoc group nndigest-group-alist)))))
 179
 180 (defun nndigest-narrow-to-article (article)
 181   (save-excursion
 182     (set-buffer nndigest-current-buffer)
 183     (widen)
 184     (goto-char (point-min))
 185     (re-search-forward nndigest-first-article-separator nil t)
 186     (while (and (not (zerop (setq article (1- article))))
 187                 (re-search-forward nndigest-separator nil t)))
 188     (if (zerop article)
 189         (progn
 190           (goto-char (match-end 0))
 191           (beginning-of-line)
 192           (narrow-to-region
 193            (point)
 194            (or (and (re-search-forward nndigest-separator nil t)
 195                     (match-beginning 0))
 196                (point-max)))
 197           (cons (point-min) (point-max)))
 198       nil)))
 199
 200
 201 (provide 'nndigest)
 202
 203 ;;; nndigest.el ends here