X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-parse.el;h=e5a390fc7274c7657d76a4fa4e8cc70e4f4ee2e7;hb=327711693e20cc80cb741d6c97d2c1ae3f383a70;hp=1401f17a5060608cc738a49d429ad06a7d8ff65a;hpb=b32afecb7e1e90d59062b878a2ebd4591a756bce;p=elisp%2Ftm.git diff --git a/tm-parse.el b/tm-parse.el index 1401f17..e5a390f 100644 --- a/tm-parse.el +++ b/tm-parse.el @@ -1,33 +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 7.1 1995/12/21 18:13:54 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.13 1996/09/20 07:27:41 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) +(require 'std11) (require 'tl-misc) (require 'tm-def) @@ -44,7 +42,7 @@ (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) @@ -52,36 +50,36 @@ (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 (str) - "Parse STR as field-body of Content-Disposition field. [tm-parse.el]" - (setq str (rfc822/unfolding-string str)) - (if (string-match mime::dtype-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)) ))) @@ -91,7 +89,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) ))) @@ -100,16 +98,21 @@ 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 (rfc822/get-field-body "Content-Disposition"))) + (let ((str (std11-field-body "Content-Disposition"))) (if str (mime/parse-Content-Disposition str) ))) @@ -125,18 +128,21 @@ and return parsed it. [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) @@ -164,7 +170,7 @@ and return parsed it. [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) @@ -176,10 +182,12 @@ and return parsed it. [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) @@ -187,7 +195,7 @@ and return parsed it. [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)) @@ -207,3 +215,5 @@ and return parsed it. [tm-parse.el]" ;;; (provide 'tm-parse) + +;;; tm-parse.el ends here