mime/mime-conf.el

   1 ;;; mime-conf.el --- mailcap parser and MIME playback configuration
   2
   3 ;; Copyright (C) 1997,1998,1999,2000 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;; Created: 1997-06-27
   7 ;; Original: 1997-06-27 mailcap.el by MORIOKA Tomohiko
   8 ;;      Renamed: 2000-11-24 to mime-conf.el by MORIOKA Tomohiko
   9 ;; Keywords: mailcap, setting, configuration, MIME, multimedia
  10
  11 ;; This file is part of FLIM (Faithful Library about Internet Message).
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Code:
  29
  30 (require 'mime-def)
  31
  32
  33 ;;; @ comment
  34 ;;;
  35
  36 (defsubst mime-mailcap-skip-comment ()
  37   (let ((chr (char-after (point))))
  38     (when (and chr
  39                (or (= chr ?\n)
  40                    (= chr ?#)))
  41       (forward-line)
  42       t)))
  43
  44
  45 ;;; @ token
  46 ;;;
  47
  48 (defsubst mime-mailcap-look-at-token ()
  49   (if (looking-at mime-token-regexp)
  50       (let ((beg (match-beginning 0))
  51             (end (match-end 0)))
  52         (goto-char end)
  53         (buffer-substring beg end)
  54         )))
  55
  56
  57 ;;; @ typefield
  58 ;;;
  59
  60 (defsubst mime-mailcap-look-at-type-field ()
  61   (let ((type (mime-mailcap-look-at-token)))
  62     (if type
  63         (if (eq (char-after (point)) ?/)
  64             (progn
  65               (forward-char)
  66               (let ((subtype (mime-mailcap-look-at-token)))
  67                 (if subtype
  68                     (cons (cons 'type (intern type))
  69                           (unless (string= subtype "*")
  70                             (list (cons 'subtype (intern subtype)))
  71                             )))))
  72           (list (cons 'type (intern type)))
  73           ))))
  74
  75
  76 ;;; @ field separator
  77 ;;;
  78
  79 (defsubst mime-mailcap-skip-field-separator ()
  80   (let ((ret (looking-at "\\([ \t]\\|\\\\\n\\)*;\\([ \t]\\|\\\\\n\\)*")))
  81     (when ret
  82       (goto-char (match-end 0))
  83       t)))
  84
  85
  86 ;;; @ mtext
  87 ;;;
  88
  89 (defsubst mime-mailcap-look-at-schar ()
  90   (let ((chr (char-after (point))))
  91     (if (and chr
  92              (>= chr ? )
  93              (/= chr ?\;)
  94              (/= chr ?\\)
  95              )
  96         (prog1
  97             chr
  98           (forward-char)))))
  99
 100 (defsubst mime-mailcap-look-at-qchar ()
 101   (when (eq (char-after (point)) ?\\)
 102     (prog2
 103         (forward-char)
 104         (char-after (point))
 105       (forward-char))))
 106
 107 (defsubst mime-mailcap-look-at-mtext ()
 108   (let ((beg (point)))
 109     (while (or (mime-mailcap-look-at-qchar)
 110                (mime-mailcap-look-at-schar)))
 111     (buffer-substring beg (point))
 112     ))
 113
 114
 115 ;;; @ field
 116 ;;;
 117
 118 (defsubst mime-mailcap-look-at-field ()
 119   (let ((token (mime-mailcap-look-at-token)))
 120     (if token
 121         (if (looking-at "[ \t]*=[ \t]*")
 122             (let ((value (progn
 123                            (goto-char (match-end 0))
 124                            (mime-mailcap-look-at-mtext))))
 125               (if value
 126                   (cons (intern token) value)
 127                 ))
 128           (list (intern token))
 129           ))))
 130
 131
 132 ;;; @ mailcap entry
 133 ;;;
 134
 135 (defun mime-mailcap-look-at-entry ()
 136   (let ((type (mime-mailcap-look-at-type-field)))
 137     (if (and type (mime-mailcap-skip-field-separator))
 138         (let ((view (mime-mailcap-look-at-mtext))
 139               fields field)
 140           (when view
 141             (while (and (mime-mailcap-skip-field-separator)
 142                         (setq field (mime-mailcap-look-at-field))
 143                         )
 144               (setq fields (cons field fields))
 145               )
 146             (nconc type
 147                    (list (cons 'view view))
 148                    fields))))))
 149
 150
 151 ;;; @ main
 152 ;;;
 153
 154 ;;;###autoload
 155 (defun mime-parse-mailcap-buffer (&optional buffer order)
 156   "Parse BUFFER as a mailcap, and return the result.
 157 If optional argument ORDER is a function, result is sorted by it.
 158 If optional argument ORDER is not specified, result is sorted original
 159 order.  Otherwise result is not sorted."
 160   (save-excursion
 161     (if buffer
 162         (set-buffer buffer))
 163     (goto-char (point-min))
 164     (let (entries entry)
 165       (while (progn
 166                (while (mime-mailcap-skip-comment))
 167                (setq entry (mime-mailcap-look-at-entry))
 168                )
 169         (setq entries (cons entry entries))
 170         (forward-line)
 171         )
 172       (cond ((functionp order) (sort entries order))
 173             ((null order) (nreverse entries))
 174             (t entries)
 175             ))))
 176
 177
 178 ;;;###autoload
 179 (defcustom mime-mailcap-file "~/.mailcap"
 180   "*File name of user's mailcap file."
 181   :group 'mime
 182   :type 'file)
 183
 184 ;;;###autoload
 185 (defun mime-parse-mailcap-file (&optional filename order)
 186   "Parse FILENAME as a mailcap, and return the result.
 187 If optional argument ORDER is a function, result is sorted by it.
 188 If optional argument ORDER is not specified, result is sorted original
 189 order.  Otherwise result is not sorted."
 190   (or filename
 191       (setq filename mime-mailcap-file))
 192   (with-temp-buffer
 193     (insert-file-contents filename)
 194     (mime-parse-mailcap-buffer (current-buffer) order)
 195     ))
 196
 197
 198 ;;;###autoload
 199 (defun mime-format-mailcap-command (mtext situation)
 200   "Return formated command string from MTEXT and SITUATION.
 201
 202 MTEXT is a command text of mailcap specification, such as
 203 view-command.
 204
 205 SITUATION is an association-list about information of entity.  Its key
 206 may be:
 207
 208         'type           primary media-type
 209         'subtype        media-subtype
 210         'filename       filename
 211         STRING          parameter of Content-Type field"
 212   (let ((i 0)
 213         (len (length mtext))
 214         (p 0)
 215         dest)
 216     (while (< i len)
 217       (let ((chr (aref mtext i)))
 218         (cond ((eq chr ?%)
 219                (setq i (1+ i)
 220                      chr (aref mtext i))
 221                (cond ((eq chr ?s)
 222                       (let ((file (cdr (assq 'filename situation))))
 223                         (if (null file)
 224                             (error "'filename is not specified in situation.")
 225                           (setq dest (concat dest
 226                                              (substring mtext p (1- i))
 227                                              file)
 228                                 i (1+ i)
 229                                 p i)
 230                           )))
 231                      ((eq chr ?t)
 232                       (let ((type (or (mime-type/subtype-string
 233                                        (cdr (assq 'type situation))
 234                                        (cdr (assq 'subtype situation)))
 235                                       "text/plain")))
 236                         (setq dest (concat dest
 237                                            (substring mtext p (1- i))
 238                                            type)
 239                               i (1+ i)
 240                               p i)
 241                         ))
 242                      ((eq chr ?\{)
 243                       (setq i (1+ i))
 244                       (if (not (string-match "}" mtext i))
 245                           (error "parse error!!!")
 246                         (let* ((me (match-end 0))
 247                                (attribute (substring mtext i (1- me)))
 248                                (parameter (cdr (assoc attribute situation))))
 249                           (if (null parameter)
 250                               (error "\"%s\" is not specified in situation."
 251                                      attribute)
 252                             (setq dest (concat dest
 253                                                (substring mtext p (- i 2))
 254                                                parameter)
 255                                   i me
 256                                   p i)
 257                             )
 258                           )))
 259                      (t (error "Invalid sequence `%%%c'." chr))
 260                      ))
 261               ((eq chr ?\\)
 262                (setq dest (concat dest (substring mtext p i))
 263                      p (1+ i)
 264                      i (+ i 2))
 265                )
 266               (t (setq i (1+ i)))
 267               )))
 268     (concat dest (substring mtext p))
 269     ))
 270
 271
 272 ;;; @ end
 273 ;;;
 274
 275 (provide 'mime-conf)
 276
 277 ;;; mime-conf.el ends here