+2000-08-28 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * eword-encode.el (eword-encode-mailboxes-to-rword-list):
+ New inline function.
+ (eword-encode-address-to-rword-list): Ditto.
+ (eword-encode-addresses-to-rword-list):
+ Use `eword-encode-address-to-rword-list' instead of
+ `eword-encode-mailbox-to-rword-list'.
+
+ * std11.el (std11-address-string): Fix for group list.
+
+2000-08-10 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mmgeneric.el: Enclose definition of class `mime-entity' and its
+ internal accessors by `eval-and-compile'.
+
+ * luna.el: Define `luna-class-name' before it is used in macros.
+
+\f
+2000-07-12 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * FLIM-Chao: Version 1.14.1 (Rokujiz\e-Dò) released.\e-A
+
+2000-07-10 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mmexternal.el (initialize-instance): Deleted.
+ (mmexternal-require-file-name): New function.
+ (mmexternal-require-buffer): Use `mmexternal-require-file-name'.
+
+2000-06-30 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mime.el (mime-entity-read-field): Fix a bug when FIELD-NAME is a
+ string.
+
+2000-06-23 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mmexternal.el (initialize-instance): New method.
+ (mime-entity-name): Fixed.
+ (mmexternal-require-buffer): New function.
+ (mime-insert-entity): New implementation.
+ (mime-write-entity): Likewise.
+ (mime-entity-body): New method.
+ (mime-insert-entity-body): New method.
+ (mime-write-entity-body): New implementation.
+ (mime-entity-content): Likewise.
+ (mime-insert-entity-content): Likewise.
+ (mime-write-entity-content): Likewise.
+ (mime-entity-fetch-field): Likewise.
+ (mime-insert-header): Likewise.
+
+ * mmbuffer.el (initialize-instance): Store buffer instead of name
+ of buffer to `buffer' slot.
+
+2000-06-21 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mmgeneric.el (mime-entity-children): Deleted.
+
+ * mmbuffer.el (mime-insert-entity-body): New method.
+ (mmbuffer-parse-multipart): New function.
+ (mmbuffer-parse-encapsulated): New function.
+ (mime-entity-children): New function.
+
+2000-06-21 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mime.el (mime-find-root-entity): New function.
+ (mime-entity-header-buffer): Comment out.
+ (mime-goto-header-start-point): Likewise.
+ (mime-entity-header-start-point): Likewise.
+ (mime-entity-header-end-point): Likewise.
+ (mime-entity-body-buffer): Likewise.
+ (mime-goto-body-start-point): Likewise.
+ (mime-goto-body-end-point): Likewise.
+ (mime-entity-body-start-point): Likewise.
+ (mime-entity-body-end-point): Likewise.
+ (mime-entity-body-start): Likewise.
+ (mime-entity-body-end): Likewise.
+ (mime-entity-buffer): Likewise.
+ (mime-entity-point-min): Likewise.
+ (mime-entity-point-max): Likewise.
+ (mime-insert-entity-body): New generic function.
+ (mime-entity-uu-filename): Use `mime-insert-entity-body'.
+ (mime-entity-set-content-type): New function.
+ (mime-entity-set-encoding): New function.
+
+ * mime-parse.el (mime-parse-multipart): Comment out.
+ (mime-parse-encapsulated): Likewise.
+ (mime-parse-external): Likewise.
+
+ * mmbuffer.el (mime-entity-header-buffer): Comment out.
+ (mime-goto-header-start-point): Likewise.
+ (mime-entity-header-start-point): Likewise.
+ (mime-entity-header-end-point): Likewise.
+ (mime-entity-body-buffer): Likewise.
+ (mime-goto-body-start-point): Likewise.
+ (mime-goto-body-end-point): Likewise.
+ (mime-entity-body-start-point): Likewise.
+ (mime-entity-body-end-point): Likewise.
+ (mime-entity-buffer): Likewise.
+ (mime-entity-point-min): Likewise.
+ (mime-entity-point-max): Likewise.
+
+2000-05-30 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * eword-encode.el (eword-charset-encoding-alist): Add
+ `iso-2022-jp-3'.
+
2000-05-25 Tanaka Akira <akr@m17n.org>
* mime-en.sgml, mime-ja.sgml: Update for CVS via SSH.
-
+
2000-05-09 Katsumi Yamaoka <yamaoka@jpl.org>
* smtp.el (smtp-deduce-address-list): Set `case-fold-search' to `t'
in the working buffer.
+2000-04-26 Yoshiki Hayashi <yoshiki@xemacs.org>
+
+ * mime.el (mime-entity-body): New function.
+ * mmbuffer.el (mime-entity-body): Implement it.
+
+2000-03-03 Keiichi Suzuki <keiichi@nanap.org>
+
+ * mime.el (mime-entity-node-id): Change to function.
+
+2000-03-03 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mmdbuffer.el, mmbuffer.el (initialize-instance): Don't setup
+ `mime-message-structure'.
+
+ * mime-parse.el (mime-parse-buffer): Don't setup
+ `mime-message-structure'.
+
+2000-03-02 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mmgeneric.el (mime-visible-field-p): Moved from mmbuffer.el.
+ (mime-insert-header-from-buffer): Moved from mmbuffer.el.
+
+ * mmexternal.el, mmdbuffer.el, mmbuffer.el (mime-visible-field-p):
+ Moved to mmgeneric.el.
+ (mime-insert-header-from-buffer): Moved to mmgeneric.el.
+
+2000-03-02 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * FLIM-ELS (flim-modules): Add `mmgeneric'.
+
+ * mmgeneric.el: New file.
+
+ * mmbuffer.el: Require `mmgeneric'.
+
+ * mime.el: Require `mmgeneric' when compiling.
+
+ * mime-def.el: Move mime-entity related definitions to
+ mmgeneric.el.
+
+2000-03-01 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime.el (mime-find-entity-from-number): Now second argument
+ `message' is not an optional argument.
+ (mime-find-entity-from-node-id): Likewise.
+ (mime-find-entity-from-content-id): Likewise.
+ (mime-fetch-field): Delete obsolete function.
+ (mime-read-field): Likewise.
+
+2000-03-01 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime.el (mime-entity-header-buffer): Mark it as obsolete.
+ (mime-goto-header-start-point): Likewise.
+ (mime-entity-header-start-point): Likewise.
+ (mime-entity-header-end-point): Likewise.
+ (mime-entity-body-start): Use `defalias'; don't recommend to use
+ `mime-entity-body-start-point' instead.
+ (mime-entity-body-end): Use `defalias'; don't recommend to use
+ `mime-entity-body-end-point' instead.
+ (mime-entity-body-buffer): Mark it as obsolete.
+ (mime-goto-body-start-point): Likewise.
+ (mime-goto-body-end-point): Likewise.
+ (mime-entity-body-start-point): Likewise.
+ (mime-entity-body-end-point): Likewise.
+ (mime-entity-buffer): Don't recommend to use
+ `mime-entity-header-buffer' or `mime-entity-body-buffer' instead.
+ (mime-entity-point-min): Don't recommend to use
+ `mime-entity-header-start-point' instead.
+ (mime-entity-point-max): Don't recommend to use
+ `mime-entity-body-end-point' instead.
+
+ * mime-def.el (mime-library-version): update to 1.14.1.
+ - Add autoload setting for `mime-parse-external'.
+
+\f
+2000-03-01 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * Chao: Version 1.14.0 (Momoyama) released.
+
2000-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
* Makefile, mime-en.sgml, mime-ja.sgml: Update for the new CVS
(base64-internal-encode-region): Likewise.
(base64-encode-string): Likewise.
+1999-12-16 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * FLIM-ELS (flim-modules): Add `mmexternal'.
+
+ * mime-parse.el (mime-parse-external): New function.
+
+ * mime-def.el (mime-entity-children [mime-entity]): Use
+ `mime-parse-external' for message/external-body.
+
+ * mmexternal.el: New module.
+
1999-12-13 Katsumi Yamaoka <yamaoka@jpl.org>
- * README.en,README.ja,mime-en.sgml,mime-en.texi,mime-ja.sgml,
- mime-ja.texi: Update for the recent ML address and ftp site.
+ * README.en, README.ja, mime-en.sgml, mime-ja.sgml: Update for the
+ recent ML address and ftp site.
1999-10-17 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
\f
1999-05-31 MORIOKA Tomohiko <tomo@m17n.org>
- * FLIM: Version 1.12.7 (Y\e-Dþzaki)\e-A released.
+ * FLIM: Version 1.12.7 (Y\e-Dþzaki) released.\e-A
1999-05-31 MORIOKA Tomohiko <tomo@m17n.org>
\f
1999-05-11 MORIOKA Tomohiko <tomo@m17n.org>
- * FLIM: Version 1.12.6 (Family-K\e-Dòenmae)\e-A released.
+ * FLIM: Version 1.12.6 (Family-K\e-Dòenmae) released.\e-A
1999-04-27 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
\f
1999-01-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.12.3 (Kintetsu-K\e-Dòriyama)\e-A released.
+ * FLIM: Version 1.12.3 (Kintetsu-K\e-Dòriyama) released.\e-A
1999-01-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1999-01-21 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.12.2 (Kuj\e-Dò)\e-A released.
+ * FLIM: Version 1.12.2 (Kuj\e-Dò) released.\e-A
1999-01-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-12-02 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.12.1 (Nishinoky\e-Dò)\e-A released.
+ * FLIM: Version 1.12.1 (Nishinoky\e-Dò) released.\e-A
1998-11-30 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-10-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.11.2 (Heij\e-Dò)\e-A was released.
+ * FLIM: Version 1.11.2 (Heij\e-Dò) was released.\e-A
* NEWS (Abolish variable `mime-temp-directory'): New subsection.
\f
1998-10-12 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.10.4 (Shin-H\e-Dòsono)\e-A was released.
+ * FLIM: Version 1.10.4 (Shin-H\e-Dòsono) was released.\e-A
1998-10-12 Katsumi Yamaoka <yamaoka@jpl.org>
\f
1998-09-29 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.10.0 (K\e-Dòdo)\e-A was released.
+ * FLIM: Version 1.10.0 (K\e-Dòdo) was released.\e-A
* README.en (What's FLIM): Add mel-ccl.el.
\f
1998-08-31 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.9.1 (Tonosh\e-Dò)\e-A was released.
+ * FLIM: Version 1.9.1 (Tonosh\e-Dò) was released.\e-A
* mime-en.sgml (mm-backend): Translate a little.
\f
1998-07-07 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM-Chao: Version 1.8.0 (Shij\e-Dò)\e-A was released.
+ * FLIM-Chao: Version 1.8.0 (Shij\e-Dò) was released.\e-A
1998-07-07 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-07-01 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.8.0 (\e-DÒkubo)\e-A was released.
+ * FLIM: Version 1.8.0 (\e-DÒkubo) was released.\e-A
* README.en: Delete `How to use'.
\f
1998-06-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM-Chao: Version 1.7.0 (Goj\e-Dò)\e-A was released.
+ * FLIM-Chao: Version 1.7.0 (Goj\e-Dò) was released.\e-A
1998-06-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-06-19 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.4.1 (Momoyama-Gory\e-Dòmae)\e-A was released.
+ * FLIM: Version 1.4.1 (Momoyama-Gory\e-Dòmae) was released.\e-A
1998-06-18 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-05-06 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.2.0 (J\e-Dþjò)\e-A was released.
+ * FLIM: Version 1.2.0 (J\e-Dþjò) was released.\e-A
* README.en (What's FLIM): Delete description about
std11-parse.el; add description about mailcap.el.
\f
1998-05-05 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.1.0 (T\e-Dòji)\e-A was released.
+ * FLIM: Version 1.1.0 (T\e-Dòji) was released.\e-A
1998-05-04 MORIOKA Tomohiko <morioka@jaist.ac.jp>
\f
1998-04-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.0.1 (Ky\e-Dòto)\e-A was released.
+ * FLIM: Version 1.0.1 (Ky\e-Dòto) was released.\e-A
* mime-def.el (mime-spadework-module-version-string): New
constant.
luna mime-def
mel mel-q mel-u mel-g
eword-decode eword-encode
- mime mime-parse mmbuffer mmcooked mmdbuffer
+ mime mime-parse mmgeneric
+ mmbuffer mmcooked mmdbuffer mmexternal
mailcap
smtp smtpmail))
# Makefile for FLIM.
#
-PACKAGE = flim
-API = 1.13
-RELEASE = 2
+PACKAGE = flim-chao
+API = 1.14
+RELEASE = 1
TAR = tar
RM = /bin/rm -f
FILES = README.?? Makefile FLIM-MK FLIM-CFG FLIM-ELS *.el ChangeLog
VERSION = $(API).$(RELEASE)
-ARC_DIR = /ftp/pub/mule/flim/flim-$(API)
-SEMI_ARC_DIR = /ftp/pub/mule/semi/semi-1.13-for-flim-$(API)
+ARC_DIR_PREFIX = /home/tomo/public_html/comp/emacsen/lisp
+ARC_DIR = $(ARC_DIR_PREFIX)/flim/flim-$(API)
+SEMI_ARC_DIR = $(ARC_DIR_PREFIX)/semi/semi-1.14-for-flim-$(API)
elc:
$(EMACS) $(FLAGS) -f compile-flim $(PREFIX) $(LISPDIR) \
1.12.1 T\e-Dòfukuji\e-A \e$(BElJ!;{\e(B ; <=> \e$(B5~:e\e(B
1.12.2 Inari \e$(B0p2Y\e(B
1.13.0 JR Fujinomori JR \e$(BF#?9\e(B
+1.14.0 Momoyama \e$(BEm;3\e(B
+1.14.1 Rokujiz\e-Dò\e-A \e$(BO;COB"\e(B
+------ Kohata \e$(BLZH(\e(B
(iso-8859-8 . "Q")
(iso-8859-9 . "Q")
(iso-2022-jp . "B")
+ (iso-2022-jp-3 . "B")
(iso-2022-kr . "B")
(gb2312 . "B")
(cn-gb . "B")
)))
dest))
+(defsubst eword-encode-mailboxes-to-rword-list (mboxes)
+ (let ((dest (eword-encode-mailbox-to-rword-list (car mboxes))))
+ (if dest
+ (while (setq mboxes (cdr mboxes))
+ (setq dest
+ (nconc dest
+ (list '("," nil nil))
+ (eword-encode-mailbox-to-rword-list
+ (car mboxes))))))
+ dest))
+
+(defsubst eword-encode-address-to-rword-list (address)
+ (cond
+ ((eq (car address) 'mailbox)
+ (eword-encode-mailbox-to-rword-list address))
+ ((eq (car address) 'group)
+ (nconc
+ (eword-encode-phrase-to-rword-list (nth 1 address))
+ (list (list ":" nil nil))
+ (eword-encode-mailboxes-to-rword-list (nth 2 address))
+ (list (list ";" nil nil))))))
+
(defsubst eword-encode-addresses-to-rword-list (addresses)
- (let ((dest (eword-encode-mailbox-to-rword-list (car addresses))))
+ (let ((dest (eword-encode-address-to-rword-list (car addresses))))
(if dest
(while (setq addresses (cdr addresses))
(setq dest
(nconc dest
(list '("," nil nil))
;; (list '(" " nil nil))
- (eword-encode-mailbox-to-rword-list (car addresses))
- ))
- ))
+ (eword-encode-address-to-rword-list (car addresses))))))
dest))
(defsubst eword-encode-msg-id-to-rword-list (msg-id)
It is available from
- ftp://ftp.m17n.org/pub/mule/flim/flim-API
+ http://www.kanji.zinbun.kyoto-u.ac.jp/~tomo/comp/emacsen/lisp/flim/flim-API/
-or
-
- ftp://ftp.etl.go.jp/pub/mule/flim/flim-API
-
---[[message/external-body;
- access-type=anon-ftp;
- site="ftp.m17n.org";
- directory="/pub/mule/flim/flim-API";
- name="PACKAGE-VERSION.tar.gz";
- mode=image]]
+--[[message/external-body; access-type=URL;
+ URL*0="http://";
+ URL*1="www.kanji.zinbun.kyoto-u.ac.jp/~tomo/";
+ URL*2="comp/emacsen/lisp/";
+ URL*3="flim/flim-API/";
+ URL*4="PACKAGE-VERSION.tar.gz"]]
Content-Type: application/octet-stream;
name="PACKAGE-VERSION.tar.gz";
type=tar;
;;; luna.el --- tiny OOP system kernel
-;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: OOP
(defconst :after ':after)
(defconst :around ':around)))
+
+;;; @ class
+;;;
+
(defmacro luna-find-class (name)
"Return the luna-class of the given NAME."
`(get ,name 'luna-class))
(defmacro luna-class-slot-index (class slot-name)
`(get (luna-class-find-member ,class ,slot-name) 'luna-slot-index))
-(defmacro luna-slot-index (entity slot-name)
- `(luna-class-slot-index (luna-find-class (luna-class-name ,entity))
- ,slot-name))
-
-(defsubst luna-slot-value (entity slot)
- "Return the value of SLOT of ENTITY."
- (aref entity (luna-slot-index entity slot)))
-
-(defsubst luna-set-slot-value (entity slot value)
- "Store VALUE into SLOT of ENTITY."
- (aset entity (luna-slot-index entity slot) value))
-
(defmacro luna-define-method (name &rest definition)
"Define NAME as a method function of a class.
(luna-class-find-parents-functions class service)
)))
+
+;;; @ instance (entity)
+;;;
+
+(defmacro luna-class-name (entity)
+ "Return class-name of the ENTITY."
+ `(aref ,entity 0))
+
+(defmacro luna-set-class-name (entity name)
+ `(aset ,entity 0 ,name))
+
+(defmacro luna-get-obarray (entity)
+ `(aref ,entity 1))
+
+(defmacro luna-set-obarray (entity obarray)
+ `(aset ,entity 1 ,obarray))
+
+(defmacro luna-slot-index (entity slot-name)
+ `(luna-class-slot-index (luna-find-class (luna-class-name ,entity))
+ ,slot-name))
+
+(defsubst luna-slot-value (entity slot)
+ "Return the value of SLOT of ENTITY."
+ (aref entity (luna-slot-index entity slot)))
+
+(defsubst luna-set-slot-value (entity slot value)
+ "Store VALUE into SLOT of ENTITY."
+ (aset entity (luna-slot-index entity slot) value))
+
(defmacro luna-find-functions (entity service)
`(luna-class-find-functions (luna-find-class (luna-class-name ,entity))
,service))
t))))
luna-previous-return-value))
-(defmacro luna-class-name (entity)
- "Return class-name of the ENTITY."
- `(aref ,entity 0))
-
-(defmacro luna-set-class-name (entity name)
- `(aset ,entity 0 ,name))
-
-(defmacro luna-get-obarray (entity)
- `(aref ,entity 1))
-
-(defmacro luna-set-obarray (entity obarray)
- `(aset ,entity 1 ,obarray))
-
(defun luna-make-entity (type &rest init-args)
"Make instance of luna-class TYPE and return it.
If INIT-ARGS is specified, it is used as initial values of the slots.
(apply #'luna-send v 'initialize-instance v init-args)
))
+
+;;; @ interface (generic function)
+;;;
+
(defsubst luna-arglist-to-arguments (arglist)
(let (dest)
(while arglist
(put 'luna-define-generic 'lisp-indent-function 'defun)
+
+;;; @ accessor
+;;;
+
(defun luna-define-internal-accessors (class-name)
"Define internal accessors for an entity of CLASS-NAME."
(let ((entity-class (luna-find-class class-name))
)))
(luna-class-obarray entity-class))))
+
+;;; @ standard object
+;;;
+
(luna-define-class-function 'standard-object)
(luna-define-method initialize-instance ((entity standard-object)
-;;; mime-def.el --- definition module about MIME
+;;; mime-def.el --- definition module about MIME -*- coding: iso-8859-4; -*-
-;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
-;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: definition, MIME, multimedia, mail, news
(require 'mcharset)
(require 'alist)
-(eval-when-compile (require 'cl)) ; list*
+(eval-when-compile
+ (require 'cl) ; list*
+ (require 'luna) ; luna-arglist-to-arguments
+ )
(eval-and-compile
- (defconst mime-library-product ["FLIM" (1 13 2) "Kasanui"]
- "Product name, version number and code name of MIME-library package.")
- )
+ (defconst mime-library-product ["Chao" (1 14 1) "Rokujizò"]
+ "Product name, version number and code name of MIME-library package."))
(defmacro mime-product-name (product)
`(aref ,product 0))
(mime-content-disposition-parameter content-disposition "filename"))
-;;; @ MIME entity
-;;;
-
-(require 'luna)
-
-(autoload 'mime-entity-content-type "mime")
-(autoload 'mime-parse-multipart "mime-parse")
-(autoload 'mime-parse-encapsulated "mime-parse")
-(autoload 'mime-entity-content "mime")
-
-(luna-define-class mime-entity ()
- (location
- content-type children parent
- node-id
- content-disposition encoding
- ;; for other fields
- original-header parsed-header))
-
-(defalias 'mime-entity-representation-type-internal 'luna-class-name)
-(defalias 'mime-entity-set-representation-type-internal 'luna-set-class-name)
-
-(luna-define-internal-accessors 'mime-entity)
-
-(luna-define-method mime-entity-fetch-field ((entity mime-entity)
- field-name)
- (or (symbolp field-name)
- (setq field-name (intern (capitalize (capitalize field-name)))))
- (cdr (assq field-name
- (mime-entity-original-header-internal entity))))
-
-(luna-define-method mime-entity-children ((entity mime-entity))
- (let* ((content-type (mime-entity-content-type entity))
- (primary-type (mime-content-type-primary-type content-type)))
- (cond ((eq primary-type 'multipart)
- (mime-parse-multipart entity)
- )
- ((and (eq primary-type 'message)
- (memq (mime-content-type-subtype content-type)
- '(rfc822 news external-body)
- ))
- (mime-parse-encapsulated entity)
- ))
- ))
-
-(luna-define-method mime-insert-text-content ((entity mime-entity))
- (insert
- (decode-mime-charset-string (mime-entity-content entity)
- (or (mime-content-type-parameter
- (mime-entity-content-type entity)
- "charset")
- default-mime-charset)
- 'CRLF)
- ))
-
-
-;;; @ for mm-backend
-;;;
-
-(defmacro mm-expand-class-name (type)
- `(intern (format "mime-%s-entity" ,type)))
-
-(defmacro mm-define-backend (type &optional parents)
- `(luna-define-class ,(mm-expand-class-name type)
- ,(nconc (mapcar (lambda (parent)
- (mm-expand-class-name parent)
- )
- parents)
- '(mime-entity))))
-
-(defmacro mm-define-method (name args &rest body)
- (or (eq name 'initialize-instance)
- (setq name (intern (format "mime-%s" name))))
- (let ((spec (car args)))
- (setq args
- (cons (list (car spec)
- (mm-expand-class-name (nth 1 spec)))
- (cdr args)))
- `(luna-define-method ,name ,args ,@body)
- ))
-
-(put 'mm-define-method 'lisp-indent-function 'defun)
-
-(def-edebug-spec mm-define-method
- (&define name ((arg symbolp)
- [&rest arg]
- [&optional ["&optional" arg &rest arg]]
- &optional ["&rest" arg]
- )
- def-body))
-
-
;;; @ message structure
;;;
\e$B$3$N>l9g!"\e(BUNIX \e$B$N\e(B /etc/passwd \e$BMM<0$G0E9f2=$5$l$?%Q%9%o!<%I$rAw$C$F2<$5$$!#\e(B
\e$B$3$N>l9g\e(B cvsroot \e$B$O\e(B :pserver:<\e$B%"%+%&%s%HL>\e(B>@cvs.m17n.org:/cvs/root \e$B$H$J$j$^$9!#\e(B
-
<h2> History of FLIM
<node> History
<p>
;;; @ message parser
;;;
-(defun mime-parse-multipart (entity)
- (with-current-buffer (mime-entity-body-buffer 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)))
- (close-delimiter (concat delimiter "--[ \t]*$"))
- (rsep (concat delimiter "[ \t]*\n"))
- (dc-ctl
- (if (eq (mime-content-type-subtype content-type) 'digest)
- (make-mime-content-type 'message 'rfc822)
- (make-mime-content-type 'text 'plain)
- ))
- (body-start (mime-entity-body-start-point entity))
- (body-end (mime-entity-body-end-point entity)))
- (save-restriction
- (goto-char body-end)
- (narrow-to-region body-start
- (if (re-search-backward close-delimiter nil t)
- (match-beginning 0)
- body-end))
- (goto-char body-start)
- (if (re-search-forward
- (concat "^" (regexp-quote dash-boundary) "[ \t]*\n")
- 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 representation-type dc-ctl
- entity (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 representation-type dc-ctl
- entity (cons i node-id)))
- )
- (setq children (cons ret children))
- (mime-entity-set-children-internal entity (nreverse children))
- )
- (mime-entity-set-content-type-internal
- entity (make-mime-content-type 'message 'x-broken))
- nil)
- ))))
-
-(defun mime-parse-encapsulated (entity)
- (mime-entity-set-children-internal
- entity
- (with-current-buffer (mime-entity-body-buffer entity)
- (save-restriction
- (narrow-to-region (mime-entity-body-start-point entity)
- (mime-entity-body-end-point entity))
- (list (mime-parse-message
- (mime-entity-representation-type-internal entity) nil
- entity (cons 0 (mime-entity-node-id-internal entity))))
- ))))
+;; (defun mime-parse-multipart (entity)
+;; (with-current-buffer (mime-entity-body-buffer 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)))
+;; (close-delimiter (concat delimiter "--[ \t]*$"))
+;; (rsep (concat delimiter "[ \t]*\n"))
+;; (dc-ctl
+;; (if (eq (mime-content-type-subtype content-type) 'digest)
+;; (make-mime-content-type 'message 'rfc822)
+;; (make-mime-content-type 'text 'plain)
+;; ))
+;; (body-start (mime-entity-body-start-point entity))
+;; (body-end (mime-entity-body-end-point entity)))
+;; (save-restriction
+;; (goto-char body-end)
+;; (narrow-to-region body-start
+;; (if (re-search-backward close-delimiter nil t)
+;; (match-beginning 0)
+;; body-end))
+;; (goto-char body-start)
+;; (if (re-search-forward
+;; (concat "^" (regexp-quote dash-boundary) "[ \t]*\n")
+;; 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 representation-type dc-ctl
+;; entity (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 representation-type dc-ctl
+;; entity (cons i node-id)))
+;; )
+;; (setq children (cons ret children))
+;; (mime-entity-set-children-internal entity (nreverse children))
+;; )
+;; (mime-entity-set-content-type-internal
+;; entity (make-mime-content-type 'message 'x-broken))
+;; nil)
+;; ))))
+
+;; (defun mime-parse-encapsulated (entity)
+;; (mime-entity-set-children-internal
+;; entity
+;; (with-current-buffer (mime-entity-body-buffer entity)
+;; (save-restriction
+;; (narrow-to-region (mime-entity-body-start-point entity)
+;; (mime-entity-body-end-point entity))
+;; (list (mime-parse-message
+;; (mime-entity-representation-type-internal entity) nil
+;; entity (cons 0 (mime-entity-node-id-internal entity))))
+;; ))))
+
+;; (defun mime-parse-external (entity)
+;; (require 'mmexternal)
+;; (mime-entity-set-children-internal
+;; entity
+;; (with-current-buffer (mime-entity-body-buffer entity)
+;; (save-restriction
+;; (narrow-to-region (mime-entity-body-start-point entity)
+;; (mime-entity-body-end-point entity))
+;; (list (mime-parse-message
+;; 'mime-external-entity nil
+;; entity (cons 0 (mime-entity-node-id-internal entity))))
+;; ;; [tomo] Should we unify with `mime-parse-encapsulated'?
+;; ))))
(defun mime-parse-message (representation-type &optional default-ctl
parent node-id)
If buffer is omitted, it parses current-buffer."
(save-excursion
(if buffer (set-buffer buffer))
- (setq mime-message-structure
- (mime-parse-message (or representation-type
- 'mime-buffer-entity) nil))
- ))
+ (mime-parse-message (or representation-type
+ 'mime-buffer-entity) nil)))
;;; @ end
;;; mime.el --- MIME library module
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
-;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: MIME, multimedia, mail, news
(require 'mime-def)
(require 'eword-decode)
+(eval-when-compile (require 'mmgeneric))
+
(eval-and-compile
(autoload 'eword-encode-header "eword-encode"
(or (mime-entity-children-internal entity)
(luna-send entity 'mime-entity-children entity)))
-(defalias 'mime-entity-node-id 'mime-entity-node-id-internal)
+(defun mime-entity-node-id (entity)
+ (mime-entity-node-id-internal entity))
(defun mime-entity-number (entity)
"Return entity-number of ENTITY."
(reverse (mime-entity-node-id-internal entity)))
-(defun mime-find-entity-from-number (entity-number &optional message)
- "Return entity from ENTITY-NUMBER in MESSAGE.
-If MESSAGE is not specified, `mime-message-structure' is used."
- (or message
- (setq message mime-message-structure))
+(defun mime-find-entity-from-number (entity-number message)
+ "Return entity from ENTITY-NUMBER in MESSAGE."
(let ((sn (car entity-number)))
(if (null sn)
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."
+(defun mime-find-entity-from-node-id (entity-node-id message)
+ "Return entity from ENTITY-NODE-ID in MESSAGE."
(mime-find-entity-from-number (reverse entity-node-id) message))
-(defun mime-find-entity-from-content-id (cid &optional message)
- "Return entity from CID in MESSAGE.
-If MESSAGE is not specified, `mime-message-structure' is used."
- (or message
- (setq message mime-message-structure))
+(defun mime-find-entity-from-content-id (cid message)
+ "Return entity from CID in MESSAGE."
(if (equal cid (mime-entity-read-field message "Content-Id"))
message
(let ((children (mime-entity-children message))
If MESSAGE is specified, it is regarded as root entity."
(null (mime-entity-parent entity message)))
+(defun mime-find-root-entity (entity)
+ "Return root entity of ENTITY."
+ (let ((p (mime-entity-parent entity)))
+ (if (null p)
+ entity
+ (mime-entity-parent p))))
+
-;;; @ Header buffer
+;;; @ Header buffer (obsolete)
;;;
-(luna-define-generic mime-entity-header-buffer (entity))
+;; (luna-define-generic mime-entity-header-buffer (entity))
-(luna-define-generic mime-goto-header-start-point (entity)
- "Set buffer and point to header-start-position of ENTITY.")
+;; (luna-define-generic mime-goto-header-start-point (entity)
+;; "Set buffer and point to header-start-position of ENTITY.")
-(luna-define-generic mime-entity-header-start-point (entity)
- "Return header-start-position of ENTITY.")
+;; (luna-define-generic mime-entity-header-start-point (entity)
+;; "Return header-start-position of ENTITY.")
-(luna-define-generic mime-entity-header-end-point (entity)
- "Return header-end-position of ENTITY.")
+;; (luna-define-generic mime-entity-header-end-point (entity)
+;; "Return header-end-position of ENTITY.")
+;; (make-obsolete 'mime-entity-header-buffer "don't use it.")
+;; (make-obsolete 'mime-goto-header-start-point "don't use it.")
+;; (make-obsolete 'mime-entity-header-start-point "don't use it.")
+;; (make-obsolete 'mime-entity-header-end-point "don't use it.")
-;;; @ Body buffer
+
+;;; @ Body buffer (obsolete)
;;;
-(luna-define-generic mime-entity-body-buffer (entity))
+;; (luna-define-generic mime-entity-body-buffer (entity))
-(luna-define-generic mime-goto-body-start-point (entity)
- "Set buffer and point to body-start-position of ENTITY.")
+;; (luna-define-generic mime-goto-body-start-point (entity)
+;; "Set buffer and point to body-start-position of ENTITY.")
-(luna-define-generic mime-goto-body-end-point (entity)
- "Set buffer and point to body-end-position of ENTITY.")
+;; (luna-define-generic mime-goto-body-end-point (entity)
+;; "Set buffer and point to body-end-position of ENTITY.")
-(luna-define-generic mime-entity-body-start-point (entity)
- "Return body-start-position of ENTITY.")
+;; (luna-define-generic mime-entity-body-start-point (entity)
+;; "Return body-start-position of ENTITY.")
-(define-obsolete-function-alias
- 'mime-entity-body-start 'mime-entity-body-start-point)
+;; (luna-define-generic mime-entity-body-end-point (entity)
+;; "Return body-end-position of ENTITY.")
-(luna-define-generic mime-entity-body-end-point (entity)
- "Return body-end-position of ENTITY.")
+;; (defalias 'mime-entity-body-start 'mime-entity-body-start-point)
+;; (defalias 'mime-entity-body-end 'mime-entity-body-end-point)
-(define-obsolete-function-alias
- 'mime-entity-body-end 'mime-entity-body-end-point)
+;; (make-obsolete 'mime-entity-body-buffer "don't use it.")
+;; (make-obsolete 'mime-goto-body-start-point "don't use it.")
+;; (make-obsolete 'mime-goto-body-end-point "don't use it.")
+;; (make-obsolete 'mime-entity-body-start-point "don't use it.")
+;; (make-obsolete 'mime-entity-body-end-point "don't use it.")
+;; (make-obsolete 'mime-entity-body-start "don't use it.")
+;; (make-obsolete 'mime-entity-body-end "don't use it.")
;;; @ Entity buffer (obsolete)
;;;
-(luna-define-generic mime-entity-buffer (entity))
-(make-obsolete 'mime-entity-buffer
- "use mime-entity-header-buffer or mime-entity-body-buffer instead.")
+;; (luna-define-generic mime-entity-buffer (entity))
+;; (make-obsolete 'mime-entity-buffer "don't use it.")
+
+;; (luna-define-generic mime-entity-point-min (entity))
+;; (make-obsolete 'mime-entity-point-min "don't use it.")
+
+;; (luna-define-generic mime-entity-point-max (entity))
+;; (make-obsolete 'mime-entity-point-max "don't use it.")
+
+
+;;; @ Entity
+;;;
+
+(luna-define-generic mime-insert-entity (entity)
+ "Insert header and body of ENTITY at point.")
+
+(luna-define-generic mime-write-entity (entity filename)
+ "Write header and body of ENTITY into FILENAME.")
+
+
+;;; @ Entity Body
+;;;
+
+(luna-define-generic mime-entity-body (entity)
+ "Return network representation of ENTITY body.")
-(luna-define-generic mime-entity-point-min (entity))
-(make-obsolete 'mime-entity-point-min 'mime-entity-header-start-point)
+(luna-define-generic mime-insert-entity-body (entity)
+ "Insert network representation of ENTITY body at point.")
-(luna-define-generic mime-entity-point-max (entity))
-(make-obsolete 'mime-entity-point-max 'mime-entity-body-end-point)
+(luna-define-generic mime-write-entity-body (entity filename)
+ "Write body of ENTITY into FILENAME.")
-;;; @ Entity Header
+;;; @ Entity Content
+;;;
+
+(luna-define-generic mime-entity-content (entity)
+ "Return content of ENTITY as byte sequence (string).")
+
+(luna-define-generic mime-insert-entity-content (entity)
+ "Insert content of ENTITY at point.")
+
+(luna-define-generic mime-write-entity-content (entity filename)
+ "Write content of ENTITY into FILENAME.")
+
+(luna-define-generic mime-insert-text-content (entity)
+ "Insert decoded text body of ENTITY.")
+
+
+;;; @ Header fields
;;;
(luna-define-generic mime-entity-fetch-field (entity field-name)
"Return the value of the ENTITY's header field whose type is FIELD-NAME.")
-(defun mime-fetch-field (field-name &optional entity)
- "Return the value of the ENTITY's header field whose type is FIELD-NAME."
- (if (symbolp field-name)
- (setq field-name (symbol-name field-name))
- )
- (or entity
- (setq entity mime-message-structure))
- (mime-entity-fetch-field entity field-name)
- )
-(make-obsolete 'mime-fetch-field 'mime-entity-fetch-field)
+;; (defun mime-fetch-field (field-name &optional entity)
+;; "Return the value of the ENTITY's header field whose type is FIELD-NAME."
+;; (if (symbolp field-name)
+;; (setq field-name (symbol-name field-name))
+;; )
+;; (or entity
+;; (setq entity mime-message-structure))
+;; (mime-entity-fetch-field entity field-name)
+;; )
+;; (make-obsolete 'mime-fetch-field 'mime-entity-fetch-field)
(defun mime-entity-content-type (entity)
(or (mime-entity-content-type-internal entity)
(prog1
field-name
(setq field-name (symbol-name field-name)))
- (capitalize (capitalize field-name)))))
+ (intern (capitalize (capitalize field-name))))))
(cond ((eq sym 'Content-Type)
(mime-entity-content-type entity)
)
entity (put-alist sym field header))
field))))))))
-(defun mime-read-field (field-name &optional entity)
- (or entity
- (setq entity mime-message-structure))
- (mime-entity-read-field entity field-name)
- )
-(make-obsolete 'mime-read-field 'mime-entity-read-field)
+;; (defun mime-read-field (field-name &optional entity)
+;; (or entity
+;; (setq entity mime-message-structure))
+;; (mime-entity-read-field entity field-name)
+;; )
+;; (make-obsolete 'mime-read-field 'mime-entity-read-field)
(luna-define-generic mime-insert-header (entity &optional invisible-fields
visible-fields)
(defun mime-entity-uu-filename (entity)
(if (member (mime-entity-encoding entity) mime-uuencode-encoding-name-list)
- (save-excursion
- (mime-goto-body-start-point entity)
- (if (re-search-forward "^begin [0-9]+ "
- (mime-entity-body-end-point entity) t)
+ (with-temp-buffer
+ (mime-insert-entity-body entity)
+ (if (re-search-forward "^begin [0-9]+ " nil t)
(if (looking-at ".+$")
(buffer-substring (match-beginning 0)(match-end 0))
)))))
(mime-type/subtype-string (mime-entity-media-type entity-info)
(mime-entity-media-subtype entity-info)))
+(defun mime-entity-set-content-type (entity content-type)
+ (mime-entity-set-content-type-internal entity content-type))
-;;; @ Entity Content
-;;;
-
-(luna-define-generic mime-entity-content (entity)
- "Return content of ENTITY as byte sequence (string).")
-
-(luna-define-generic mime-insert-entity-content (entity)
- "Insert content of ENTITY at point.")
-
-(luna-define-generic mime-write-entity-content (entity filename)
- "Write content of ENTITY into FILENAME.")
-
-(luna-define-generic mime-insert-text-content (entity)
- "Insert decoded text body of ENTITY.")
-
-(luna-define-generic mime-insert-entity (entity)
- "Insert header and body of ENTITY at point.")
-
-(luna-define-generic mime-write-entity (entity filename)
- "Write header and body of ENTITY into FILENAME.")
-
-(luna-define-generic mime-write-entity-body (entity filename)
- "Write body of ENTITY into FILENAME.")
+(defun mime-entity-set-encoding (entity encoding)
+ (mime-entity-set-encoding-internal entity encoding))
;;; @ end
;;; mmbuffer.el --- MIME entity module for binary buffer
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
-;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: MIME, multimedia, mail, news
;;; Code:
+(require 'mmgeneric)
(require 'mime)
(eval-and-compile
&rest init-args)
(or (mime-buffer-entity-buffer-internal entity)
(mime-buffer-entity-set-buffer-internal
- entity (mime-entity-location-internal entity)))
+ entity (get-buffer (mime-entity-location-internal entity))))
(save-excursion
(set-buffer (mime-buffer-entity-buffer-internal entity))
- (if (mime-root-entity-p entity)
- (setq mime-message-structure entity))
(let ((header-start
(or (mime-buffer-entity-header-start-internal entity)
(mime-buffer-entity-set-header-start-internal
)
-(defun mime-visible-field-p (field-name visible-fields invisible-fields)
- (or (catch 'found
- (while visible-fields
- (let ((regexp (car visible-fields)))
- (if (string-match regexp field-name)
- (throw 'found t)
- ))
- (setq visible-fields (cdr visible-fields))
- ))
- (catch 'found
- (while invisible-fields
- (let ((regexp (car invisible-fields)))
- (if (string-match regexp field-name)
- (throw 'found nil)
- ))
- (setq invisible-fields (cdr invisible-fields))
- )
- t)))
-
-(defun mime-insert-header-from-buffer (buffer start end
- &optional invisible-fields
- visible-fields)
- (let ((the-buf (current-buffer))
- (mode-obj (mime-find-field-presentation-method 'wide))
- field-decoder
- f-b p f-e field-name len field field-body)
- (save-excursion
- (set-buffer buffer)
- (save-restriction
- (narrow-to-region start end)
- (goto-char start)
- (while (re-search-forward std11-field-head-regexp nil t)
- (setq f-b (match-beginning 0)
- p (match-end 0)
- field-name (buffer-substring f-b p)
- len (string-width field-name)
- f-e (std11-field-end))
- (when (mime-visible-field-p field-name
- visible-fields invisible-fields)
- (setq field (intern
- (capitalize (buffer-substring f-b (1- p))))
- field-body (buffer-substring p f-e)
- field-decoder (inline (mime-find-field-decoder-internal
- field mode-obj)))
- (with-current-buffer the-buf
- (insert field-name)
- (insert (if field-decoder
- (funcall field-decoder field-body len)
- ;; Don't decode
- field-body))
- (insert "\n")
- )))))))
+;;; @ entity
+;;;
-(luna-define-method mime-insert-header ((entity mime-buffer-entity)
- &optional invisible-fields
- visible-fields)
- (mime-insert-header-from-buffer
- (mime-buffer-entity-buffer-internal entity)
- (mime-buffer-entity-header-start-internal entity)
- (mime-buffer-entity-header-end-internal entity)
- invisible-fields visible-fields)
+(luna-define-method mime-insert-entity ((entity mime-buffer-entity))
+ (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
+ (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))
)
+(luna-define-method mime-write-entity ((entity mime-buffer-entity) filename)
+ (save-excursion
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (write-region-as-raw-text-CRLF
+ (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity)
+ filename)
+ ))
+
+
+;;; @ entity header
+;;;
+
+
+;;; @ entity body
+;;;
+
+(luna-define-method mime-entity-body ((entity mime-buffer-entity))
+ (save-excursion
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (buffer-substring (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))))
+
+(luna-define-method mime-insert-entity-body ((entity mime-buffer-entity))
+ (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
+ (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))
+ )
+
+(luna-define-method mime-write-entity-body ((entity mime-buffer-entity)
+ filename)
+ (save-excursion
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (write-region-as-binary (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity)
+ filename)
+ ))
+
+
+;;; @ entity content
+;;;
+
(luna-define-method mime-entity-content ((entity mime-buffer-entity))
(save-excursion
(set-buffer (mime-buffer-entity-buffer-internal entity))
(mime-buffer-entity-body-end-internal entity))
(mime-entity-encoding entity))))
+(luna-define-method mime-insert-entity-content ((entity mime-buffer-entity))
+ (insert (with-current-buffer (mime-buffer-entity-buffer-internal entity)
+ (mime-decode-string
+ (buffer-substring (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))
+ (mime-entity-encoding entity)))))
+
+(luna-define-method mime-write-entity-content ((entity mime-buffer-entity)
+ filename)
+ (save-excursion
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity)
+ filename
+ (or (mime-entity-encoding entity) "7bit"))
+ ))
+
+
+;;; @ header field
+;;;
+
(luna-define-method mime-entity-fetch-field :around
((entity mime-buffer-entity) field-name)
(or (luna-call-next-method)
(mime-entity-original-header-internal entity)))
ret))))))
-(mm-define-method insert-entity-content ((entity buffer))
- (insert (with-current-buffer (mime-buffer-entity-buffer-internal entity)
- (mime-decode-string
- (buffer-substring (mime-buffer-entity-body-start-internal entity)
- (mime-buffer-entity-body-end-internal entity))
- (mime-entity-encoding entity)))))
-
-(mm-define-method write-entity-content ((entity buffer) filename)
- (save-excursion
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity)
- (mime-buffer-entity-body-end-internal entity)
- filename
- (or (mime-entity-encoding entity) "7bit"))
- ))
-
-(mm-define-method insert-entity ((entity buffer))
- (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
- (mime-buffer-entity-header-start-internal entity)
- (mime-buffer-entity-body-end-internal entity))
+(luna-define-method mime-insert-header ((entity mime-buffer-entity)
+ &optional invisible-fields
+ visible-fields)
+ (mime-insert-header-from-buffer
+ (mime-buffer-entity-buffer-internal entity)
+ (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-header-end-internal entity)
+ invisible-fields visible-fields)
)
-(mm-define-method write-entity ((entity buffer) filename)
- (save-excursion
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (write-region-as-raw-text-CRLF
- (mime-buffer-entity-header-start-internal entity)
- (mime-buffer-entity-body-end-internal entity)
- filename)
- ))
-
-(mm-define-method write-entity-body ((entity buffer) filename)
- (save-excursion
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (write-region-as-binary (mime-buffer-entity-body-start-internal entity)
- (mime-buffer-entity-body-end-internal entity)
- filename)
- ))
-
;;; @ header buffer
;;;
-(luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity))
- (mime-buffer-entity-buffer-internal entity)
- )
+;; (luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity))
+;; (mime-buffer-entity-buffer-internal entity)
+;; )
-(luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity))
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (goto-char (mime-buffer-entity-header-start-internal entity))
- )
+;; (luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity))
+;; (set-buffer (mime-buffer-entity-buffer-internal entity))
+;; (goto-char (mime-buffer-entity-header-start-internal entity))
+;; )
-(luna-define-method mime-entity-header-start-point ((entity
- mime-buffer-entity))
- (mime-buffer-entity-header-start-internal entity)
- )
+;; (luna-define-method mime-entity-header-start-point ((entity
+;; mime-buffer-entity))
+;; (mime-buffer-entity-header-start-internal entity)
+;; )
-(luna-define-method mime-entity-header-end-point ((entity
- mime-buffer-entity))
- (mime-buffer-entity-header-end-internal entity)
- )
+;; (luna-define-method mime-entity-header-end-point ((entity
+;; mime-buffer-entity))
+;; (mime-buffer-entity-header-end-internal entity)
+;; )
;;; @ body buffer
;;;
-(luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity))
- (mime-buffer-entity-buffer-internal entity)
- )
+;; (luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity))
+;; (mime-buffer-entity-buffer-internal entity)
+;; )
-(luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity))
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (goto-char (mime-buffer-entity-body-start-internal entity))
- )
+;; (luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity))
+;; (set-buffer (mime-buffer-entity-buffer-internal entity))
+;; (goto-char (mime-buffer-entity-body-start-internal entity))
+;; )
-(luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity))
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (goto-char (mime-buffer-entity-body-end-internal entity))
- )
+;; (luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity))
+;; (set-buffer (mime-buffer-entity-buffer-internal entity))
+;; (goto-char (mime-buffer-entity-body-end-internal entity))
+;; )
-(luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity))
- (mime-buffer-entity-body-start-internal entity)
- )
+;; (luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity))
+;; (mime-buffer-entity-body-start-internal entity)
+;; )
-(luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity))
- (mime-buffer-entity-body-end-internal entity)
- )
+;; (luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity))
+;; (mime-buffer-entity-body-end-internal entity)
+;; )
;;; @ buffer (obsolete)
;;;
-(luna-define-method mime-entity-buffer ((entity mime-buffer-entity))
- (mime-buffer-entity-buffer-internal entity)
- )
+;; (luna-define-method mime-entity-buffer ((entity mime-buffer-entity))
+;; (mime-buffer-entity-buffer-internal entity)
+;; )
-(luna-define-method mime-entity-point-min ((entity mime-buffer-entity))
- (mime-buffer-entity-header-start-internal entity)
- )
+;; (luna-define-method mime-entity-point-min ((entity mime-buffer-entity))
+;; (mime-buffer-entity-header-start-internal entity)
+;; )
-(luna-define-method mime-entity-point-max ((entity mime-buffer-entity))
- (mime-buffer-entity-body-end-internal entity)
- )
+;; (luna-define-method mime-entity-point-max ((entity mime-buffer-entity))
+;; (mime-buffer-entity-body-end-internal entity)
+;; )
+
+
+;;; @ children
+;;;
+
+(defun mmbuffer-parse-multipart (entity)
+ (with-current-buffer (mime-buffer-entity-buffer-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)))
+ (close-delimiter (concat delimiter "--[ \t]*$"))
+ (rsep (concat delimiter "[ \t]*\n"))
+ (dc-ctl
+ (if (eq (mime-content-type-subtype content-type) 'digest)
+ (make-mime-content-type 'message 'rfc822)
+ (make-mime-content-type 'text 'plain)
+ ))
+ (body-start (mime-buffer-entity-body-start-internal entity))
+ (body-end (mime-buffer-entity-body-end-internal entity)))
+ (save-restriction
+ (goto-char body-end)
+ (narrow-to-region body-start
+ (if (re-search-backward close-delimiter nil t)
+ (match-beginning 0)
+ body-end))
+ (goto-char body-start)
+ (if (re-search-forward
+ (concat "^" (regexp-quote dash-boundary) "[ \t]*\n")
+ 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 representation-type dc-ctl
+ entity (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 representation-type dc-ctl
+ entity (cons i node-id)))
+ )
+ (setq children (cons ret children))
+ (mime-entity-set-children-internal entity (nreverse children))
+ )
+ (mime-entity-set-content-type-internal
+ entity (make-mime-content-type 'message 'x-broken))
+ nil)
+ ))))
+
+(defun mmbuffer-parse-encapsulated (entity &optional external)
+ (mime-entity-set-children-internal
+ entity
+ (with-current-buffer (mime-buffer-entity-buffer-internal entity)
+ (save-restriction
+ (narrow-to-region (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))
+ (list (mime-parse-message
+ (if external
+ (progn
+ (require 'mmexternal)
+ 'mime-external-entity)
+ (mime-entity-representation-type-internal entity))
+ nil
+ entity (cons 0 (mime-entity-node-id-internal entity))))))))
+
+(luna-define-method mime-entity-children ((entity mime-buffer-entity))
+ (let* ((content-type (mime-entity-content-type entity))
+ (primary-type (mime-content-type-primary-type content-type))
+ sub-type)
+ (cond ((eq primary-type 'multipart)
+ (mmbuffer-parse-multipart entity))
+ ((eq primary-type 'message)
+ (setq sub-type (mime-content-type-subtype content-type))
+ (cond ((eq sub-type 'external-body)
+ (mmbuffer-parse-encapsulated entity 'external))
+ ((memq sub-type '(rfc822 news))
+ (mmbuffer-parse-encapsulated entity)))))))
;;; @ end
;;; mmdual.el --- MIME entity module for dual buffers
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
-;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: MIME, multimedia, mail, news
(luna-define-method initialize-instance :after ((entity mime-dual-entity)
&rest init-args)
- (let (buf)
- (setq buf (mime-dual-entity-header-buffer-internal entity))
+ (let ((buf (mime-dual-entity-header-buffer-internal entity)))
(if buf
(with-current-buffer buf
- (if (mime-root-entity-p entity)
- (setq mime-message-structure entity))
(or (mime-entity-content-type-internal entity)
(mime-entity-set-content-type-internal
entity
(let ((str (std11-fetch-field "Content-Type")))
(if str
(mime-parse-Content-Type str)
- ))))))
- (setq buf (mime-dual-entity-body-buffer-internal entity))
- (if buf
- (with-current-buffer buf
- (if (mime-root-entity-p entity)
- (setq mime-message-structure entity))))
- ) entity)
+ )))))))
+ entity)
(luna-define-method mime-entity-name ((entity mime-dual-entity))
(buffer-name (mime-dual-entity-header-buffer-internal entity))
)
-(defun mime-visible-field-p (field-name visible-fields invisible-fields)
- (or (catch 'found
- (while visible-fields
- (let ((regexp (car visible-fields)))
- (if (string-match regexp field-name)
- (throw 'found t)
- ))
- (setq visible-fields (cdr visible-fields))
- ))
- (catch 'found
- (while invisible-fields
- (let ((regexp (car invisible-fields)))
- (if (string-match regexp field-name)
- (throw 'found nil)
- ))
- (setq invisible-fields (cdr invisible-fields))
- )
- t)))
-
-(defun mime-insert-header-from-buffer (buffer start end
- &optional invisible-fields
- visible-fields)
- (let ((the-buf (current-buffer))
- (mode-obj (mime-find-field-presentation-method 'wide))
- field-decoder
- f-b p f-e field-name len field field-body)
- (save-excursion
- (set-buffer buffer)
- (save-restriction
- (narrow-to-region start end)
- (goto-char start)
- (while (re-search-forward std11-field-head-regexp nil t)
- (setq f-b (match-beginning 0)
- p (match-end 0)
- field-name (buffer-substring f-b p)
- len (string-width field-name)
- f-e (std11-field-end))
- (when (mime-visible-field-p field-name
- visible-fields invisible-fields)
- (setq field (intern
- (capitalize (buffer-substring f-b (1- p))))
- field-body (buffer-substring p f-e)
- field-decoder (inline (mime-find-field-decoder-internal
- field mode-obj)))
- (with-current-buffer the-buf
- (insert field-name)
- (insert (if field-decoder
- (funcall field-decoder field-body len)
- ;; Don't decode
- field-body))
- (insert "\n")
- )))))))
-
(luna-define-method mime-insert-header ((entity mime-dual-entity)
&optional invisible-fields
visible-fields)
--- /dev/null
+;;; mmexternal.el --- MIME entity module for external buffer
+
+;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; 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)
+(require 'pces)
+
+(eval-and-compile
+ (luna-define-class mime-external-entity (mime-entity)
+ (body-buffer
+ body-file))
+ (luna-define-internal-accessors 'mime-external-entity)
+
+ ;; In an external entity, information of media-type or other
+ ;; information which are represented in a header in a non-external
+ ;; entity are in the body of the parent entity.
+ )
+
+(luna-define-method mime-entity-name ((entity mime-external-entity))
+ (concat "child of "
+ (mime-entity-name
+ (mime-entity-parent-internal entity))))
+
+
+(defun mmexternal-require-file-name (entity)
+ (condition-case nil
+ (or (mime-external-entity-body-file-internal entity)
+ (let* ((ct (mime-entity-content-type
+ (mime-entity-parent-internal entity)))
+ (access-type
+ (mime-content-type-parameter ct "access-type")))
+ (if (and access-type
+ (string= access-type "anon-ftp"))
+ (let ((site (mime-content-type-parameter ct "site"))
+ (directory
+ (mime-content-type-parameter ct "directory"))
+ (name (mime-content-type-parameter ct "name")))
+ (mime-external-entity-set-body-file-internal
+ entity
+ (expand-file-name
+ name
+ (concat "/anonymous@" site ":"
+ (file-name-as-directory directory))))))))
+ (error (message "Can't make file-name of external-body."))))
+
+(defun mmexternal-require-buffer (entity)
+ (unless (and (mime-external-entity-body-buffer-internal entity)
+ (buffer-live-p
+ (mime-external-entity-body-buffer-internal entity)))
+ (condition-case nil
+ (progn
+ (mmexternal-require-file-name entity)
+ (mime-external-entity-set-body-buffer-internal
+ entity
+ (with-current-buffer (get-buffer-create
+ (concat " *Body of "
+ (mime-entity-name entity)
+ "*"))
+ (insert-file-contents-as-binary
+ (mime-external-entity-body-file-internal entity))
+ (current-buffer))))
+ (error (message "Can't get external-body.")))))
+
+
+;;; @ entity
+;;;
+
+(luna-define-method mime-insert-entity ((entity mime-external-entity))
+ (mime-insert-entity-body (mime-entity-parent-internal entity))
+ (insert "\n")
+ (mime-insert-entity-body entity))
+
+(luna-define-method mime-write-entity ((entity mime-external-entity) filename)
+ (with-temp-buffer
+ (mime-insert-entity entity)
+ (write-region-as-raw-text-CRLF (point-min) (point-max) filename)))
+
+
+;;; @ entity header
+;;;
+
+
+;;; @ entity body
+;;;
+
+(luna-define-method mime-entity-body ((entity mime-external-entity))
+ (mmexternal-require-buffer entity)
+ (with-current-buffer (mime-external-entity-body-buffer-internal entity)
+ (buffer-string)))
+
+(luna-define-method mime-insert-entity-body ((entity mime-external-entity))
+ (mmexternal-require-buffer entity)
+ (insert-buffer-substring
+ (mime-external-entity-body-buffer-internal entity)))
+
+(luna-define-method mime-write-entity-body ((entity mime-external-entity)
+ filename)
+ (mmexternal-require-buffer entity)
+ (with-current-buffer (mime-external-entity-body-buffer-internal entity)
+ (write-region-as-binary (point-min) (point-max) filename)))
+
+
+;;; @ entity content
+;;;
+
+(luna-define-method mime-entity-content ((entity mime-external-entity))
+ (let ((ret (mime-entity-body entity)))
+ (if ret
+ (mime-decode-string ret (mime-entity-encoding entity))
+ (message "Cannot get content")
+ nil)))
+
+(luna-define-method mime-insert-entity-content ((entity mime-external-entity))
+ (insert (mime-entity-content entity)))
+
+(luna-define-method mime-write-entity-content ((entity mime-external-entity)
+ filename)
+ (mmexternal-require-buffer entity)
+ (with-current-buffer (mime-external-entity-body-buffer-internal entity)
+ (mime-write-decoded-region (point-min) (point-max)
+ filename
+ (or (mime-entity-encoding entity) "7bit"))))
+
+
+;;; @ header field
+;;;
+
+(luna-define-method mime-entity-fetch-field :around
+ ((entity mime-external-entity) field-name)
+ (or (luna-call-next-method)
+ (with-temp-buffer
+ (mime-insert-entity-body (mime-entity-parent-internal entity))
+ (let ((ret (std11-fetch-field field-name)))
+ (when ret
+ (or (symbolp field-name)
+ (setq field-name
+ (intern (capitalize (capitalize field-name)))))
+ (mime-entity-set-original-header-internal
+ entity
+ (put-alist field-name ret
+ (mime-entity-original-header-internal entity)))
+ ret)))))
+
+(luna-define-method mime-insert-header ((entity mime-external-entity)
+ &optional invisible-fields
+ visible-fields)
+ (let ((the-buf (current-buffer))
+ buf p-min p-max)
+ (with-temp-buffer
+ (mime-insert-entity-body (mime-entity-parent-internal entity))
+ (setq buf (current-buffer)
+ p-min (point-min)
+ p-max (point-max))
+ (set-buffer the-buf)
+ (mime-insert-header-from-buffer buf p-min p-max
+ invisible-fields visible-fields))))
+
+
+;;; @ end
+;;;
+
+(provide 'mmexternal)
+
+;;; mmexternal.el ends here
--- /dev/null
+;;; mmgeneric.el --- MIME generic entity module
+
+;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; Keywords: definition, 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 'luna)
+
+
+;;; @ MIME entity
+;;;
+
+(autoload 'mime-entity-content-type "mime")
+(autoload 'mime-parse-multipart "mime-parse")
+(autoload 'mime-parse-message "mime-parse")
+;; (autoload 'mime-parse-encapsulated "mime-parse")
+;; (autoload 'mime-parse-external "mime-parse")
+(autoload 'mime-entity-content "mime")
+
+(eval-and-compile
+ (luna-define-class mime-entity ()
+ (location
+ content-type children parent
+ node-id
+ content-disposition encoding
+ ;; for other fields
+ original-header parsed-header))
+
+ (luna-define-internal-accessors 'mime-entity)
+ )
+
+(defalias 'mime-entity-representation-type-internal 'luna-class-name)
+(defalias 'mime-entity-set-representation-type-internal 'luna-set-class-name)
+
+(luna-define-method mime-entity-fetch-field ((entity mime-entity)
+ field-name)
+ (or (symbolp field-name)
+ (setq field-name (intern (capitalize (capitalize field-name)))))
+ (cdr (assq field-name
+ (mime-entity-original-header-internal entity))))
+
+(luna-define-method mime-insert-text-content ((entity mime-entity))
+ (insert
+ (decode-mime-charset-string (mime-entity-content entity)
+ (or (mime-content-type-parameter
+ (mime-entity-content-type entity)
+ "charset")
+ default-mime-charset)
+ 'CRLF)
+ ))
+
+
+;;; @ for mm-backend
+;;;
+
+(defmacro mm-expand-class-name (type)
+ `(intern (format "mime-%s-entity" ,type)))
+
+(defmacro mm-define-backend (type &optional parents)
+ `(luna-define-class ,(mm-expand-class-name type)
+ ,(nconc (mapcar (lambda (parent)
+ (mm-expand-class-name parent)
+ )
+ parents)
+ '(mime-entity))))
+
+(defmacro mm-define-method (name args &rest body)
+ (or (eq name 'initialize-instance)
+ (setq name (intern (format "mime-%s" name))))
+ (let ((spec (car args)))
+ (setq args
+ (cons (list (car spec)
+ (mm-expand-class-name (nth 1 spec)))
+ (cdr args)))
+ `(luna-define-method ,name ,args ,@body)
+ ))
+
+(put 'mm-define-method 'lisp-indent-function 'defun)
+
+(def-edebug-spec mm-define-method
+ (&define name ((arg symbolp)
+ [&rest arg]
+ [&optional ["&optional" arg &rest arg]]
+ &optional ["&rest" arg]
+ )
+ def-body))
+
+
+;;; @ header filter
+;;;
+
+;; [tomo] We should think about specification of better filtering
+;; mechanism. Please discuss in the emacs-mime mailing lists.
+
+(defun mime-visible-field-p (field-name visible-fields invisible-fields)
+ (or (catch 'found
+ (while visible-fields
+ (let ((regexp (car visible-fields)))
+ (if (string-match regexp field-name)
+ (throw 'found t)
+ ))
+ (setq visible-fields (cdr visible-fields))
+ ))
+ (catch 'found
+ (while invisible-fields
+ (let ((regexp (car invisible-fields)))
+ (if (string-match regexp field-name)
+ (throw 'found nil)
+ ))
+ (setq invisible-fields (cdr invisible-fields))
+ )
+ t)))
+
+(defun mime-insert-header-from-buffer (buffer start end
+ &optional invisible-fields
+ visible-fields)
+ (let ((the-buf (current-buffer))
+ (mode-obj (mime-find-field-presentation-method 'wide))
+ field-decoder
+ f-b p f-e field-name len field field-body)
+ (save-excursion
+ (set-buffer buffer)
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (while (re-search-forward std11-field-head-regexp nil t)
+ (setq f-b (match-beginning 0)
+ p (match-end 0)
+ field-name (buffer-substring f-b p)
+ len (string-width field-name)
+ f-e (std11-field-end))
+ (when (mime-visible-field-p field-name
+ visible-fields invisible-fields)
+ (setq field (intern
+ (capitalize (buffer-substring f-b (1- p))))
+ field-body (buffer-substring p f-e)
+ field-decoder (inline (mime-find-field-decoder-internal
+ field mode-obj)))
+ (with-current-buffer the-buf
+ (insert field-name)
+ (insert (if field-decoder
+ (funcall field-decoder field-body len)
+ ;; Don't decode
+ field-body))
+ (insert "\n")
+ )))))))
+
+
+;;; @ end
+;;;
+
+(provide 'mmgeneric)
+
+;;; mmgeneric.el ends here
"Return string of address part from parsed ADDRESS of RFC 822."
(cond ((eq (car address) 'group)
(mapconcat (function std11-address-string)
- (car (cdr address))
+ (nth 2 address)
", ")
)
((eq (car address) 'mailbox)
projects / elisp / flim.git / commitdiff