From 1ecae8a67b185ceb2201ab5af799208455b13e63 Mon Sep 17 00:00:00 2001 From: tomo Date: Wed, 25 Oct 2000 03:52:46 +0000 Subject: [PATCH] Merge chao-1_14_1-1. --- ChangeLog | 233 +++++++++++++++++++++++++++++++++--- FLIM-ELS | 3 +- Makefile | 11 +- VERSION | 3 + eword-encode.el | 29 ++++- ftp.in | 18 ++- luna.el | 73 +++++++----- mime-def.el | 107 ++--------------- mime-en.sgml | 1 - mime-parse.el | 158 ++++++++++++------------ mime.el | 211 +++++++++++++++++++-------------- mmbuffer.el | 356 +++++++++++++++++++++++++++++++++---------------------- mmdbuffer.el | 71 +---------- mmexternal.el | 186 +++++++++++++++++++++++++++++ mmgeneric.el | 174 +++++++++++++++++++++++++++ std11.el | 2 +- 16 files changed, 1093 insertions(+), 543 deletions(-) create mode 100644 mmexternal.el create mode 100644 mmgeneric.el diff --git a/ChangeLog b/ChangeLog index d591c14..5726824 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,12 +1,196 @@ +2000-08-28 Yuuichi Teranishi + + * 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 + + * 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. + + +2000-07-12 MORIOKA Tomohiko + + * FLIM-Chao: Version 1.14.1 (Rokujiz-Dò) released.-A + +2000-07-10 MORIOKA Tomohiko + + * mmexternal.el (initialize-instance): Deleted. + (mmexternal-require-file-name): New function. + (mmexternal-require-buffer): Use `mmexternal-require-file-name'. + +2000-06-30 MORIOKA Tomohiko + + * mime.el (mime-entity-read-field): Fix a bug when FIELD-NAME is a + string. + +2000-06-23 MORIOKA Tomohiko + + * 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 + + * 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 + + * 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 + + * eword-encode.el (eword-charset-encoding-alist): Add + `iso-2022-jp-3'. + 2000-05-25 Tanaka Akira * mime-en.sgml, mime-ja.sgml: Update for CVS via SSH. - + 2000-05-09 Katsumi Yamaoka * smtp.el (smtp-deduce-address-list): Set `case-fold-search' to `t' in the working buffer. +2000-04-26 Yoshiki Hayashi + + * mime.el (mime-entity-body): New function. + * mmbuffer.el (mime-entity-body): Implement it. + +2000-03-03 Keiichi Suzuki + + * mime.el (mime-entity-node-id): Change to function. + +2000-03-03 MORIOKA Tomohiko + + * 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 + + * 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 + + * 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 + + * 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 + + * 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'. + + +2000-03-01 MORIOKA Tomohiko + + * Chao: Version 1.14.0 (Momoyama) released. + 2000-01-05 Katsumi Yamaoka * Makefile, mime-en.sgml, mime-ja.sgml: Update for the new CVS @@ -20,10 +204,21 @@ (base64-internal-encode-region): Likewise. (base64-encode-string): Likewise. +1999-12-16 MORIOKA Tomohiko + + * 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 - * 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 @@ -442,7 +637,7 @@ 1999-05-31 MORIOKA Tomohiko - * FLIM: Version 1.12.7 (Y-Dþzaki)-A released. + * FLIM: Version 1.12.7 (Y-Dþzaki) released.-A 1999-05-31 MORIOKA Tomohiko @@ -617,7 +812,7 @@ 1999-05-11 MORIOKA Tomohiko - * FLIM: Version 1.12.6 (Family-K-Dòenmae)-A released. + * FLIM: Version 1.12.6 (Family-K-Dòenmae) released.-A 1999-04-27 Shuhei KOBAYASHI @@ -734,7 +929,7 @@ 1999-01-23 MORIOKA Tomohiko - * FLIM: Version 1.12.3 (Kintetsu-K-Dòriyama)-A released. + * FLIM: Version 1.12.3 (Kintetsu-K-Dòriyama) released.-A 1999-01-23 MORIOKA Tomohiko @@ -777,7 +972,7 @@ 1999-01-21 MORIOKA Tomohiko - * FLIM: Version 1.12.2 (Kuj-Dò)-A released. + * FLIM: Version 1.12.2 (Kuj-Dò) released.-A 1999-01-16 MORIOKA Tomohiko @@ -963,7 +1158,7 @@ 1998-12-02 MORIOKA Tomohiko - * FLIM: Version 1.12.1 (Nishinoky-Dò)-A released. + * FLIM: Version 1.12.1 (Nishinoky-Dò) released.-A 1998-11-30 MORIOKA Tomohiko @@ -1181,7 +1376,7 @@ 1998-10-26 MORIOKA Tomohiko - * FLIM: Version 1.11.2 (Heij-Dò)-A was released. + * FLIM: Version 1.11.2 (Heij-Dò) was released.-A * NEWS (Abolish variable `mime-temp-directory'): New subsection. @@ -1461,7 +1656,7 @@ 1998-10-12 MORIOKA Tomohiko - * FLIM: Version 1.10.4 (Shin-H-Dòsono)-A was released. + * FLIM: Version 1.10.4 (Shin-H-Dòsono) was released.-A 1998-10-12 Katsumi Yamaoka @@ -1646,7 +1841,7 @@ 1998-09-29 MORIOKA Tomohiko - * FLIM: Version 1.10.0 (K-Dòdo)-A was released. + * FLIM: Version 1.10.0 (K-Dòdo) was released.-A * README.en (What's FLIM): Add mel-ccl.el. @@ -1933,7 +2128,7 @@ 1998-08-31 MORIOKA Tomohiko - * FLIM: Version 1.9.1 (Tonosh-Dò)-A was released. + * FLIM: Version 1.9.1 (Tonosh-Dò) was released.-A * mime-en.sgml (mm-backend): Translate a little. @@ -2076,7 +2271,7 @@ 1998-07-07 MORIOKA Tomohiko - * FLIM-Chao: Version 1.8.0 (Shij-Dò)-A was released. + * FLIM-Chao: Version 1.8.0 (Shij-Dò) was released.-A 1998-07-07 MORIOKA Tomohiko @@ -2188,7 +2383,7 @@ 1998-07-01 MORIOKA Tomohiko - * FLIM: Version 1.8.0 (-DÒkubo)-A was released. + * FLIM: Version 1.8.0 (-DÒkubo) was released.-A * README.en: Delete `How to use'. @@ -2313,7 +2508,7 @@ 1998-06-28 MORIOKA Tomohiko - * FLIM-Chao: Version 1.7.0 (Goj-Dò)-A was released. + * FLIM-Chao: Version 1.7.0 (Goj-Dò) was released.-A 1998-06-26 MORIOKA Tomohiko @@ -2572,7 +2767,7 @@ 1998-06-19 MORIOKA Tomohiko - * FLIM: Version 1.4.1 (Momoyama-Gory-Dòmae)-A was released. + * FLIM: Version 1.4.1 (Momoyama-Gory-Dòmae) was released.-A 1998-06-18 MORIOKA Tomohiko @@ -2692,7 +2887,7 @@ 1998-05-06 MORIOKA Tomohiko - * FLIM: Version 1.2.0 (J-Dþjò)-A was released. + * FLIM: Version 1.2.0 (J-Dþjò) was released.-A * README.en (What's FLIM): Delete description about std11-parse.el; add description about mailcap.el. @@ -2743,7 +2938,7 @@ 1998-05-05 MORIOKA Tomohiko - * FLIM: Version 1.1.0 (T-Dòji)-A was released. + * FLIM: Version 1.1.0 (T-Dòji) was released.-A 1998-05-04 MORIOKA Tomohiko @@ -2779,7 +2974,7 @@ 1998-04-17 MORIOKA Tomohiko - * FLIM: Version 1.0.1 (Ky-Dòto)-A was released. + * FLIM: Version 1.0.1 (Ky-Dòto) was released.-A * mime-def.el (mime-spadework-module-version-string): New constant. diff --git a/FLIM-ELS b/FLIM-ELS index 1d8ebf6..775bb54 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -8,7 +8,8 @@ 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)) diff --git a/Makefile b/Makefile index 9d899e4..2bd0536 100644 --- a/Makefile +++ b/Makefile @@ -2,9 +2,9 @@ # Makefile for FLIM. # -PACKAGE = flim -API = 1.13 -RELEASE = 2 +PACKAGE = flim-chao +API = 1.14 +RELEASE = 1 TAR = tar RM = /bin/rm -f @@ -25,8 +25,9 @@ GOMI = *.elc \ 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) \ diff --git a/VERSION b/VERSION index 173b421..4e453c7 100644 --- a/VERSION +++ b/VERSION @@ -87,3 +87,6 @@ 1.12.1 T-Dòfukuji-A $(BElJ!;{(B ; <=> $(B5~:e(B 1.12.2 Inari $(B0p2Y(B 1.13.0 JR Fujinomori JR $(BF#?9(B +1.14.0 Momoyama $(BEm;3(B +1.14.1 Rokujiz-Dò-A $(BO;COB"(B +------ Kohata $(BLZH((B diff --git a/eword-encode.el b/eword-encode.el index 4f45c6f..f7111c1 100644 --- a/eword-encode.el +++ b/eword-encode.el @@ -77,6 +77,7 @@ If method is nil, this field will not be encoded." (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") @@ -516,17 +517,37 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is ))) 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) diff --git a/ftp.in b/ftp.in index 1d17d2a..391fb8a 100644 --- a/ftp.in +++ b/ftp.in @@ -2,18 +2,14 @@ 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; diff --git a/luna.el b/luna.el index e66d265..48da490 100644 --- a/luna.el +++ b/luna.el @@ -1,7 +1,6 @@ ;;; 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 ;; Keywords: OOP @@ -36,6 +35,10 @@ (defconst :after ':after) (defconst :around ':around))) + +;;; @ class +;;; + (defmacro luna-find-class (name) "Return the luna-class of the given NAME." `(get ,name 'luna-class)) @@ -116,18 +119,6 @@ If SLOTS is specified, TYPE will be defined to have them." (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. @@ -208,6 +199,35 @@ BODY is the body of method." (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)) @@ -251,19 +271,6 @@ LUNA-CURRENT-METHOD-ARGUMENTS is arguments of the MESSAGE." 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. @@ -275,6 +282,10 @@ It must be plist and each slot name must have prefix `:'." (apply #'luna-send v 'initialize-instance v init-args) )) + +;;; @ interface (generic function) +;;; + (defsubst luna-arglist-to-arguments (arglist) (let (dest) (while arglist @@ -301,6 +312,10 @@ ARGS is argument of and DOC is DOC-string." (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)) @@ -336,6 +351,10 @@ ARGS is argument of and DOC is DOC-string." ))) (luna-class-obarray entity-class)))) + +;;; @ standard object +;;; + (luna-define-class-function 'standard-object) (luna-define-method initialize-instance ((entity standard-object) diff --git a/mime-def.el b/mime-def.el index 276dadd..6c55e6b 100644 --- a/mime-def.el +++ b/mime-def.el @@ -1,8 +1,6 @@ -;;; 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 ;; Keywords: definition, MIME, multimedia, mail, news @@ -32,12 +30,14 @@ (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)) @@ -207,97 +207,6 @@ (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 ;;; diff --git a/mime-en.sgml b/mime-en.sgml index 746c987..4e8dcad 100644 --- a/mime-en.sgml +++ b/mime-en.sgml @@ -1358,7 +1358,6 @@ cvsroot $B$O(B :ext:cvs@cvs.m17n.org:/cvs/root $B$H$J$j$^$9!#(B $B$3$N>l9g!"(BUNIX $B$N(B /etc/passwd $BMM<0$G0E9f2=$5$l$?%Q%9%o!<%I$rAw$C$F2<$5$$!#(B $B$3$N>l9g(B cvsroot $B$O(B :pserver:<$B%"%+%&%s%HL>(B>@cvs.m17n.org:/cvs/root $B$H$J$j$^$9!#(B -

History of FLIM History

diff --git a/mime-parse.el b/mime-parse.el index 5442896..4aeb30c 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -216,75 +216,89 @@ If is is not found, return DEFAULT-ENCODING." ;;; @ 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) @@ -331,10 +345,8 @@ If is is not found, return DEFAULT-ENCODING." 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 diff --git a/mime.el b/mime.el index 63af880..328d599 100644 --- a/mime.el +++ b/mime.el @@ -1,8 +1,6 @@ ;;; 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 ;; Keywords: MIME, multimedia, mail, news @@ -31,6 +29,8 @@ (require 'mime-def) (require 'eword-decode) +(eval-when-compile (require 'mmgeneric)) + (eval-and-compile (autoload 'eword-encode-header "eword-encode" @@ -90,17 +90,15 @@ representation-type." (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 @@ -110,16 +108,12 @@ If MESSAGE is not specified, `mime-message-structure' is used." )) ))) -(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)) @@ -142,76 +136,131 @@ If MESSAGE is specified, it is regarded as root entity." 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) @@ -272,7 +321,7 @@ If MESSAGE is specified, it is regarded as root 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) ) @@ -301,12 +350,12 @@ If MESSAGE is specified, it is regarded as root 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) @@ -321,10 +370,9 @@ If MESSAGE is specified, it is regarded as root entity." (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)) ))))) @@ -351,30 +399,11 @@ If MESSAGE is specified, it is regarded as root entity." (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 diff --git a/mmbuffer.el b/mmbuffer.el index f014aec..97fc783 100644 --- a/mmbuffer.el +++ b/mmbuffer.el @@ -1,8 +1,6 @@ ;;; 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 ;; Keywords: MIME, multimedia, mail, news @@ -26,6 +24,7 @@ ;;; Code: +(require 'mmgeneric) (require 'mime) (eval-and-compile @@ -43,11 +42,9 @@ &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 @@ -87,69 +84,57 @@ ) -(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)) @@ -158,6 +143,27 @@ (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) @@ -177,109 +183,171 @@ (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 diff --git a/mmdbuffer.el b/mmdbuffer.el index 637eab3..5a1ae20 100644 --- a/mmdbuffer.el +++ b/mmdbuffer.el @@ -1,8 +1,6 @@ ;;; 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 ;; Keywords: MIME, multimedia, mail, news @@ -38,84 +36,23 @@ (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) diff --git a/mmexternal.el b/mmexternal.el new file mode 100644 index 0000000..04e5649 --- /dev/null +++ b/mmexternal.el @@ -0,0 +1,186 @@ +;;; mmexternal.el --- MIME entity module for external buffer + +;; Copyright (C) 1998,1999,2000 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) +(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 diff --git a/mmgeneric.el b/mmgeneric.el new file mode 100644 index 0000000..5bd9686 --- /dev/null +++ b/mmgeneric.el @@ -0,0 +1,174 @@ +;;; mmgeneric.el --- MIME generic entity module + +;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; 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 diff --git a/std11.el b/std11.el index 982b895..dc7bde5 100644 --- a/std11.el +++ b/std11.el @@ -765,7 +765,7 @@ represents addr-spec of RFC 822." "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) -- 1.7.10.4