mailcap.el

   1 ;;; mailcap.el --- mailcap parser
   2
   3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1997/6/27
   7 ;; Version: $Id: mailcap.el,v 0.1 1997-07-02 16:43:23 morioka Exp $
   8 ;; Keywords: mailcap, setting, configuration, MIME, multimedia
   9
  10 ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Code:
  28
  29 ;;; @ comment
  30 ;;;
  31
  32 (defsubst mailcap-skip-comment ()
  33   (let ((chr (char-after (point))))
  34     (when (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 type)
  65                       (unless (string= subtype "*")
  66                         (list (cons 'subtype 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
 170 ;;; @ end
 171 ;;;
 172
 173 (provide 'mailcap)
 174
 175 ;;; mailcap.el ends here