(nnmh-retrieve-parsed-headers): New function.

diff --git a/lisp/nnmh.el b/lisp/nnmh.el
index 8997237..434bcf9 100644 (file)
--- a/lisp/nnmh.el
+++ b/lisp/nnmh.el
@@ -113,6 +113,143 @@
         ;; (nnheader-fold-continuation-lines)
        'headers))))
 
+(deffoo nnmh-retrieve-parsed-headers (articles
+                                     dependencies
+                                     &optional newsgroup server fetch-old
+                                     force-new)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (let* ((file nil)
+          (number (length articles))
+          (large (and (numberp nnmail-large-newsgroup)
+                      (> number nnmail-large-newsgroup)))
+          (count 0)
+          (pathname-coding-system 'binary)
+          (case-fold-search t)
+          ;;beg
+          article
+          headers header id end ref lines chars ctype)
+      (nnmh-possibly-change-directory newsgroup server)
+      ;; We don't support fetching by Message-ID.
+      (if (stringp (car articles))
+         'headers
+       (while articles
+         (when (and (file-exists-p
+                     (setq file (concat (file-name-as-directory
+                                         nnmh-current-directory)
+                                        (int-to-string
+                                         (setq article (pop articles))))))
+                    (not (file-directory-p file)))
+           ;;(insert (format "221 %d Article retrieved.\n" article))
+           ;;(setq beg (point))
+           (erase-buffer)
+           (nnheader-insert-head file)
+           (save-restriction
+             (std11-narrow-to-header)
+             (setq
+              header
+              (make-full-mail-header
+               ;; Number.
+               article
+               ;; Subject.
+               (or (std11-fetch-field "Subject")
+                   "(none)")
+               ;; From.
+               (or (std11-fetch-field "From")
+                   "(nobody)")
+               ;; Date.
+               (or (std11-fetch-field "Date")
+                   "")
+               ;; Message-ID.
+               (progn
+                 (goto-char (point-min))
+                 (setq id (if (re-search-forward
+                               "^Message-ID: *\\(<[^\n\t> ]+>\\)" nil t)
+                              ;; We do it this way to make sure the Message-ID
+                              ;; is (somewhat) syntactically valid.
+                              (buffer-substring (match-beginning 1)
+                                                (match-end 1))
+                            ;; If there was no message-id, we just fake one
+                            ;; to make subsequent routines simpler.
+                            (nnheader-generate-fake-message-id))))
+               ;; References.
+               (progn
+                 (goto-char (point-min))
+                 (if (search-forward "\nReferences: " nil t)
+                     (progn
+                       (setq end (point))
+                       (prog1
+                           (buffer-substring (match-end 0) (std11-field-end))
+                         (setq ref
+                               (buffer-substring
+                                (progn
+                                  ;; (end-of-line)
+                                  (search-backward ">" end t)
+                                  (1+ (point)))
+                                (progn
+                                  (search-backward "<" end t)
+                                  (point))))))
+                   ;; Get the references from the in-reply-to header if there
+                   ;; were no references and the in-reply-to header looks
+                   ;; promising.
+                   (if (and (search-forward "\nIn-Reply-To: " nil t)
+                            (setq in-reply-to
+                                  (buffer-substring (match-end 0)
+                                                    (std11-field-end)))
+                            (string-match "<[^>]+>" in-reply-to))
+                       (let (ref2)
+                         (setq ref (substring in-reply-to (match-beginning 0)
+                                              (match-end 0)))
+                         (while (string-match "<[^>]+>"
+                                              in-reply-to (match-end 0))
+                           (setq ref2
+                                 (substring in-reply-to (match-beginning 0)
+                                            (match-end 0)))
+                           (when (> (length ref2) (length ref))
+                             (setq ref ref2)))
+                         ref)
+                     (setq ref nil))))
+               ;; Chars.
+               (progn
+                 (goto-char (point-min))
+                 (if (search-forward "\nChars: " nil t)
+                     (if (numberp (setq chars (ignore-errors (read cur))))
+                         chars 0)
+                   0))
+               ;; Lines.
+               (progn
+                 (goto-char (point-min))
+                 (if (search-forward "\nLines: " nil t)
+                     (if (numberp (setq lines (ignore-errors (read cur))))
+                         lines 0)
+                   0))
+               ;; Xref.
+               (std11-fetch-field "Xref")
+               ))
+             (goto-char (point-min))
+             (if (setq ctype (std11-fetch-field "Content-Type"))
+                 (mime-entity-set-content-type-internal
+                  header (mime-parse-Content-Type ctype)))
+             )
+           (when (setq header
+                       (gnus-dependencies-add-header
+                        header dependencies force-new))
+             (push header headers))
+           )
+         (setq count (1+ count))
+
+         (and large
+              (zerop (% count 20))
+              (nnheader-message 5 "nnmh: Receiving headers... %d%%"
+                                (/ (* count 100) number))))
+
+       (when large
+         (nnheader-message 5 "nnmh: Receiving headers...done"))
+
+        ;; (nnheader-fold-continuation-lines)
+       (cons 'header (nreverse headers))
+       ))))
+
 (deffoo nnmh-open-server (server &optional defs)
   (nnoo-change-server 'nnmh server defs)
   (when (not (file-exists-p nnmh-directory))