Move `mime-content-disposition-parameter' and
[elisp/flim.git] / mime-def.el
1 ;;; mime-def.el --- definition module about MIME
2
3 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
4
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Keywords: definition, MIME, multimedia, mail, news
7
8 ;; This file is part of FLIM (Faithful Library about Internet Message).
9
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
14
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18 ;; General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Code:
26
27 (defconst mime-library-version-string "FLIM 1.5.0 - \"Mukaijima\"")
28
29
30 ;;; @ variables
31 ;;;
32
33 (require 'custom)
34
35 (eval-when-compile (require 'cl))
36
37 (defgroup mime nil
38   "Emacs MIME Interfaces"
39   :group 'news
40   :group 'mail)
41
42 (custom-handle-keyword 'default-mime-charset :group 'mime
43                        'custom-variable)
44
45 (defcustom mime-temp-directory (or (getenv "MIME_TMP_DIR")
46                                    (getenv "TM_TMP_DIR")
47                                    (getenv "TMPDIR")
48                                    (getenv "TMP")
49                                    (getenv "TEMP")
50                                    "/tmp/")
51   "*Directory for temporary files."
52   :group 'mime
53   :type 'directory)
54
55
56 ;;; @ required functions
57 ;;;
58
59 (unless (fboundp 'butlast)
60   (defun butlast (x &optional n)
61     "Returns a copy of LIST with the last N elements removed."
62     (if (and n (<= n 0)) x
63       (nbutlast (copy-sequence x) n)))
64   
65   (defun nbutlast (x &optional n)
66     "Modifies LIST to remove the last N elements."
67     (let ((m (length x)))
68       (or n (setq n 1))
69       (and (< n m)
70            (progn
71              (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
72              x))))
73   )
74
75 (defsubst eliminate-top-spaces (string)
76   "Eliminate top sequence of space or tab in STRING."
77   (if (string-match "^[ \t]+" string)
78       (substring string (match-end 0))
79     string))
80
81 (defsubst regexp-* (regexp)
82   (concat regexp "*"))
83
84 (defsubst regexp-or (&rest args)
85   (concat "\\(" (mapconcat (function identity) args "\\|") "\\)"))
86
87
88 ;;; @ about STD 11
89 ;;;
90
91 (defconst std11-quoted-pair-regexp "\\\\.")
92 (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
93 (defconst std11-qtext-regexp
94   (concat "[^" (char-list-to-string std11-non-qtext-char-list) "]"))
95 (defconst std11-quoted-string-regexp
96   (concat "\""
97           (regexp-*
98            (regexp-or std11-qtext-regexp std11-quoted-pair-regexp))
99           "\""))
100
101
102 ;;; @ about MIME
103 ;;;
104
105 (defconst mime-tspecials "][()<>@,\;:\\\"/?=")
106 (defconst mime-token-regexp (concat "[^" mime-tspecials "\000-\040]+"))
107 (defconst mime-charset-regexp mime-token-regexp)
108
109 (defconst mime-media-type/subtype-regexp
110   (concat mime-token-regexp "/" mime-token-regexp))
111
112
113 ;;; @@ Quoted-Printable
114 ;;;
115
116 (defconst quoted-printable-hex-chars "0123456789ABCDEF")
117
118 (defconst quoted-printable-octet-regexp
119   (concat "=[" quoted-printable-hex-chars
120           "][" quoted-printable-hex-chars "]"))
121
122
123 ;;; @ Content-Type
124 ;;;
125
126 (defsubst make-mime-content-type (type subtype &optional parameters)
127   (list* (cons 'type type)
128          (cons 'subtype subtype)
129          (nreverse parameters))
130   )
131
132 (defsubst mime-content-type-primary-type (content-type)
133   "Return primary-type of CONTENT-TYPE."
134   (cdr (car content-type)))
135
136 (defsubst mime-content-type-subtype (content-type)
137   "Return primary-type of CONTENT-TYPE."
138   (cdr (cadr content-type)))
139
140 (defsubst mime-content-type-parameters (content-type)
141   "Return primary-type of CONTENT-TYPE."
142   (cddr content-type))
143
144 (defsubst mime-content-type-parameter (content-type parameter)
145   "Return PARAMETER value of CONTENT-TYPE."
146   (cdr (assoc parameter (mime-content-type-parameters content-type))))
147
148
149 (defsubst mime-type/subtype-string (type &optional subtype)
150   "Return type/subtype string from TYPE and SUBTYPE."
151   (if type
152       (if subtype
153           (format "%s/%s" type subtype)
154         (format "%s" type))))
155
156
157 ;;; @ Content-Disposition
158 ;;;
159
160 (defsubst mime-content-disposition-type (content-disposition)
161   "Return disposition-type of CONTENT-DISPOSITION."
162   (cdr (car content-disposition)))
163
164 (defsubst mime-content-disposition-parameters (content-disposition)
165   "Return disposition-parameters of CONTENT-DISPOSITION."
166   (cdr content-disposition))
167
168
169 ;;; @ MIME entity
170 ;;;
171
172 (defsubst make-mime-entity (buffer
173                             header-start header-end body-start body-end
174                             &optional node-id
175                             content-type content-disposition
176                             encoding children)
177   (vector buffer header-start header-end body-start body-end
178           node-id content-type content-disposition encoding nil
179           children nil))
180
181 (defsubst mime-entity-buffer (entity)              (aref entity  0))
182 (defsubst mime-entity-header-start (entity)        (aref entity  1))
183 (defsubst mime-entity-header-end (entity)          (aref entity  2))
184 (defsubst mime-entity-body-start (entity)          (aref entity  3))
185 (defsubst mime-entity-body-end (entity)            (aref entity  4))
186 (defsubst mime-entity-node-id (entity)             (aref entity  5))
187 (defsubst mime-entity-content-type (entity)        (aref entity  6))
188 (defsubst mime-entity-content-disposition (entity) (aref entity  7))
189 (defsubst mime-entity-encoding (entity)            (aref entity  8))
190 (defsubst mime-entity-original-header (entity)     (aref entity  9))
191 (defsubst mime-entity-children (entity)            (aref entity 10))
192 (defsubst mime-entity-parsed-header (entity)       (aref entity 11))
193
194 (defsubst mime-entity-set-original-header (entity header)
195   (aset entity 9 header))
196 (defsubst mime-entity-set-parsed-header (entity header)
197   (aset entity 11 header))
198
199 (defsubst mime-entity-number (entity)
200   (reverse (mime-entity-node-id entity)))
201
202 (defalias 'mime-entity-point-min 'mime-entity-header-start)
203 (defalias 'mime-entity-point-max 'mime-entity-body-end)
204
205 (defsubst mime-entity-media-type (entity)
206   (mime-content-type-primary-type (mime-entity-content-type entity)))
207 (defsubst mime-entity-media-subtype (entity)
208   (mime-content-type-subtype (mime-entity-content-type entity)))
209 (defsubst mime-entity-parameters (entity)
210   (mime-content-type-parameters (mime-entity-content-type entity)))
211
212 (defsubst mime-entity-type/subtype (entity-info)
213   (mime-type/subtype-string (mime-entity-media-type entity-info)
214                             (mime-entity-media-subtype entity-info)))
215
216
217 ;;; @ message structure
218 ;;;
219
220 (defvar mime-message-structure nil
221   "Information about structure of message.
222 Please use reference function `mime-entity-SLOT' to get value of SLOT.
223
224 Following is a list of slots of the structure:
225
226 buffer                  buffer includes this entity (buffer).
227 node-id                 node-id (list of integers)
228 header-start            minimum point of header in raw-buffer
229 header-end              maximum point of header in raw-buffer
230 body-start              minimum point of body in raw-buffer
231 body-end                maximum point of body in raw-buffer
232 content-type            content-type (content-type)
233 content-disposition     content-disposition (content-disposition)
234 encoding                Content-Transfer-Encoding (string or nil)
235 children                entities included in this entity (list of entity)
236
237 If an entity includes other entities in its body, such as multipart or
238 message/rfc822, `mime-entity' structures of them are included in
239 `children', so the `mime-entity' structure become a tree.")
240
241 (make-variable-buffer-local 'mime-message-structure)
242
243
244 ;;; @ end
245 ;;;
246
247 (provide 'mime-def)
248
249 ;;; mime-def.el ends here