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 (require 'mime-def)
  29
  30
  31 ;;; @ comment
  32 ;;;
  33
  34 (defsubst mailcap-skip-comment ()
  35   (let ((chr (char-after (point))))
  36     (when (and chr
  37                (or (= chr ?\n)
  38                    (= chr ?#)))
  39       (forward-line)
  40       t)))
  41
  42
  43 ;;; @ token
  44 ;;;
  45
  46 (defsubst mailcap-look-at-token ()
  47   (if (looking-at mime-token-regexp)
  48       (let ((beg (match-beginning 0))
  49             (end (match-end 0)))
  50         (goto-char end)
  51         (buffer-substring beg end)
  52         )))
  53
  54
  55 ;;; @ typefield
  56 ;;;
  57
  58 (defsubst mailcap-look-at-type-field ()
  59   (let ((type (mailcap-look-at-token)))
  60     (if type
  61         (if (eq (char-after (point)) ?/)
  62             (progn
  63               (forward-char)
  64               (let ((subtype (mailcap-look-at-token)))
  65                 (if subtype
  66                     (cons (cons 'type (intern type))
  67                           (unless (string= subtype "*")
  68                             (list (cons 'subtype (intern subtype)))
  69                             )))))
  70           (list (cons 'type (intern type)))
  71           ))))
  72
  73
  74 ;;; @ field separator
  75 ;;;
  76
  77 (defsubst mailcap-skip-field-separator ()
  78   (let ((ret (looking-at "\\([ \t]\\|\\\\\n\\)*;\\([ \t]\\|\\\\\n\\)*")))
  79     (when ret
  80       (goto-char (match-end 0))
  81       t)))
  82
  83
  84 ;;; @ mtext
  85 ;;;
  86
  87 (defsubst mailcap-look-at-schar ()
  88   (let ((chr (char-after (point))))
  89     (if (and (>= chr ? )
  90              (/= chr ?\;)
  91              (/= chr ?\\)
  92              )
  93         (prog1
  94             chr
  95           (forward-char)))))
  96
  97 (defsubst mailcap-look-at-qchar ()
  98   (let ((chr (char-after (point))))
  99     (when (eq chr ?\\)
 100       (forward-char 2)
 101       (char-before (point))
 102       )))
 103
 104 (defsubst mailcap-look-at-mtext ()
 105   (let ((beg (point)))
 106     (while (or (mailcap-look-at-qchar)
 107                (mailcap-look-at-schar)))
 108     (buffer-substring beg (point))
 109     ))
 110
 111
 112 ;;; @ field
 113 ;;;
 114
 115 (defsubst mailcap-look-at-field ()
 116   (let ((token (mailcap-look-at-token)))
 117     (if token
 118         (if (looking-at "[ \t]*=[ \t]*")
 119             (let ((value (progn
 120                            (goto-char (match-end 0))
 121                            (mailcap-look-at-mtext))))
 122               (if value
 123                   (cons (intern token) value)
 124                 ))
 125           (list (intern token))
 126           ))))
 127
 128
 129 ;;; @ mailcap entry
 130 ;;;
 131
 132 (defun mailcap-look-at-entry ()
 133   (let ((type (mailcap-look-at-type-field)))
 134     (if (and type (mailcap-skip-field-separator))
 135         (let ((view (mailcap-look-at-mtext))
 136               fields field)
 137           (when view
 138             (while (and (mailcap-skip-field-separator)
 139                         (setq field (mailcap-look-at-field))
 140                         )
 141               (setq fields (cons field fields))
 142               )
 143             (nconc type
 144                    (list (cons 'view view))
 145                    fields))))))
 146
 147
 148 ;;; @ main
 149 ;;;
 150
 151 (defun mailcap-parse-buffer (&optional buffer order)
 152   "Parse BUFFER as a mailcap, and return the result.
 153 If optional argument ORDER is a function, result is sorted by it.
 154 If optional argument ORDER is not specified, result is sorted original
 155 order.  Otherwise result is not sorted."
 156   (save-excursion
 157     (if buffer
 158         (set-buffer buffer))
 159     (goto-char (point-min))
 160     (let (entries entry)
 161       (while (progn
 162                (while (mailcap-skip-comment))
 163                (setq entry (mailcap-look-at-entry))
 164                )
 165         (setq entries (cons entry entries))
 166         (forward-line)
 167         )
 168       (cond ((functionp order) (sort entries order))
 169             ((null order) (nreverse entries))
 170             (t entries)
 171             ))))
 172
 173 (defvar mailcap-file "~/.mailcap"
 174   "*File name of user's mailcap file.")
 175
 176 (defun mailcap-parse-file (&optional filename order)
 177   "Parse FILENAME as a mailcap, and return the result.
 178 If optional argument ORDER is a function, result is sorted by it.
 179 If optional argument ORDER is not specified, result is sorted original
 180 order.  Otherwise result is not sorted."
 181   (or filename
 182       (setq filename mailcap-file))
 183   (with-temp-buffer
 184     (insert-file-contents filename)
 185     (mailcap-parse-buffer (current-buffer) order)
 186     ))
 187
 188 (defun mailcap-format-command (mtext situation)
 189   "Return formated command string from MTEXT and SITUATION.
 190
 191 MTEXT is a command text of mailcap specification, such as
 192 view-command.
 193
 194 SITUATION is an association-list about information of entity.  Its key
 195 may be:
 196
 197         'type           primary media-type
 198         'subtype        media-subtype
 199         'filename       filename
 200         STRING          parameter of Content-Type field"
 201   (let ((i 0)
 202         (len (length mtext))
 203         (p 0)
 204         dest)
 205     (while (< i len)
 206       (let ((chr (aref mtext i)))
 207         (cond ((eq chr ?%)
 208                (setq i (1+ i)
 209                      chr (aref mtext i))
 210                (cond ((eq chr ?s)
 211                       (let ((file (cdr (assq 'filename situation))))
 212                         (if (null file)
 213                             (error "'filename is not specified in situation.")
 214                           (setq dest (concat dest
 215                                              (substring mtext p (1- i))
 216                                              file)
 217                                 i (1+ i)
 218                                 p i)
 219                           )))
 220                      ((eq chr ?t)
 221                       (let ((type (or (mime-type/subtype-string
 222                                        (cdr (assq 'type situation))
 223                                        (cdr (assq 'subtype situation)))
 224                                       "text/plain")))
 225                         (setq dest (concat dest
 226                                            (substring mtext p (1- i))
 227                                            type)
 228                               i (1+ i)
 229                               p i)
 230                         ))
 231                      ((eq chr ?\{)
 232                       (setq i (1+ i))
 233                       (if (not (string-match "}" mtext i))
 234                           (error "parse error!!!")
 235                         (let* ((me (match-end 0))
 236                                (attribute (substring mtext i (1- me)))
 237                                (parameter (cdr (assoc attribute situation))))
 238                           (if (null parameter)
 239                               (error "\"%s\" is not specified in situation."
 240                                      attribute)
 241                             (setq dest (concat dest
 242                                                (substring mtext p (- i 2))
 243                                                parameter)
 244                                   i me
 245                                   p i)
 246                             )
 247                           )))
 248                      (t (error "Invalid sequence `%%%c'." chr))
 249                      ))
 250               ((eq chr ?\\)
 251                (setq dest (concat dest (substring mtext p i))
 252                      p (1+ i)
 253                      i (+ i 2))
 254                )
 255               (t (setq i (1+ i)))
 256               )))
 257     (concat dest (substring mtext p))
 258     ))
 259
 260
 261 ;;; @ end
 262 ;;;
 263
 264 (provide 'mailcap)
 265
 266 ;;; mailcap.el ends here