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