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
  28   '("FLIM" "Shin-Tanabe" 1 9 2)
  29   "Implementation name, version name and numbers of MIME-library package.")
  30
  31 (defconst mime-library-version-string
  32   `,(concat (car mime-library-version) " "
  33             (mapconcat #'number-to-string
  34                        (cddr mime-library-version) ".")
  35             " - \"" (cadr mime-library-version) "\""))
  36
  37
  38 ;;; @ variables
  39 ;;;
  40
  41 (require 'custom)
  42
  43 (eval-when-compile (require 'cl))
  44
  45 (defgroup mime nil
  46   "Emacs MIME Interfaces"
  47   :group 'news
  48   :group 'mail)
  49
  50 (custom-handle-keyword 'default-mime-charset :group 'mime
  51                        'custom-variable)
  52
  53 (defcustom mime-temp-directory (or (getenv "MIME_TMP_DIR")
  54                                    (getenv "TM_TMP_DIR")
  55                                    (getenv "TMPDIR")
  56                                    (getenv "TMP")
  57                                    (getenv "TEMP")
  58                                    "/tmp/")
  59   "*Directory for temporary files."
  60   :group 'mime
  61   :type 'directory)
  62
  63 (defcustom mime-uuencode-encoding-name-list '("x-uue" "x-uuencode")
  64   "*List of encoding names for uuencode format."
  65   :group 'mime
  66   :type '(repeat string))
  67
  68
  69 ;;; @ required functions
  70 ;;;
  71
  72 (defsubst eliminate-top-spaces (string)
  73   "Eliminate top sequence of space or tab in STRING."
  74   (if (string-match "^[ \t]+" string)
  75       (substring string (match-end 0))
  76     string))
  77
  78 (defsubst regexp-* (regexp)
  79   (concat regexp "*"))
  80
  81 (defsubst regexp-or (&rest args)
  82   (concat "\\(" (mapconcat (function identity) args "\\|") "\\)"))
  83
  84
  85 ;;; @ about STD 11
  86 ;;;
  87
  88 (defconst std11-quoted-pair-regexp "\\\\.")
  89 (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
  90 (defconst std11-qtext-regexp
  91   (concat "[^" (char-list-to-string std11-non-qtext-char-list) "]"))
  92 (defconst std11-quoted-string-regexp
  93   (concat "\""
  94           (regexp-*
  95            (regexp-or std11-qtext-regexp std11-quoted-pair-regexp))
  96           "\""))
  97
  98
  99 ;;; @ about MIME
 100 ;;;
 101
 102 (defconst mime-tspecials "][()<>@,\;:\\\"/?=")
 103 (defconst mime-token-regexp (concat "[^" mime-tspecials "\000-\040]+"))
 104 (defconst mime-charset-regexp mime-token-regexp)
 105
 106 (defconst mime-media-type/subtype-regexp
 107   (concat mime-token-regexp "/" mime-token-regexp))
 108
 109
 110 ;;; @@ Quoted-Printable
 111 ;;;
 112
 113 (defconst quoted-printable-hex-chars "0123456789ABCDEF")
 114
 115 (defconst quoted-printable-octet-regexp
 116   (concat "=[" quoted-printable-hex-chars
 117           "][" quoted-printable-hex-chars "]"))
 118
 119
 120 ;;; @ Content-Type
 121 ;;;
 122
 123 (defsubst make-mime-content-type (type subtype &optional parameters)
 124   (list* (cons 'type type)
 125          (cons 'subtype subtype)
 126          (nreverse parameters))
 127   )
 128
 129 (defsubst mime-content-type-primary-type (content-type)
 130   "Return primary-type of CONTENT-TYPE."
 131   (cdr (car content-type)))
 132
 133 (defsubst mime-content-type-subtype (content-type)
 134   "Return primary-type of CONTENT-TYPE."
 135   (cdr (cadr content-type)))
 136
 137 (defsubst mime-content-type-parameters (content-type)
 138   "Return primary-type of CONTENT-TYPE."
 139   (cddr content-type))
 140
 141 (defsubst mime-content-type-parameter (content-type parameter)
 142   "Return PARAMETER value of CONTENT-TYPE."
 143   (cdr (assoc parameter (mime-content-type-parameters content-type))))
 144
 145
 146 (defsubst mime-type/subtype-string (type &optional subtype)
 147   "Return type/subtype string from TYPE and SUBTYPE."
 148   (if type
 149       (if subtype
 150           (format "%s/%s" type subtype)
 151         (format "%s" type))))
 152
 153
 154 ;;; @ Content-Disposition
 155 ;;;
 156
 157 (defsubst mime-content-disposition-type (content-disposition)
 158   "Return disposition-type of CONTENT-DISPOSITION."
 159   (cdr (car content-disposition)))
 160
 161 (defsubst mime-content-disposition-parameters (content-disposition)
 162   "Return disposition-parameters of CONTENT-DISPOSITION."
 163   (cdr content-disposition))
 164
 165 (defsubst mime-content-disposition-parameter (content-disposition parameter)
 166   "Return PARAMETER value of CONTENT-DISPOSITION."
 167   (cdr (assoc parameter (cdr content-disposition))))
 168
 169 (defsubst mime-content-disposition-filename (content-disposition)
 170   "Return filename of CONTENT-DISPOSITION."
 171   (mime-content-disposition-parameter content-disposition "filename"))
 172
 173
 174 ;;; @ MIME entity
 175 ;;;
 176
 177 (defsubst make-mime-entity-internal (representation-type location
 178                                      &optional content-type
 179                                      children parent node-id
 180                                      buffer
 181                                      header-start header-end
 182                                      body-start body-end)
 183   (vector representation-type location
 184           content-type nil nil children parent node-id
 185           buffer header-start header-end body-start body-end
 186           nil nil))
 187
 188 (defsubst mime-entity-representation-type-internal (entity)
 189   (aref entity 0))
 190 (defsubst mime-entity-set-representation-type-internal (entity type)
 191   (aset entity 0 type))
 192 (defsubst mime-entity-location-internal (entity)
 193   (aref entity 1))
 194
 195 (defsubst mime-entity-content-type-internal (entity)
 196   (aref entity 2))
 197 (defsubst mime-entity-set-content-type-internal (entity type)
 198   (aset entity 2 type))
 199 (defsubst mime-entity-content-disposition-internal (entity)
 200   (aref entity 3))
 201 (defsubst mime-entity-set-content-disposition-internal (entity disposition)
 202   (aset entity 3 disposition))
 203 (defsubst mime-entity-encoding-internal (entity)
 204   (aref entity 4))
 205 (defsubst mime-entity-set-encoding-internal (entity encoding)
 206   (aset entity 4 encoding))
 207
 208 (defsubst mime-entity-children-internal (entity)
 209   (aref entity 5))
 210 (defsubst mime-entity-set-children-internal (entity children)
 211   (aset entity 5 children))
 212 (defsubst mime-entity-parent-internal (entity)
 213   (aref entity 6))
 214 (defsubst mime-entity-node-id-internal (entity)
 215   (aref entity 7))
 216
 217 (defsubst mime-entity-buffer-internal (entity)
 218   (aref entity 8))
 219 (defsubst mime-entity-set-buffer-internal (entity buffer)
 220   (aset entity 8 buffer))
 221 (defsubst mime-entity-header-start-internal (entity)
 222   (aref entity 9))
 223 (defsubst mime-entity-set-header-start-internal (entity point)
 224   (aset entity 9 point))
 225 (defsubst mime-entity-header-end-internal (entity)
 226   (aref entity 10))
 227 (defsubst mime-entity-set-header-end-internal (entity point)
 228   (aset entity 10 point))
 229 (defsubst mime-entity-body-start-internal (entity)
 230   (aref entity 11))
 231 (defsubst mime-entity-set-body-start-internal (entity point)
 232   (aset entity 11 point))
 233 (defsubst mime-entity-body-end-internal (entity)
 234   (aref entity 12))
 235 (defsubst mime-entity-set-body-end-internal (entity point)
 236   (aset entity 12 point))
 237
 238 (defsubst mime-entity-original-header-internal (entity)
 239   (aref entity 13))
 240 (defsubst mime-entity-set-original-header-internal (entity header)
 241   (aset entity 13 header))
 242 (defsubst mime-entity-parsed-header-internal (entity)
 243   (aref entity 14))
 244 (defsubst mime-entity-set-parsed-header-internal (entity header)
 245   (aset entity 14 header))
 246
 247
 248 ;;; @ message structure
 249 ;;;
 250
 251 (defvar mime-message-structure nil
 252   "Information about structure of message.
 253 Please use reference function `mime-entity-SLOT' to get value of SLOT.
 254
 255 Following is a list of slots of the structure:
 256
 257 buffer                  buffer includes this entity (buffer).
 258 node-id                 node-id (list of integers)
 259 header-start            minimum point of header in raw-buffer
 260 header-end              maximum point of header in raw-buffer
 261 body-start              minimum point of body in raw-buffer
 262 body-end                maximum point of body in raw-buffer
 263 content-type            content-type (content-type)
 264 content-disposition     content-disposition (content-disposition)
 265 encoding                Content-Transfer-Encoding (string or nil)
 266 children                entities included in this entity (list of entity)
 267
 268 If an entity includes other entities in its body, such as multipart or
 269 message/rfc822, `mime-entity' structures of them are included in
 270 `children', so the `mime-entity' structure become a tree.")
 271
 272 (make-variable-buffer-local 'mime-message-structure)
 273
 274
 275 ;;; @ for mm-backend
 276 ;;;
 277
 278 (defvar mime-entity-implementation-alist nil)
 279
 280 (defmacro mm-define-backend (type &optional parents)
 281   (if parents
 282       `(let ((rest ',(reverse parents)))
 283          (while rest
 284            (set-alist 'mime-entity-implementation-alist
 285                       ',type
 286                       (copy-alist
 287                        (cdr (assq (car rest)
 288                                   mime-entity-implementation-alist))))
 289            (setq rest (cdr rest))
 290            ))))
 291
 292 (defmacro mm-define-method (name args &rest body)
 293   (let* ((specializer (car args))
 294          (class (nth 1 specializer))
 295          (self (car specializer)))
 296     `(let ((imps (cdr (assq ',class mime-entity-implementation-alist)))
 297            (func (lambda ,(if self
 298                               (cons self (cdr args))
 299                             (cdr args))
 300                    ,@body)))
 301        (if imps
 302            (set-alist 'mime-entity-implementation-alist
 303                       ',class (put-alist ',name func imps))
 304          (set-alist 'mime-entity-implementation-alist
 305                     ',class
 306                     (list (cons ',name func)))
 307          ))))
 308
 309 (put 'mm-define-method 'lisp-indent-function 'defun)
 310 (put 'mm-define-method 'edebug-form-spec
 311      '(&define name ((arg symbolp) &rest arg) def-body))
 312
 313
 314 ;;; @ end
 315 ;;;
 316
 317 (provide 'mime-def)
 318
 319 ;;; mime-def.el ends here