From a0635960288973b743ad8cbc6902efa866b5dbd7 Mon Sep 17 00:00:00 2001 From: kawabata Date: Mon, 3 Jun 2002 14:55:27 +0000 Subject: [PATCH] *** empty log message *** --- ChangeLog | 88 ++++++++++++++++++----- eword-encode.el | 74 ++++++++++++++++++- mime-def.el | 11 ++- mime-parse.el | 212 ++++++++++++++++++++++++++++++++++++++++++++++++++++--- 4 files changed, 353 insertions(+), 32 deletions(-) diff --git a/ChangeLog b/ChangeLog index c06eecb..5d76090 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,56 @@ +2002-06-03 KAWABATA, Taichi + + * FLIM-rfc2231-encoder: merged with FLIM Version 1.14.4. + 2002-06-03 MORIOKA Tomohiko - * FLIM: Version 1.14.4 (Kashiharajing-Dþ-mae) released.-A + * FLIM: Version 1.14.4 (Kashiharajing.DŽþ-mae) released. + +2002-06-02 Shuhei KOBAYASHI + + * eword-encode.el (mime-header-encode-method-alist): + Added encoder for Content-Type. + + * mime-def.el (mime-attribute-char-regexp): Arranged. + + * mime-parse.el (mime-decode-parameter-value): Comment fix. + (mime-read-Content-Type): Docstring fix. + (mime-read-Content-Disposition): Ditto. + (mime-read-Content-Transfer-Encoding): Ditto. + (mime-parse-buffer): Ditto. + +2002-05-30 Shuhei KOBAYASHI + + * mime-parse.el (mime-divide-regular-parameter): New function. + (mime-encode-regular-parameter): Cleanup. + (mime-divide-extended-parameter): Ditto. + (mime-encode-extended-parameter): Ditto. + (mime-encode-parameters): Ditto. + +2002-05-30 Shuhei KOBAYASHI + + * eword-encode.el (eword-encode-Content-Type): New function. + (eword-encode-Content-Disposition): Ditto. + +2002-05-26 Daiki Ueno + + * mime-parse.el (eword-encode-Content-Type-field-body): + New function. + +2002-05-20 KAWABATA, Taichi + + MIME Parameter Value encoder support. + + * eword-encode.el: Require 'mime-parse. + (eword-encode-Content-Disposition-field-body): New function. + (mime-header-encode-method-alist): Use it. + + * mime-def.el (mime-non-attribute-char-regexp): New variable. + + * mime-parse.el (mime-divide-extended-parameter): New function. + (mime-encode-extended-parameter): Likewise. + (mime-encode-regular-parameter): Likewise. + (mime-encode-parameters): Likewise. 2002-01-16 Hiroya Murata @@ -29,7 +79,7 @@ 2001-06-01 MORIOKA Tomohiko - * FLIM: Version 1.14.3 (Unebigory-Dòmae) released.-A + * FLIM: Version 1.14.3 (UnebigoryŽòmae) released. 2001-06-01 Katsumi Yamaoka @@ -1091,7 +1141,7 @@ 2000-07-12 MORIOKA Tomohiko - * FLIM-Chao: Version 1.14.1 (Rokujiz-Dò) released.-A + * FLIM-Chao: Version 1.14.1 (RokujizŽò) released. 2000-07-10 MORIOKA Tomohiko @@ -1709,7 +1759,7 @@ 1999-05-31 MORIOKA Tomohiko - * FLIM: Version 1.12.7 (Y-Dþzaki) released.-A + * FLIM: Version 1.12.7 (YŽþzaki) released. 1999-05-31 MORIOKA Tomohiko @@ -1884,7 +1934,7 @@ 1999-05-11 MORIOKA Tomohiko - * FLIM: Version 1.12.6 (Family-K-Dòenmae) released.-A + * FLIM: Version 1.12.6 (Family-KŽòenmae) released. 1999-04-27 Shuhei KOBAYASHI @@ -2001,7 +2051,7 @@ 1999-01-23 MORIOKA Tomohiko - * FLIM: Version 1.12.3 (Kintetsu-K-Dòriyama) released.-A + * FLIM: Version 1.12.3 (Kintetsu-KŽòriyama) released. 1999-01-23 MORIOKA Tomohiko @@ -2044,7 +2094,7 @@ 1999-01-21 MORIOKA Tomohiko - * FLIM: Version 1.12.2 (Kuj-Dò) released.-A + * FLIM: Version 1.12.2 (KujŽò) released. 1999-01-16 MORIOKA Tomohiko @@ -2230,7 +2280,7 @@ 1998-12-02 MORIOKA Tomohiko - * FLIM: Version 1.12.1 (Nishinoky-Dò) released.-A + * FLIM: Version 1.12.1 (NishinokyŽò) released. 1998-11-30 MORIOKA Tomohiko @@ -2448,7 +2498,7 @@ 1998-10-26 MORIOKA Tomohiko - * FLIM: Version 1.11.2 (Heij-Dò) was released.-A + * FLIM: Version 1.11.2 (HeijŽò) was released. * NEWS (Abolish variable `mime-temp-directory'): New subsection. @@ -2728,7 +2778,7 @@ 1998-10-12 MORIOKA Tomohiko - * FLIM: Version 1.10.4 (Shin-H-Dòsono) was released.-A + * FLIM: Version 1.10.4 (Shin-HŽòsono) was released. 1998-10-12 Katsumi Yamaoka @@ -2913,7 +2963,7 @@ 1998-09-29 MORIOKA Tomohiko - * FLIM: Version 1.10.0 (K-Dòdo) was released.-A + * FLIM: Version 1.10.0 (KŽòdo) was released. * README.en (What's FLIM): Add mel-ccl.el. @@ -3200,7 +3250,7 @@ 1998-08-31 MORIOKA Tomohiko - * FLIM: Version 1.9.1 (Tonosh-Dò) was released.-A + * FLIM: Version 1.9.1 (TonoshŽò) was released. * mime-en.sgml (mm-backend): Translate a little. @@ -3343,7 +3393,7 @@ 1998-07-07 MORIOKA Tomohiko - * FLIM-Chao: Version 1.8.0 (Shij-Dò) was released.-A + * FLIM-Chao: Version 1.8.0 (ShijŽò) was released. 1998-07-07 MORIOKA Tomohiko @@ -3455,7 +3505,7 @@ 1998-07-01 MORIOKA Tomohiko - * FLIM: Version 1.8.0 (-DÒkubo) was released.-A + * FLIM: Version 1.8.0 (ŽÒkubo) was released. * README.en: Delete `How to use'. @@ -3580,7 +3630,7 @@ 1998-06-28 MORIOKA Tomohiko - * FLIM-Chao: Version 1.7.0 (Goj-Dò) was released.-A + * FLIM-Chao: Version 1.7.0 (GojŽò) was released. 1998-06-26 MORIOKA Tomohiko @@ -3839,7 +3889,7 @@ 1998-06-19 MORIOKA Tomohiko - * FLIM: Version 1.4.1 (Momoyama-Gory-Dòmae) was released.-A + * FLIM: Version 1.4.1 (Momoyama-GoryŽòmae) was released. 1998-06-18 MORIOKA Tomohiko @@ -3959,7 +4009,7 @@ 1998-05-06 MORIOKA Tomohiko - * FLIM: Version 1.2.0 (J-Dþjò) was released.-A + * FLIM: Version 1.2.0 (JŽþjŽò) was released. * README.en (What's FLIM): Delete description about std11-parse.el; add description about mailcap.el. @@ -4010,7 +4060,7 @@ 1998-05-05 MORIOKA Tomohiko - * FLIM: Version 1.1.0 (T-Dòji) was released.-A + * FLIM: Version 1.1.0 (TŽòji) was released. 1998-05-04 MORIOKA Tomohiko @@ -4046,7 +4096,7 @@ 1998-04-17 MORIOKA Tomohiko - * FLIM: Version 1.0.1 (Ky-Dòto) was released.-A + * FLIM: Version 1.0.1 (KyŽòto) was released. * mime-def.el (mime-spadework-module-version-string): New constant. diff --git a/eword-encode.el b/eword-encode.el index 83ff53a..694ed57 100644 --- a/eword-encode.el +++ b/eword-encode.el @@ -1,6 +1,6 @@ ;;; eword-encode.el --- RFC 2047 based encoded-word encoder for GNU Emacs -;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997,1998,1999,2000,2002 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: encoded-word, MIME, multilingual, header, mail, news @@ -27,6 +27,7 @@ (require 'mime-def) (require 'mel) (require 'std11) +(require 'mime-parse) (require 'eword-decode) @@ -71,8 +72,11 @@ Dcc)) (eword-encode-in-reply-to . (In-Reply-To)) (eword-encode-structured-field-body . (Mime-Version User-Agent)) + (eword-encode-Content-Disposition-field-body . (Content-Disposition)) + (eword-encode-Content-Type-field-body . (Content-Type)) (eword-encode-unstructured-field-body))) + ;;; @ encoded-text encoder ;;; @@ -606,6 +610,74 @@ Optional argument COLUMN is start-position of the field." (or column eword-encode-default-start-column) (eword-encode-split-string string 'text)))) +(defun eword-encode-Content-Type-field-body (field-body &optional column) + "Encode FIELD-BODY with MIME Parameter-Value Extensions, if necessary. +Optional second arg COLUMN is ignored." + (let ((tokens (mime-lexical-analyze field-body)) + primary-type) + (unless (eq (car (car tokens)) 'mime-token) + (error "Invalid Content-Type value: %s" field-body)) + (setq primary-type (downcase (cdr (car tokens))) + tokens (cdr tokens)) + (unless (and (eq (car (car tokens)) 'tspecials) + (string= (cdr (car tokens)) "/") + (setq tokens (cdr tokens)) + (eq (car (car tokens)) 'mime-token)) + (error "Invalid Content-Type value: %s" field-body)) + (concat " " primary-type "/" (downcase (cdr (car tokens))) + (mapconcat + (function + (lambda (param) + (concat ";\n " (car param) "=" (cdr param)))) + (mime-encode-parameters + (mime-parse-parameters (cdr tokens))) + "")))) + +(defun eword-encode-Content-Disposition-field-body (field-body &optional column) + "Encode FIELD-BODY with MIME Parameter-Value Extensions, if necessary. +Optional second arg COLUMN is ignored." + (let ((tokens (mime-lexical-analyze field-body))) + (unless (eq (car (car tokens)) 'mime-token) + (error "Invalid Content-Disposition value: %s" field-body)) + (concat " " (cdr (car tokens)) + (mapconcat + (function + (lambda (param) + (concat ";\n " (car param) "=" (cdr param)))) + (mime-encode-parameters + (mime-parse-parameters (cdr tokens))) + "")))) + +;;; for MIME-Edit Next Generation. +;;; (eword-encode-Content-Type type subtype parameters) +(defun eword-encode-Content-Type (content-type) + "Stringfy CONTENT-TYPE, using MIME Parameter-Value Extensions." + (concat " " ; XXX: Who requires this space? + (mime-type/subtype-string + (mime-content-type-primary-type content-type) + (mime-content-type-subtype content-type)) + (mapconcat + (function + (lambda (param) + (concat ";\n " (car param) "=" (cdr param)))) + (mime-encode-parameters + (mime-content-type-parameters content-type)) + ""))) + +;;; for MIME-Edit Next Generation. +;;; (eword-encode-Content-Disposition type parameters) +(defun eword-encode-Content-Disposition (content-disposition) + "Stringfy CONTENT-DISPOSITION, using MIME Parameter-Value Extensions." + (concat " " ; XXX: Who requires this space? + (symbol-name (mime-content-disposition-type content-disposition)) + (mapconcat + (function + (lambda (param) + (concat ";\n " (car param) "=" (cdr param)))) + (mime-encode-parameters + (mime-content-disposition-parameters content-disposition)) + ""))) + ;;;###autoload (defun mime-encode-field-body (field-body field-name) "Encode FIELD-BODY as FIELD-NAME, and return the result. diff --git a/mime-def.el b/mime-def.el index 25002ef..113c548 100644 --- a/mime-def.el +++ b/mime-def.el @@ -135,8 +135,14 @@ If method is nil, this field will not be encoded." (defconst mime-token-regexp (concat "[^" mime-tspecial-char-list "\000-\040]+")) (defconst mime-attribute-char-regexp - (concat "[^" mime-tspecial-char-list "\000-\040" + (concat "[^" mime-tspecial-char-list + "*'%" ; introduced in RFC 2231. + "\000-\040" + "]")) +(defconst mime-non-attribute-char-regexp + (concat "[" mime-tspecial-char-list "*'%" ; introduced in RFC 2231. + "\000-\040\177-\377" ; non-printable, non-US-ASCII. "]")) (defconst mime-charset-regexp @@ -144,7 +150,8 @@ If method is nil, this field will not be encoded." "*'%" ; should not include "%"? "]+")) -;; More precisely, length of "[A-Za-z]+" is limited to at most 8. +;; More precisely, length of each "[A-Za-z]+" is limited to at most 8. +;; See RFC 3066 "Tags for the Identification of Languages". ;; (defconst mime-language-regexp "[A-Za-z]+\\(-[A-Za-z]+\\)*") (defconst mime-language-regexp "[-A-Za-z]+") diff --git a/mime-parse.el b/mime-parse.el index fef2ac3..6f87d8f 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -1,6 +1,6 @@ ;;; mime-parse.el --- MIME message parser -;; Copyright (C) 1994,95,96,97,98,99,2001 Free Software Foundation, Inc. +;; Copyright (C) 1994,95,96,97,98,99,2001,2002 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Shuhei KOBAYASHI @@ -88,7 +88,7 @@ be the result." ret)) -;;; @ field parser +;;; @ parameter value decoder ;;; (defun mime-decode-parameter-value (text charset language) @@ -162,7 +162,7 @@ property of the decoded-value." (setq eparam (cdr eparam)) (setq eparam (list (make-vector len nil) nil nil) eparams (cons (cons attribute eparam) eparams))) - ;; if parameter-name ends with "*", it is an extended-parameter. + ;; if parameter name ends with "*", it is an extended-parameter. (if (match-beginning 3) (if (zerop section) ;; extended-initial-parameter. @@ -192,7 +192,7 @@ property of the decoded-value." (substring value (match-beginning 2) (match-end 2))))))) - ;; invalid parameter-value. + ;; invalid parameter value. (aset (car eparam) 0 (mime-decode-parameter-encode-segment value))) ;; extended-other-parameter. @@ -202,14 +202,14 @@ property of the decoded-value." "\\|%[0-9A-Fa-f][0-9A-Fa-f]\\)+\\)$")) value) (aset (car eparam) section value) - ;; invalid parameter-value. + ;; invalid parameter value. (aset (car eparam) section (mime-decode-parameter-encode-segment value)))) ;; regular-parameter. parameter continuation only. (aset (car eparam) section (mime-decode-parameter-encode-segment value)))) ;; parameter value extensions are not used, - ;; or invalid attribute-name (in RFC2231, although valid in RFC2045). + ;; or invalid parameter name (in RFC 2231, although valid in RFC 2045). (setq dest (cons (cons (downcase (car params)) ;;; ;; decode (invalid!) encoded-words. ;;; (eword-decode-string @@ -239,6 +239,198 @@ property of the decoded-value." (defalias 'mime-parse-parameters-from-list 'mime-decode-parameters) (make-obsolete 'mime-parse-parameters-from-list 'mime-decode-parameters) + +;;; @ parameter value encoder +;;; + +(defun mime-divide-extended-parameter (name value) + "Divide MIME parameter value \"NAME=VALUE\" into segments. +Each of \" NAME*n*=SEGMENT_n\;\" will be no more than 78 characters. +Return value is a list of string when division is performed, otherwise +return value is just a string." + ;; `limit' must be more than (length "CHARSET'LANGUAGE'%XX"). + ;; + ;; Since MIME spec does not limit either length of CHARSET or length + ;; of LANGUAGE, we choose 30 for minimum `limit' based on the longest + ;; name of charset that Emacs supports ("ISO-2022-CN-EXT"; 15 chars). + ;; + ;; Anyway, if `name' is too long, we will ignore 78 chars limit. + (let ((limit (max (- 78 4 (length name)) 30))); (length " *=;") => 4 + (if (> limit (length value)) + value + (let ((count 0) + result) + (setq limit (max (- limit 2) 30)) ; (length "*n") => 2 + (with-temp-buffer + (set-buffer-multibyte nil) + (insert value) + (while (> (point-max) limit) + (goto-char (- limit 3)) ; (length "%XX") => 3 + (cond + ((eq (char-after) ?%) + (forward-char 3)) + ((progn + (forward-char) + (eq (char-after) ?%))) + ((progn + (forward-char) + (eq (char-after) ?%))) + (t + (forward-char))) + (setq result (cons (prog1 (buffer-substring (point-min)(point)) + (delete-region (point-min)(point))) + result) + count (1+ count)) + (when (zerop (% count 10)) + (setq limit (max (1- limit) 30)))) + (nreverse + (cons (buffer-substring (point-min)(point-max)) + result))))))) + +(defun mime-encode-extended-parameter (name value) + "Encode MIME parameter value \"NAME=VALUE\" as an extended-parameter. +If encoding is unnecessary, return nil. +If division is performed, return value is a list of string, otherwise +return value is just a string." + (let ((language (get-text-property 0 'mime-language value))) + (when (or language + (string-match "[^ -~]" value)) ; Nonmatching printable US-ASCII. + (with-temp-buffer + (let ((charset (find-mime-charset-by-charsets + (find-charset-string value)))) + ;; I believe that `encode-mime-charset-string' of mcs-e20.el should + ;; be independent of the value of `enable-multibyte-characters'. + ;; -- shuhei + (set-buffer-multibyte t) + (setq value (encode-mime-charset-string value charset)) + (set-buffer-multibyte nil) + (insert value) + (goto-char (point-min)) + (insert (symbol-name charset) + ?' + (if language (symbol-name language) "") + ?') + (while (re-search-forward mime-non-attribute-char-regexp nil t) + (insert (prog1 (format "%%%02X" (char-int + (char-after (1- (point))))) + (delete-region (1- (point))(point))))) + (mime-divide-extended-parameter name (buffer-string))))))) + +(defun mime-divide-regular-parameter (name value) + "Divide MIME parameter value \"NAME=VALUE\" into segments. +Each of \" NAME*n=SEGMENT_n\;\" will be no more than 78 characters. +Return value is a list of string when division is performed, otherwise +just a string is returned." + (let ((limit (max (- (eval-when-compile (- 78 (length " =\"\";"))) + (length name)) + 30))) + (if (> limit (length value)) + (concat "\"" value "\"") + (let ((count 0) + result) + (setq limit (max (- limit 2) 30)) ; (length "*n") => 2 + (setq limit (1- limit)) ; XXX + (with-temp-buffer + (set-buffer-multibyte nil) + (insert value) + (while (> (point-max) limit) + (goto-char (point-min)) + (while (< (point) limit) + (when (eq (char-after) ?\\) + (forward-char)) + (forward-char)) + (setq result (cons (concat "\"" + (prog1 (buffer-substring + (point-min)(point)) + (delete-region + (point-min)(point))) + "\"") + result) + count (1+ count)) + (when (zerop (% count 10)) + (setq limit (max (1- limit) 30)))) + (nreverse + (cons (concat "\"" + (buffer-substring (point-min)(point-max)) + "\"") + result))))))) + +(defun mime-encode-regular-parameter (name value) + "Encode MIME parameter value \"NAME=VALUE\" as a regular-parameter. +If division is performed, return value is a list of string, otherwise +return value is just a string." + (with-temp-buffer + (set-buffer-multibyte nil) + (insert value) + (goto-char (point-min)) + (while (not (eobp)) + (when (memq (char-after) '(?\\ ?\")) + (insert ?\\)) + (forward-char 1)) + (mime-divide-regular-parameter name (buffer-string)))) + +(defun mime-encode-parameters (params) + "Encode PARAMS plist with MIME Parameter-Value Extensions. +Return value is an alist of MIME parameter values." + (let (name value encoded result) + (while params + (setq name (car params) + value (car (cdr params)) + params (cdr (cdr params))) + (cond + ;; first two clauses are for backward compatibility, + ;; especially for "ftp.in" in the distribution. + ((not (string-match (eval-when-compile + (concat "^\\(" mime-attribute-char-regexp "+\\)" + "\\(\\*[0-9]+\\)?" ; continuation + "\\(\\*\\)?$")) ; charset/language + name)) + ;; invalid parameter name. + ;; XXX: Should we signal an error? + ) + ((> (match-end 0) (match-end 1)) + ;; this parameter value is already encoded. + (setq result (cons (cons name + (if (match-beginning 3) + ;; extended-parameter + value + ;; regular-parameter + (std11-wrap-as-quoted-string value))) + result))) + ((setq encoded (mime-encode-extended-parameter name value)) + ;; extended-parameter + (if (stringp encoded) + (setq result (cons (cons (concat name "*") encoded) result)) + ;; with continuation + (let ((section 0)) + (while encoded + (setq result (cons (cons (concat name + "*" (int-to-string section) + "*") + (car encoded)) + result) + section (1+ section) + encoded(cdr encoded)))))) + (t + ;; regular-parameter + (setq encoded (mime-encode-regular-parameter name value)) + (if (stringp encoded) + (setq result (cons (cons name encoded) result)) + ;; with continuation + (let ((section 0)) + (while encoded + (setq result (cons (cons (concat name + "*" (int-to-string section)) + (car encoded)) + result) + section (1+ section) + encoded (cdr encoded)))))))) + (nreverse result))) + + +;;; @ field parser +;;; + (defun mime-parse-parameters (tokens) "Parse TOKENS as MIME parameter values. Return a property list, which is a list of the form @@ -289,7 +481,7 @@ If FIELD-BODY is not a valid Content-Type field, return nil." ;;;###autoload (defun mime-read-Content-Type () - "Parse field-body of Content-Type field of current-buffer. + "Parse field-body of Content-Type field of current buffer. Return value is a mime-content-type object. If Content-Type field is not found, return nil." (let ((field-body (std11-field-body "Content-Type"))) @@ -316,7 +508,7 @@ If FIELD-BODY is not a valid Content-Disposition field, return nil." ;;;###autoload (defun mime-read-Content-Disposition () - "Parse field-body of Content-Disposition field of current-buffer. + "Parse field-body of Content-Disposition field of current buffer. Return value is a mime-content-disposition object. If Content-Disposition field is not found, return nil." (let ((field-body (std11-field-body "Content-Disposition"))) @@ -340,7 +532,7 @@ If FIELD-BODY is not a valid Content-Transfer-Encoding field, return nil." ;;;###autoload (defun mime-read-Content-Transfer-Encoding () - "Parse field-body of Content-Transfer-Encoding field of current-buffer. + "Parse field-body of Content-Transfer-Encoding field of current buffer. Return value is a string. If Content-Transfer-Encoding field is not found, return nil." (let ((field-body (std11-field-body "Content-Transfer-Encoding"))) @@ -495,7 +687,7 @@ If Content-Transfer-Encoding field is not found, return nil." ;;;###autoload (defun mime-parse-buffer (&optional buffer representation-type) "Parse BUFFER as a MIME message. -If buffer is omitted, it parses current-buffer." +If buffer is omitted, it parses current buffer." (save-excursion (if buffer (set-buffer buffer)) (mime-parse-message (or representation-type -- 1.7.10.4