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