update.
[elisp/flim.git] / mailcap.el
index a27be3e..a2c40ae 100644 (file)
@@ -1,12 +1,14 @@
 ;;; mailcap.el --- mailcap parser
 
-;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1997,1998,1999,2000 Free Software Foundation, Inc.
 
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Created: 1997/6/27
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; Created: 1997-06-27
+;;     2000-11-24      Rewrote to use mime-conf.el.
 ;; Keywords: mailcap, setting, configuration, MIME, multimedia
+;; Status: obsolete
 
-;; This file is part of SEMI (Spadework for Emacs MIME Interfaces).
+;; 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
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Code:
 
-;;; @ comment
-;;;
-
-(defsubst mailcap-skip-comment ()
-  (let ((chr (char-after (point))))
-    (when (and chr
-              (or (= chr ?\n)
-                  (= chr ?#)))
-      (forward-line)
-      t)))
-
-
-;;; @ token
-;;;
-
-(defsubst 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 mailcap-look-at-type-field ()
-  (let ((type (mailcap-look-at-token)))
-    (if type
-       (if (eq (char-after (point)) ?/)
-           (progn
-             (forward-char)
-             (let ((subtype (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 mailcap-skip-field-separator ()
-  (let ((ret (looking-at "\\([ \t]\\|\\\\\n\\)*;\\([ \t]\\|\\\\\n\\)*")))
-    (when ret
-      (goto-char (match-end 0))
-      t)))
-
-
-;;; @ mtext
-;;;
-
-(defsubst mailcap-look-at-schar ()
-  (let ((chr (char-after (point))))
-    (if (and (>= chr ? )
-            (/= chr ?\;)
-            (/= chr ?\\)
-            )
-       (prog1
-           chr
-         (forward-char)))))
-
-(defsubst mailcap-look-at-qchar ()
-  (let ((chr (char-after (point))))
-    (when (eq chr ?\\)
-      (forward-char 2)
-      (char-before (point))
-      )))
-
-(defsubst mailcap-look-at-mtext ()
-  (let ((p0 (point))
-       dest)
-    (while (cond ((mailcap-look-at-qchar)
-                 (setq dest
-                       (concat dest
-                               (buffer-substring p0 (- (point) 2))
-                               (char-to-string (char-before (point)))
-                               )
-                       p0 (point))
-                 )
-                ((mailcap-look-at-schar)
-                 t)))
-    (concat dest (buffer-substring p0 (point)))
-    ))
-
-
-;;; @ field
-;;;
-
-(defsubst mailcap-look-at-field ()
-  (let ((token (mailcap-look-at-token)))
-    (if token
-       (if (looking-at "[ \t]*=[ \t]*")
-           (let ((value (progn
-                          (goto-char (match-end 0))
-                          (mailcap-look-at-mtext))))
-             (if value
-                 (cons (intern token) value)
-               ))
-         (list (intern token))
-         ))))
-
-
-;;; @ mailcap entry
-;;;
-
-(defun mailcap-look-at-entry ()
-  (let ((type (mailcap-look-at-type-field)))
-    (if (and type (mailcap-skip-field-separator))
-       (let ((view (mailcap-look-at-mtext))
-             fields field)
-         (when view
-           (while (and (mailcap-skip-field-separator)
-                       (setq field (mailcap-look-at-field))
-                       )
-             (setq fields (cons field fields))
-             )
-           (nconc type
-                  (list (cons 'view view))
-                  fields))))))
-
-
-;;; @ main
-;;;
-
-(defun mailcap-parse-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 (mailcap-skip-comment))
-              (setq entry (mailcap-look-at-entry))
-              )
-       (setq entries (cons entry entries))
-       (forward-line)
-       )
-      (cond ((functionp order) (sort entries order))
-           ((null order) (nreverse entries))
-           (t entries)
-           ))))
-
-(defvar mailcap-file "~/.mailcap"
-  "*File name of user's mailcap file.")
-
-(defun mailcap-parse-file (&optional filename order)
-  "Parse FILENAME as a mailcap, and return the result.
+(require 'mime-conf)
+(require 'poe) ; define-obsolete-function-alias
+
+(define-obsolete-function-alias
+  'mailcap-parse-buffer 'mime-parse-mailcap-buffer)
+
+(define-obsolete-function-alias
+  'mailcap-format-command 'mime-format-mailcap-command)
+  
+(cond
+ ((featurep 'xemacs)
+  (define-obsolete-variable-alias
+    'mailcap-file 'mime-mailcap-file)
+  (define-obsolete-function-alias
+    'mailcap-parse-file 'mime-parse-mailcap-file)
+  )
+ (t
+  (defvar mailcap-file mime-mailcap-file)
+  (defun mailcap-parse-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 mailcap-file))
-  (with-temp-buffer
-    (insert-file-contents filename)
-    (mailcap-parse-buffer (current-buffer) order)
-    ))
+order.  Otherwise result is not sorted.
+This function is obsolete.  Please use mime-parse-mailcap-file instead."
+    (if filename
+       (mime-parse-mailcap-file filename order)
+      (let ((mime-mailcap-file mailcap-file))
+       (mime-parse-mailcap-file nil order))))
+  (make-obsolete 'mailcap-parse-file 'mime-parse-mailcap-file)
+  ))
 
 
 ;;; @ end