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 FLAM (Faithful Library About MIME).
   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-spadework-module-version-string
  28   "FLIM-FLAM 1.8.0 - \"\e$B@VAIK'\e(B\" 7.5R4.0/14.0")
  29
  30
  31 ;;; @ variables
  32 ;;;
  33
  34 (require 'custom)
  35
  36 (eval-when-compile (require 'cl))
  37
  38 (defgroup mime nil
  39   "Emacs MIME Interfaces"
  40   :group 'news
  41   :group 'mail)
  42
  43 (custom-handle-keyword 'default-mime-charset :group 'mime
  44                        'custom-variable)
  45
  46 (defcustom mime-temp-directory (or (getenv "MIME_TMP_DIR")
  47                                    (getenv "TM_TMP_DIR")
  48                                    (getenv "TMPDIR")
  49                                    (getenv "TMP")
  50                                    (getenv "TEMP")
  51                                    "/tmp/")
  52   "*Directory for temporary files."
  53   :group 'mime
  54   :type 'directory)
  55
  56 (defcustom mime-uuencode-encoding-name-list '("x-uue" "x-uuencode")
  57   "*List of encoding names for uuencode format."
  58   :group 'mime
  59   :type '(repeat string))
  60
  61
  62 ;;; @ required functions
  63 ;;;
  64
  65 (unless (fboundp 'butlast)
  66   (defun butlast (x &optional n)
  67     "Returns a copy of LIST with the last N elements removed."
  68     (if (and n (<= n 0)) x
  69       (nbutlast (copy-sequence x) n)))
  70
  71   (defun nbutlast (x &optional n)
  72     "Modifies LIST to remove the last N elements."
  73     (let ((m (length x)))
  74       (or n (setq n 1))
  75       (and (< n m)
  76            (progn
  77              (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
  78              x))))
  79   )
  80
  81 (defsubst eliminate-top-spaces (string)
  82   "Eliminate top sequence of space or tab in STRING."
  83   (if (string-match "^[ \t]+" string)
  84       (substring string (match-end 0))
  85     string))
  86
  87 (defsubst regexp-* (regexp)
  88   (concat regexp "*"))
  89
  90 (defsubst regexp-or (&rest args)
  91   (concat "\\(" (mapconcat (function identity) args "\\|") "\\)"))
  92
  93
  94 ;;; @ about STD 11
  95 ;;;
  96
  97 (defconst std11-quoted-pair-regexp "\\\\.")
  98 (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
  99 (defconst std11-qtext-regexp
 100   (concat "[^" (char-list-to-string std11-non-qtext-char-list) "]"))
 101 (defconst std11-quoted-string-regexp
 102   (concat "\""
 103           (regexp-*
 104            (regexp-or std11-qtext-regexp std11-quoted-pair-regexp))
 105           "\""))
 106
 107
 108 ;;; @ about MIME
 109 ;;;
 110
 111 (defconst mime-tspecials "][()<>@,\;:\\\"/?=")
 112 (defconst mime-token-regexp (concat "[^" mime-tspecials "\000-\040]+"))
 113 (defconst mime-charset-regexp mime-token-regexp)
 114
 115 (defconst mime-media-type/subtype-regexp
 116   (concat mime-token-regexp "/" mime-token-regexp))
 117
 118
 119 ;;; @@ Quoted-Printable
 120 ;;;
 121
 122 (defconst quoted-printable-hex-chars "0123456789ABCDEF")
 123
 124 (defconst quoted-printable-octet-regexp
 125   (concat "=[" quoted-printable-hex-chars
 126           "][" quoted-printable-hex-chars "]"))
 127
 128
 129 ;;; @ Content-Type
 130 ;;;
 131
 132 (defsubst make-mime-content-type (type subtype &optional parameters)
 133   (list* (cons 'type type)
 134          (cons 'subtype subtype)
 135          (nreverse parameters))
 136   )
 137
 138 (defsubst mime-content-type-primary-type (content-type)
 139   "Return primary-type of CONTENT-TYPE."
 140   (cdr (car content-type)))
 141
 142 (defsubst mime-content-type-subtype (content-type)
 143   "Return primary-type of CONTENT-TYPE."
 144   (cdr (cadr content-type)))
 145
 146 (defsubst mime-content-type-parameters (content-type)
 147   "Return primary-type of CONTENT-TYPE."
 148   (cddr content-type))
 149
 150 (defsubst mime-content-type-parameter (content-type parameter)
 151   "Return PARAMETER value of CONTENT-TYPE."
 152   (cdr (assoc parameter (mime-content-type-parameters content-type))))
 153
 154
 155 (defsubst mime-type/subtype-string (type &optional subtype)
 156   "Return type/subtype string from TYPE and SUBTYPE."
 157   (if type
 158       (if subtype
 159           (format "%s/%s" type subtype)
 160         (format "%s" type))))
 161
 162
 163 ;;; @ Content-Disposition
 164 ;;;
 165
 166 (defsubst mime-content-disposition-type (content-disposition)
 167   "Return disposition-type of CONTENT-DISPOSITION."
 168   (cdr (car content-disposition)))
 169
 170 (defsubst mime-content-disposition-parameters (content-disposition)
 171   "Return disposition-parameters of CONTENT-DISPOSITION."
 172   (cdr content-disposition))
 173
 174 (defsubst mime-content-disposition-parameter (content-disposition parameter)
 175   "Return PARAMETER value of CONTENT-DISPOSITION."
 176   (cdr (assoc parameter (cdr content-disposition))))
 177
 178 (defsubst mime-content-disposition-filename (content-disposition)
 179   "Return filename of CONTENT-DISPOSITION."
 180   (mime-content-disposition-parameter content-disposition "filename"))
 181
 182
 183 ;;; @ MIME entity
 184 ;;;
 185
 186 (defsubst make-mime-entity-internal (representation-type
 187                                      location
 188                                      &optional content-type children
 189                                      node-id
 190                                      buffer
 191                                      header-start header-end
 192                                      body-start body-end)
 193   (vector representation-type location
 194           content-type children nil nil node-id
 195           buffer header-start header-end body-start body-end
 196           nil nil))
 197
 198 (defsubst mime-entity-representation-type-internal (entity) (aref entity  0))
 199 (defsubst mime-entity-location-internal            (entity) (aref entity  1))
 200
 201 (defsubst mime-entity-content-type-internal (entity)        (aref entity  2))
 202 (defsubst mime-entity-children-internal (entity)            (aref entity  3))
 203 (defsubst mime-entity-content-disposition-internal (entity) (aref entity  4))
 204 (defsubst mime-entity-encoding-internal (entity)            (aref entity  5))
 205 (defsubst mime-entity-node-id-internal (entity)             (aref entity  6))
 206
 207 (defsubst mime-entity-buffer-internal (entity)              (aref entity  7))
 208 (defsubst mime-entity-header-start-internal (entity)        (aref entity  8))
 209 (defsubst mime-entity-header-end-internal (entity)          (aref entity  9))
 210 (defsubst mime-entity-body-start-internal (entity)          (aref entity 10))
 211 (defsubst mime-entity-body-end-internal (entity)            (aref entity 11))
 212
 213 (defsubst mime-entity-original-header-internal (entity)     (aref entity 12))
 214 (defsubst mime-entity-parsed-header-internal (entity)       (aref entity 13))
 215
 216 (defsubst mime-entity-set-representation-type-internal (entity type)
 217   (aset entity  0 type))
 218 (defsubst mime-entity-set-content-type-internal (entity type)
 219   (aset entity  2 type))
 220 (defsubst mime-entity-set-children-internal (entity children)
 221   (aset entity  3 children))
 222 (defsubst mime-entity-set-content-disposition-internal (entity disposition)
 223   (aset entity  4 disposition))
 224 (defsubst mime-entity-set-encoding-internal (entity encoding)
 225   (aset entity  5 encoding))
 226 (defsubst mime-entity-set-original-header-internal (entity header)
 227   (aset entity 12 header))
 228 (defsubst mime-entity-set-parsed-header-internal (entity header)
 229   (aset entity 13 header))
 230
 231
 232 ;;; @ message structure
 233 ;;;
 234
 235 (defvar mime-message-structure nil
 236   "Information about structure of message.
 237 Please use reference function `mime-entity-SLOT' to get value of SLOT.
 238
 239 Following is a list of slots of the structure:
 240
 241 buffer                  buffer includes this entity (buffer).
 242 node-id                 node-id (list of integers)
 243 header-start            minimum point of header in raw-buffer
 244 header-end              maximum point of header in raw-buffer
 245 body-start              minimum point of body in raw-buffer
 246 body-end                maximum point of body in raw-buffer
 247 content-type            content-type (content-type)
 248 content-disposition     content-disposition (content-disposition)
 249 encoding                Content-Transfer-Encoding (string or nil)
 250 children                entities included in this entity (list of entity)
 251
 252 If an entity includes other entities in its body, such as multipart or
 253 message/rfc822, `mime-entity' structures of them are included in
 254 `children', so the `mime-entity' structure become a tree.")
 255
 256 (make-variable-buffer-local 'mime-message-structure)
 257
 258
 259 ;;; @ end
 260 ;;;
 261
 262 (provide 'mime-def)
 263
 264 ;;; mime-def.el ends here