update.
[elisp/flim.git] / mime-def.el
index 5db2cf9..9ee7781 100644 (file)
@@ -1,8 +1,10 @@
 ;;; mime-def.el --- definition module about MIME -*- coding: iso-8859-4; -*-
 
-;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99,2000,2001,2002,2003,2004,2005,2006
+;;   Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;;     Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
 ;; Keywords: definition, MIME, multimedia, mail, news
 
 ;; This file is part of FLIM (Faithful Library about Internet Message).
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Code:
 
-(require 'poe)
 (require 'custom)
 (require 'mcharset)
 (require 'alist)
 
-(eval-when-compile
-  (require 'cl)   ; list*
-  (require 'luna) ; luna-arglist-to-arguments
-  )
+(eval-when-compile (require 'luna))    ; luna-arglist-to-arguments
 
 (eval-and-compile
-  (defconst mime-library-product ["FLIM" (1 14 0) "Ninokuchi"]
+  (defconst mime-library-product ["FLIM" (1 14 9) "Gojò"]
     "Product name, version number and code name of MIME-library package."))
 
 (defmacro mime-product-name (product)
   :type '(repeat string))
 
 
+;;; @@ for encoded-word
+;;;
+
+(defgroup mime-header nil
+  "Header representation, specially encoded-word"
+  :group 'mime)
+
+;;; @@@ decoding
+;;;
+
+(defcustom mime-field-decoding-max-size 1000
+  "*Max size to decode header field."
+  :group 'mime-header
+  :type '(choice (integer :tag "Limit (bytes)")
+                (const :tag "Don't limit" nil)))
+
+(defcustom mime-header-accept-quoted-encoded-words nil
+  "*Accept encoded-words in quoted-strings."
+  :group 'mime-header
+  :type 'boolean)
+
+
+;;; @@@ encoding
+;;;
+
+(defcustom mime-field-encoding-method-alist
+  '(("X-Nsubject" . iso-2022-jp-2)
+    ("Newsgroups" . nil)
+    ("Message-ID" . nil)
+    (t            . mime)
+    )
+  "*Alist to specify field encoding method.
+Its key is field-name, value is encoding method.
+
+If method is `mime', this field will be encoded into MIME format.
+
+If method is a MIME-charset, this field will be encoded as the charset
+when it must be convert into network-code.
+
+If method is `default-mime-charset', this field will be encoded as
+variable `default-mime-charset' when it must be convert into
+network-code.
+
+If method is nil, this field will not be encoded."
+  :group 'mime-header
+  :type '(repeat (cons (choice :tag "Field"
+                              (string :tag "Name")
+                              (const :tag "Default" t))
+                      (choice :tag "Method"
+                              (const :tag "MIME conversion" mime)
+                              (symbol :tag "non-MIME conversion")
+                              (const :tag "no-conversion" nil)))))
+
+
 ;;; @ required functions
 ;;;
 
 (defsubst regexp-or (&rest args)
   (concat "\\(" (mapconcat (function identity) args "\\|") "\\)"))
 
-(eval-when-compile (require 'static))
-
-(static-if (and (featurep 'xemacs)
-               (not (featurep 'utf-2000)))
-    (progn
-      (require 'pces)
-      (defalias 'binary-insert-file-contents 'insert-file-contents-as-binary)
-      (defalias 'binary-write-region 'write-region-as-binary))
-  (defalias 'binary-insert-file-contents 'insert-file-contents-literally)
-  (defun binary-write-region (start end filename
-                                   &optional append visit lockname)
-    "Like `write-region', q.v., but don't encode."
-    (let ((coding-system-for-write 'binary)
-         jka-compr-compression-info-list jam-zcat-filename-list)
-      (write-region start end filename append visit lockname)))
-  )
-
-  
-;;; @ about STD 11
-;;;
-
-(eval-and-compile
-  (defconst std11-quoted-pair-regexp "\\\\.")
-  (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
-  (defconst std11-qtext-regexp
-    (eval-when-compile
-      (concat "[^" std11-non-qtext-char-list "]"))))
-(defconst std11-quoted-string-regexp
-  (eval-when-compile
-    (concat "\""
-           (regexp-*
-            (regexp-or std11-qtext-regexp std11-quoted-pair-regexp))
-           "\"")))
+(or (fboundp 'char-int)
+    (defalias 'char-int 'identity))
 
 
-;;; @ about MIME
+;;; @ MIME constants
 ;;;
 
-(eval-and-compile
-  (defconst mime-tspecial-char-list
-    '(?\] ?\[ ?\( ?\) ?< ?> ?@ ?, ?\; ?: ?\\ ?\" ?/ ?? ?=)))
+(defconst mime-tspecial-char-list
+  '(?\] ?\[ ?\( ?\) ?< ?> ?@ ?, ?\; ?: ?\\ ?\" ?/ ?? ?=))
 (defconst mime-token-regexp
-  (eval-when-compile
-    (concat "[^" mime-tspecial-char-list "\000-\040]+")))
-(defconst mime-charset-regexp mime-token-regexp)
+  (concat "[^" mime-tspecial-char-list "\000-\040]+"))
+(defconst mime-attribute-char-regexp
+  (concat "[^" mime-tspecial-char-list "\000-\040"
+         "*'%"                         ; introduced in RFC 2231.
+         "]"))
+
+(defconst mime-charset-regexp
+  (concat "[^" mime-tspecial-char-list "\000-\040"
+         "*'%"                         ; should not include "%"?
+         "]+"))
+
+;; More precisely, length of "[A-Za-z]+" is limited to at most 8.
+;; (defconst mime-language-regexp "[A-Za-z]+\\(-[A-Za-z]+\\)*")
+(defconst mime-language-regexp "[-A-Za-z]+")
 
-(defconst mime-media-type/subtype-regexp
-  (concat mime-token-regexp "/" mime-token-regexp))
+(defconst mime-encoding-regexp mime-token-regexp)
 
 
 ;;; @@ base64 / B
 ;;;
 
 (defsubst make-mime-content-type (type subtype &optional parameters)
-  (list* (cons 'type type)
-        (cons 'subtype subtype)
-        (nreverse parameters))
-  )
+  (cons (cons 'type type)
+       (cons (cons 'subtype subtype)
+             parameters)))
 
 (defsubst mime-content-type-primary-type (content-type)
   "Return primary-type of CONTENT-TYPE."
   (cdr (car content-type)))
 
 (defsubst mime-content-type-subtype (content-type)
-  "Return primary-type of CONTENT-TYPE."
-  (cdr (cadr content-type)))
+  "Return subtype of CONTENT-TYPE."
+  (cdr (car (cdr content-type))))
 
 (defsubst mime-content-type-parameters (content-type)
-  "Return primary-type of CONTENT-TYPE."
-  (cddr content-type))
+  "Return parameters of CONTENT-TYPE."
+  (cdr (cdr content-type)))
 
 (defsubst mime-content-type-parameter (content-type parameter)
   "Return PARAMETER value of CONTENT-TYPE."
-  (cdr (assoc parameter (mime-content-type-parameters content-type))))
+  (cdr (assoc parameter (cdr (cdr content-type)))))
 
 
 (defsubst mime-type/subtype-string (type &optional subtype)
 ;;; @ Content-Disposition
 ;;;
 
+(defsubst make-mime-content-disposition (type &optional parameters)
+  (cons (cons 'type type)
+       parameters))
+
 (defsubst mime-content-disposition-type (content-disposition)
   "Return disposition-type of CONTENT-DISPOSITION."
   (cdr (car content-disposition)))