X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-parse.el;h=40d5f5fa3709f99ebc93c956613b9f48f691d353;hb=8e18eb1fd95180a6ea115a00ce2f045815809b49;hp=88f3e34e90b2d06be5984c6cafafea4c5c4692c2;hpb=475cff608c49d7999800b5d8b22c66ef91f7df2f;p=elisp%2Ftm.git diff --git a/tm-parse.el b/tm-parse.el index 88f3e34..40d5f5f 100644 --- a/tm-parse.el +++ b/tm-parse.el @@ -1,18 +1,31 @@ -;;; ;;; tm-parse.el --- MIME message parser -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1994,1995 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; Version: -;;; $Id: tm-parse.el,v 4.0 1995/10/12 06:08:12 morioka Exp $ -;;; Keywords: mail, news, MIME, multimedia -;;; -;;; This file is part of tm (Tools for MIME). -;;; -(require 'tl-822) +;; Copyright (C) 1994,1995,1996 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Version: $Id: tm-parse.el,v 7.16 1996/12/17 11:44:55 morioka Exp $ +;; Keywords: mail, news, MIME, multimedia + +;; This file is part of tm (Tools for MIME). + +;; This program is free software; you can redistribute it and/or +;; modify 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. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 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, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'std11) (require 'tl-misc) (require 'tm-def) @@ -20,6 +33,21 @@ ;;; @ field parser ;;; +(defconst rfc822/quoted-pair-regexp "\\\\.") +(defconst rfc822/qtext-regexp + (concat "[^" (char-list-to-string std11-non-qtext-char-list) "]")) +(defconst rfc822/quoted-string-regexp + (concat "\"" + (regexp-* + (regexp-or rfc822/qtext-regexp rfc822/quoted-pair-regexp) + ) + "\"")) + +(defconst mime/content-parameter-value-regexp + (concat "\\(" + rfc822/quoted-string-regexp + "\\|[^; \t\n]*\\)")) + (defconst mime::parameter-regexp (concat "^[ \t]*\;[ \t]*\\(" mime/token-regexp "\\)" "[ \t]*=[ \t]*\\(" mime/content-parameter-value-regexp "\\)")) @@ -29,28 +57,44 @@ (let ((e (match-end 2))) (cons (cons (downcase (substring str (match-beginning 1) (match-end 1))) - (rfc822/strip-quoted-string + (std11-strip-quoted-string (substring str (match-beginning 2) e)) ) (substring str e) )))) -(defconst mime::ctype-regexp - (concat "^" mime/content-type-subtype-regexp)) +(defconst mime::ctype-regexp (concat "^" mime/content-type-subtype-regexp)) -(defun mime/parse-Content-Type (str) - "Parse STR as field-body of Content-Type field. [tm-parse.el]" - (setq str (rfc822/unfolding-string str)) - (if (string-match mime::ctype-regexp str) +(defun mime/parse-Content-Type (string) + "Parse STRING as field-body of Content-Type field. [tm-parse.el]" + (setq string (std11-unfold-string string)) + (if (string-match mime::ctype-regexp string) (let* ((e (match-end 0)) - (ctype (downcase (substring str 0 e))) + (ctype (downcase (substring string 0 e))) ret dest) - (setq str (substring str e)) - (while (setq ret (mime/parse-parameter str)) - (setq dest (cons (car ret) dest)) - (setq str (cdr ret)) + (setq string (substring string e)) + (while (setq ret (mime/parse-parameter string)) + (setq dest (cons (car ret) dest) + string (cdr ret)) ) - (cons ctype (reverse dest)) + (cons ctype (nreverse dest)) + ))) + +(defconst mime::dtype-regexp (concat "^" mime/disposition-type-regexp)) + +(defun mime/parse-Content-Disposition (string) + "Parse STRING as field-body of Content-Disposition field. [tm-parse.el]" + (setq string (std11-unfold-string string)) + (if (string-match mime::dtype-regexp string) + (let* ((e (match-end 0)) + (ctype (downcase (substring string 0 e))) + ret dest) + (setq string (substring string e)) + (while (setq ret (mime/parse-parameter string)) + (setq dest (cons (car ret) dest) + string (cdr ret)) + ) + (cons ctype (nreverse dest)) ))) @@ -60,7 +104,7 @@ (defun mime/Content-Type () "Read field-body of Content-Type field from current-buffer, and return parsed it. [tm-parse.el]" - (let ((str (rfc822/get-field-body "Content-Type"))) + (let ((str (std11-field-body "Content-Type"))) (if str (mime/parse-Content-Type str) ))) @@ -69,12 +113,25 @@ and return parsed it. [tm-parse.el]" "Read field-body of Content-Transfer-Encoding field from current-buffer, and return it. If is is not found, return DEFAULT-ENCODING. [tm-parse.el]" - (let ((str (rfc822/get-field-body "Content-Transfer-Encoding"))) + (let ((str (std11-field-body "Content-Transfer-Encoding"))) (if str - (downcase str) + (progn + (if (string-match "[ \t\n\r]+$" str) + (setq str (substring str 0 (match-beginning 0))) + ) + (downcase str) + ) default-encoding) )) +(defun mime/Content-Disposition () + "Read field-body of Content-Disposition field from current-buffer, +and return parsed it. [tm-parse.el]" + (let ((str (std11-field-body "Content-Disposition"))) + (if str + (mime/parse-Content-Disposition str) + ))) + ;;; @ message parser ;;; @@ -85,17 +142,23 @@ If is is not found, return DEFAULT-ENCODING. [tm-parse.el]" (defun mime/parse-multipart (boundary ctype params encoding rcnum) (goto-char (point-min)) - (let ((beg (point-min)) - (end (if (re-search-forward - (concat "^--" (regexp-quote boundary) "--$") nil t) - (match-beginning 0) - (point-max) - )) - (rsep (concat "^--" (regexp-quote boundary) "\n")) - (dc-ctl - (cond ((string= ctype "multipart/digest") '("message/rfc822")) - (t '("text/plain")))) - cb ce ct ret ncb children (i 0)) + (let* ((dash-boundary (concat "--" boundary)) + (delimiter (concat "\n" (regexp-quote dash-boundary))) + (close-delimiter (concat delimiter "--[ \t]*$")) + (beg (point-min)) + (end (progn + (goto-char (point-max)) + (if (re-search-backward close-delimiter nil t) + (match-beginning 0) + (point-max) + ))) + (rsep (concat delimiter "[ \t]*\n")) + (dc-ctl + (if (string-equal ctype "multipart/digest") + '("message/rfc822") + '("text/plain") + )) + cb ce ct ret ncb children (i 0)) (save-restriction (narrow-to-region beg end) (goto-char beg) @@ -120,8 +183,9 @@ If is is not found, return DEFAULT-ENCODING. [tm-parse.el]" ) (setq children (cons ret children)) ) - (mime::content-info/create rcnum beg end ctype params encoding - (reverse children)) + (mime::content-info/create rcnum beg (point-max) + ctype params encoding + (nreverse children)) )) (defun mime/parse-message (&optional ctl encoding rcnum) @@ -133,21 +197,25 @@ If is is not found, return DEFAULT-ENCODING. [tm-parse.el]" ) (let ((boundary (assoc "boundary" params))) (cond (boundary - (setq boundary (rfc822/strip-quoted-string (cdr boundary))) + (setq boundary (std11-strip-quoted-string (cdr boundary))) (mime/parse-multipart boundary ctype params encoding rcnum) ) - ((string= ctype "message/rfc822") + ((or (string-equal ctype "message/rfc822") + (string-equal ctype "message/news") + ) (goto-char (point-min)) - (mime::content-info/create rcnum (point-min) (point-max) + (mime::content-info/create rcnum + (point-min) (point-max) ctype params encoding (save-restriction (narrow-to-region (if (re-search-forward "^$" nil t) - (+ (match-end 0) 1) + (1+ (match-end 0)) (point-min) ) (point-max)) - (list (mime/parse-message)) + (list (mime/parse-message + nil nil (cons 0 rcnum))) ) ) ) @@ -162,3 +230,5 @@ If is is not found, return DEFAULT-ENCODING. [tm-parse.el]" ;;; (provide 'tm-parse) + +;;; tm-parse.el ends here