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 ((p0 (point))
 103         dest)
 104     (while (cond ((mailcap-look-at-qchar)
 105                   (setq dest
 106                         (concat dest
 107                                 (buffer-substring p0 (- (point) 2))
 108                                 (char-to-string (char-before (point)))
 109                                 )
 110                         p0 (point))
 111                   )
 112                  ((mailcap-look-at-schar)
 113                   t)))
 114     (concat dest (buffer-substring p0 (point)))
 115     ))
 116
 117
 118 ;;; @ field
 119 ;;;
 120
 121 (defsubst mailcap-look-at-field ()
 122   (let ((token (mailcap-look-at-token)))
 123     (if token
 124         (if (looking-at "[ \t]*=[ \t]*")
 125             (let ((value (progn
 126                            (goto-char (match-end 0))
 127                            (mailcap-look-at-mtext))))
 128               (if value
 129                   (cons (intern token) value)
 130                 ))
 131           (list (intern token))
 132           ))))
 133
 134
 135 ;;; @ mailcap entry
 136 ;;;
 137
 138 (defun mailcap-look-at-entry ()
 139   (let ((type (mailcap-look-at-type-field)))
 140     (if (and type (mailcap-skip-field-separator))
 141         (let ((view (mailcap-look-at-mtext))
 142               fields field)
 143           (when view
 144             (while (and (mailcap-skip-field-separator)
 145                         (setq field (mailcap-look-at-field))
 146                         )
 147               (setq fields (cons field fields))
 148               )
 149             (nconc type
 150                    (list (cons 'view view))
 151                    fields))))))
 152
 153
 154 ;;; @ main
 155 ;;;
 156
 157 (defun mailcap-parse-buffer (&optional buffer order)
 158   "Parse BUFFER as a mailcap, and return the result.
 159 If optional argument ORDER is a function, result is sorted by it.
 160 If optional argument ORDER is not specified, result is sorted original
 161 order.  Otherwise result is not sorted."
 162   (save-excursion
 163     (if buffer
 164         (set-buffer buffer))
 165     (goto-char (point-min))
 166     (let (entries entry)
 167       (while (progn
 168                (while (mailcap-skip-comment))
 169                (setq entry (mailcap-look-at-entry))
 170                )
 171         (setq entries (cons entry entries))
 172         (forward-line)
 173         )
 174       (cond ((functionp order) (sort entries order))
 175             ((null order) (nreverse entries))
 176             (t entries)
 177             ))))
 178
 179 (defvar mailcap-file "~/.mailcap"
 180   "*File name of user's mailcap file.")
 181
 182 (defun mailcap-parse-file (&optional filename order)
 183   "Parse FILENAME as a mailcap, and return the result.
 184 If optional argument ORDER is a function, result is sorted by it.
 185 If optional argument ORDER is not specified, result is sorted original
 186 order.  Otherwise result is not sorted."
 187   (or filename
 188       (setq filename mailcap-file))
 189   (with-temp-buffer
 190     (insert-file-contents filename)
 191     (mailcap-parse-buffer (current-buffer) order)
 192     ))
 193
 194
 195 ;;; @ end
 196 ;;;
 197
 198 (provide 'mailcap)
 199
 200 ;;; mailcap.el ends here