+1998-06-29 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime.el (mime-write-entity-content): New function.
+
+1998-06-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime.el (mime-write-entity-body): New function.
+
+ * mime.el (mime-write-entity): New function.
+
+1998-06-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * 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'.
+
+\f
+1998-06-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM-Chao: Version 1.7.0 (Goj\e-Dò)\e-A was released.
+
1998-06-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
* mime-ja.sgml: Modify for FLIM 1.7.
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))
1.4.0 J\e-Dþjò\e-A \e$(B==>r\e(B
1.6.0 Kuj\e-Dò\e-A \e$(B6e>r\e(B
1.6.1 Ky\e-Dòto\e-A \e$(B5~ET\e(B ; <=> JR, \e$(B6aE4\e(B
+1.7.0 Goj\e-Dò\e-A \e$(B8^>r\e(B
# Makefile for FLIM.
#
-VERSION = 1.6.0
+PACKAGE = flim
+VERSION = 1.7.0
TAR = tar
RM = /bin/rm -f
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 .
;;; @ 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
(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)))
(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
(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
(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
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)
)
;;;
;;;###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))
))
"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
;;;
(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)))
))
)))
-(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."
(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)))
;;; @ 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
(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))
)
(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
;;;
--- /dev/null
+;;; mmbuffer.el --- MIME entity module for binary buffer
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; 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
--- /dev/null
+;;; mmcooked.el --- MIME entity implementation for binary buffer
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; 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
projects / elisp / flim.git / commitdiff