- (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 (format "%s"
- (buffer-substring
- (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)
- (or (not nndoc-head-begin)
- (re-search-forward nndoc-head-begin nil t))
- (re-search-forward nndoc-head-end nil t))
- (setq n (1- n)))
- (zerop n))
-
-(defun nndoc-number-of-articles ()
- (save-excursion
- (set-buffer nndoc-current-buffer)
- (widen)
- (goto-char (point-min))
- (let ((num 0))
- (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)))))
- num)))
-
-(defun nndoc-narrow-to-article (article)
- (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)))
+ (when (numberp (setq result (funcall (intern
+ (format "nndoc-%s-type-p"
+ (car entry))))))
+ (push (cons result entry) results)
+ (setq result nil))))
+ (unless (or result results)
+ (error "Document is not of any recognized type"))
+ (if result
+ (car entry)
+ (cadar (sort results (lambda (r1 r2) (< (car r1) (car r2))))))))
+
+;;;
+;;; Built-in type predicates and functions
+;;;
+
+(defun nndoc-mbox-type-p ()
+ (when (looking-at message-unix-mail-delimiter)
+ t))
+
+(defun nndoc-mbox-article-begin ()
+ (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
+ (goto-char (match-beginning 0))))
+
+(defun nndoc-mbox-body-end ()
+ (let ((beg (point))
+ len end)
+ (when
+ (save-excursion
+ (and (re-search-backward
+ (concat "^" message-unix-mail-delimiter) nil t)
+ (setq end (point))
+ (search-forward "\n\n" beg t)
+ (re-search-backward
+ "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
+ (setq len (string-to-int (match-string 1)))
+ (search-forward "\n\n" beg t)
+ (unless (= (setq len (+ (point) len)) (point-max))
+ (and (< len (point-max))
+ (goto-char len)
+ (looking-at message-unix-mail-delimiter)))))
+ (goto-char len))))
+
+(defun nndoc-mmdf-type-p ()
+ (when (looking-at "\^A\^A\^A\^A$")
+ t))
+
+(defun nndoc-news-type-p ()
+ (when (looking-at "^Path:.*\n")
+ t))
+
+(defun nndoc-rnews-type-p ()
+ (when (looking-at "#! *rnews")
+ t))
+
+(defun nndoc-rnews-body-end ()
+ (and (re-search-backward nndoc-article-begin nil t)
+ (forward-line 1)
+ (goto-char (+ (point) (string-to-int (match-string 1))))))
+
+(defun nndoc-babyl-type-p ()
+ (when (re-search-forward "\^_\^L *\n" nil t)
+ t))
+
+(defun nndoc-babyl-body-begin ()
+ (re-search-forward "^\n" nil t)
+ (when (looking-at "\*\*\* EOOH \*\*\*")
+ (let ((next (or (save-excursion
+ (re-search-forward nndoc-article-begin nil t))
+ (point-max))))
+ (unless (re-search-forward "^\n" next t)
+ (goto-char next)
+ (forward-line -1)
+ (insert "\n")
+ (forward-line -1)))))
+
+(defun nndoc-babyl-head-begin ()
+ (when (re-search-forward "^[0-9].*\n" nil t)
+ (when (looking-at "\*\*\* EOOH \*\*\*")
+ (forward-line 1))
+ t))
+
+(defun nndoc-forward-type-p ()
+ (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
+ (not (re-search-forward "^Subject:.*digest" nil t))
+ (not (re-search-backward "^From:" nil t 2))
+ (not (re-search-forward "^From:" nil t 2)))
+ t))
+
+(defun nndoc-rfc934-type-p ()
+ (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t)
+ (not (re-search-forward "^Subject:.*digest" nil t))
+ (not (re-search-backward "^From:" nil t 2))
+ (not (re-search-forward "^From:" nil t 2)))
+ t))
+
+(defun nndoc-clari-briefs-type-p ()
+ (when (let ((case-fold-search nil))
+ (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
+ t))
+
+(defun nndoc-transform-clari-briefs (article)
+ (goto-char (point-min))
+ (when (looking-at " *\\*\\(.*\\)\n")
+ (replace-match "" t t))
+ (nndoc-generate-clari-briefs-head article))
+
+(defun nndoc-generate-clari-briefs-head (article)
+ (let ((entry (cdr (assq article nndoc-dissection-alist)))
+ subject from)
+ (save-excursion
+ (set-buffer nndoc-current-buffer)
+ (save-restriction
+ (narrow-to-region (car entry) (nth 3 entry))
+ (goto-char (point-min))
+ (when (looking-at " *\\*\\(.*\\)$")
+ (setq subject (match-string 1))
+ (when (string-match "[ \t]+$" subject)
+ (setq subject (substring subject 0 (match-beginning 0)))))
+ (when
+ (let ((case-fold-search nil))
+ (re-search-forward
+ "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t))
+ (setq from (match-string 1)))))
+ (insert "From: " "clari@clari.net (" (or from "unknown") ")"
+ "\nSubject: " (or subject "(no subject)") "\n")))
+
+(defun nndoc-mime-digest-type-p ()
+ (let ((case-fold-search t)
+ boundary-id b-delimiter entry)
+ (when (and
+ (re-search-forward
+ (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
+ "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
+ nil t)
+ (match-beginning 1))
+ (setq boundary-id (match-string 1)
+ b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
+ (setq entry (assq 'mime-digest nndoc-type-alist))
+ (setcdr entry
+ (list
+ (cons 'head-end "^ ?$")
+ (cons 'body-begin "^ ?\n")
+ (cons 'article-begin b-delimiter)
+ (cons 'body-end-function 'nndoc-digest-body-end)
+ (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))