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   (when (eq (char-after (point)) ?\\)
  99     (prog2
 100         (forward-char)
 101         (char-after (point))
 102       (forward-char))))
 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 ;;; @ field
 112 ;;;
 113
 114 (defsubst mailcap-look-at-field ()
 115   (let ((token (mailcap-look-at-token)))
 116     (if token
 117         (if (looking-at "[ \t]*=[ \t]*")
 118             (let ((value (progn
 119                            (goto-char (match-end 0))
 120                            (mailcap-look-at-mtext))))
 121               (if value
 122                   (cons (intern token) value)
 123                 ))
 124           (list (intern token))
 125           ))))
 126
 127
 128 ;;; @ mailcap entry
 129 ;;;
 130
 131 (defun mailcap-look-at-entry ()
 132   (let ((type (mailcap-look-at-type-field)))
 133     (if (and type (mailcap-skip-field-separator))
 134         (let ((view (mailcap-look-at-mtext))
 135               fields field)
 136           (when view
 137             (while (and (mailcap-skip-field-separator)
 138                         (setq field (mailcap-look-at-field))
 139                         )
 140               (setq fields (cons field fields))
 141               )
 142             (nconc type
 143                    (list (cons 'view view))
 144                    fields))))))
 145
 146
 147 ;;; @ main
 148 ;;;
 149
 150 (defun mailcap-parse-buffer (&optional buffer order)
 151   "Parse BUFFER as a mailcap, and return the result.
 152 If optional argument ORDER is a function, result is sorted by it.
 153 If optional argument ORDER is not specified, result is sorted original
 154 order.  Otherwise result is not sorted."
 155   (save-excursion
 156     (if buffer
 157         (set-buffer buffer))
 158     (goto-char (point-min))
 159     (let (entries entry)
 160       (while (progn
 161                (while (mailcap-skip-comment))
 162                (setq entry (mailcap-look-at-entry))
 163                )
 164         (setq entries (cons entry entries))
 165         (forward-line)
 166         )
 167       (cond ((functionp order) (sort entries order))
 168             ((null order) (nreverse entries))
 169             (t entries)
 170             ))))
 171
 172
 173 (defcustom mailcap-file "~/.mailcap"
 174   "*File name of user's mailcap file."
 175   :group 'mime
 176   :type 'file)
 177
 178 (defun mailcap-parse-file (&optional filename order)
 179   "Parse FILENAME as a mailcap, and return the result.
 180 If optional argument ORDER is a function, result is sorted by it.
 181 If optional argument ORDER is not specified, result is sorted original
 182 order.  Otherwise result is not sorted."
 183   (or filename
 184       (setq filename mailcap-file))
 185   (with-temp-buffer
 186     (insert-file-contents filename)
 187     (mailcap-parse-buffer (current-buffer) order)
 188     ))
 189
 190 (defun mailcap-format-command (mtext situation)
 191   "Return formated command string from MTEXT and SITUATION.
 192
 193 MTEXT is a command text of mailcap specification, such as
 194 view-command.
 195
 196 SITUATION is an association-list about information of entity.  Its key
 197 may be:
 198
 199         'type           primary media-type
 200         'subtype        media-subtype
 201         'filename       filename
 202         STRING          parameter of Content-Type field"
 203   (let ((i 0)
 204         (len (length mtext))
 205         (p 0)
 206         dest)
 207     (while (< i len)
 208       (let ((chr (aref mtext i)))
 209         (cond ((eq chr ?%)
 210                (setq i (1+ i)
 211                      chr (aref mtext i))
 212                (cond ((eq chr ?s)
 213                       (let ((file (cdr (assq 'filename situation))))
 214                         (if (null file)
 215                             (error "'filename is not specified in situation.")
 216                           (setq dest (concat dest
 217                                              (substring mtext p (1- i))
 218                                              file)
 219                                 i (1+ i)
 220                                 p i)
 221                           )))
 222                      ((eq chr ?t)
 223                       (let ((type (or (mime-type/subtype-string
 224                                        (cdr (assq 'type situation))
 225                                        (cdr (assq 'subtype situation)))
 226                                       "text/plain")))
 227                         (setq dest (concat dest
 228                                            (substring mtext p (1- i))
 229                                            type)
 230                               i (1+ i)
 231                               p i)
 232                         ))
 233                      ((eq chr ?\{)
 234                       (setq i (1+ i))
 235                       (if (not (string-match "}" mtext i))
 236                           (error "parse error!!!")
 237                         (let* ((me (match-end 0))
 238                                (attribute (substring mtext i (1- me)))
 239                                (parameter (cdr (assoc attribute situation))))
 240                           (if (null parameter)
 241                               (error "\"%s\" is not specified in situation."
 242                                      attribute)
 243                             (setq dest (concat dest
 244                                                (substring mtext p (- i 2))
 245                                                parameter)
 246                                   i me
 247                                   p i)
 248                             )
 249                           )))
 250                      (t (error "Invalid sequence `%%%c'." chr))
 251                      ))
 252               ((eq chr ?\\)
 253                (setq dest (concat dest (substring mtext p i))
 254                      p (1+ i)
 255                      i (+ i 2))
 256                )
 257               (t (setq i (1+ i)))
 258               )))
 259     (concat dest (substring mtext p))
 260     ))
 261
 262
 263 ;;; @ end
 264 ;;;
 265
 266 (provide 'mailcap)
 267
 268 ;;; mailcap.el ends here