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 (defsubst mime-content-disposition-parameter (content-disposition parameter)
 169   "Return PARAMETER value of CONTENT-DISPOSITION."
 170   (std11-strip-quoted-string
 171    (cdr (assoc parameter (cdr content-disposition)))))
 172
 173 (defsubst mime-content-disposition-filename (content-disposition)
 174   "Return filename of CONTENT-DISPOSITION."
 175   (mime-content-disposition-parameter content-disposition "filename"))
 176
 177
 178 ;;; @ MIME entity
 179 ;;;
 180
 181 (defsubst make-mime-entity (buffer
 182                             header-start header-end body-start body-end
 183                             &optional node-id
 184                             content-type content-disposition
 185                             encoding children)
 186   (vector buffer header-start header-end body-start body-end
 187           node-id content-type content-disposition encoding nil
 188           children nil))
 189
 190 (defsubst mime-entity-buffer (entity)              (aref entity  0))
 191 (defsubst mime-entity-header-start (entity)        (aref entity  1))
 192 (defsubst mime-entity-header-end (entity)          (aref entity  2))
 193 (defsubst mime-entity-body-start (entity)          (aref entity  3))
 194 (defsubst mime-entity-body-end (entity)            (aref entity  4))
 195 (defsubst mime-entity-node-id (entity)             (aref entity  5))
 196 (defsubst mime-entity-content-type (entity)        (aref entity  6))
 197 (defsubst mime-entity-content-disposition (entity) (aref entity  7))
 198 (defsubst mime-entity-encoding (entity)            (aref entity  8))
 199 (defsubst mime-entity-original-header (entity)     (aref entity  9))
 200 (defsubst mime-entity-children (entity)            (aref entity 10))
 201 (defsubst mime-entity-parsed-header (entity)       (aref entity 11))
 202
 203 (defsubst mime-entity-set-original-header (entity header)
 204   (aset entity 9 header))
 205 (defsubst mime-entity-set-parsed-header (entity header)
 206   (aset entity 11 header))
 207
 208 (defsubst mime-entity-number (entity)
 209   (reverse (mime-entity-node-id entity)))
 210
 211 (defalias 'mime-entity-point-min 'mime-entity-header-start)
 212 (defalias 'mime-entity-point-max 'mime-entity-body-end)
 213
 214 (defsubst mime-entity-media-type (entity)
 215   (mime-content-type-primary-type (mime-entity-content-type entity)))
 216 (defsubst mime-entity-media-subtype (entity)
 217   (mime-content-type-subtype (mime-entity-content-type entity)))
 218 (defsubst mime-entity-parameters (entity)
 219   (mime-content-type-parameters (mime-entity-content-type entity)))
 220
 221 (defsubst mime-entity-type/subtype (entity-info)
 222   (mime-type/subtype-string (mime-entity-media-type entity-info)
 223                             (mime-entity-media-subtype entity-info)))
 224
 225
 226 ;;; @ message structure
 227 ;;;
 228
 229 (defvar mime-message-structure nil
 230   "Information about structure of message.
 231 Please use reference function `mime-entity-SLOT' to get value of SLOT.
 232
 233 Following is a list of slots of the structure:
 234
 235 buffer                  buffer includes this entity (buffer).
 236 node-id                 node-id (list of integers)
 237 header-start            minimum point of header in raw-buffer
 238 header-end              maximum point of header in raw-buffer
 239 body-start              minimum point of body in raw-buffer
 240 body-end                maximum point of body in raw-buffer
 241 content-type            content-type (content-type)
 242 content-disposition     content-disposition (content-disposition)
 243 encoding                Content-Transfer-Encoding (string or nil)
 244 children                entities included in this entity (list of entity)
 245
 246 If an entity includes other entities in its body, such as multipart or
 247 message/rfc822, `mime-entity' structures of them are included in
 248 `children', so the `mime-entity' structure become a tree.")
 249
 250 (make-variable-buffer-local 'mime-message-structure)
 251
 252
 253 ;;; @ end
 254 ;;;
 255
 256 (provide 'mime-def)
 257
 258 ;;; mime-def.el ends here