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" "Tonosh\e-Dò"\e-A 1 9 1)
  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 (unless (fboundp 'butlast)
  73   (defun butlast (x &optional n)
  74     "Returns a copy of LIST with the last N elements removed."
  75     (if (and n (<= n 0)) x
  76       (nbutlast (copy-sequence x) n)))
  77
  78   (defun nbutlast (x &optional n)
  79     "Modifies LIST to remove the last N elements."
  80     (let ((m (length x)))
  81       (or n (setq n 1))
  82       (and (< n m)
  83            (progn
  84              (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
  85              x))))
  86   )
  87
  88 (defsubst eliminate-top-spaces (string)
  89   "Eliminate top sequence of space or tab in STRING."
  90   (if (string-match "^[ \t]+" string)
  91       (substring string (match-end 0))
  92     string))
  93
  94 (defsubst regexp-* (regexp)
  95   (concat regexp "*"))
  96
  97 (defsubst regexp-or (&rest args)
  98   (concat "\\(" (mapconcat (function identity) args "\\|") "\\)"))
  99
 100
 101 ;;; @ about STD 11
 102 ;;;
 103
 104 (defconst std11-quoted-pair-regexp "\\\\.")
 105 (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
 106 (defconst std11-qtext-regexp
 107   (concat "[^" (char-list-to-string std11-non-qtext-char-list) "]"))
 108 (defconst std11-quoted-string-regexp
 109   (concat "\""
 110           (regexp-*
 111            (regexp-or std11-qtext-regexp std11-quoted-pair-regexp))
 112           "\""))
 113
 114
 115 ;;; @ about MIME
 116 ;;;
 117
 118 (defconst mime-tspecials "][()<>@,\;:\\\"/?=")
 119 (defconst mime-token-regexp (concat "[^" mime-tspecials "\000-\040]+"))
 120 (defconst mime-charset-regexp mime-token-regexp)
 121
 122 (defconst mime-media-type/subtype-regexp
 123   (concat mime-token-regexp "/" mime-token-regexp))
 124
 125
 126 ;;; @@ Quoted-Printable
 127 ;;;
 128
 129 (defconst quoted-printable-hex-chars "0123456789ABCDEF")
 130
 131 (defconst quoted-printable-octet-regexp
 132   (concat "=[" quoted-printable-hex-chars
 133           "][" quoted-printable-hex-chars "]"))
 134
 135
 136 ;;; @ Content-Type
 137 ;;;
 138
 139 (defsubst make-mime-content-type (type subtype &optional parameters)
 140   (list* (cons 'type type)
 141          (cons 'subtype subtype)
 142          (nreverse parameters))
 143   )
 144
 145 (defsubst mime-content-type-primary-type (content-type)
 146   "Return primary-type of CONTENT-TYPE."
 147   (cdr (car content-type)))
 148
 149 (defsubst mime-content-type-subtype (content-type)
 150   "Return primary-type of CONTENT-TYPE."
 151   (cdr (cadr content-type)))
 152
 153 (defsubst mime-content-type-parameters (content-type)
 154   "Return primary-type of CONTENT-TYPE."
 155   (cddr content-type))
 156
 157 (defsubst mime-content-type-parameter (content-type parameter)
 158   "Return PARAMETER value of CONTENT-TYPE."
 159   (cdr (assoc parameter (mime-content-type-parameters content-type))))
 160
 161
 162 (defsubst mime-type/subtype-string (type &optional subtype)
 163   "Return type/subtype string from TYPE and SUBTYPE."
 164   (if type
 165       (if subtype
 166           (format "%s/%s" type subtype)
 167         (format "%s" type))))
 168
 169
 170 ;;; @ Content-Disposition
 171 ;;;
 172
 173 (defsubst mime-content-disposition-type (content-disposition)
 174   "Return disposition-type of CONTENT-DISPOSITION."
 175   (cdr (car content-disposition)))
 176
 177 (defsubst mime-content-disposition-parameters (content-disposition)
 178   "Return disposition-parameters of CONTENT-DISPOSITION."
 179   (cdr content-disposition))
 180
 181 (defsubst mime-content-disposition-parameter (content-disposition parameter)
 182   "Return PARAMETER value of CONTENT-DISPOSITION."
 183   (cdr (assoc parameter (cdr content-disposition))))
 184
 185 (defsubst mime-content-disposition-filename (content-disposition)
 186   "Return filename of CONTENT-DISPOSITION."
 187   (mime-content-disposition-parameter content-disposition "filename"))
 188
 189
 190 ;;; @ MIME entity
 191 ;;;
 192
 193 (defsubst make-mime-entity-internal (representation-type location
 194                                      &optional content-type
 195                                      children parent node-id
 196                                      buffer
 197                                      header-start header-end
 198                                      body-start body-end)
 199   (vector representation-type location
 200           content-type nil nil children parent node-id
 201           buffer header-start header-end body-start body-end
 202           nil nil))
 203
 204 (defsubst mime-entity-representation-type-internal (entity)
 205   (aref entity 0))
 206 (defsubst mime-entity-set-representation-type-internal (entity type)
 207   (aset entity 0 type))
 208 (defsubst mime-entity-location-internal (entity)
 209   (aref entity 1))
 210
 211 (defsubst mime-entity-content-type-internal (entity)
 212   (aref entity 2))
 213 (defsubst mime-entity-set-content-type-internal (entity type)
 214   (aset entity 2 type))
 215 (defsubst mime-entity-content-disposition-internal (entity)
 216   (aref entity 3))
 217 (defsubst mime-entity-set-content-disposition-internal (entity disposition)
 218   (aset entity 3 disposition))
 219 (defsubst mime-entity-encoding-internal (entity)
 220   (aref entity 4))
 221 (defsubst mime-entity-set-encoding-internal (entity encoding)
 222   (aset entity 4 encoding))
 223
 224 (defsubst mime-entity-children-internal (entity)
 225   (aref entity 5))
 226 (defsubst mime-entity-set-children-internal (entity children)
 227   (aset entity 5 children))
 228 (defsubst mime-entity-parent-internal (entity)
 229   (aref entity 6))
 230 (defsubst mime-entity-node-id-internal (entity)
 231   (aref entity 7))
 232
 233 (defsubst mime-entity-buffer-internal (entity)
 234   (aref entity 8))
 235 (defsubst mime-entity-set-buffer-internal (entity buffer)
 236   (aset entity 8 buffer))
 237 (defsubst mime-entity-header-start-internal (entity)
 238   (aref entity 9))
 239 (defsubst mime-entity-set-header-start-internal (entity point)
 240   (aset entity 9 point))
 241 (defsubst mime-entity-header-end-internal (entity)
 242   (aref entity 10))
 243 (defsubst mime-entity-set-header-end-internal (entity point)
 244   (aset entity 10 point))
 245 (defsubst mime-entity-body-start-internal (entity)
 246   (aref entity 11))
 247 (defsubst mime-entity-set-body-start-internal (entity point)
 248   (aset entity 11 point))
 249 (defsubst mime-entity-body-end-internal (entity)
 250   (aref entity 12))
 251 (defsubst mime-entity-set-body-end-internal (entity point)
 252   (aset entity 12 point))
 253
 254 (defsubst mime-entity-original-header-internal (entity)
 255   (aref entity 13))
 256 (defsubst mime-entity-set-original-header-internal (entity header)
 257   (aset entity 13 header))
 258 (defsubst mime-entity-parsed-header-internal (entity)
 259   (aref entity 14))
 260 (defsubst mime-entity-set-parsed-header-internal (entity header)
 261   (aset entity 14 header))
 262
 263
 264 ;;; @ message structure
 265 ;;;
 266
 267 (defvar mime-message-structure nil
 268   "Information about structure of message.
 269 Please use reference function `mime-entity-SLOT' to get value of SLOT.
 270
 271 Following is a list of slots of the structure:
 272
 273 buffer                  buffer includes this entity (buffer).
 274 node-id                 node-id (list of integers)
 275 header-start            minimum point of header in raw-buffer
 276 header-end              maximum point of header in raw-buffer
 277 body-start              minimum point of body in raw-buffer
 278 body-end                maximum point of body in raw-buffer
 279 content-type            content-type (content-type)
 280 content-disposition     content-disposition (content-disposition)
 281 encoding                Content-Transfer-Encoding (string or nil)
 282 children                entities included in this entity (list of entity)
 283
 284 If an entity includes other entities in its body, such as multipart or
 285 message/rfc822, `mime-entity' structures of them are included in
 286 `children', so the `mime-entity' structure become a tree.")
 287
 288 (make-variable-buffer-local 'mime-message-structure)
 289
 290
 291 ;;; @ for mm-backend
 292 ;;;
 293
 294 (defvar mime-entity-implementation-alist nil)
 295
 296 (defmacro mm-define-backend (type &optional parents)
 297   (if parents
 298       `(let ((rest ',(reverse parents)))
 299          (while rest
 300            (set-alist 'mime-entity-implementation-alist
 301                       ',type
 302                       (copy-alist
 303                        (cdr (assq (car rest)
 304                                   mime-entity-implementation-alist))))
 305            (setq rest (cdr rest))
 306            ))))
 307
 308 (defmacro mm-define-method (name args &rest body)
 309   (let* ((specializer (car args))
 310          (class (nth 1 specializer))
 311          (self (car specializer)))
 312     `(let ((imps (cdr (assq ',class mime-entity-implementation-alist)))
 313            (func (lambda ,(if self
 314                               (cons self (cdr args))
 315                             (cdr args))
 316                    ,@body)))
 317        (if imps
 318            (set-alist 'mime-entity-implementation-alist
 319                       ',class (put-alist ',name func imps))
 320          (set-alist 'mime-entity-implementation-alist
 321                     ',class
 322                     (list (cons ',name func)))
 323          ))))
 324
 325 (put 'mm-define-method 'lisp-indent-function 'defun)
 326 (put 'mm-define-method 'edebug-form-spec
 327      '(&define name ((arg symbolp) &rest arg) def-body))
 328
 329
 330 ;;; @ end
 331 ;;;
 332
 333 (provide 'mime-def)
 334
 335 ;;; mime-def.el ends here