;;; mime-conf.el --- mailcap parser and MIME playback configuration -*- lexical-binding: t -*-
;; Copyright (C) 1997,1998,1999,2000,2004 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Created: 1997-06-27
;; Original: 1997-06-27 mailcap.el by MORIOKA Tomohiko
;; Renamed: 2000-11-24 to mime-conf.el by MORIOKA Tomohiko
;; Keywords: mailcap, setting, configuration, MIME, multimedia
;; This file is part of FLIM (Faithful Library about Internet Message).
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(require 'mime-def)
;;; @ comment
;;;
(defsubst mime-mailcap-skip-comment ()
(let ((chr (following-char)))
(when (and chr
(or (= chr ?\n)
(= chr ?#)))
(forward-line)
t)))
;;; @ token
;;;
(defsubst mime-mailcap-look-at-token ()
(if (looking-at mime-token-regexp)
(let ((beg (match-beginning 0))
(end (match-end 0)))
(goto-char end)
(buffer-substring beg end))))
;;; @ typefield
;;;
(defsubst mime-mailcap-look-at-type-field ()
(let ((type (mime-mailcap-look-at-token)))
(if type
(if (eq (following-char) ?/)
(progn
(forward-char)
(let ((subtype (mime-mailcap-look-at-token)))
(if subtype
(cons (cons 'type (intern type))
(unless (string= subtype "*")
(list (cons 'subtype (intern subtype))))))))
(list (cons 'type (intern type)))))))
;;; @ field separator
;;;
(defsubst mime-mailcap-skip-field-separator ()
(let ((ret (looking-at "\\([ \t]\\|\\\\\n\\)*;\\([ \t]\\|\\\\\n\\)*")))
(when ret
(goto-char (match-end 0))
t)))
;;; @ mtext
;;;
(defsubst mime-mailcap-look-at-schar ()
(let ((chr (following-char)))
(if (and chr
(>= chr ?\s)
(/= chr ?\;)
(/= chr ?\\))
(prog1
chr
(forward-char)))))
(defsubst mime-mailcap-look-at-qchar ()
(when (eq (following-char) ?\\)
(prog2
(forward-char)
(following-char)
(forward-char))))
(defsubst mime-mailcap-look-at-mtext ()
(let ((beg (point)))
(while (or (mime-mailcap-look-at-qchar)
(mime-mailcap-look-at-schar)))
(buffer-substring beg (point))))
;;; @ field
;;;
(defsubst mime-mailcap-look-at-field ()
(let ((token (mime-mailcap-look-at-token)))
(if token
(if (looking-at "[ \t]*=[ \t]*")
(let ((value (progn
(goto-char (match-end 0))
(mime-mailcap-look-at-mtext))))
(if value
(cons (intern token) value)))
(list (intern token))))))
;;; @ mailcap entry
;;;
(defun mime-mailcap-look-at-entry ()
(let ((type (mime-mailcap-look-at-type-field)))
(if (and type (mime-mailcap-skip-field-separator))
(let ((view (mime-mailcap-look-at-mtext))
fields field)
(when view
(while (and (mime-mailcap-skip-field-separator)
(setq field (mime-mailcap-look-at-field)))
(setq fields (cons field fields)))
(nconc type
(list (cons 'view view))
fields))))))
;;; @ main
;;;
;;;###autoload
(defun mime-parse-mailcap-buffer (&optional buffer order)
"Parse BUFFER as a mailcap, and return the result.
If optional argument ORDER is a function, result is sorted by it.
If optional argument ORDER is not specified, result is sorted original
order. Otherwise result is not sorted."
(save-excursion
(if buffer
(set-buffer buffer))
(goto-char (point-min))
(let (entries entry)
(while (progn
(while (mime-mailcap-skip-comment))
(setq entry (mime-mailcap-look-at-entry)))
(setq entries (cons entry entries))
(forward-line))
(cond ((functionp order) (sort entries order))
((null order) (nreverse entries))
(t entries)))))
;;;###autoload
(defvar mime-mailcap-file "~/.mailcap"
"*File name of user's mailcap file.")
;;;###autoload
(defun mime-parse-mailcap-file (&optional filename order)
"Parse FILENAME as a mailcap, and return the result.
If optional argument ORDER is a function, result is sorted by it.
If optional argument ORDER is not specified, result is sorted original
order. Otherwise result is not sorted."
(or filename
(setq filename mime-mailcap-file))
(with-temp-buffer
(insert-file-contents filename)
(mime-parse-mailcap-buffer (current-buffer) order)))
;;;###autoload
(defun mime-format-mailcap-command (mtext situation)
"Return formated command string from MTEXT and SITUATION.
MTEXT is a command text of mailcap specification, such as
view-command.
SITUATION is an association-list about information of entity. Its key
may be:
\\='type primary media-type
\\='subtype media-subtype
\\='filename filename
STRING parameter of Content-Type field"
(let ((i 0)
(len (length mtext))
(p 0)
dest)
(while (< i len)
(let ((chr (aref mtext i)))
(cond
((eq chr ?%)
(setq i (1+ i)
chr (aref mtext i))
(cond
((eq chr ?s)
(let ((file (cdr (assq 'filename situation))))
(if file
(setq file (shell-quote-argument file))
(error "'filename is not specified in situation."))
(setq dest (concat dest
(substring mtext p (1- i))
;; if the situation (wrongly) quotes
;; the argument, fix it.
(if (eq ?' (aref mtext (- i 2)))
(concat "'" file "'")
file))
i (1+ i)
p i)))
((eq chr ?t)
(let ((type (or (mime-type/subtype-string
(cdr (assq 'type situation))
(cdr (assq 'subtype situation)))
"text/plain")))
(setq dest (concat dest (substring mtext p (1- i)) type)
i (1+ i)
p i)))
((eq chr ?\{)
(setq i (1+ i))
(unless (string-match "}" mtext i)
(error "parse error!!!"))
(let* ((me (match-end 0))
(attribute (substring mtext i (1- me)))
(parameter (cdr (assoc attribute situation))))
(unless parameter
(error "\"%s\" is not specified in situation." attribute))
(setq dest (concat dest (substring mtext p (- i 2)) parameter)
i me
p i)))
(t (error "Invalid sequence `%%%c'." chr))))
((eq chr ?\\)
(setq dest (concat dest (substring mtext p i))
p (1+ i)
i (+ i 2)))
(t (setq i (1+ i))))))
(concat dest (substring mtext p))))
;;; @ end
;;;
(provide 'mime-conf)
;;; mime-conf.el ends here