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-library-version-string
  28   "FLIM-FLAM 1.9.1 - \"\e$B`O!9Hl\e(B\" 7.5R4.5/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 location
 187                                      &optional content-type
 188                                      children parent node-id
 189                                      buffer
 190                                      header-start header-end
 191                                      body-start body-end)
 192   (vector representation-type location
 193           content-type nil nil children parent node-id
 194           buffer header-start header-end body-start body-end
 195           nil nil))
 196
 197 (defsubst mime-entity-representation-type-internal (entity)
 198   (aref entity 0))
 199 (defsubst mime-entity-set-representation-type-internal (entity type)
 200   (aset entity 0 type))
 201 (defsubst mime-entity-location-internal (entity)
 202   (aref entity 1))
 203
 204 (defsubst mime-entity-content-type-internal (entity)
 205   (aref entity 2))
 206 (defsubst mime-entity-set-content-type-internal (entity type)
 207   (aset entity 2 type))
 208 (defsubst mime-entity-content-disposition-internal (entity)
 209   (aref entity 3))
 210 (defsubst mime-entity-set-content-disposition-internal (entity disposition)
 211   (aset entity 3 disposition))
 212 (defsubst mime-entity-encoding-internal (entity)
 213   (aref entity 4))
 214 (defsubst mime-entity-set-encoding-internal (entity encoding)
 215   (aset entity 4 encoding))
 216
 217 (defsubst mime-entity-children-internal (entity)
 218   (aref entity 5))
 219 (defsubst mime-entity-set-children-internal (entity children)
 220   (aset entity 5 children))
 221 (defsubst mime-entity-parent-internal (entity)
 222   (aref entity 6))
 223 (defsubst mime-entity-node-id-internal (entity)
 224   (aref entity 7))
 225
 226 (defsubst mime-entity-buffer-internal (entity)
 227   (aref entity 8))
 228 (defsubst mime-entity-set-buffer-internal (entity buffer)
 229   (aset entity 8 buffer))
 230 (defsubst mime-entity-header-start-internal (entity)
 231   (aref entity 9))
 232 (defsubst mime-entity-set-header-start-internal (entity point)
 233   (aset entity 9 point))
 234 (defsubst mime-entity-header-end-internal (entity)
 235   (aref entity 10))
 236 (defsubst mime-entity-set-header-end-internal (entity point)
 237   (aset entity 10 point))
 238 (defsubst mime-entity-body-start-internal (entity)
 239   (aref entity 11))
 240 (defsubst mime-entity-set-body-start-internal (entity point)
 241   (aset entity 11 point))
 242 (defsubst mime-entity-body-end-internal (entity)
 243   (aref entity 12))
 244 (defsubst mime-entity-set-body-end-internal (entity point)
 245   (aset entity 12 point))
 246
 247 (defsubst mime-entity-original-header-internal (entity)
 248   (aref entity 13))
 249 (defsubst mime-entity-set-original-header-internal (entity header)
 250   (aset entity 13 header))
 251 (defsubst mime-entity-parsed-header-internal (entity)
 252   (aref entity 14))
 253 (defsubst mime-entity-set-parsed-header-internal (entity header)
 254   (aset entity 14 header))
 255
 256
 257 ;;; @ message structure
 258 ;;;
 259
 260 (defvar mime-message-structure nil
 261   "Information about structure of message.
 262 Please use reference function `mime-entity-SLOT' to get value of SLOT.
 263
 264 Following is a list of slots of the structure:
 265
 266 buffer                  buffer includes this entity (buffer).
 267 node-id                 node-id (list of integers)
 268 header-start            minimum point of header in raw-buffer
 269 header-end              maximum point of header in raw-buffer
 270 body-start              minimum point of body in raw-buffer
 271 body-end                maximum point of body in raw-buffer
 272 content-type            content-type (content-type)
 273 content-disposition     content-disposition (content-disposition)
 274 encoding                Content-Transfer-Encoding (string or nil)
 275 children                entities included in this entity (list of entity)
 276
 277 If an entity includes other entities in its body, such as multipart or
 278 message/rfc822, `mime-entity' structures of them are included in
 279 `children', so the `mime-entity' structure become a tree.")
 280
 281 (make-variable-buffer-local 'mime-message-structure)
 282
 283
 284 ;;; @ for mm-backend
 285 ;;;
 286
 287 (defvar mime-entity-implementation-alist nil)
 288
 289 (defmacro mm-define-backend (type &optional parents)
 290   (if parents
 291       `(let ((rest ',(reverse parents)))
 292          (while rest
 293            (set-alist 'mime-entity-implementation-alist
 294                       ',type
 295                       (copy-alist
 296                        (cdr (assq (car rest)
 297                                   mime-entity-implementation-alist))))
 298            (setq rest (cdr rest))
 299            ))))
 300
 301 (defmacro mm-define-method (name args &rest body)
 302   (let* ((specializer (car args))
 303          (class (nth 1 specializer))
 304          (self (car specializer)))
 305     `(let ((imps (cdr (assq ',class mime-entity-implementation-alist)))
 306            (func (lambda ,(if self
 307                               (cons self (cdr args))
 308                             (cdr args))
 309                    ,@body)))
 310        (if imps
 311            (set-alist 'mime-entity-implementation-alist
 312                       ',class (put-alist ',name func imps))
 313          (set-alist 'mime-entity-implementation-alist
 314                     ',class
 315                     (list (cons ',name func)))
 316          ))))
 317
 318 (put 'mm-define-method 'lisp-indent-function 'defun)
 319
 320
 321 ;;; @ end
 322 ;;;
 323
 324 (provide 'mime-def)
 325
 326 ;;; mime-def.el ends here