Silence byte compiler.

[gnus] / lisp / nneething.el

diff --git a/lisp/nneething.el b/lisp/nneething.el
index 043f83d..57475b9 100644 (file)
--- a/lisp/nneething.el
+++ b/lisp/nneething.el
@@ -1,16 +1,17 @@
-;;; nneething.el --- random file access for Gnus
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;;; nneething.el --- arbitrary file access for Gnus

 
 

-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>

 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
 
 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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
 ;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -18,316 +19,406 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

-;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.  
-

 ;;; Code:
 
 ;;; Code:
 

+(eval-when-compile (require 'cl))
+
+(require 'mailcap)

 (require 'nnheader)
 (require 'nnmail)
 (require 'nnheader)
 (require 'nnmail)

+(require 'nnoo)
+(require 'gnus-util)
+
+(nnoo-declare nneething)

 
 

-(defvar nneething-map-file-directory "~/.nneething/"
-  "*Map files directory.")
+(defvoo nneething-map-file-directory
+  (nnheader-concat gnus-directory ".nneething/")
+  "Where nneething stores the map files.")

 
 

-(defvar nneething-exclude-files "~$"
-  "*Regexp saying what files to exclude from the group.")
+(defvoo nneething-map-file ".nneething"
+  "Name of the map files.")

 
 

-(defvar nneething-map-file ".nneething"
-  "*Name of map files.")
+(defvoo nneething-exclude-files nil
+  "Regexp saying what files to exclude from the group.
+If this variable is nil, no files will be excluded.")
+
+(defvoo nneething-include-files nil
+  "Regexp saying what files to include in the group.
+If this variable is non-nil, only files matching this regexp will be
+included.")

 
 \f
 
 
 \f
 

+;;; Internal variables.
+

 (defconst nneething-version "nneething 1.0"
   "nneething version.")
 
 (defconst nneething-version "nneething 1.0"
   "nneething version.")
 

-(defvar nneething-current-directory nil
+(defvoo nneething-current-directory nil

   "Current news group directory.")
 
   "Current news group directory.")
 

-(defvar nneething-status-string "")
-(defvar nneething-group-alist nil)
+(defvoo nneething-status-string "")

 
 

-\f
+(defvoo nneething-work-buffer " *nneething work*")

 
 

-(defvar nneething-directory nil)
-(defvar nneething-group nil)
-(defvar nneething-map nil)
-(defvar nneething-read-only nil)
-(defvar nneething-active nil)
-(defvar nneething-server-variables 
-  (list
-   (list 'nneething-directory nneething-directory)
-   '(nneething-current-directory nil)
-   '(nneething-status-string "")
-   '(nneething-group-alist)))
+(defvoo nneething-group nil)
+(defvoo nneething-map nil)
+(defvoo nneething-read-only nil)
+(defvoo nneething-active nil)
+(defvoo nneething-address nil)

 
 \f
 
 ;;; Interface functions.
 
 
 \f
 
 ;;; Interface functions.
 

-(defun nneething-retrieve-headers (sequence &optional newsgroup server fetch-old)
-  (nneething-possibly-change-directory newsgroup)
+(nnoo-define-basics nneething)
+
+(deffoo nneething-retrieve-headers (articles &optional group server fetch-old)
+  (nneething-possibly-change-directory group)

 
 

-  (save-excursion
-    (set-buffer nntp-server-buffer)
+  (with-current-buffer nntp-server-buffer

     (erase-buffer)
     (erase-buffer)

-    (let* ((number (length sequence))
+    (let* ((number (length articles))

           (count 0)
           (large (and (numberp nnmail-large-newsgroup)
                       (> number nnmail-large-newsgroup)))
           article file)
 
           (count 0)
           (large (and (numberp nnmail-large-newsgroup)
                       (> number nnmail-large-newsgroup)))
           article file)
 

-      (if (stringp (car sequence))
+      (if (stringp (car articles))

          'headers
 
          'headers
 

-       (while sequence
-         (setq article (car sequence))
+       (while (setq article (pop articles))

          (setq file (nneething-file-name article))
 
          (setq file (nneething-file-name article))
 

-         (if (and (file-exists-p file)
-                  (not (zerop (nth 7 (file-attributes file)))))
-             (progn
-               (insert (format "221 %d Article retrieved.\n" article))
-               (nneething-insert-head file)
-               (insert ".\n")))
+         (when (and (file-exists-p file)
+                    (or (file-directory-p file)
+                        (not (zerop (nnheader-file-size file)))))
+           (insert (format "221 %d Article retrieved.\n" article))
+           (nneething-insert-head file)
+           (insert ".\n"))

 
 

-         (setq sequence (cdr sequence)
-               count (1+ count))
+         (incf count)

 
          (and large
               (zerop (% count 20))
 
          (and large
               (zerop (% count 20))

-              (message "nneething: Receiving headers... %d%%"
-                       (/ (* count 100) number))))
+              (nnheader-message 5 "nneething: Receiving headers... %d%%"
+                                (/ (* count 100) number))))

 
 

-       (and large (message "nneething: Receiving headers...done"))
+       (when large
+         (nnheader-message 5 "nneething: Receiving headers...done"))

 
 

-       ;; Fold continuation lines.
-       (goto-char (point-min))
-       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
-         (replace-match " " t t))
+       (nnheader-fold-continuation-lines)

        'headers))))
 
        'headers))))
 

-(defun nneething-open-server (server &optional defs)
-  (setq nneething-status-string "")
-  (nnheader-init-server-buffer))
-
-(defun nneething-close-server (&optional server)
-  t)
-
-(defun nneething-server-opened (&optional server)
-  t)
-
-(defun nneething-status-message (&optional server)
-  nneething-status-string)
-
-(defun nneething-request-article (id &optional newsgroup server buffer)
-  (nneething-possibly-change-directory newsgroup)
-  (let ((file (if (stringp id) nil (nneething-file-name id)))
+(deffoo nneething-request-article (id &optional group server buffer)
+  (nneething-possibly-change-directory group)
+  (let ((file (unless (stringp id)
+               (nneething-file-name id)))

        (nntp-server-buffer (or buffer nntp-server-buffer)))
        (nntp-server-buffer (or buffer nntp-server-buffer)))

-    (and (stringp file)                        ; We did not request by Message-ID.
+    (and (stringp file)                   ; We did not request by Message-ID.

         (file-exists-p file)           ; The file exists.
         (not (file-directory-p file))  ; It's not a dir.
         (save-excursion
         (file-exists-p file)           ; The file exists.
         (not (file-directory-p file))  ; It's not a dir.
         (save-excursion

-          (nnmail-find-file file)      ; Insert the file in the nntp buf.
-          (or (nnheader-article-p)     ; Either it's a real article...
-              (progn
-                (goto-char (point-min))
-                (nneething-make-head file) ; ... or we fake some headers.
-                (insert "\n")))
+          (let ((nnmail-file-coding-system 'binary))
+            (nnmail-find-file file))   ; Insert the file in the nntp buf.
+          (unless (nnheader-article-p) ; Either it's a real article...
+            (let ((type
+                   (unless (file-directory-p file)
+                     (or (cdr (assoc (concat "." (file-name-extension file))
+                                     mailcap-mime-extensions))
+                         "text/plain")))
+                  (charset
+                   (mm-detect-mime-charset-region (point-min) (point-max)))
+                  (encoding))
+              (unless (string-match "\\`text/" type)
+                (base64-encode-region (point-min) (point-max))
+                (setq encoding "base64"))
+              (goto-char (point-min))
+              (nneething-make-head file (current-buffer)
+                                   nil type charset encoding))
+            (insert "\n"))

           t))))
 
           t))))
 

-(defun nneething-request-group (group &optional dir dont-check)
-  (nneething-possibly-change-directory group dir)
-  (or dont-check (nneething-create-mapping))
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
+(deffoo nneething-request-group (group &optional server dont-check info)
+  (nneething-possibly-change-directory group server)
+  (unless dont-check
+    (nneething-create-mapping)

     (if (> (car nneething-active) (cdr nneething-active))
     (if (> (car nneething-active) (cdr nneething-active))

-       (insert (format "211 0 1 0 %s\n" group))
-      (insert (format "211 %d %d %d %s\n" 
-                     (- (1+ (cdr nneething-active)) (car nneething-active))
-                     (car nneething-active) (cdr nneething-active)
-                     group)))
-    t))
-
-(defun nneething-request-list (&optional server dir)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer))
-  nil)
-
-(defun nneething-request-newgroups (date &optional server)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer))
-  nil)
-
-(defun nneething-request-post (&optional server)
-  (mail-send-and-exit nil))
-
-(defun nneething-close-group (group &optional server)
+       (nnheader-insert "211 0 1 0 %s\n" group)
+      (nnheader-insert
+       "211 %d %d %d %s\n"
+       (- (1+ (cdr nneething-active)) (car nneething-active))
+       (car nneething-active) (cdr nneething-active)
+       group)))

   t)
 
   t)
 

+(deffoo nneething-request-list (&optional server dir)
+  (nnheader-report 'nneething "LIST is not implemented."))
+
+(deffoo nneething-request-newgroups (date &optional server)
+  (nnheader-report 'nneething "NEWSGROUPS is not implemented."))
+
+(deffoo nneething-request-type (group &optional article)
+  'unknown)
+
+(deffoo nneething-close-group (group &optional server)
+  (setq nneething-current-directory nil)
+  t)
+
+(deffoo nneething-open-server (server &optional defs)
+  (nnheader-init-server-buffer)
+  (if (nneething-server-opened server)
+      t
+    (unless (assq 'nneething-address defs)
+      (setq defs (append defs (list (list 'nneething-address server)))))
+    (nnoo-change-server 'nneething server defs)))
+

 \f
 ;;; Internal functions.
 
 \f
 ;;; Internal functions.
 

-(defun nneething-possibly-change-directory (group &optional dir)
-  (if (not group)
-      ()
-    (if (and nneething-group
-            (string= group nneething-group))
-       t
-      (let (entry)
-       (if (setq entry (assoc group nneething-group-alist))
-           (progn
-             (setq nneething-group group)
-             (setq nneething-directory (nth 1 entry))
-             (setq nneething-map (nth 2 entry))
-             (setq nneething-active (nth 3 entry)))
-         (setq nneething-group group)
-         (setq nneething-directory dir)
-         (setq nneething-map nil)
-         (setq nneething-active (cons 1 0))
-         (nneething-create-mapping)
-         (setq nneething-group-alist
-               (cons (list group dir nneething-map nneething-active)
-                     nneething-group-alist)))))))
+(defun nneething-possibly-change-directory (group &optional server)
+  (when (and server
+            (not (nneething-server-opened server)))
+    (nneething-open-server server))
+  (when (and group
+            (not (equal nneething-group group)))
+    (setq nneething-group group)
+    (setq nneething-map nil)
+    (setq nneething-active (cons 1 0))
+    (nneething-create-mapping)))

 
 (defun nneething-map-file ()
 
 (defun nneething-map-file ()

-  ;; We make sure that the .neething directory exists. 
-  (or (file-exists-p nneething-map-file-directory)
-      (make-directory nneething-map-file-directory 'parents))
+  ;; We make sure that the .nneething directory exists.
+  (gnus-make-dir