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

   1 ;;; nneething.el --- arbitrary file access for Gnus
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
   4 ;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   8 ;; Keywords: news, mail
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (eval-when-compile (require 'cl))
  30
  31 (require 'mailcap)
  32 (require 'nnheader)
  33 (require 'nnmail)
  34 (require 'nnoo)
  35 (require 'gnus-util)
  36
  37 (nnoo-declare nneething)
  38
  39 (defvoo nneething-map-file-directory
  40   (nnheader-concat gnus-directory ".nneething/")
  41   "Where nneething stores the map files.")
  42
  43 (defvoo nneething-map-file ".nneething"
  44   "Name of the map files.")
  45
  46 (defvoo nneething-exclude-files nil
  47   "Regexp saying what files to exclude from the group.
  48 If this variable is nil, no files will be excluded.")
  49
  50 (defvoo nneething-include-files nil
  51   "Regexp saying what files to include in the group.
  52 If this variable is non-nil, only files matching this regexp will be
  53 included.")
  54
  55 \f
  56
  57 ;;; Internal variables.
  58
  59 (defconst nneething-version "nneething 1.0"
  60   "nneething version.")
  61
  62 (defvoo nneething-current-directory nil
  63   "Current news group directory.")
  64
  65 (defvoo nneething-status-string "")
  66
  67 (defvoo nneething-work-buffer " *nneething work*")
  68
  69 (defvoo nneething-group nil)
  70 (defvoo nneething-map nil)
  71 (defvoo nneething-read-only nil)
  72 (defvoo nneething-active nil)
  73 (defvoo nneething-address nil)
  74
  75 \f
  76
  77 ;;; Interface functions.
  78
  79 (nnoo-define-basics nneething)
  80
  81 (deffoo nneething-retrieve-headers (articles &optional group server fetch-old)
  82   (nneething-possibly-change-directory group)
  83
  84   (with-current-buffer nntp-server-buffer
  85     (erase-buffer)
  86     (let* ((number (length articles))
  87            (count 0)
  88            (large (and (numberp nnmail-large-newsgroup)
  89                        (> number nnmail-large-newsgroup)))
  90            article file)
  91
  92       (if (stringp (car articles))
  93           'headers
  94
  95         (while (setq article (pop articles))
  96           (setq file (nneething-file-name article))
  97
  98           (when (and (file-exists-p file)
  99                      (or (file-directory-p file)
 100                          (not (zerop (nnheader-file-size file)))))
 101             (insert (format "221 %d Article retrieved.\n" article))
 102             (nneething-insert-head file)
 103             (insert ".\n"))
 104
 105           (incf count)
 106
 107           (and large
 108                (zerop (% count 20))
 109                (nnheader-message 5 "nneething: Receiving headers... %d%%"
 110                                  (/ (* count 100) number))))
 111
 112         (when large
 113           (nnheader-message 5 "nneething: Receiving headers...done"))
 114
 115         (nnheader-fold-continuation-lines)
 116         'headers))))
 117
 118 (deffoo nneething-request-article (id &optional group server buffer)
 119   (nneething-possibly-change-directory group)
 120   (let ((file (unless (stringp id)
 121                 (nneething-file-name id)))
 122         (nntp-server-buffer (or buffer nntp-server-buffer)))
 123     (and (stringp file)            ; We did not request by Message-ID.
 124          (file-exists-p file)           ; The file exists.
 125          (not (file-directory-p file))  ; It's not a dir.
 126          (save-excursion
 127            (let ((nnmail-file-coding-system 'binary))
 128              (nnmail-find-file file))   ; Insert the file in the nntp buf.
 129            (unless (nnheader-article-p) ; Either it's a real article...
 130              (let ((type
 131                     (unless (file-directory-p file)
 132                       (or (cdr (assoc (concat "." (file-name-extension file))
 133                                       mailcap-mime-extensions))
 134                           "text/plain")))
 135                    (charset
 136                     (mm-detect-mime-charset-region (point-min) (point-max)))
 137                    (encoding))
 138                (unless (string-match "\\`text/" type)
 139                  (base64-encode-region (point-min) (point-max))
 140                  (setq encoding "base64"))
 141                (goto-char (point-min))
 142                (nneething-make-head file (current-buffer)
 143                                     nil type charset encoding))
 144              (insert "\n"))
 145            t))))
 146
 147 (deffoo nneething-request-group (group &optional server dont-check info)