+2002-06-03 KAWABATA, Taichi <batta@beige.ocn.ne.jp>
+
+ * FLIM-rfc2231-encoder: merged with FLIM Version 1.14.4.
+
2002-06-03 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
- * FLIM: Version 1.14.4 (Kashiharajing\e-Dþ-mae) released.\e-A
+ * FLIM: Version 1.14.4 (Kashiharajing\e.D\8eþ-mae) released.
+
+2002-06-02 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * 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 <shuhei@aqua.ocn.ne.jp>
+
+ * 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 <shuhei@aqua.ocn.ne.jp>
+
+ * eword-encode.el (eword-encode-Content-Type): New function.
+ (eword-encode-Content-Disposition): Ditto.
+
+2002-05-26 Daiki Ueno <ueno@unixuser.org>
+
+ * mime-parse.el (eword-encode-Content-Type-field-body):
+ New function.
+
+2002-05-20 KAWABATA, Taichi <batta@beige.ocn.ne.jp>
+
+ 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 <lapis-lazuli@pop06.odn.ne.jp>
\f
2001-06-01 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
- * FLIM: Version 1.14.3 (Unebigory\e-Dòmae) released.\e-A
+ * FLIM: Version 1.14.3 (Unebigory\8eòmae) released.
2001-06-01 Katsumi Yamaoka <yamaoka@jpl.org>
\f
2000-07-12 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
- * FLIM-Chao: Version 1.14.1 (Rokujiz\e-Dò) released.\e-A
+ * FLIM-Chao: Version 1.14.1 (Rokujiz\8eò) released.
2000-07-10 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
\f
1999-05-31 MORIOKA Tomohiko <tomo@m17n.org>
- * FLIM: Version 1.12.7 (Y\e-Dþzaki) released.\e-A
+ * FLIM: Version 1.12.7 (Y\8eþzaki) released.
1999-05-31 MORIOKA Tomohiko <tomo@m17n.org>
\f
1999-05-11 MORIOKA Tomohiko <tomo@m17n.org>
- * FLIM: Version 1.12.6 (Family-K\e-Dòenmae) released.\e-A
+ * FLIM: Version 1.12.6 (Family-K\8eòenmae) released.
1999-04-27 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
\f
1999-01-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.12.3 (Kintetsu-K\e-Dòriyama) released.\e-A
+ * FLIM: Version 1.12.3 (Kintetsu-K\8eòriyama) released.
1999-01-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1999-01-21 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.12.2 (Kuj\e-Dò) released.\e-A
+ * FLIM: Version 1.12.2 (Kuj\8eò) released.
1999-01-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-12-02 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.12.1 (Nishinoky\e-Dò) released.\e-A
+ * FLIM: Version 1.12.1 (Nishinoky\8eò) released.
1998-11-30 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-10-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.11.2 (Heij\e-Dò) was released.\e-A
+ * FLIM: Version 1.11.2 (Heij\8eò) was released.
* NEWS (Abolish variable `mime-temp-directory'): New subsection.
\f
1998-10-12 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.10.4 (Shin-H\e-Dòsono) was released.\e-A
+ * FLIM: Version 1.10.4 (Shin-H\8eòsono) was released.
1998-10-12 Katsumi Yamaoka <yamaoka@jpl.org>
\f
1998-09-29 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.10.0 (K\e-Dòdo) was released.\e-A
+ * FLIM: Version 1.10.0 (K\8eòdo) was released.
* README.en (What's FLIM): Add mel-ccl.el.
\f
1998-08-31 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.9.1 (Tonosh\e-Dò) was released.\e-A
+ * FLIM: Version 1.9.1 (Tonosh\8eò) was released.
* mime-en.sgml (mm-backend): Translate a little.
\f
1998-07-07 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM-Chao: Version 1.8.0 (Shij\e-Dò) was released.\e-A
+ * FLIM-Chao: Version 1.8.0 (Shij\8eò) was released.
1998-07-07 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-07-01 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.8.0 (\e-DÒkubo) was released.\e-A
+ * FLIM: Version 1.8.0 (\8eÒkubo) was released.
* README.en: Delete `How to use'.
\f
1998-06-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM-Chao: Version 1.7.0 (Goj\e-Dò) was released.\e-A
+ * FLIM-Chao: Version 1.7.0 (Goj\8eò) was released.
1998-06-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-06-19 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.4.1 (Momoyama-Gory\e-Dòmae) was released.\e-A
+ * FLIM: Version 1.4.1 (Momoyama-Gory\8eòmae) was released.
1998-06-18 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-05-06 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.2.0 (J\e-Dþjò) was released.\e-A
+ * FLIM: Version 1.2.0 (J\8eþj\8eò) was released.
* README.en (What's FLIM): Delete description about
std11-parse.el; add description about mailcap.el.
\f
1998-05-05 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.1.0 (T\e-Dòji) was released.\e-A
+ * FLIM: Version 1.1.0 (T\8eòji) was released.
1998-05-04 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-04-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.0.1 (Ky\e-Dòto) was released.\e-A
+ * FLIM: Version 1.0.1 (Ky\8eòto) was released.
* mime-def.el (mime-spadework-module-version-string): New
constant.
;;; 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 <tomo@m17n.org>
;; Keywords: encoded-word, MIME, multilingual, header, mail, news
(require 'mime-def)
(require 'mel)
(require 'std11)
+(require 'mime-parse)
(require 'eword-decode)
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
;;;
(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.
(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
"*'%" ; 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]+")
;;; 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 <morioka@jaist.ac.jp>
;; Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
ret))
-;;; @ field parser
+;;; @ parameter value decoder
;;;
(defun mime-decode-parameter-value (text charset language)
(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.
(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.
"\\|%[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
(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
;;;###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")))
;;;###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")))
;;;###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")))
;;;###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
projects / elisp / flim.git / commitdiff