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.2 1997-09-05 07:12:46 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 (and chr
  35                (or (= chr ?\n)
  36                    (= chr ?#)))
  37       (forward-line)
  38       t)))
  39
  40
  41 ;;; @ token
  42 ;;;
  43
  44 (defsubst mailcap-look-at-token ()
  45   (if (looking-at mime-token-regexp)
  46       (let ((beg (match-beginning 0))
  47             (end (match-end 0)))
  48         (goto-char end)
  49         (buffer-substring beg end)
  50         )))
  51
  52
  53 ;;; @ typefield
  54 ;;;
  55
  56 (defsubst mailcap-look-at-type-field ()
  57   (let ((type (mailcap-look-at-token)))
  58     (if (and type
  59              (eq (char-after (point)) ?/)
  60              )
  61         (progn
  62           (forward-char)
  63           (let ((subtype (mailcap-look-at-token)))
  64             (if subtype
  65                 (cons (cons 'type type)
  66                       (unless (string= subtype "*")
  67                         (list (cons 'subtype subtype))
  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 (eq (char-after (point)) ?=)
 116             (let ((value (progn
 117                            (forward-char)
 118                            (mailcap-look-at-mtext))))
 119               (if value
 120                   (cons token value)
 121                 ))
 122           (list 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
 171 ;;; @ end
 172 ;;;
 173
 174 (provide 'mailcap)
 175
 176 ;;; mailcap.el ends here