X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-parse.el;h=0503a976883fcd2d305a51a649e21765938ecc9f;hb=f0a284c80bae5a16a58fe2f6c542c4e4d3002969;hp=f4fc429d93aa9b1a45c698a389e4f732b373e686;hpb=f94c46d394e1304bcc35fee20db5523746cf7a7a;p=elisp%2Ftm.git diff --git a/tm-parse.el b/tm-parse.el index f4fc429..0503a97 100644 --- a/tm-parse.el +++ b/tm-parse.el @@ -1,30 +1,29 @@ -;;; ;;; 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 7.0 1995/12/09 01:56:28 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1994,1995,1996 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Version: +;; $Id: tm-parse.el,v 7.11 1996/08/30 06:20:52 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 this program; 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 'tl-822) @@ -50,22 +49,38 @@ (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 (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 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)) + ))) + +(defconst mime::dtype-regexp (concat "^" mime/disposition-type-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-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 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)) ))) @@ -75,7 +90,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) ))) @@ -84,12 +99,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 ;;; @@ -101,18 +129,21 @@ 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* ((dash-boundary (concat "--" boundary)) - (delimiter (concat "\n" dash-boundary)) - (close-delimiter (concat delimiter "--")) + (delimiter (concat "\n" (regexp-quote dash-boundary))) + (close-delimiter (concat delimiter "--[ \t]*$")) (beg (point-min)) - (end (if (search-forward close-delimiter nil t) - (match-beginning 0) - (point-max) - )) - (rsep (concat (regexp-quote delimiter) "[ \t]*\n")) + (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 - (cond ((string= ctype "multipart/digest") '("message/rfc822")) - (t '("text/plain")) - )) + (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) @@ -140,7 +171,7 @@ If is is not found, return DEFAULT-ENCODING. [tm-parse.el]" ) (mime::content-info/create rcnum beg (point-max) ctype params encoding - (reverse children)) + (nreverse children)) )) (defun mime/parse-message (&optional ctl encoding rcnum) @@ -155,7 +186,7 @@ If is is not found, return DEFAULT-ENCODING. [tm-parse.el]" (setq boundary (rfc822/strip-quoted-string (cdr boundary))) (mime/parse-multipart boundary ctype params encoding rcnum) ) - ((string= ctype "message/rfc822") + ((string-equal ctype "message/rfc822") (goto-char (point-min)) (mime::content-info/create rcnum (point-min) (point-max) @@ -163,7 +194,7 @@ If is is not found, return DEFAULT-ENCODING. [tm-parse.el]" (save-restriction (narrow-to-region (if (re-search-forward "^$" nil t) - (+ (match-end 0) 1) + (1+ (match-end 0)) (point-min) ) (point-max)) @@ -183,3 +214,5 @@ If is is not found, return DEFAULT-ENCODING. [tm-parse.el]" ;;; (provide 'tm-parse) + +;;; tm-parse.el ends here