From: ueno Date: Mon, 4 Dec 2000 01:40:32 +0000 (+0000) Subject: Synch up with `flim-1_14'. X-Git-Tag: deisui-1_14_0-2000-12-14~8 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=f50f60416af06de73803488b388b4335a7bbf714;p=elisp%2Fflim.git Synch up with `flim-1_14'. --- diff --git a/FLIM-CFG b/FLIM-CFG index 7fd366e..8a314fd 100644 --- a/FLIM-CFG +++ b/FLIM-CFG @@ -57,6 +57,9 @@ ;; (setq FLIM_DIR (expand-file-name FLIM_PREFIX VERSION_SPECIFIC_LISPDIR)) (setq FLIM_DIR (expand-file-name FLIM_PREFIX LISPDIR)) +(setq FLIM_VERSION_SPECIFIC_DIR + (expand-file-name FLIM_PREFIX VERSION_SPECIFIC_LISPDIR)) + (defvar PACKAGEDIR (if (boundp 'early-packages) (let ((dirs (append (if early-package-load-path diff --git a/FLIM-ELS b/FLIM-ELS index e258b79..2d72a1f 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -10,10 +10,12 @@ eword-decode eword-encode mime mime-parse mmgeneric mmbuffer mmcooked mmdbuffer mmexternal - mailcap + mime-conf sasl sasl-cram sasl-digest smtp qmtp smtpmail)) +(setq flim-version-specific-modules '(mailcap)) + (setq hmac-modules '(hex-util hmac-def md5 md5-el md5-dl diff --git a/FLIM-MK b/FLIM-MK index a0474ae..701ff61 100644 --- a/FLIM-MK +++ b/FLIM-MK @@ -28,10 +28,13 @@ LISPDIR=%s\n" PREFIX LISPDIR)))) (defun compile-flim () (config-flim) + (compile-elisp-modules flim-version-specific-modules ".") (compile-elisp-modules flim-modules ".")) (defun install-flim () (config-flim) + (install-elisp-modules flim-version-specific-modules "./" + FLIM_VERSION_SPECIFIC_DIR) (install-elisp-modules flim-modules "./" FLIM_DIR)) (defun check-flim () @@ -72,11 +75,13 @@ LISPDIR=%s\n" PREFIX LISPDIR)))) (add-to-list 'command-line-args-left ".") (Custom-make-dependencies) + (compile-elisp-modules flim-version-specific-modules ".") (compile-elisp-modules flim-modules ".")) (defun install-flim-package () (config-flim-package) - (install-elisp-modules flim-modules + (install-elisp-modules (append flim-version-specific-modules + flim-modules) "./" (expand-file-name FLIM_PREFIX (expand-file-name "lisp" diff --git a/mailcap.el b/mailcap.el index 25595f0..b31dd21 100644 --- a/mailcap.el +++ b/mailcap.el @@ -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 -;; Created: 1997/6/27 +;; Author: MORIOKA Tomohiko +;; 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 @@ -25,241 +27,35 @@ ;;; Code: -(require 'mime-def) - - -;;; @ 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 ?\;) - (/= chr ?\\) - ) - (prog1 - chr - (forward-char))))) - -(defsubst mailcap-look-at-qchar () - (when (eq (char-after (point)) ?\\) - (prog2 - (forward-char) - (char-after (point)) - (forward-char)))) - -(defsubst mailcap-look-at-mtext () - (let ((beg (point))) - (while (or (mailcap-look-at-qchar) - (mailcap-look-at-schar))) - (buffer-substring beg (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) - )))) - - -(defcustom mailcap-file "~/.mailcap" - "*File name of user's mailcap file." - :group 'mime - :type 'file) - -(defun mailcap-parse-file (&optional filename order) - "Parse FILENAME as a mailcap, and return the result. +(require 'mime-conf) + +(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) - )) - -(defun mailcap-format-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)) - )) +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 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