X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnndoc.el;h=a9824febc2c59d848b6b0381f374382627b5a00b;hb=0651fabaac80cf08698f066dae0af33f29b91a9a;hp=d9f3f21f61a125556ba6586ad66221d9703c9617;hpb=fb74c6b3b0b50bbd8b88bff08b1f0998d9d7b1ff;p=gnus diff --git a/lisp/nndoc.el b/lisp/nndoc.el index d9f3f21f6..a9824febc 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -1,5 +1,6 @@ ;;; nndoc.el --- single file access for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -31,6 +32,7 @@ (require 'nnmail) (require 'nnoo) (require 'gnus-util) +(require 'mm-util) (eval-when-compile (require 'cl)) (nnoo-declare nndoc) @@ -38,8 +40,8 @@ (defvoo nndoc-article-type 'guess "*Type of the file. One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', -`rfc934', `rfc822-forward', `mime-digest', `mime-parts', `standard-digest', -`slack-digest', `clari-briefs' or `guess'.") +`rfc934', `rfc822-forward', `mime-parts', `standard-digest', +`slack-digest', `clari-briefs', `nsmail' or `guess'.") (defvoo nndoc-post-type 'mail "*Whether the nndoc group is `mail' or `post'.") @@ -47,12 +49,14 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', (defvoo nndoc-open-document-hook 'nnheader-ms-strip-cr "Hook run after opening a document. The default function removes all trailing carriage returns -from the document.") +from the document.") (defvar nndoc-type-alist `((mmdf (article-begin . "^\^A\^A\^A\^A\n") (body-end . "^\^A\^A\^A\^A\n")) + (nsmail + (article-begin . "^From - ")) (news (article-begin . "^Path:")) (rnews @@ -67,8 +71,8 @@ from the document.") (body-begin-function . nndoc-babyl-body-begin) (head-begin-function . nndoc-babyl-head-begin)) (forward - (article-begin . "^-+ Start of forwarded message -+\n+") - (body-end . "^-+ End of forwarded message -+$") + (article-begin . "^-+ \\(Start of \\)?forwarded message.*\n+") + (body-end . "^-+ End \\(of \\)?forwarded message.*$") (prepare-body-function . nndoc-unquote-dashes)) (rfc934 (article-begin . "^--.*\n+") @@ -83,6 +87,7 @@ from the document.") (article-transform-function . nndoc-transform-clari-briefs)) (mime-digest (article-begin . "") + (head-begin . "^ ?\n") (head-end . "^ ?$") (body-end . "") (file-end . "") @@ -120,6 +125,9 @@ from the document.") (rfc822-forward (article-begin . "^\n") (body-end-function . nndoc-rfc822-forward-body-end-function)) + (outlook + (article-begin-function . nndoc-outlook-article-begin) + (body-end . "\0")) (guess (guess . t) (subtype nil)) @@ -143,7 +151,7 @@ from the document.") (defvoo nndoc-head-begin-function nil) (defvoo nndoc-body-end nil) ;; nndoc-dissection-alist is a list of sublists. Each sublist holds the -;; following items. ARTICLE act as the association key and is an ordinal +;; following items. ARTICLE acts as the association key and is an ordinal ;; starting at 1. HEAD-BEGIN [0], HEAD-END [1], BODY-BEGIN [2] and BODY-END ;; [3] are positions in the `nndoc' buffer. LINE-COUNT [4] is a count of ;; lines in the body. For MIME dissections only, ARTICLE-INSERT [5] and @@ -343,6 +351,9 @@ from the document.") (setq entry (pop alist))) (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess))) (goto-char (point-min)) + ;; Remove blank lines. + (while (eq (following-char) ?\n) + (delete-char 1)) (when (numberp (setq result (funcall (intern (format "nndoc-%s-type-p" (car entry)))))) @@ -425,7 +436,8 @@ from the document.") t)) (defun nndoc-forward-type-p () - (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t) + (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))) @@ -452,27 +464,30 @@ from the document.") (limit (search-forward "\n\n" nil t))) (goto-char (point-min)) (when (and limit - (re-search-forward - (concat "\ -^Content-Type:[ \t]*multipart/[a-z]+ *;\\(.*;\\)*" - "[ \t\n]*[ \t]boundary=\"?[^\"\n]*[^\" \t\n]") - limit t)) + (re-search-forward + (concat "\ +^Content-Type:[ \t]*multipart/[a-z]+ *; *\\(\\(\n[ \t]\\)?.*;\\)*" + "\\(\n[ \t]\\)?[ \t]*boundary=\"?[^\"\n]*[^\" \t\n]") + limit t)) t))) (defun nndoc-transform-mime-parts (article) (let* ((entry (cdr (assq article nndoc-dissection-alist))) (headers (nth 5 entry))) (when headers - (goto-char (point-min)) + (goto-char (point-min)) (insert headers)))) (defun nndoc-generate-mime-parts-head (article) (let* ((entry (cdr (assq article nndoc-dissection-alist))) (headers (nth 6 entry))) + (save-restriction + (narrow-to-region (point) (point)) + (insert-buffer-substring + nndoc-current-buffer (car entry) (nth 1 entry)) + (goto-char (point-max))) (when headers - (insert headers)) - (insert-buffer-substring - nndoc-current-buffer (car entry) (nth 1 entry)))) + (insert headers)))) (defun nndoc-clari-briefs-type-p () (when (let ((case-fold-search nil)) @@ -505,6 +520,7 @@ from the document.") (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) @@ -515,10 +531,11 @@ from the document.") nil t) (match-beginning 1)) (setq boundary-id (match-string 1) - b-delimiter (concat "\n--" boundary-id "[\n \t]+")) + b-delimiter (concat "\n--" boundary-id "[ \t]*$")) (setq entry (assq 'mime-digest nndoc-type-alist)) (setcdr entry (list + (cons 'head-begin "^ ?\n") (cons 'head-end "^ ?$") (cons 'body-begin "^ ?\n") (cons 'article-begin b-delimiter) @@ -547,10 +564,7 @@ from the document.") (defun nndoc-transform-lanl-gov-announce (article) (goto-char (point-max)) (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t) - (replace-match "\n\nGet it at \\1 (\\2)" t nil)) - ;; (when (re-search-backward "^\\\\\\\\$" nil t) - ;; (replace-match "" t t)) - ) + (replace-match "\n\nGet it at \\1 (\\2)" t nil))) (defun nndoc-generate-lanl-gov-head (article) (let ((entry (cdr (assq article nndoc-dissection-alist))) @@ -568,18 +582,28 @@ from the document.") (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)" nil t) (setq subject (concat (match-string 1) subject)) - (setq from (concat (match-string 2) " <" e-mail ">")))) - )) + (setq from (concat (match-string 2) " <" e-mail ">")))))) (while (and from (string-match "(\[^)\]*)" from)) (setq from (replace-match "" t t from))) (insert "From: " (or from "unknown") "\nSubject: " (or subject "(no subject)") "\n"))) +(defun nndoc-nsmail-type-p () + (when (looking-at "From - ") + t)) + +(defun nndoc-outlook-article-begin () + (prog1 (re-search-forward "From:\\|Received:" nil t) + (goto-char (match-beginning 0)))) + +(defun nndoc-outlook-type-p () + ;; FIXME: Is JMF the magic of outlook mailbox? -- ShengHuo. + (looking-at "JMF")) + (deffoo nndoc-request-accept-article (group &optional server last) nil) - ;;; ;;; Functions for dissecting the documents ;;; @@ -598,6 +622,9 @@ from the document.") (save-excursion (set-buffer nndoc-current-buffer) (goto-char (point-min)) + ;; Remove blank lines. + (while (eq (following-char) ?\n) + (delete-char 1)) ;; Find the beginning of the file. (when nndoc-file-begin (nndoc-search nndoc-file-begin)) @@ -672,19 +699,21 @@ PARENT is the message-ID of the parent summary line, or nil for none." (message-id (nnmail-message-id)) head-end body-begin summary-insert message-rfc822 multipart-any subject content-type type subtype boundary-regexp) - ;; Gracefully handle a missing body. - (goto-char head-begin) - (if (search-forward "\n\n" body-end t) - (setq head-end (1- (point)) - body-begin (point)) + ;; Gracefully handle a missing body. + (goto-char head-begin) + (if (or (and (eq (char-after) ?\n) (or (forward-char 1) t)) + (search-forward "\n\n" body-end t)) + (setq head-end (1- (point)) + body-begin (point)) (setq head-end body-end body-begin body-end)) (narrow-to-region head-begin head-end) - ;; Save MIME attributes. - (goto-char head-begin) + ;; Save MIME attributes. + (goto-char head-begin) (setq content-type (message-fetch-field "Content-Type")) (when content-type - (when (string-match "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" content-type) + (when (string-match + "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" content-type) (setq type (downcase (match-string 1 content-type)) subtype (downcase (match-string 2 content-type)) message-rfc822 (and (string= type "message") @@ -701,8 +730,8 @@ PARENT is the message-ID of the parent summary line, or nil for none." (when (or multipart-any (not article-insert)) (setq subject (message-fetch-field "Subject")))) (unless type - (setq type "text" - subtype "plain")) + (setq type "text" + subtype "plain")) ;; Prepare the article and summary inserts. (unless article-insert (setq article-insert (buffer-substring (point-min) (point-max)) @@ -714,8 +743,8 @@ PARENT is the message-ID of the parent summary line, or nil for none." (and position multipart-any ".") (and multipart-any "*") (and (or position multipart-any) " ") - (cond ((string= subtype "plain") type) - ((string= subtype "basic") type) + (cond ((string= subtype "plain") type) + ((string= subtype "basic") type) (t subtype)) ">" (and subject " ") @@ -738,13 +767,13 @@ PARENT is the message-ID of the parent summary line, or nil for none." summary-insert) (replace-match line t t summary-insert) (concat summary-insert line))))) - ;; Generate dissection information for this entity. - (push (list (incf nndoc-mime-split-ordinal) - head-begin head-end body-begin body-end - (count-lines body-begin body-end) + ;; Generate dissection information for this entity. + (push (list (incf nndoc-mime-split-ordinal) + head-begin head-end body-begin body-end + (count-lines body-begin body-end) article-insert summary-insert) - nndoc-dissection-alist) - ;; Recurse for all sub-entities, if any. + nndoc-dissection-alist) + ;; Recurse for all sub-entities, if any. (widen) (cond (message-rfc822 @@ -755,7 +784,7 @@ PARENT is the message-ID of the parent summary line, or nil for none." (let ((part-counter 0) part-begin part-end eof-flag) (while (string-match "\ -^\\(Lines\\|Content-\\(Type\\|Transfer-Encoding\\)\\):.*\n\\([ \t].*\n\\)*" +^\\(Lines\\|Content-\\(Type\\|Transfer-Encoding\\|Disposition\\)\\):.*\n\\([ \t].*\n\\)*" article-insert) (setq article-insert (replace-match "" t t article-insert))) (let ((case-fold-search nil))