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 (and type
  58              (eq (char-after (point)) ?/)
  59              )
  60         (progn
  61           (forward-char)
  62           (let ((subtype (mailcap-look-at-token)))
  63             (if subtype
  64                 (cons (cons 'type (intern type))
  65                       (unless (string= subtype "*")
  66                         (list (cons 'subtype (intern subtype)))
  67                         ))))))))
  68
  69
  70 ;;; @ field separator
  71 ;;;
  72
  73 (defsubst mailcap-skip-field-separator ()
  74   (let ((ret (looking-at "\\([ \t]\\|\\\\\n\\)*;\\([ \t]\\|\\\\\n\\)*")))
  75     (when ret
  76       (goto-char (match-end 0))
  77       t)))
  78
  79
  80 ;;; @ mtext
  81 ;;;
  82
  83 (defsubst mailcap-look-at-schar ()
  84   (let ((chr (char-after (point))))
  85     (if (and (>= chr ? )
  86              (/= chr ?\;)
  87              (/= chr ?\\)
  88              )
  89         (prog1
  90             chr
  91           (forward-char)))))
  92
  93 (defsubst mailcap-look-at-qchar ()
  94   (let ((chr (char-after (point))))
  95     (when (eq chr ?\\)
  96       (forward-char 2)
  97       (char-before (point))
  98       )))
  99
 100 (defsubst mailcap-look-at-mtext ()
 101   (let ((beg (point)))
 102     (while (or (mailcap-look-at-schar)
 103                (mailcap-look-at-schar)))
 104     (buffer-substring beg (point))
 105     ))
 106
 107
 108 ;;; @ field
 109 ;;;
 110
 111 (defsubst mailcap-look-at-field ()
 112   (let ((token (mailcap-look-at-token)))
 113     (if token
 114         (if (eq (char-after (point)) ?=)
 115             (let ((value (progn
 116                            (forward-char)
 117                            (mailcap-look-at-mtext))))
 118               (if value
 119                   (cons token value)
 120                 ))
 121           (list token)
 122           ))))
 123
 124
 125 ;;; @ mailcap entry
 126 ;;;
 127
 128 (defun mailcap-look-at-entry ()
 129   (let ((type (mailcap-look-at-type-field)))
 130     (if (and type (mailcap-skip-field-separator))
 131         (let ((view (mailcap-look-at-mtext))
 132               fields field)
 133           (when view
 134             (while (and (mailcap-skip-field-separator)
 135                         (setq field (mailcap-look-at-field))
 136                         )
 137               (setq fields (cons field fields))
 138               )
 139             (nconc type
 140                    (list (cons 'view view))
 141                    fields))))))
 142
 143
 144 ;;; @ main
 145 ;;;
 146
 147 (defun mailcap-parse-buffer (&optional buffer order)
 148   "Parse BUFFER as a mailcap, and return the result.
 149 If optional argument ORDER is a function, result is sorted by it.
 150 If optional argument ORDER is not specified, result is sorted original
 151 order.  Otherwise result is not sorted."
 152   (save-excursion
 153     (if buffer
 154         (set-buffer buffer))
 155     (goto-char (point-min))
 156     (let (entries entry)
 157       (while (progn
 158                (while (mailcap-skip-comment))
 159                (setq entry (mailcap-look-at-entry))
 160                )
 161         (setq entries (cons entry entries))
 162         (forward-line)
 163         )
 164       (cond ((functionp order) (sort entries order))
 165             ((null order) (nreverse entries))
 166             (t entries)
 167             ))))
 168
 169 (defvar mailcap-file "~/.mailcap"
 170   "*File name of user's mailcap file.")
 171
 172 (defun mailcap-parse-file (&optional filename order)
 173   "Parse FILENAME as a mailcap, and return the result.
 174 If optional argument ORDER is a function, result is sorted by it.
 175 If optional argument ORDER is not specified, result is sorted original
 176 order.  Otherwise result is not sorted."
 177   (or filename
 178       (setq filename mailcap-file))
 179   (with-temp-buffer
 180     (insert-file-contents filename)
 181     (mailcap-parse-buffer (current-buffer) order)
 182     ))
 183
 184
 185 ;;; @ end
 186 ;;;
 187
 188 (provide 'mailcap)
 189
 190 ;;; mailcap.el ends here