From 99783ea757d4de0e2e1f6905e2a98d58cabe9979 Mon Sep 17 00:00:00 2001 From: tomo Date: Mon, 27 Nov 2000 06:03:51 +0000 Subject: [PATCH] New file. --- mime-conf.el | 277 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 277 insertions(+) create mode 100644 mime-conf.el diff --git a/mime-conf.el b/mime-conf.el new file mode 100644 index 0000000..84fed40 --- /dev/null +++ b/mime-conf.el @@ -0,0 +1,277 @@ +;;; mime-conf.el --- mailcap parser and MIME playback configuration + +;; Copyright (C) 1997,1998,1999,2000 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'mime-def) + + +;;; @ comment +;;; + +(defsubst mime-mailcap-skip-comment () + (let ((chr (char-after (point)))) + (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 (char-after (point)) ?/) + (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 (char-after (point)))) + (if (and chr + (>= chr ? ) + (/= chr ?\;) + (/= chr ?\\) + ) + (prog1 + chr + (forward-char))))) + +(defsubst mime-mailcap-look-at-qchar () + (when (eq (char-after (point)) ?\\) + (prog2 + (forward-char) + (char-after (point)) + (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 +(defcustom mime-mailcap-file "~/.mailcap" + "*File name of user's mailcap file." + :group 'mime + :type '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 (null file) + (error "'filename is not specified in situation.") + (setq dest (concat dest + (substring mtext p (1- i)) + 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)) + (if (not (string-match "}" mtext i)) + (error "parse error!!!") + (let* ((me (match-end 0)) + (attribute (substring mtext i (1- me))) + (parameter (cdr (assoc attribute situation)))) + (if (null 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 -- 1.7.10.4