*** empty log message ***
[gnus] / lisp / nndoc.el
index 629e1cd..5554628 100644 (file)
 (defvar nndoc-article-type 'mbox
   "*Type of the file - one of `mbox', `babyl' or `digest'.")
 
+(defvar nndoc-digest-type 'traditional
+  "Type of the last digest.  Auto-detected from the article header.
+Possible values:
+  `traditional' -- the \"lots of dashes\" (30+) rules used;
+                   we currently also do unconditional RFC 934 unquoting.
+  `rfc1341' -- RFC 1341 digest (MIME, unique boundary, no quoting).")
+
 (defconst nndoc-type-to-regexp
   (list (list 'mbox 
              (concat "^" rmail-unix-mail-delimiter)
              (concat "^" rmail-unix-mail-delimiter)
-             nil "^$" nil)
-       (list 'babyl "\^_\^L *\n" "\^_" nil "^$" nil)
+             nil "^$" nil nil nil)
+       (list 'babyl "\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil
+             "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*")
        (list 'digest
+             "^------------------------------*[\n \t]+"
              "^------------------------------[\n \t]+"
-             "^------------------------------[\n \t]+"
-             nil "^$"   
-             "^------------------------------*[\n \t]*\n[^ ]+: "))
+             nil "^ ?$"   
+             "^------------------------------*[\n \t]+"
+             "^End of" nil))
   "Regular expressions for articles of the various types.")
 
 \f
@@ -52,6 +61,8 @@
 (defvar nndoc-head-begin nil)
 (defvar nndoc-head-end nil)
 (defvar nndoc-first-article nil)
+(defvar nndoc-end-of-file nil)
+(defvar nndoc-body-begin nil)
 
 (defvar nndoc-current-server nil)
 (defvar nndoc-server-alist nil)
@@ -65,6 +76,8 @@
    '(nndoc-first-article nil)
    '(nndoc-current-buffer nil)
    '(nndoc-group-alist nil)
