From 79afbe85ece9473654c1a92906f839ff5e889fad Mon Sep 17 00:00:00 2001 From: morioka Date: Mon, 29 Jun 1998 13:58:16 +0000 Subject: [PATCH] Merge chao-1_7_0. --- ChangeLog | 50 +++++++++++++++++++++ FLIM-ELS | 4 +- FLIM-VERSION | 1 + Makefile | 21 ++++----- mime-def.el | 65 ++++++++++++++++----------- mime-parse.el | 80 +++++++++++++++++++--------------- mime.el | 135 +++++++++++++++++++++++++++++++++++++++++++++++---------- mmbuffer.el | 58 +++++++++++++++++++++++++ mmcooked.el | 45 +++++++++++++++++++ 9 files changed, 365 insertions(+), 94 deletions(-) create mode 100644 mmbuffer.el create mode 100644 mmcooked.el diff --git a/ChangeLog b/ChangeLog index 4161685..e67c89d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,53 @@ +1998-06-29 MORIOKA Tomohiko + + * mime.el (mime-write-entity-content): New function. + +1998-06-28 MORIOKA Tomohiko + + * mime.el (mime-write-entity-body): New function. + + * mime.el (mime-write-entity): New function. + +1998-06-28 MORIOKA Tomohiko + + * mime-parse.el (mime-parse-multipart): Change media-type of + entity to application/octet-stream if the first delimiter is not + found. + +1998-06-28 MORIOKA Tomohiko + + * FLIM-ELS (flim-modules): Add `mmbuffer' and `mmcooked'. + + * mmcooked.el: New file. + + * mmbuffer.el: New file. + + * mime.el (mime-entity-implementation-alist): New variable. + (mime-find-function): New function. + (mime-open-entity): New function. + (mime-entity-function): New function. + (mime-entity-cooked-p): New function. + (mime-entity-buffer): Use backend-module. + (mime-entity-point-min): Likewise. + (mime-entity-point-max): Likewise. + (mime-entity-header-start): Likewise. + (mime-entity-header-end): Likewise. + (mime-entity-body-start): Likewise. + (mime-entity-body-end): Likewise. + (mime-fetch-field): Likewise. + + * mime-parse.el (mime-parse-message): New optional argument + `representation-type'. + (mime-parse-buffer): Likewise. + + * mime-def.el: Change format of mime-entity-internal to add + `representation-type' and `location'. + + +1998-06-28 MORIOKA Tomohiko + + * FLIM-Chao: Version 1.7.0 (Goj-Dò)-A was released. + 1998-06-26 MORIOKA Tomohiko * mime-ja.sgml: Modify for FLIM 1.7. diff --git a/FLIM-ELS b/FLIM-ELS index 0afc7da..3e53c65 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -8,9 +8,9 @@ mime-def mel mel-dl mel-b mel-q mel-u mel-g eword-decode eword-encode - mime mime-parse mailcap + mime mime-parse mmbuffer mmcooked ;; mime-lib - )) + mailcap)) (if (fboundp 'dynamic-link) (setq flim-modules (cons 'mel-dl flim-modules)) diff --git a/FLIM-VERSION b/FLIM-VERSION index 69d5224..a2263ad 100644 --- a/FLIM-VERSION +++ b/FLIM-VERSION @@ -32,3 +32,4 @@ 1.4.0 J-Dþjò-A $(B==>r(B 1.6.0 Kuj-Dò-A $(B6e>r(B 1.6.1 Ky-Dòto-A $(B5~ET(B ; <=> JR, $(B6aE4(B +1.7.0 Goj-Dò-A $(B8^>r(B diff --git a/Makefile b/Makefile index efaf8be..6ea2e13 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,8 @@ # Makefile for FLIM. # -VERSION = 1.6.0 +PACKAGE = flim +VERSION = 1.7.0 TAR = tar RM = /bin/rm -f @@ -31,20 +32,20 @@ clean: tar: cvs commit - sh -c 'cvs tag -RF flim-`echo $(VERSION) \ + sh -c 'cvs tag -RF $(PACKAGE)-`echo $(VERSION) \ | sed s/\\\\./_/ | sed s/\\\\./_/`; \ cd /tmp; \ cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \ - export -d flim-$(VERSION) \ - -r flim-`echo $(VERSION) | sed s/\\\\./_/ | sed s/\\\\./_/` \ + export -d $(PACKAGE)-$(VERSION) \ + -r $(PACKAGE)-`echo $(VERSION) | sed s/\\\\./_/ | sed s/\\\\./_/` \ flim' - cd /tmp; $(RM) flim-$(VERSION)/ftp.in ; \ - $(TAR) cvzf flim-$(VERSION).tar.gz flim-$(VERSION) - cd /tmp; $(RM) -r flim-$(VERSION) + cd /tmp; $(RM) $(PACKAGE)-$(VERSION)/ftp.in ; \ + $(TAR) cvzf $(PACKAGE)-$(VERSION).tar.gz $(PACKAGE)-$(VERSION) + cd /tmp; $(RM) -r $(PACKAGE)-$(VERSION) sed "s/VERSION/$(VERSION)/" < ftp.in > ftp release: - -$(RM) /pub/GNU/elisp/apel/flim-$(VERSION).tar.gz - mv /tmp/flim-$(VERSION).tar.gz /pub/GNU/elisp/flim/ + -$(RM) /pub/GNU/elisp/apel/$(PACKAGE)-$(VERSION).tar.gz + mv /tmp/$(PACKAGE)-$(VERSION).tar.gz /pub/GNU/elisp/flim/ cd /pub/GNU/elisp/semi/ ; \ - ln -s ../flim/flim-$(VERSION).tar.gz . + ln -s ../flim/$(PACKAGE)-$(VERSION).tar.gz . diff --git a/mime-def.el b/mime-def.el index 810aa2b..9e17e79 100644 --- a/mime-def.el +++ b/mime-def.el @@ -182,37 +182,50 @@ ;;; @ MIME entity ;;; -(defsubst make-mime-entity-internal (buffer +(defsubst make-mime-entity-internal (representation-type + location + &optional content-type children + node-id + buffer header-start header-end - body-start body-end - &optional node-id - content-type children) - (vector buffer header-start header-end body-start body-end - node-id content-type nil nil nil children nil)) - -(defsubst mime-entity-buffer-internal (entity) (aref entity 0)) -(defsubst mime-entity-header-start-internal (entity) (aref entity 1)) -(defsubst mime-entity-header-end-internal (entity) (aref entity 2)) -(defsubst mime-entity-body-start-internal (entity) (aref entity 3)) -(defsubst mime-entity-body-end-internal (entity) (aref entity 4)) -(defsubst mime-entity-node-id-internal (entity) (aref entity 5)) -(defsubst mime-entity-content-type-internal (entity) (aref entity 6)) -(defsubst mime-entity-content-disposition-internal (entity) (aref entity 7)) -(defsubst mime-entity-encoding-internal (entity) (aref entity 8)) -(defsubst mime-entity-original-header-internal (entity) (aref entity 9)) -(defsubst mime-entity-children-internal (entity) (aref entity 10)) -(defsubst mime-entity-parsed-header-internal (entity) (aref entity 11)) - + body-start body-end) + (vector representation-type location + content-type children nil nil node-id + buffer header-start header-end body-start body-end + nil nil)) + +(defsubst mime-entity-representation-type-internal (entity) (aref entity 0)) +(defsubst mime-entity-location-internal (entity) (aref entity 1)) + +(defsubst mime-entity-content-type-internal (entity) (aref entity 2)) +(defsubst mime-entity-children-internal (entity) (aref entity 3)) +(defsubst mime-entity-content-disposition-internal (entity) (aref entity 4)) +(defsubst mime-entity-encoding-internal (entity) (aref entity 5)) +(defsubst mime-entity-node-id-internal (entity) (aref entity 6)) + +(defsubst mime-entity-buffer-internal (entity) (aref entity 7)) +(defsubst mime-entity-header-start-internal (entity) (aref entity 8)) +(defsubst mime-entity-header-end-internal (entity) (aref entity 9)) +(defsubst mime-entity-body-start-internal (entity) (aref entity 10)) +(defsubst mime-entity-body-end-internal (entity) (aref entity 11)) + +(defsubst mime-entity-original-header-internal (entity) (aref entity 12)) +(defsubst mime-entity-parsed-header-internal (entity) (aref entity 13)) + +(defsubst mime-entity-set-representation-type-internal (entity type) + (aset entity 0 type)) +(defsubst mime-entity-set-content-type-internal (entity type) + (aset entity 2 type)) +(defsubst mime-entity-set-children-internal (entity children) + (aset entity 3 children)) (defsubst mime-entity-set-content-disposition-internal (entity disposition) - (aset entity 7 disposition)) + (aset entity 4 disposition)) (defsubst mime-entity-set-encoding-internal (entity encoding) - (aset entity 8 encoding)) + (aset entity 5 encoding)) (defsubst mime-entity-set-original-header-internal (entity header) - (aset entity 9 header)) -(defsubst mime-entity-set-children-internal (entity children) - (aset entity 10 children)) + (aset entity 12 header)) (defsubst mime-entity-set-parsed-header-internal (entity header) - (aset entity 11 header)) + (aset entity 13 header)) ;;; @ message structure diff --git a/mime-parse.el b/mime-parse.el index 3201a9f..b198b96 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -152,7 +152,9 @@ If is is not found, return DEFAULT-ENCODING." (defun mime-parse-multipart (entity) (goto-char (point-min)) - (let* ((content-type (mime-entity-content-type-internal entity)) + (let* ((representation-type + (mime-entity-representation-type-internal entity)) + (content-type (mime-entity-content-type-internal entity)) (dash-boundary (concat "--" (mime-content-type-parameter content-type "boundary"))) (delimiter (concat "\n" (regexp-quote dash-boundary))) @@ -164,9 +166,7 @@ If is is not found, return DEFAULT-ENCODING." (make-mime-content-type 'text 'plain) )) (header-end (mime-entity-header-end-internal entity)) - (body-end (mime-entity-body-end-internal entity)) - (node-id (mime-entity-node-id-internal entity)) - cb ce ret ncb children (i 0)) + (body-end (mime-entity-body-end-internal entity))) (save-restriction (goto-char body-end) (narrow-to-region header-end @@ -174,28 +174,36 @@ If is is not found, return DEFAULT-ENCODING." (match-beginning 0) body-end)) (goto-char header-end) - (re-search-forward rsep nil t) - (setq cb (match-end 0)) - (while (re-search-forward rsep nil t) - (setq ce (match-beginning 0)) - (setq ncb (match-end 0)) - (save-restriction - (narrow-to-region cb ce) - (setq ret (mime-parse-message dc-ctl (cons i node-id))) - ) - (setq children (cons ret children)) - (goto-char (setq cb ncb)) - (setq i (1+ i)) - ) - (setq ce (point-max)) - (save-restriction - (narrow-to-region cb ce) - (setq ret (mime-parse-message dc-ctl (cons i node-id))) - ) - (setq children (cons ret children)) - ) - (mime-entity-set-children-internal entity (nreverse children)) - entity)) + (if (re-search-forward rsep nil t) + (let ((cb (match-end 0)) + ce ncb ret children + (node-id (mime-entity-node-id-internal entity)) + (i 0)) + (while (re-search-forward rsep nil t) + (setq ce (match-beginning 0)) + (setq ncb (match-end 0)) + (save-restriction + (narrow-to-region cb ce) + (setq ret (mime-parse-message dc-ctl (cons i node-id) + representation-type)) + ) + (setq children (cons ret children)) + (goto-char (setq cb ncb)) + (setq i (1+ i)) + ) + (setq ce (point-max)) + (save-restriction + (narrow-to-region cb ce) + (setq ret (mime-parse-message dc-ctl (cons i node-id) + representation-type)) + ) + (setq children (cons ret children)) + (mime-entity-set-children-internal entity (nreverse children)) + ) + (mime-entity-set-content-type-internal + entity (make-mime-content-type 'application 'octet-stream)) + ))) + entity) (defun mime-parse-encapsulated (entity) (mime-entity-set-children-internal @@ -204,12 +212,13 @@ If is is not found, return DEFAULT-ENCODING." (narrow-to-region (mime-entity-body-start-internal entity) (mime-entity-body-end-internal entity)) (list (mime-parse-message - nil (cons 0 (mime-entity-node-id-internal entity)))) + nil (cons 0 (mime-entity-node-id-internal entity)) + (mime-entity-representation-type-internal entity))) )) entity) ;;;###autoload -(defun mime-parse-message (&optional default-ctl node-id) +(defun mime-parse-message (&optional default-ctl node-id representation-type) "Parse current-buffer as a MIME message. DEFAULT-CTL is used when an entity does not have valid Content-Type field. Its format must be as same as return value of @@ -236,10 +245,12 @@ mime-{parse|read}-Content-Type." default-ctl) primary-type (mime-content-type-primary-type content-type)) ) - (setq entity - (make-mime-entity-internal - (current-buffer) header-start header-end body-start body-end - node-id content-type)) + (setq entity (make-mime-entity-internal (or representation-type 'buffer) + (current-buffer) + content-type nil node-id + (current-buffer) + header-start header-end + body-start body-end)) (cond ((eq primary-type 'multipart) (mime-parse-multipart entity) ) @@ -256,12 +267,13 @@ mime-{parse|read}-Content-Type." ;;; ;;;###autoload -(defun mime-parse-buffer (&optional buffer) +(defun mime-parse-buffer (&optional buffer representation-type) "Parse BUFFER as a MIME message. If buffer is omitted, it parses current-buffer." (save-excursion (if buffer (set-buffer buffer)) - (setq mime-message-structure (mime-parse-message)) + (setq mime-message-structure + (mime-parse-message nil nil representation-type)) )) diff --git a/mime.el b/mime.el index 4f6555f..681376d 100644 --- a/mime.el +++ b/mime.el @@ -60,6 +60,47 @@ current-buffer, and return it.") "Parse BUFFER as a MIME message.") +;;; @ Entity Representation and Implementation +;;; + +(defvar mime-entity-implementation-alist nil) + +(defsubst mime-find-function (service type) + (let ((imps (cdr (assq type mime-entity-implementation-alist)))) + (if imps + (let ((func (cdr (assq service imps)))) + (unless func + (setq func (intern (format "mm%s-%s" type service))) + (set-alist 'mime-entity-implementation-alist + type (put-alist service func imps)) + ) + func) + (let ((prefix (format "mm%s" type))) + (require (intern prefix)) + (let ((func (intern (format "%s-%s" prefix service)))) + (set-alist 'mime-entity-implementation-alist + type + (list (cons service func))) + func))))) + +(defun mime-open-entity (type location) + "Open an entity and return it. +TYPE is representation-type. +LOCATION is location of entity. Specification of it is depended on +representation-type." + (funcall (mime-find-function 'open-entity type) location) + ) + +(defsubst mime-entity-function (entity service) + (mime-find-function service + (mime-entity-representation-type-internal entity))) + +(defun mime-entity-cooked-p (entity) + "Return non-nil if contents of ENTITY has been already code-converted." + (funcall (mime-entity-function entity 'cooked-p)) + ) + + ;;; @ Entity as node of message ;;; @@ -67,7 +108,7 @@ current-buffer, and return it.") (defalias 'mime-entity-node-id 'mime-entity-node-id-internal) -(defsubst mime-entity-number (entity) +(defun mime-entity-number (entity) "Return entity-number of ENTITY." (reverse (mime-entity-node-id-internal entity))) @@ -85,12 +126,12 @@ If MESSAGE is not specified, `mime-message-structure' is used." )) ))) -(defsubst mime-find-entity-from-node-id (entity-node-id &optional message) +(defun mime-find-entity-from-node-id (entity-node-id &optional message) "Return entity from ENTITY-NODE-ID in MESSAGE. If MESSAGE is not specified, `mime-message-structure' is used." (mime-find-entity-from-number (reverse entity-node-id) message)) -(defsubst mime-entity-parent (entity &optional message) +(defun mime-entity-parent (entity &optional message) "Return mother entity of ENTITY. If MESSAGE is not specified, `mime-message-structure' in the buffer of ENTITY is used." @@ -101,7 +142,7 @@ ENTITY is used." (set-buffer (mime-entity-buffer entity)) mime-message-structure)))) -(defsubst mime-root-entity-p (entity) +(defun mime-root-entity-p (entity) "Return t if ENTITY is root-entity (message)." (null (mime-entity-node-id entity))) @@ -109,16 +150,35 @@ ENTITY is used." ;;; @ Entity Buffer ;;; -(defalias 'mime-entity-buffer 'mime-entity-buffer-internal) - -(defalias 'mime-entity-point-min 'mime-entity-header-start-internal) -(defalias 'mime-entity-point-max 'mime-entity-body-end-internal) - -(defalias 'mime-entity-header-start 'mime-entity-header-start-internal) -(defalias 'mime-entity-header-end 'mime-entity-header-end-internal) - -(defalias 'mime-entity-body-start 'mime-entity-body-start-internal) -(defalias 'mime-entity-body-end 'mime-entity-body-end-internal) +(defun mime-entity-buffer (entity) + (or (mime-entity-buffer-internal entity) + (funcall (mime-entity-function entity 'entity-buffer) entity) + )) + +(defun mime-entity-point-min (entity) + (funcall (mime-entity-function entity 'entity-point-min) entity) + ) +(defun mime-entity-point-max (entity) + (funcall (mime-entity-function entity 'entity-point-max) entity) + ) + +(defun mime-entity-header-start (entity) + (or (mime-entity-header-start-internal entity) + (funcall (mime-entity-function entity 'entity-header-start) entity) + )) +(defsubst mime-entity-header-end (entity) + (or (mime-entity-header-end-internal entity) + (funcall (mime-entity-function entity 'entity-header-end) entity) + )) + +(defsubst mime-entity-body-start (entity) + (or (mime-entity-body-start-internal entity) + (funcall (mime-entity-function entity 'entity-body-start) entity) + )) +(defsubst mime-entity-body-end (entity) + (or (mime-entity-body-end-internal entity) + (funcall (mime-entity-function entity 'entity-body-end) entity) + )) ;;; @ Entity Header @@ -133,14 +193,9 @@ ENTITY is used." (field-body (cdr (assq field-name header)))) (or field-body (progn - (if (save-excursion - (set-buffer (mime-entity-buffer entity)) - (save-restriction - (narrow-to-region (mime-entity-header-start entity) - (mime-entity-header-end entity)) - (setq field-body - (std11-fetch-field (symbol-name field-name))) - )) + (if (setq field-body + (funcall (mime-entity-function entity 'fetch-field) + entity (symbol-name field-name))) (mime-entity-set-original-header-internal entity (put-alist field-name field-body header)) ) @@ -337,6 +392,42 @@ ENTITY is used." (mime-entity-body-end entity)) (mime-entity-encoding entity)))) +(defun mime-write-entity-content (entity filename) + "Write content of ENTITY into FILENAME." + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (let ((encoding (or (mime-entity-encoding entity) "7bit"))) + (if (and (mime-entity-cooked-p entity) + (member encoding '("7bit" "8bit" "binary"))) + (write-region (mime-entity-body-start entity) + (mime-entity-body-end entity) filename) + (mime-write-decoded-region (mime-entity-body-start entity) + (mime-entity-body-end entity) + filename encoding) + )))) + +(defun mime-write-entity (entity filename) + "Write ENTITY into FILENAME." + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (if (mime-entity-cooked-p entity) + (write-region (mime-entity-point-min entity) + (mime-entity-point-max entity) filename) + (write-region-as-binary (mime-entity-point-min entity) + (mime-entity-point-max entity) filename) + ))) + +(defun mime-write-entity-body (entity filename) + "Write body of ENTITY into FILENAME." + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (if (mime-entity-cooked-p entity) + (write-region (mime-entity-body-start entity) + (mime-entity-body-end entity) filename) + (write-region-as-binary (mime-entity-body-start entity) + (mime-entity-body-end entity) filename) + ))) + ;;; @ end ;;; diff --git a/mmbuffer.el b/mmbuffer.el new file mode 100644 index 0000000..fd948b3 --- /dev/null +++ b/mmbuffer.el @@ -0,0 +1,58 @@ +;;; mmbuffer.el --- MIME entity module for binary buffer + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: MIME, multimedia, mail, news + +;; 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-parse) + +(defun mmbuffer-open-entity (location) + (mime-parse-buffer location) + ) + +(defun mmbuffer-entity-point-min (entity) + (mime-entity-header-start-internal entity) + ) + +(defun mmbuffer-entity-point-max (entity) + (mime-entity-body-end-internal entity) + ) + +(defun mmbuffer-fetch-field (entity field-name) + (save-excursion + (set-buffer (mime-entity-buffer-internal entity)) + (save-restriction + (narrow-to-region (mime-entity-header-start-internal entity) + (mime-entity-header-end-internal entity)) + (std11-fetch-field field-name) + ))) + +(defun mmbuffer-cooked-p () nil) + + +;;; @ end +;;; + +(provide 'mmbuffer) + +;;; mmbuffer.el ends here diff --git a/mmcooked.el b/mmcooked.el new file mode 100644 index 0000000..8d4e0df --- /dev/null +++ b/mmcooked.el @@ -0,0 +1,45 @@ +;;; mmcooked.el --- MIME entity implementation for binary buffer + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: MIME, multimedia, mail, news + +;; 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 'mmbuffer) + +(defun mmcooked-open-entity (location) + (mime-parse-buffer location 'cooked) + ) + +(defalias 'mmcooked-entity-point-min 'mmbuffer-entity-point-min) +(defalias 'mmcooked-entity-point-max 'mmbuffer-entity-point-max) +(defalias 'mmcooked-fetch-field 'mmbuffer-fetch-field) + +(defun mmcooked-cooked-p () t) + + +;;; @ end +;;; + +(provide 'mmcooked) + +;;; mmcooked.el ends here -- 1.7.10.4