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