+   '(nndoc-end-of-file nil)
+   '(nndoc-body-begin nil)
    '(nndoc-address nil)))
 
 (defconst nndoc-version "nndoc 0.1"
   (save-excursion
     (set-buffer nntp-server-buffer)
     (erase-buffer)
-    (let ((prev 1)
-         article p beg end lines)
+    (let ((prev 2)
+         article p beg lines)
       (nndoc-possibly-change-buffer newsgroup server)
       (if (stringp (car sequence))
          'headers
        (set-buffer nndoc-current-buffer)
        (goto-char (point-min))
-       (re-search-forward nndoc-article-begin nil t)
+       (re-search-forward (or nndoc-first-article 
+                              nndoc-article-begin) nil t)
        (or (not nndoc-head-begin)
            (re-search-forward nndoc-head-begin nil t))
        (re-search-forward nndoc-head-end nil t)
        (while sequence
          (setq article (car sequence))
          (set-buffer nndoc-current-buffer)
-         (if (not (nndoc-forward-article (- article prev)))
+         (if (not (nndoc-forward-article (max 0 (- article prev))))
              ()
            (setq p (point))
-           (setq beg (or (re-search-backward nndoc-article-begin nil t)
+           (setq beg (or (and
+                          (re-search-backward nndoc-article-begin nil t)
+                          (match-end 0))
                          (point-min)))
            (goto-char p)
            (setq lines (count-lines 
                          (and (re-search-forward nndoc-article-end nil t)
                               (goto-char (match-beginning 0)))
                          (goto-char (point-max)))))
-           (setq end (point))
 
            (set-buffer nntp-server-buffer)
            (insert (format "221 %d Article retrieved.\n" article))
-           (insert-buffer-substring nndoc-current-buffer beg end)
+           (insert-buffer-substring nndoc-current-buffer beg p)
            (goto-char (point-max))
            (insert (format "Lines: %d\n" lines))
            (insert ".\n"))
                sequence (cdr sequence)))
 
        ;; Fold continuation lines.
+       (set-buffer nntp-server-buffer)
        (goto-char (point-min))
        (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
          (replace-match " " t t))
       (setq nndoc-article-end (nth 1 defs))
       (setq nndoc-head-begin (nth 2 defs))
       (setq nndoc-head-end (nth 3 defs))
-      (setq nndoc-first-article (nth 4 defs)))
+      (setq nndoc-first-article (nth 4 defs))
+      (setq nndoc-end-of-file (nth 5 defs))
+      (setq nndoc-body-begin (nth 6 defs)))
     t))
 
 (defun nndoc-close-server (&optional server)
       (erase-buffer)
       (if (stringp article)
          nil
-       (nndoc-narrow-to-article article)
-       (insert-buffer-substring nndoc-current-buffer)
+       (nndoc-insert-article article)
+       ;; Unquote quoted non-separators in digests.
+       (if (and (eq nndoc-article-type 'digest)
+                (eq nndoc-digest-type 'traditional))
+           (progn
+             (goto-char (point-min))
+             (while (re-search-forward "^- -"nil t)
+               (replace-match "-" t t))))
        t))))
 
 (defun nndoc-request-group (group &optional server dont-check)
        (progn
          (setq nndoc-status-string "No such file or buffer")
          nil)
+      (nndoc-set-header-dependent-regexps) ; hack for MIME digests
       (if dont-check
          t
        (save-excursion
      ;; `source' is either a string (a file name) or a buffer object. 
      (buf
       (setq nndoc-current-buffer buf))
-     ;; It's a totally new group. 
+     ;; It's a totally new group.    
      ((or (and (bufferp nndoc-address)
               (buffer-name nndoc-address))
          (and (stringp nndoc-address)
          (insert-buffer-substring nndoc-address))
        t)))))
 
+;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>.
+(defun nndoc-set-header-dependent-regexps ()
+  (if (not (eq nndoc-article-type 'digest))
+      ()
+    (let ((case-fold-search t)     ; We match a bit too much, keep it simple.
+         (boundary-id) (b-delimiter))
+      (save-excursion
+       (set-buffer nndoc-current-buffer)
+       (goto-char (point-min))
+       (if (and
+            (re-search-forward
+             (concat "\n\n\\|^Content-Type: multipart/digest;[ \t\n]*[ \t]"
+                     "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
+             nil t)
+            (match-beginning 1))
+           (setq nndoc-digest-type 'rfc1341
+                 boundary-id (buffer-substring-no-properties
+                              (match-beginning 1) (match-end 1))
+                 b-delimiter       (concat "\n--" boundary-id "[\n \t]+")
+                 nndoc-article-begin b-delimiter ; Too strict: "[ \t]*$"
+                 nndoc-article-end (concat "\n--" boundary-id
+                                           "\\(--\\)?[\n \t]+")
+                 nndoc-first-article b-delimiter ; ^eof ends article too.
+                 nndoc-end-of-file (concat "\n--" boundary-id "--[ \t]*$"))
+         (setq nndoc-digest-type 'traditional))))))
+
 (defun nndoc-forward-article (n)
   (while (and (> n 0)
              (re-search-forward nndoc-article-begin nil t)
     (widen)
     (goto-char (point-min))
     (let ((num 0))
-      (while (and (re-search-forward nndoc-article-begin nil t)
+      (if (re-search-forward (or nndoc-first-article
+                                nndoc-article-begin) nil t)
+       (progn
+         (setq num 1)
+          (while (and (re-search-forward nndoc-article-begin nil t)
+                 (or (not nndoc-end-of-file)
+                     (not (looking-at nndoc-end-of-file)))
                  (or (not nndoc-head-begin)
                      (re-search-forward nndoc-head-begin nil t))
                  (re-search-forward nndoc-head-end nil t))
-       (setq num (1+ num)))
+           (setq num (1+ num)))))
       num)))
 
 (defun nndoc-narrow-to-article (article)
           (point-max)))
       t)))
 
+;; Insert article ARTICLE in the current buffer.
+(defun nndoc-insert-article (article)
+  (let ((ibuf (current-buffer)))
+    (save-excursion
+      (set-buffer nndoc-current-buffer)
+      (widen)
+      (goto-char (point-min))
+      (while (and (re-search-forward nndoc-article-begin nil t)
+                 (not (zerop (setq article (1- article))))))
+      (if (not (zerop article))
+         ()
+       (narrow-to-region 
+        (match-end 0)
+        (or (and (re-search-forward nndoc-article-end nil t)
+                 (match-beginning 0))
+            (point-max)))
+       (goto-char (point-min))
+       (and nndoc-head-begin
+            (re-search-forward nndoc-head-begin nil t)
+            (narrow-to-region (point) (point-max)))
+       (or (re-search-forward nndoc-head-end nil t)
+           (goto-char (point-max)))
+       (append-to-buffer ibuf (point-min) (point))
+       (and nndoc-body-begin 
+            (re-search-forward nndoc-body-begin nil t))
+       (append-to-buffer ibuf (point) (point-max))
+       t))))
+
 (provide 'nndoc)
 
 ;;; nndoc.el ends here