X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-parse.el;h=ac77bffc5c9b95072da310a9db983bcb0b50144a;hb=9a66489164af2c205b587629a8efe9d175c120e9;hp=c380312b66c296eb067e888c3d812f99fa70c892;hpb=777bde87d1387683f0ef37a1dd449dd9a73e093b;p=elisp%2Fsemi.git diff --git a/mime-parse.el b/mime-parse.el index c380312..ac77bff 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -1,12 +1,11 @@ ;;; mime-parse.el --- MIME message parser -;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc. +;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko -;; Version: $Id: mime-parse.el,v 0.5 1997-02-27 13:43:38 tmorioka Exp $ ;; Keywords: parse, MIME, multimedia, mail, news -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). +;; This file is part of SEMI (Spadework for Emacs MIME Interfaces). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -25,49 +24,19 @@ ;;; Code: +(require 'emu) (require 'std11) (require 'mime-def) (defsubst symbol-concat (&rest args) "Return a symbol whose name is concatenation of arguments ARGS which are string or symbol." - (intern (apply (function concat) - (mapcar (function - (lambda (s) - (cond ((symbolp s) (symbol-name s)) - ((stringp s) s) - ))) - args)))) - -(defmacro define-structure (name &rest slots) - (let ((pred (symbol-concat name '-p))) - (cons 'progn - (nconc - (list - (` (defun (, pred) (obj) - (and (vectorp obj) - (eq (elt obj 0) '(, name)) - )) - ) - (` (defun (, (symbol-concat name '/create)) (, slots) - (, (cons 'vector (cons (list 'quote name) slots))) - ) - )) - (let ((i 1)) - (mapcar (function - (lambda (slot) - (prog1 - (` (defun (, (symbol-concat name '/ slot)) (obj) - (if ((, pred) obj) - (elt obj (, i)) - )) - ) - (setq i (+ i 1)) - ) - )) slots) - ) - (list (list 'quote name)) - )))) + (intern (mapconcat (function + (lambda (s) + (cond ((symbolp s) (symbol-name s)) + ((stringp s) s) + ))) + args ""))) ;;; @ field parser @@ -76,6 +45,9 @@ which are string or symbol." (defsubst regexp-* (regexp) (concat regexp "*")) +(defsubst regexp-or (&rest args) + (concat "\\(" (mapconcat (function identity) args "\\|") "\\)")) + (defconst rfc822/quoted-pair-regexp "\\\\.") (defconst rfc822/qtext-regexp (concat "[^" (char-list-to-string std11-non-qtext-char-list) "]")) @@ -92,7 +64,7 @@ which are string or symbol." "\\|[^; \t\n]*\\)")) (defconst mime::parameter-regexp - (concat "^[ \t]*\;[ \t]*\\(" mime/token-regexp "\\)" + (concat "^[ \t]*\;[ \t]*\\(" mime-token-regexp "\\)" "[ \t]*=[ \t]*\\(" mime/content-parameter-value-regexp "\\)")) (defun mime-parse-parameter (str) @@ -106,29 +78,35 @@ which are string or symbol." (substring str e) )))) -(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. [mime-parse.el]" + "Parse STRING as field-body of Content-Type field. +Return value is + (PRIMARY-TYPE SUBTYPE (NAME1 . VALUE1)(NAME2 . VALUE2) ...) +or nil. PRIMARY-TYPE and SUBTYPE are symbol and NAME_n and VALUE_n +are string." (setq string (std11-unfold-string string)) - (if (string-match mime::ctype-regexp string) - (let* ((e (match-end 0)) - (ctype (downcase (substring string 0 e))) + (if (string-match `,(concat "^\\(" mime-token-regexp + "\\)/\\(" mime-token-regexp "\\)") string) + (let* ((type (downcase + (substring string (match-beginning 1) (match-end 1)))) + (subtype (downcase + (substring string (match-beginning 2) (match-end 2)))) ret dest) - (setq string (substring string e)) + (setq string (substring string (match-end 0))) (while (setq ret (mime-parse-parameter string)) (setq dest (cons (car ret) dest) string (cdr ret)) ) - (cons ctype (nreverse dest)) + (cons (intern type) (cons (intern subtype) (nreverse dest))) ))) -(defconst mime::dtype-regexp (concat "^" mime/disposition-type-regexp)) + +(defconst mime-disposition-type-regexp mime-token-regexp) (defun mime-parse-Content-Disposition (string) - "Parse STRING as field-body of Content-Disposition field. [mime-parse.el]" + "Parse STRING as field-body of Content-Disposition field." (setq string (std11-unfold-string string)) - (if (string-match mime::dtype-regexp string) + (if (string-match `,(concat "^" mime-disposition-type-regexp) string) (let* ((e (match-end 0)) (ctype (downcase (substring string 0 e))) ret dest) @@ -144,9 +122,10 @@ which are string or symbol." ;;; @ field reader ;;; -(defun mime/Content-Type () +(defun mime-read-Content-Type () "Read field-body of Content-Type field from current-buffer, -and return parsed it. [mime-parse.el]" +and return parsed it. Format of return value is as same as +`mime-parse-Content-Type'." (let ((str (std11-field-body "Content-Type"))) (if str (mime-parse-Content-Type str) @@ -179,11 +158,34 @@ and return parsed it. [mime-parse.el]" ;;; @ message parser ;;; -(define-structure mime::content-info - rcnum point-min point-max type parameters encoding children) - - -(defun mime-parse-multipart (boundary ctype params encoding rcnum) +(defsubst make-mime-entity (node-id + point-min point-max + media-type media-subtype parameters + encoding children) + (vector node-id point-min point-max + media-type media-subtype parameters encoding children)) + +(defsubst mime-entity-node-id (entity-info) (aref entity-info 0)) +(defsubst mime-entity-point-min (entity-info) (aref entity-info 1)) +(defsubst mime-entity-point-max (entity-info) (aref entity-info 2)) +(defsubst mime-entity-media-type (entity-info) (aref entity-info 3)) +(defsubst mime-entity-media-subtype (entity-info) (aref entity-info 4)) +(defsubst mime-entity-parameters (entity-info) (aref entity-info 5)) +(defsubst mime-entity-encoding (entity-info) (aref entity-info 6)) +(defsubst mime-entity-children (entity-info) (aref entity-info 7)) + +(defsubst mime-type/subtype-string (type &optional subtype) + "Return type/subtype string from TYPE and SUBTYPE." + (if type + (if subtype + (format "%s/%s" type subtype) + (format "%s" type)))) + +(defsubst mime-entity-type/subtype (entity-info) + (mime-type/subtype-string (mime-entity-media-type entity-info) + (mime-entity-media-subtype entity-info))) + +(defun mime-parse-multipart (boundary primtype subtype params encoding rcnum) (goto-char (point-min)) (let* ((dash-boundary (concat "--" boundary)) (delimiter (concat "\n" (regexp-quote dash-boundary))) @@ -197,11 +199,11 @@ and return parsed it. [mime-parse.el]" ))) (rsep (concat delimiter "[ \t]*\n")) (dc-ctl - (if (string-equal ctype "multipart/digest") - '("message/rfc822") - '("text/plain") + (if (eq subtype 'digest) + '(message rfc822) + '(text plain) )) - cb ce ct ret ncb children (i 0)) + cb ce ret ncb children (i 0)) (save-restriction (narrow-to-region beg end) (goto-char beg) @@ -215,7 +217,7 @@ and return parsed it. [mime-parse.el]" (setq ret (mime-parse-message dc-ctl "7bit" (cons i rcnum))) ) (setq children (cons ret children)) - (goto-char (mime::content-info/point-max ret)) + (goto-char (mime-entity-point-max ret)) (goto-char (setq cb ncb)) (setq i (1+ i)) ) @@ -226,49 +228,62 @@ and return parsed it. [mime-parse.el]" ) (setq children (cons ret children)) ) - (mime::content-info/create rcnum beg (point-max) - ctype params encoding - (nreverse children)) + (make-mime-entity rcnum beg (point-max) + primtype subtype params encoding + (nreverse children)) )) -(defun mime-parse-message (&optional ctl encoding rcnum) - "Parse current-buffer as a MIME message. [mime-parse.el]" - (setq ctl (or (mime/Content-Type) ctl)) - (setq encoding (or (mime/Content-Transfer-Encoding) encoding)) - (let ((ctype (car ctl)) - (params (cdr ctl)) +(defun mime-parse-message (&optional default-ctl default-encoding rcnum) + "Parse current-buffer as a MIME message. +DEFAULT-CTL is used when an entity does not have valid Content-Type +field. Its format must be as same as return value of +mime-{parse|read}-Content-Type." + (setq default-ctl (or (mime-read-Content-Type) default-ctl)) + (let ((primtype (car default-ctl)) + (subtype (car (cdr default-ctl))) + (params (cdr (cdr default-ctl))) + (encoding (or (mime/Content-Transfer-Encoding) default-encoding)) ) (let ((boundary (assoc "boundary" params))) (cond (boundary (setq boundary (std11-strip-quoted-string (cdr boundary))) - (mime-parse-multipart boundary ctype params encoding rcnum) + (mime-parse-multipart + boundary + primtype subtype params encoding rcnum) ) - ((or (string-equal ctype "message/rfc822") - (string-equal ctype "message/news") - ) + ((and (eq primtype 'message) + (memq subtype '(rfc822 news)) + ) (goto-char (point-min)) - (mime::content-info/create rcnum - (point-min) (point-max) - ctype params encoding - (save-restriction - (narrow-to-region - (if (re-search-forward "^$" nil t) - (1+ (match-end 0)) - (point-min) - ) - (point-max)) - (list (mime-parse-message - nil nil (cons 0 rcnum))) - ) - ) + (make-mime-entity rcnum (point-min) (point-max) + primtype subtype params encoding + (save-restriction + (narrow-to-region + (if (re-search-forward "^$" nil t) + (1+ (match-end 0)) + (point-min) + ) + (point-max)) + (list (mime-parse-message + nil nil (cons 0 rcnum))) + )) ) (t - (mime::content-info/create rcnum (point-min) (point-max) - ctype params encoding nil) + (make-mime-entity rcnum (point-min) (point-max) + primtype subtype params encoding + nil) )) ))) +;;; @ utilities +;;; + +(defsubst mime-root-entity-p (entity) + "Return t if ENTITY is root-entity (message)." + (null (mime-entity-node-id entity))) + + ;;; @ end ;;;