mailcap.el

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