mime-conf.el

   1 ;;; mime-conf.el --- mailcap parser and MIME playback configuration
   2
   3 ;; Copyright (C) 1997,1998,1999,2000,2004 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., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, 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 (defvar mime-mailcap-file "~/.mailcap"
 180   "*File name of user's mailcap file.")
 181
 182 ;;;###autoload
 183 (defun mime-parse-mailcap-file (&optional filename order)
 184   "Parse FILENAME as a mailcap, and return the result.
 185 If optional argument ORDER is a function, result is sorted by it.
 186 If optional argument ORDER is not specified, result is sorted original
 187 order.  Otherwise result is not sorted."
 188   (or filename
 189       (setq filename mime-mailcap-file))
 190   (with-temp-buffer
 191     (insert-file-contents filename)
 192     (mime-parse-mailcap-buffer (current-buffer) order)
 193     ))
 194
 195
 196 ;;;###autoload
 197 (defun mime-format-mailcap-command (mtext situation)
 198   "Return formated command string from MTEXT and SITUATION.
 199
 200 MTEXT is a command text of mailcap specification, such as
 201 view-command.
 202
 203 SITUATION is an association-list about information of entity.  Its key
 204 may be:
 205
 206         'type           primary media-type
 207         'subtype        media-subtype
 208         'filename       filename
 209         STRING          parameter of Content-Type field"
 210   (let ((i 0)
 211         (len (length mtext))
 212         (p 0)
 213         dest)
 214     (while (< i len)
 215       (let ((chr (aref mtext i)))
 216         (cond ((eq chr ?%)
 217                (setq i (1+ i)
 218                      chr (aref mtext i))
 219                (cond ((eq chr ?s)
 220                       (let ((file (cdr (assq 'filename situation))))
 221                         (if (null file)
 222                             (error "'filename is not specified in situation.")
 223                           (setq dest (concat dest
 224                                              (substring mtext p (1- i))
 225                                              (shell-quote-argument file))
 226                                 i (1+ i)
 227                                 p i)
 228                           )))
 229                      ((eq chr ?t)
 230                       (let ((type (or (mime-type/subtype-string
 231                                        (cdr (assq 'type situation))
 232                                        (cdr (assq 'subtype situation)))
 233                                       "text/plain")))
 234                         (setq dest (concat dest
 235                                            (substring mtext p (1- i))
 236                                            type)
 237                               i (1+ i)
 238                               p i)
 239                         ))
 240                      ((eq chr ?\{)
 241                       (setq i (1+ i))
 242                       (if (not (string-match "}" mtext i))
 243                           (error "parse error!!!")
 244                         (let* ((me (match-end 0))
 245                                (attribute (substring mtext i (1- me)))
 246                                (parameter (cdr (assoc attribute situation))))
 247                           (if (null parameter)
 248                               (error "\"%s\" is not specified in situation."
 249                                      attribute)
 250                             (setq dest (concat dest
 251                                                (substring mtext p (- i 2))
 252                                                parameter)
 253                                   i me
 254                                   p i)
 255                             )
 256                           )))
 257                      (t (error "Invalid sequence `%%%c'." chr))
 258                      ))
 259               ((eq chr ?\\)
 260                (setq dest (concat dest (substring mtext p i))
 261                      p (1+ i)
 262                      i (+ i 2))
 263                )
 264               (t (setq i (1+ i)))
 265               )))
 266     (concat dest (substring mtext p))
 267     ))
 268
 269
 270 ;;; @ end
 271 ;;;
 272
 273 (provide 'mime-conf)
 274
 275 ;;; mime-conf.el ends here