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