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 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 ".\n")
  73               (delete-region (point) (point-max))))
  74         (setq sequence (cdr sequence)))
  75
  76       ;; Fold continuation lines.
  77       (goto-char 1)
  78       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
  79         (replace-match " " t t))
  80       'headers)))
  81
  82 (defun nndigest-open-server (host &optional service)
  83   "Open news server on HOST."
  84   (setq nndigest-status-string "")
  85   (nnheader-init-server-buffer))
  86
  87 (defun nndigest-close-server (&optional server)
  88   "Close news server."
  89   t)
  90
  91 (defun nndigest-server-opened (&optional server)
  92   "Return server process status, T or NIL."
  93   (and nntp-server-buffer
  94        (get-buffer nntp-server-buffer)))
  95
  96 (defun nndigest-status-message ()
  97   "Return server status response as string."
  98   nndigest-status-string)
  99
 100 (defun nndigest-request-article (id &optional newsgroup server buffer)
 101   "Select article by message ID (or number)."
 102   (nndigest-possibly-change-buffer newsgroup)
 103   (let ((range (nndigest-narrow-to-article id)))
 104     (and range
 105          (save-excursion
 106            (set-buffer (or buffer nntp-server-buffer))
 107            (erase-buffer)
 108            (insert-buffer-substring
 109             nndigest-current-buffer (car range) (cdr range))
 110            t))))
 111
 112 (defun nndigest-request-group (group &optional server dont-check)
 113   "Select news GROUP."
 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       (while (re-search-forward nndigest-separator nil t)
 130         (setq num (1+ num)))
 131       (set-buffer nntp-server-buffer)
 132       (erase-buffer)
 133       (insert (format "211 %d %d %d %s\n" num 1 num group))
 134       t)))
 135
 136 (defun nndigest-close-group (group &optional server)
 137   (nndigest-possibly-change-buffer group)
 138   (kill-buffer nndigest-current-buffer)
 139   (setq nndigest-group-alist (delq (assoc group nndigest-group-alist)
 140                                    nndigest-group-alist))
 141   (setq nndigest-current-buffer nil)
 142   t)
 143
 144 (defun nndigest-request-list (&optional server)
 145   "List active newsgoups."
 146   (save-excursion
 147     (set-buffer nntp-server-buffer)
 148     (erase-buffer)
 149     t))
 150
 151 (defun nndigest-request-newgroups (date &optional server)
 152   "List groups created after DATE."
 153   (save-excursion
 154     (set-buffer nntp-server-buffer)
 155     (erase-buffer)
 156     t))
 157
 158 (defun nndigest-request-list-newsgroups (&optional server)
 159   "List newsgroups (defined in NNTP2)."
 160   (save-excursion
 161     (set-buffer nntp-server-buffer)
 162     (erase-buffer)
 163     t))
 164
 165 (defun nndigest-request-post (&optional server)
 166   "Post a new news in current buffer."
 167   (mail-send-and-exit nil))
 168
 169 (fset 'nndigest-request-post-buffer 'nnmail-request-post-buffer)
 170
 171 \f
 172
 173 ;;; Internal functions
 174
 175 (defun nndigest-possibly-change-buffer (group)
 176   (and group
 177        (not (equal (cdr (assoc group nndigest-group-alist))
 178                    nndigest-current-buffer))
 179        (setq nndigest-current-buffer
 180              (cdr (assoc group nndigest-group-alist)))))
 181
 182 (defun nndigest-narrow-to-article (article)
 183   (save-excursion
 184     (set-buffer nndigest-current-buffer)
 185     (widen)
 186     (goto-char (point-min))
 187     (while (and (not (zerop article))
 188                 (re-search-forward nndigest-separator nil t))
 189       (setq article (1- article)))
 190     (if (zerop article)
 191         (progn
 192           (goto-char (match-end 0))
 193           (beginning-of-line)
 194           (narrow-to-region
 195            (point)
 196            (or (and (re-search-forward nndigest-separator nil t)
 197                     (progn
 198                       (beginning-of-line)
 199                       (point)))
 200                (point-max)))
 201           (cons (point-min) (point-max)))
 202       nil)))
 203
 204
 205 (provide 'nndigest)
 206
 207 ;;; nndigest.el ends here