From 09986cc02a99ec95288aef3f2e890426ae252b54 Mon Sep 17 00:00:00 2001 From: morioka Date: Thu, 16 Dec 1999 09:13:36 +0000 Subject: [PATCH] Merge flim-1_13_2_1. --- ChangeLog | 454 ++++++++++++++++++++++++++++++++++++++++++++++++++++++--- FLIM-CFG | 8 +- FLIM-ELS | 9 +- FLIM-MK | 2 + Makefile | 11 +- README.en | 20 +-- README.ja | 22 +-- VERSION | 7 +- ftp.in | 10 +- luna.el | 360 +++++++++++++++++++++++++++++++++++++++++++++ mailcap.el | 6 +- mel-b-ccl.el | 2 +- mel-b-dl.el | 4 +- mel-b-el.el | 4 +- mel-g.el | 3 +- mel-q-ccl.el | 2 +- mel-q.el | 2 +- mel-u.el | 2 +- mel.el | 9 +- mime-def.el | 296 ++++++++++++------------------------- mime-en.sgml | 18 +-- mime-en.texi | 18 +-- mime-ja.sgml | 16 +- mime-ja.texi | 171 +++++++++++----------- mime-parse.el | 136 +++++++++-------- mime.el | 257 +++++++++++++++----------------- mmbuffer.el | 289 +++++++++++++++++++++++++++--------- mmcooked.el | 36 +++-- mmdbuffer.el | 250 +++++++++++++++++++++++++++++++ mmgeneric.el | 219 ---------------------------- smtp.el | 19 ++- smtpmail.el | 30 ++-- 32 files changed, 1789 insertions(+), 903 deletions(-) create mode 100644 luna.el create mode 100644 mmdbuffer.el delete mode 100644 mmgeneric.el diff --git a/ChangeLog b/ChangeLog index c5598ef..f93bf6e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,426 @@ +1999-12-13 Katsumi Yamaoka + + * README.en,README.ja,mime-en.sgml,mime-en.texi,mime-ja.sgml, + mime-ja.texi: Update fot the recent ML address and ftp site. + +1999-10-17 Yoshiki Hayashi + + * FLIM-MK (install-flim-package): Delete auto-autoloads.el + and custom-load.el + +1999-09-20 Katsumi Yamaoka + + * mailcap.el (mailcap-look-at-schar): Protect against unexpected + eof. [cf. ] + +1999-09-13 Katsumi Yamaoka + + * smtpmail.el (smtpmail-send-it): Remove needless `concat'. + +1999-09-08 Yoshiki Hayashi + + * mime-ja.sgml, mime-en.sgml (Entity creation): Fix typo. + +1999-09-01 Katsumi Yamaoka + + * smtpmail.el (smtpmail-send-it): Make directory + `smtpmail-queue-dir' if it does not exist; convert filename of + queued mail using `convert-standard-filename'. + (smtpmail-queue-index): Treat `smtpmail-queue-dir' as a directory + name using `file-name-as-directory'. + (smtpmail-queue-dir, smtpmail-queue-mail): Remove "*" from doc + strings. + +1999-08-26 Katsumi Yamaoka + + * smtpmail.el (smtpmail-send-it): Use `time-stamp-yyyy-mm-dd' and + `time-stamp-hh:mm:ss' instead of `current-time'. + +1999-08-25 Katsumi Yamaoka + + * FLIM-ELS: Use `if' instead of `unless'. + + +1999-08-17 MORIOKA Tomohiko + + * FLIM: Version 1.13.2 (Kasanui) released. + +1999-08-03 Yuuichi Teranishi + + * smtp.el (smtp-notify-success): New option. + * (smtp-via-smtp): Request return receipt (defined in RFC1891) to + SMTP server if `smtp-notify-success' is non-nil. + [cf. ] + +1999-08-02 MORIOKA Tomohiko + + * mime.el (mime-entity-header-start-point): New generic function. + (mime-entity-header-end-point): New generic function. + + * mmbuffer.el (mime-entity-header-start-point): New method. + (mime-entity-header-end-point): New method. + +1999-08-09 MORIOKA Tomohiko + + * FLIM-ELS (flim-modules): Add `mmdbuffer'. + +1999-07-27 MORIOKA Tomohiko + + * mmdbuffer.el: New module. + +1999-07-28 MORIOKA Tomohiko + + * mime-parse.el: Add autoload setting for + `mime-entity-body-buffer', `mime-entity-body-start-point' and + `mime-entity-body-end-point'. + + * mime.el (mime-entity-point-min): Define as an obsolete function. + (mime-entity-point-max): Likewise. + +1999-07-27 MORIOKA Tomohiko + + * mmbuffer.el (entity-point-min): Deleted because it is + duplicated. + (entity-point-max): Deleted because it is duplicated. + +1999-07-24 MORIOKA Tomohiko + + * mmbuffer.el (mime-insert-text-content): Deleted [moved to + mime-def.el]. + + * mime-def.el: Add autoload settings for `mime-entity-content' [to + avoid warning]. + (mime-insert-text-content): New method of `mime-entity' [moved + from mmbuffer.el]. + +1999-07-24 MORIOKA Tomohiko + + * mmbuffer.el (mime-entity-children): Deleted [moved to + mime-def.el]. + + * mime-def.el: Add autoload settings for + `mime-entity-content-type', `mime-parse-multipart' and + `mime-parse-encapsulated' [to avoid warning]. + (mime-entity-children): New method of `mime-entity' [moved from + mmbuffer.el]. + + +1999-07-22 MORIOKA Tomohiko + + * FLIM: Version 1.13.1 (Tawaramoto) released. + +1999-07-21 MORIOKA Tomohiko + + * mime-parse.el (mime-parse-buffer): Fixed. + + +1999-07-16 MORIOKA Tomohiko + + * FLIM: Version 1.13.0 (Iwami) released. + +1999-07-09 Nakagawa, Makoto + + * smtpmail.el (smtpmail-send-it): Use current-time to get rid of + time-stamp-strftime. + (smtpmail-send-it): Use write-region-as-binary instead of + write-file. + (smtpmail-send-queued-mail); Use find-file-noselect-as-binary + instead of find-file-noselect. + +1999-06-23 MORIOKA Tomohiko + + * FLIM-CFG: Delete code to detect APEL 7.3 or later. + +1999-06-16 Katsumi Yamaoka + + * smtpmail.el (smtpmail-send-it): Extend the search bound to the + end of the field for fetching the recipients from Resent-To. + +1999-06-11 Katsumi Yamaoka + + * luna.el (luna-define-class-function): Check for the improbable + name of variable beginning with colon whether we should bind the + sort of symbol or not. + (TopLevel): Likewise. + +1999-06-10 Katsumi Yamaoka + + * luna.el (luna-define-class-function): Bind member variables + statically for old Emacsen. + (TopLevel): Require `static'; bind `:before', `:after' and + `:around' statically for old Emacsen. [cf. ] + + +1999-06-01 MORIOKA Tomohiko + + * Chao: Version 1.13.0 (JR Fujinomori) released. + +1999-05-29 MORIOKA Tomohiko + + * mmbuffer.el (mime-entity-fetch-field): New implementation. + + * mime-def.el (mime-entity-fetch-field): New method of luna-class + `mime-entity'. + + * luna.el (luna-define-method): Allow `:around' qualifier. + (luna-class-find-functions): Likewise. + (luna-send): Likewise. + (luna-call-next-method): New function. + +1999-05-26 MORIOKA Tomohiko + + * mime-def.el (eval-module-depended-macro): Abolished. + Use `def-edebug-spec' directly. + + * luna.el (luna-define-method): Allow `:before' qualifier. + (luna-class-find-functions): Likewise. + + * mime-def.el (mime-message-structure): Define as obsolete + variable. + +1999-05-26 MORIOKA Tomohiko + + * mime-parse.el (mime-parse-encapsulated): Use + `mime-entity-body-start-point' and `mime-entity-body-end-point'. + + * mime.el (mime-parse-buffer): Revert to auto-load from + "mime-parse". + + * mime-parse.el (mime-parse-multipart): Move from mime-parse.el + again. + (mime-parse-encapsulated): Likewise. + (mime-parse-message): Likewise. + (mime-parse-buffer): Likewise. + + * mmbuffer.el (mime-parse-multipart): Move to mime-parse.el again. + (mime-parse-encapsulated): Likewise. + (mime-parse-message): Likewise. + (mime-parse-buffer): Likewise. + + * mmbuffer.el (mime-parse-encapsulated): Run in body-buffer of an + entity. + +1999-05-26 MORIOKA Tomohiko + + * mmbuffer.el (initialize-instance): Don't initialize slots if + they are initialized. + (mime-parse-multipart): Run in body-buffer of an entity. + (mime-entity-body-start-point): New method. + +1999-05-25 MORIOKA Tomohiko + + * mmbuffer.el (mime-entity-body-end-point): New method. + (mime-goto-header-start-point): New method. + (mime-goto-body-start-point): New method. + (mime-goto-body-end-point): New method. + + * mime.el (mime-goto-body-end-point): New generic function. + + * mel.el (Q-encoded-text-length): Fixed. + +1999-05-24 MORIOKA Tomohiko + + * mmbuffer.el (mime-parse-multipart): Refer body-start instead of + header-end. + + * mmcooked.el (mime-insert-header): Fix typo. + +1999-05-23 MORIOKA Tomohiko + + * mmcooked.el (mime-insert-header): Use + `luna-class-find-functions'. + + * mime.el (mime-entity-buffer): Define as obsolete function. + (mime-entity-body-end-point): New generic function; define + `mime-entity-body-end' as obsolete function. + (mime-goto-body-start-point): New generic function. + (mime-entity-uu-filename): Use `mime-goto-body-start-point' and + `mime-entity-body-end-point'. + + * mmbuffer.el (initialize-instance): Define as after method; + return initialized instance. + + * luna.el (luna-define-class): Add `standard-object' as a parent. + (luna-define-method): Allow `:after' qualifier. + (luna-class-find-parents-functions): New function. + (luna-class-find-functions): New function [abolish + `luna-class-find-function']. + (luna-find-functions): New function [abolish + `luna-find-function']. + (luna-send): Modify for new method dispatch mechanism. + (luna-make-entity): New implementation. + (standard-object): New class. + (initialize-instance): New method. + +1999-05-22 MORIOKA Tomohiko + + * Delete mmgeneric.el. + + * mmcooked.el: Modify for mmbuffer.el. + + * mmbuffer.el: + - Don't require `mmgeneric' and `mime-parse'. + - Require mime. + - Use `luna'. + (mime-buffer-entity-buffer-internal): Renamed from + `mime-entity-set-buffer-internal'. + (mime-buffer-entity-set-buffer-internal): Likewise. + (mime-buffer-entity-header-start-internal): Likewise. + (mime-buffer-entity-set-header-start-internal): Likewise. + (mime-buffer-entity-header-end-internal): Likewise. + (mime-buffer-entity-set-header-end-internal): Likewise. + (mime-buffer-entity-body-start-internal): Likewise. + (mime-buffer-entity-set-body-start-internal): Likewise. + (mime-buffer-entity-body-end-internal): Likewise. + (mime-buffer-entity-set-body-end-internal): Likewise. + (mime-entity-name): New method. + (mime-parse-multipart): New function [moved from mime-parse.el]. + (mime-parse-encapsulated): Likewise. + (mime-parse-message): Likewise. + (mime-entity-children): New method. + (mime-goto-header-start-point): New method. + (mime-visible-field-p): New function [moved from mmgeneric.el]. + (mime-insert-header-from-buffer): Likewise. + (mime-insert-header): New method. + (mime-entity-content): Use `luna-define-method'. + (mime-insert-text-content): New method. + ((mime-entity-fetch-field): Use `luna-define-method'. + (mime-entity-header-buffer): New method. + (mime-entity-body-buffer): Likewise. + (mime-entity-buffer): Likewise. + (mime-entity-point-min): Use `luna-define-method'. + (mime-entity-point-max): Use `luna-define-method'. + (mime-parse-buffer): New function [moved from mmgeneric.el]. + + * mime-parse.el (mime-parse-multipart): Moved to mmbuffer.el. + (mime-parse-encapsulated): Likewise. + (mime-parse-message): Likewise. + (mime-parse-buffer): Likewise. + + * mime.el (mime-parse-buffer): Auto-loaded from "mmbufer". + (mime-find-function): Abolished. + (mime-entity-function): Abolished. + (mime-entity-send): Use `luna-send'. + (mime-open-entity): Use `luna-make-entity' and + `mm-expand-class-name'. + (mime-entity-cooked-p): Use `luna-define-generic'. + (mime-entity-children): Use `luna-send'. + (mime-find-entity-from-content-id): Use `mime-entity-read-field'. + (mime-entity-buffer): Change to generic function. + (mime-entity-header-buffer): New generic function. + (mime-entity-body-buffer): Likewise. + (mime-entity-point-min): Use `luna-define-generic'. + (mime-entity-point-max): Likewise. + (mime-entity-header-start): Abolished. + (mime-entity-header-end): Abolished. + (mime-entity-body-start): Abolished. + (mime-entity-body-end): Abolished. + (mime-goto-header-start-point): New generic function. + (mime-entity-fetch-field): New generic function. + (mime-fetch-field): Use `mime-entity-fetch-field'; declare as + obsolete function. + (mime-entity-content-type): Use `mime-entity-fetch-field'. + (mime-entity-content-disposition): Likewise. + (mime-entity-encoding): Likewise. + (mime-entity-read-field): New function. + (mime-read-field): Use `mime-entity-read-field'; declare as + obsolete function. + (mime-insert-header): Use `luna-define-generic'; abolish obsolete + alias `mime-insert-decoded-header'. + (mime-entity-name): New generic function. + (mime-entity-content): Use `luna-define-generic'. + (mime-insert-entity-content): Likewise. + (mime-write-entity-content): Likewise. + (mime-insert-text-content): Likewise. + (mime-insert-entity): Likewise. + (mime-write-entity): Likewise. + (mime-write-entity-body): Likewise. + + * mime-def.el: + - Use `luna'. + (make-mime-entity-internal): Abolished. + (mime-entity-representation-type-internal): Change to alias for + `luna-class-name'. + (mime-entity-set-representation-type-internal): Change to alias + for `luna-set-class-name'. + (mime-entity-location-internal): Defined by + `luna-define-internal-accessors'. + (mime-entity-set-location-internal): Likewise. + (mime-entity-content-type-internal): Likewise. + (mime-entity-set-content-type-internal): Likewise. + (mime-entity-content-disposition-internal): Likewise. + (mime-entity-set-content-disposition-internal): Likewise. + (mime-entity-encoding-internal): Likewise. + (mime-entity-set-encoding-internal): Likewise. + (mime-entity-children-internal): Likewise. + (mime-entity-set-children-internal): Likewise. + (mime-entity-parent-internal): Likewise. + (mime-entity-set-parent-internal): Likewise. + (mime-entity-node-id-internal): Likewise. + (mime-entity-decoded-subject-internal): Abolished. + (mime-entity-set-decoded-subject-internal): Abolished. + (mime-entity-decoded-from-internal): Abolished. + (mime-entity-set-decoded-from-internal): Abolished. + (mime-entity-date-internal): Abolished. + (mime-entity-set-date-internal): Abolished. + (mime-entity-message-id-internal): Abolished. + (mime-entity-set-message-id-internal): Abolished. + (mime-entity-references-internal): Abolished. + (mime-entity-set-references-internal): Abolished. + (mime-entity-chars-internal): Abolished. + (mime-entity-set-chars-internal): Abolished. + (mime-entity-lines-internal): Abolished. + (mime-entity-set-lines-internal): Abolished. + (mime-entity-xref-internal): Abolished. + (mime-entity-set-xref-internal): Abolished. + (mime-entity-original-header-internal): Defined by + `luna-define-internal-accessors'. + (mime-entity-set-original-header-internal): Likewise. + (mime-entity-parsed-header-internal): Likewise. + (mime-entity-set-parsed-header-internal): Likewise. + (mime-entity-buffer-internal): Abolished. + (mime-entity-set-buffer-internal): Abolished. + (mime-entity-header-start-internal): Abolished. + (mime-entity-set-header-start-internal): Abolished. + (mime-entity-header-end-internal): Abolished. + (mime-entity-set-header-end-internal): Abolished. + (mime-entity-body-start-internal): Abolished. + (mime-entity-set-body-start-internal): Abolished. + (mime-entity-body-end-internal): Abolished. + (mime-entity-set-body-end-internal): Abolished. + (mm-expand-class-name): New macro. + (mm-define-backend): Use `luna-define-class' and + `mm-expand-class-name'. + (mm-define-method): Use `luna-define-method' and + `mm-expand-class-name'. + (mm-arglist-to-arguments): Abolished. + (mel-define-service): Use `luna-arglist-to-arguments' instead of + `mm-arglist-to-arguments'. + + * mel.el: Require `alist'. + + * FLIM-ELS (flim-modules): Add `luna' and delete `mmgeneric'. + + * luna.el: + - Rename property `luna-member-index' to `luna-slot-index'. + - Rearrangement to avoid byte-compiling problem. + (luna-define-class-function): New function. + (luna-define-class): Use `luna-define-class-function'. + (luna-define-generic): Fixed. + (luna-define-internal-accessors): New function. + +1999-05-15 MORIOKA Tomohiko + + * luna.el (luna-make-entity-function): Send `initialize-instance'. + +1999-05-14 MORIOKA Tomohiko + + * luna.el: New module. + + 1999-05-31 MORIOKA Tomohiko - * FLIM: Version 1.12.7 (Y-Dþzaki)-A released. + * FLIM: Version 1.12.7 (Y-D~zaki) released. 1999-05-31 MORIOKA Tomohiko @@ -175,7 +595,7 @@ 1999-05-11 MORIOKA Tomohiko - * FLIM: Version 1.12.6 (Family-K-Dòenmae)-A released. + * FLIM: Version 1.12.6 (Family-K-Drenmae) released. 1999-04-27 Shuhei KOBAYASHI @@ -195,7 +615,7 @@ * mime.el: Delete autoload setting for `eword-encode-field'. -1999-04-22 MORIOKA Tomohiko +1999-04-22 MORIOKA Tomohiko * eword-encode.el: Require `poem' instead of `emu'. Don't use `cl' for `caar'. @@ -292,7 +712,7 @@ 1999-01-23 MORIOKA Tomohiko - * FLIM: Version 1.12.3 (Kintetsu-K-Dòriyama)-A released. + * FLIM: Version 1.12.3 (Kintetsu-K-Drriyama) released. 1999-01-23 MORIOKA Tomohiko @@ -335,7 +755,7 @@ 1999-01-21 MORIOKA Tomohiko - * FLIM: Version 1.12.2 (Kuj-Dò)-A released. + * FLIM: Version 1.12.2 (Kuj-Dr) released. 1999-01-16 MORIOKA Tomohiko @@ -521,7 +941,7 @@ 1998-12-02 MORIOKA Tomohiko - * FLIM: Version 1.12.1 (Nishinoky-Dò)-A released. + * FLIM: Version 1.12.1 (Nishinoky-Dr) released. 1998-11-30 MORIOKA Tomohiko @@ -739,7 +1159,7 @@ 1998-10-26 MORIOKA Tomohiko - * FLIM: Version 1.11.2 (Heij-Dò)-A was released. + * FLIM: Version 1.11.2 (Heij-Dr) was released. * NEWS (Abolish variable `mime-temp-directory'): New subsection. @@ -1019,7 +1439,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-Drsono) was released. 1998-10-12 Katsumi Yamaoka @@ -1204,7 +1624,7 @@ 1998-09-29 MORIOKA Tomohiko - * FLIM: Version 1.10.0 (K-Dòdo)-A was released. + * FLIM: Version 1.10.0 (K-Drdo) was released. * README.en (What's FLIM): Add mel-ccl.el. @@ -1491,7 +1911,7 @@ 1998-08-31 MORIOKA Tomohiko - * FLIM: Version 1.9.1 (Tonosh-Dò)-A was released. + * FLIM: Version 1.9.1 (Tonosh-Dr) was released. * mime-en.sgml (mm-backend): Translate a little. @@ -1634,7 +2054,7 @@ 1998-07-07 MORIOKA Tomohiko - * FLIM-Chao: Version 1.8.0 (Shij-Dò)-A was released. + * FLIM-Chao: Version 1.8.0 (Shij-Dr) was released. 1998-07-07 MORIOKA Tomohiko @@ -1746,7 +2166,7 @@ 1998-07-01 MORIOKA Tomohiko - * FLIM: Version 1.8.0 (-DÒkubo)-A was released. + * FLIM: Version 1.8.0 (-DRkubo) was released. * README.en: Delete `How to use'. @@ -1871,7 +2291,7 @@ 1998-06-28 MORIOKA Tomohiko - * FLIM-Chao: Version 1.7.0 (Goj-Dò)-A was released. + * FLIM-Chao: Version 1.7.0 (Goj-Dr) was released. 1998-06-26 MORIOKA Tomohiko @@ -2130,7 +2550,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-Drmae) was released. 1998-06-18 MORIOKA Tomohiko @@ -2250,7 +2670,7 @@ 1998-05-06 MORIOKA Tomohiko - * FLIM: Version 1.2.0 (J-Dþjò)-A was released. + * FLIM: Version 1.2.0 (J-D~jr) was released. * README.en (What's FLIM): Delete description about std11-parse.el; add description about mailcap.el. @@ -2301,7 +2721,7 @@ 1998-05-05 MORIOKA Tomohiko - * FLIM: Version 1.1.0 (T-Dòji)-A was released. + * FLIM: Version 1.1.0 (T-Drji) was released. 1998-05-04 MORIOKA Tomohiko @@ -2337,7 +2757,7 @@ 1998-04-17 MORIOKA Tomohiko - * FLIM: Version 1.0.1 (Ky-Dòto)-A was released. + * FLIM: Version 1.0.1 (Ky-Drto) was released. * mime-def.el (mime-spadework-module-version-string): New constant. diff --git a/FLIM-CFG b/FLIM-CFG index e4fbd65..05736ce 100644 --- a/FLIM-CFG +++ b/FLIM-CFG @@ -25,10 +25,10 @@ (add-path default-directory) -(or (fboundp 'write-region-as-binary) - (error "Please install latest APEL 7.3 or later.")) -(or (fboundp 'insert-file-contents-as-binary) - (error "Please install latest APEL 7.3 or later.")) +;; (or (fboundp 'write-region-as-binary) +;; (error "Please install latest APEL 7.3 or later.")) +;; (or (fboundp 'insert-file-contents-as-binary) +;; (error "Please install latest APEL 7.3 or later.")) ;;; @ Please specify prefix of install directory. diff --git a/FLIM-ELS b/FLIM-ELS index d389fa4..1d8ebf6 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -5,15 +5,16 @@ ;;; Code: (setq flim-modules '(std11 - mime-def + luna mime-def mel mel-q mel-u mel-g eword-decode eword-encode - mime mime-parse mmgeneric mmbuffer mmcooked + mime mime-parse mmbuffer mmcooked mmdbuffer mailcap smtp smtpmail)) -(unless (and (fboundp 'base64-encode-string) - (subrp (symbol-function 'base64-encode-string))) +(if (and (fboundp 'base64-encode-string) + (subrp (symbol-function 'base64-encode-string))) + nil (if (fboundp 'dynamic-link) (setq flim-modules (cons 'mel-b-dl flim-modules)) ) diff --git a/FLIM-MK b/FLIM-MK index e381f48..8270080 100644 --- a/FLIM-MK +++ b/FLIM-MK @@ -74,6 +74,8 @@ LISPDIR=%s\n" PREFIX LISPDIR)) (expand-file-name FLIM_PREFIX (expand-file-name "lisp" PACKAGEDIR))) + (delete-file "./auto-autoloads.el") + (delete-file "./custom-load.el") ) ;;; FLIM-MK ends here diff --git a/Makefile b/Makefile index 56f1304..996e16c 100644 --- a/Makefile +++ b/Makefile @@ -3,8 +3,8 @@ # PACKAGE = flim -API = 1.12 -RELEASE = 7 +API = 1.13 +RELEASE = 2 TAR = tar RM = /bin/rm -f @@ -25,8 +25,8 @@ GOMI = *.elc \ FILES = README.?? Makefile FLIM-MK FLIM-CFG FLIM-ELS *.el ChangeLog VERSION = $(API).$(RELEASE) -ARC_DIR = /pub/mule/flim/$(PACKAGE)-$(API) -SEMI_ARC_DIR = /pub/mule/semi/semi-1.13-for-flim-$(API) +ARC_DIR = /ftp/pub/mule/flim/flim-$(API) +SEMI_ARC_DIR = /ftp/pub/mule/semi/semi-1.13-for-flim-$(API) elc: $(EMACS) $(FLAGS) -f compile-flim $(PREFIX) $(LISPDIR) \ @@ -58,7 +58,8 @@ tar: cd /tmp; $(RM) $(PACKAGE)-$(VERSION)/ftp.in ; \ $(TAR) cvzf $(PACKAGE)-$(VERSION).tar.gz $(PACKAGE)-$(VERSION) cd /tmp; $(RM) -r $(PACKAGE)-$(VERSION) - sed "s/VERSION/$(VERSION)/" < ftp.in | sed "s/API/$(API)/" > ftp + sed "s/VERSION/$(VERSION)/" < ftp.in | sed "s/API/$(API)/" \ + | sed "s/PACKAGE/$(PACKAGE)/" > ftp release: -$(RM) $(ARC_DIR)/$(PACKAGE)-$(VERSION).tar.gz diff --git a/README.en b/README.en index c8ed0b2..8ded084 100644 --- a/README.en +++ b/README.en @@ -39,10 +39,10 @@ What's FLIM Installation ============ -(0) before installing it, please install APEL (9.19 or later) package. +(0) before installing it, please install APEL (9.22 or later) package. APEL package is available at: - ftp://ftp.etl.go.jp/pub/mule/apel/ + ftp://ftp.m17n.org/pub/mule/apel/ (1-a) run in expanded place @@ -146,14 +146,14 @@ Bug reports =========== If you write bug-reports and/or suggestions for improvement, please - send them to the tm Mailing List: + send them to the EMACS-MIME Mailing List: - bug-tm-en@chamonix.jaist.ac.jp (English) - bug-tm-ja@chamonix.jaist.ac.jp (Japanese) + emacs-mime-en@m17n.org (English) + emacs-mime-ja@m17n.org (Japanese) - Via the tm ML, you can report FLIM bugs, obtain the latest release - of FLIM, and discuss future enhancements to FLIM. To join the tm ML, - send an empty e-mail to + Via the EMACS-MIME ML, you can report FLIM bugs, obtain the latest + release of FLIM, and discuss future enhancements to FLIM. To join + the EMACS-MIME ML, send an empty e-mail to - tm-en-help@chamonix.jaist.ac.jp (English) - tm-ja-help@chamonix.jaist.ac.jp (Japanese) + emacs-mime-en-ctl@m17n.org (English) + emacs-mime-ja-ctl@m17n.org (Japanese) diff --git a/README.ja b/README.ja index c3742e1..5327de3 100644 --- a/README.ja +++ b/README.ja @@ -37,10 +37,10 @@ FLIM $B$H$O!)(B $BF3F~(B (install) ============== -(0) $BF3F~(B (install) $B$9$kA0$K!"(BAPEL (9.19 $B0J9_(B) $B$rF3F~$7$F$/$@$5$$!#(BAPEL +(0) $BF3F~(B (install) $B$9$kA0$K!"(BAPEL (9.22 $B0J9_(B) $B$rF3F~$7$F$/$@$5$$!#(BAPEL $B$O0J2<$N$H$3$m$Gl=j$X$NF3F~(B @@ -151,17 +151,17 @@ load-path (Emacs $B$H(B MULE $BMQ(B) $B%P%0Js9p(B ======== - $B%P%0Js9p$d2~A1$NDs0F$r=q$$$?$H$-$O!"@'Hs(B tm $B%a!<%j%s%0%j%9%H$KAw$C$F(B - $B$/$@$5$$(B: + $B%P%0Js9p$d2~A1$NDs0F$r=q$$$?$H$-$O!"@'Hs(B EMACS-MIME $B%a!<%j%s%0%j%9%H(B + $B$KAw$C$F$/$@$5$$(B: - bug-tm-en@chamonix.jaist.ac.jp ($B1Q8l(B) - bug-tm-ja@chamonix.jaist.ac.jp ($BF|K\8l(B) + emacs-mime-en@m17n.org ($B1Q8l(B) + emacs-mime-ja@m17n.org ($BF|K\8l(B) - tm ML $B$rDL$7$F!"(BFLIM $B$N%P%0$rJs9p$7$?$j!"(BFLIM $B$N:G?7$N%j%j!<%9$r-Mh$N3HD%$N5DO@$r$7$?$j$9$k$3$H$,$G$-$^$9!#(Btm ML $B$K(B - $B;22C$9$k$K$O!"6u$NEE;R%a!<%k$r(B + EMACS-MIME ML $B$rDL$7$F!"(BFLIM $B$N%P%0$rJs9p$7$?$j!"(BFLIM $B$N:G?7$N%j%j!<(B + $B%9$r-Mh$N3HD%$N5DO@$r$7$?$j$9$k$3$H$,$G$-$^$9!#(B + EMACS-MIME ML $B$K;22C$9$k$K$O!"6u$NEE;R%a!<%k$r(B - tm-en-help@chamonix.jaist.ac.jp ($B1Q8l(B) - tm-ja-help@chamonix.jaist.ac.jp ($BF|K\8l(B) + emacs-mime-en-ctl@m17n.org ($B1Q8l(B) + emacs-mime-ja-ctl@m17n.org ($BF|K\8l(B) $B$KAw$C$F$/$@$5$$!#(B diff --git a/VERSION b/VERSION index a4dbc84..173b421 100644 --- a/VERSION +++ b/VERSION @@ -45,9 +45,9 @@ 1.12.5 Hirahata $(BJ?C<(B ; = $(B6aE4(B $(BE7M}@~(B 1.12.6 Family-K-Dòenmae-A $(B%U%!%_%j!<8x1`A0(B 1.12.7 Y-Dþzaki-A $(B7k:j(B ------- Iwami $(B@P8+(B ------- Tawaramoto $(BED86K\(B ; <=> $(B6aE4(B $(B@>ED86K\(B ------- Kasanui $(B3^K%(B +1.13.0 Iwami $(B@P8+(B +1.13.1 Tawaramoto $(BED86K\(B ; <=> $(B6aE4(B $(B@>ED86K\(B +1.13.2 Kasanui $(B3^K%(B ------ Ninokuchi $(B?7%N8}(B ------ Yagi $(BH,LZ(B ; = $(B6aE4(B $(BBg:e@~(B ------ Yagi-Nishiguchi $(BH,LZ@>8}(B @@ -86,3 +86,4 @@ 1.12.0 [JR] Ky-Dòto-A $(B5~ET(B ; <=> $(B6aE4(B, $(B5~ET;T8rDL6I(B 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 diff --git a/ftp.in b/ftp.in index 0949088..1d17d2a 100644 --- a/ftp.in +++ b/ftp.in @@ -2,16 +2,20 @@ It is available from + ftp://ftp.m17n.org/pub/mule/flim/flim-API + +or + ftp://ftp.etl.go.jp/pub/mule/flim/flim-API --[[message/external-body; access-type=anon-ftp; - site="ftp.etl.go.jp"; + site="ftp.m17n.org"; directory="/pub/mule/flim/flim-API"; - name="flim-VERSION.tar.gz"; + name="PACKAGE-VERSION.tar.gz"; mode=image]] Content-Type: application/octet-stream; - name="flim-VERSION.tar.gz"; + name="PACKAGE-VERSION.tar.gz"; type=tar; conversions=gzip --}-<> diff --git a/luna.el b/luna.el new file mode 100644 index 0000000..e66d265 --- /dev/null +++ b/luna.el @@ -0,0 +1,360 @@ +;;; luna.el --- tiny OOP system kernel + +;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. + +;; Author: MORIOKA Tomohiko +;; Keywords: OOP + +;; 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: + +(eval-when-compile (require 'cl)) + +(eval-when-compile (require 'static)) + +(static-condition-case nil + :symbol-for-testing-whether-colon-keyword-is-available-or-not + (void-variable + (defconst :before ':before) + (defconst :after ':after) + (defconst :around ':around))) + +(defmacro luna-find-class (name) + "Return the luna-class of the given NAME." + `(get ,name 'luna-class)) + +(defmacro luna-set-class (name class) + `(put ,name 'luna-class ,class)) + +(defmacro luna-class-obarray (class) + `(aref ,class 1)) + +(defmacro luna-class-parents (class) + `(aref ,class 2)) + +(defmacro luna-class-number-of-slots (class) + `(aref ,class 3)) + +(defmacro luna-define-class (type &optional parents slots) + "Define TYPE as a luna-class. +If PARENTS is specified, TYPE inherits PARENTS. +Each parent must be name of luna-class (symbol). +If SLOTS is specified, TYPE will be defined to have them." + `(luna-define-class-function ',type ',(append parents '(standard-object)) + ',slots)) + +(defun luna-define-class-function (type &optional parents slots) + (static-condition-case nil + :symbol-for-testing-whether-colon-keyword-is-available-or-not + (void-variable + (let (key) + (dolist (slot slots) + (setq key (intern (format ":%s" slot))) + (set key key))))) + (let ((oa (make-vector 31 0)) + (rest parents) + parent name + (i 2) + b j) + (while rest + (setq parent (pop rest) + b (- i 2)) + (mapatoms (lambda (sym) + (when (setq j (get sym 'luna-slot-index)) + (setq name (symbol-name sym)) + (unless (intern-soft name oa) + (put (intern name oa) 'luna-slot-index (+ j b)) + (setq i (1+ i)) + ))) + (luna-class-obarray (luna-find-class parent))) + ) + (setq rest slots) + (while rest + (setq name (symbol-name (pop rest))) + (unless (intern-soft name oa) + (put (intern name oa) 'luna-slot-index i) + (setq i (1+ i)) + )) + (luna-set-class type (vector 'class oa parents i)) + )) + +(defun luna-class-find-member (class member-name) + (or (stringp member-name) + (setq member-name (symbol-name member-name))) + (or (intern-soft member-name (luna-class-obarray class)) + (let ((parents (luna-class-parents class)) + ret) + (while (and parents + (null + (setq ret (luna-class-find-member + (luna-find-class (pop parents)) + member-name))))) + ret))) + +(defsubst luna-class-find-or-make-member (class member-name) + (or (stringp member-name) + (setq member-name (symbol-name member-name))) + (intern member-name (luna-class-obarray 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. + +Usage of this macro follows: + + (luna-define-method NAME [METHOD-QUALIFIER] ARGLIST [DOCSTRING] BODY...) + +NAME is the name of method. + +Optional argument METHOD-QUALIFIER must be :before, :after or :around. +If it is :before / :after, the method is called before / after a +method of parent class is finished. ARGLIST is like an argument list +of lambda, but (car ARGLIST) must be specialized parameter. (car (car +ARGLIST)) is name of variable and \(nth 1 (car ARGLIST)) is name of +class. + +Optional argument DOCSTRING is the documentation of method. + +BODY is the body of method." + (let ((method-qualifier (pop definition)) + args specializer class self) + (if (memq method-qualifier '(:before :after :around)) + (setq args (pop definition)) + (setq args method-qualifier + method-qualifier nil) + ) + (setq specializer (car args) + class (nth 1 specializer) + self (car specializer)) + `(let ((func (lambda ,(if self + (cons self (cdr args)) + (cdr args)) + ,@definition)) + (sym (luna-class-find-or-make-member + (luna-find-class ',class) ',name))) + (fset sym func) + (put sym 'luna-method-qualifier ,method-qualifier) + ))) + +(put 'luna-define-method 'lisp-indent-function 'defun) + +(def-edebug-spec luna-define-method + (&define name [&optional &or ":before" ":after" ":around"] + ((arg symbolp) + [&rest arg] + [&optional ["&optional" arg &rest arg]] + &optional ["&rest" arg] + ) + def-body)) + +(defun luna-class-find-parents-functions (class service) + (let ((parents (luna-class-parents class)) + ret) + (while (and parents + (null + (setq ret (luna-class-find-functions + (luna-find-class (pop parents)) + service))))) + ret)) + +(defun luna-class-find-functions (class service) + (let ((sym (luna-class-find-member class service))) + (if (fboundp sym) + (cond ((eq (get sym 'luna-method-qualifier) :before) + (cons (symbol-function sym) + (luna-class-find-parents-functions class service)) + ) + ((eq (get sym 'luna-method-qualifier) :after) + (nconc (luna-class-find-parents-functions class service) + (list (symbol-function sym))) + ) + ((eq (get sym 'luna-method-qualifier) :around) + (cons sym (luna-class-find-parents-functions class service)) + ) + (t + (list (symbol-function sym)) + )) + (luna-class-find-parents-functions class service) + ))) + +(defmacro luna-find-functions (entity service) + `(luna-class-find-functions (luna-find-class (luna-class-name ,entity)) + ,service)) + +(defsubst luna-send (entity message &rest luna-current-method-arguments) + "Send MESSAGE to ENTITY, and return the result. +LUNA-CURRENT-METHOD-ARGUMENTS is arguments of the MESSAGE." + (let ((luna-next-methods (luna-find-functions entity message)) + luna-current-method + luna-previous-return-value) + (while (and luna-next-methods + (progn + (setq luna-current-method (pop luna-next-methods) + luna-previous-return-value + (apply luna-current-method + luna-current-method-arguments)) + (if (symbolp luna-current-method) + (not (eq (get luna-current-method + 'luna-method-qualifier) :around)) + t)))) + luna-previous-return-value)) + +(eval-when-compile + (defvar luna-next-methods nil) + (defvar luna-current-method-arguments nil) + ) + +(defun luna-call-next-method () + "Call the next method in a method with :around qualifier." + (let (luna-current-method + luna-previous-return-value) + (while (and luna-next-methods + (progn + (setq luna-current-method (pop luna-next-methods) + luna-previous-return-value + (apply luna-current-method + luna-current-method-arguments)) + (if (symbolp luna-current-method) + (not (eq (get luna-current-method + 'luna-method-qualifier) :around)) + 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. +It must be plist and each slot name must have prefix `:'." + (let* ((c (get type 'luna-class)) + (v (make-vector (luna-class-number-of-slots c) nil))) + (luna-set-class-name v type) + (luna-set-obarray v (make-vector 7 0)) + (apply #'luna-send v 'initialize-instance v init-args) + )) + +(defsubst luna-arglist-to-arguments (arglist) + (let (dest) + (while arglist + (let ((arg (car arglist))) + (or (memq arg '(&optional &rest)) + (setq dest (cons arg dest))) + ) + (setq arglist (cdr arglist))) + (nreverse dest))) + +(defmacro luna-define-generic (name args &optional doc) + "Define generic-function NAME. +ARGS is argument of and DOC is DOC-string." + (if doc + `(defun ,(intern (symbol-name name)) ,args + ,doc + (luna-send ,(car args) ',name + ,@(luna-arglist-to-arguments args)) + ) + `(defun ,(intern (symbol-name name)) ,args + (luna-send ,(car args) ',name + ,@(luna-arglist-to-arguments args)) + ))) + +(put 'luna-define-generic 'lisp-indent-function 'defun) + +(defun luna-define-internal-accessors (class-name) + "Define internal accessors for an entity of CLASS-NAME." + (let ((entity-class (luna-find-class class-name)) + parents parent-class) + (mapatoms + (lambda (slot) + (if (luna-class-slot-index entity-class slot) + (catch 'derived + (setq parents (luna-class-parents entity-class)) + (while parents + (setq parent-class (luna-find-class (car parents))) + (if (luna-class-slot-index parent-class slot) + (throw 'derived nil)) + (setq parents (cdr parents)) + ) + (eval + `(progn + (defmacro ,(intern (format "%s-%s-internal" + class-name slot)) + (entity) + (list 'aref entity + ,(luna-class-slot-index entity-class + (intern (symbol-name slot))) + )) + (defmacro ,(intern (format "%s-set-%s-internal" + class-name slot)) + (entity value) + (list 'aset entity + ,(luna-class-slot-index + entity-class (intern (symbol-name slot))) + value)) + )) + ))) + (luna-class-obarray entity-class)))) + +(luna-define-class-function 'standard-object) + +(luna-define-method initialize-instance ((entity standard-object) + &rest init-args) + (let* ((c (luna-find-class (luna-class-name entity))) + (oa (luna-class-obarray c)) + s i) + (while init-args + (setq s (intern-soft (substring (symbol-name (pop init-args)) 1) oa) + i (pop init-args)) + (if s + (aset entity (get s 'luna-slot-index) i) + )) + entity)) + + +;;; @ end +;;; + +(provide 'luna) + +;; luna.el ends here diff --git a/mailcap.el b/mailcap.el index b3b7d90..25595f0 100644 --- a/mailcap.el +++ b/mailcap.el @@ -86,7 +86,8 @@ (defsubst mailcap-look-at-schar () (let ((chr (char-after (point)))) - (if (and (>= chr ? ) + (if (and chr + (>= chr ? ) (/= chr ?\;) (/= chr ?\\) ) @@ -105,7 +106,8 @@ (let ((beg (point))) (while (or (mailcap-look-at-qchar) (mailcap-look-at-schar))) - (buffer-substring beg (point)))) + (buffer-substring beg (point)) + )) ;;; @ field diff --git a/mel-b-ccl.el b/mel-b-ccl.el index e0426b8..fa12483 100644 --- a/mel-b-ccl.el +++ b/mel-b-ccl.el @@ -1,6 +1,6 @@ ;;; mel-b-ccl.el --- Base64 encoder/decoder using CCL. -;; Copyright (C) 1998 Tanaka Akira +;; Copyright (C) 1998,1999 Tanaka Akira ;; Author: Tanaka Akira ;; Created: 1998/9/17 diff --git a/mel-b-dl.el b/mel-b-dl.el index 59bff29..47b1b81 100644 --- a/mel-b-dl.el +++ b/mel-b-dl.el @@ -1,8 +1,8 @@ ;;; mel-b-dl.el --- Base64 encoder/decoder using DL module. -;; Copyright (C) 1998 Free Software Foundation, Inc. +;; Copyright (C) 1998,1999 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: MIME, Base64 ;; This file is part of FLIM (Faithful Library about Internet Message). diff --git a/mel-b-el.el b/mel-b-el.el index 076f2f6..f661853 100644 --- a/mel-b-el.el +++ b/mel-b-el.el @@ -1,9 +1,9 @@ ;;; mel-b-el.el --- Base64 encoder/decoder. -;; Copyright (C) 1992,1995,1996,1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1992,1995,1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: ENAMI Tsugutomo -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko ;; Created: 1995/6/24 ;; Keywords: MIME, Base64 diff --git a/mel-g.el b/mel-g.el index c0f3577..16a37fd 100644 --- a/mel-g.el +++ b/mel-g.el @@ -4,7 +4,8 @@ ;; Copyright (C) 1996,1997,1999 Shuhei KOBAYASHI ;; Author: Shuhei KOBAYASHI -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko +;; Maintainer: Shuhei KOBAYASHI ;; Created: 1995/10/25 ;; Keywords: Gzip64, base64, gzip, MIME diff --git a/mel-q-ccl.el b/mel-q-ccl.el index 04e09b0..c71fab6 100644 --- a/mel-q-ccl.el +++ b/mel-q-ccl.el @@ -1,6 +1,6 @@ ;;; mel-q-ccl.el --- Quoted-Printable encoder/decoder using CCL. -;; Copyright (C) 1998 Tanaka Akira +;; Copyright (C) 1998,1999 Tanaka Akira ;; Author: Tanaka Akira ;; Created: 1998/9/17 diff --git a/mel-q.el b/mel-q.el index 6200a74..44b83c9 100644 --- a/mel-q.el +++ b/mel-q.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Created: 1995/6/25 ;; Keywords: MIME, Quoted-Printable, Q-encoding diff --git a/mel-u.el b/mel-u.el index 94ede06..49d5733 100644 --- a/mel-u.el +++ b/mel-u.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Created: 1995/10/25 ;; Keywords: uuencode diff --git a/mel.el b/mel.el index f128321..12fff86 100644 --- a/mel.el +++ b/mel.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Created: 1995/6/25 ;; Keywords: MIME, Base64, Quoted-Printable, uuencode, gzip64 @@ -26,6 +26,8 @@ ;;; Code: (require 'mime-def) +(require 'poem) +(require 'alist) (require 'path-util) (defcustom mime-encoding-list @@ -222,8 +224,9 @@ the STRING by its value." (defun Q-encoded-text-length (string &optional mode) (let ((l 0)(i 0)(len (length string)) chr) (while (< i len) - (setq chr (elt string i)) - (if (Q-encoding-printable-char-p chr mode) + (setq chr (aref string i)) + (if (or (Q-encoding-printable-char-p chr mode) + (eq chr ? )) (setq l (+ l 1)) (setq l (+ l 3))) (setq i (+ i 1))) diff --git a/mime-def.el b/mime-def.el index 75375f4..276dadd 100644 --- a/mime-def.el +++ b/mime-def.el @@ -1,8 +1,10 @@ ;;; mime-def.el --- definition module about MIME ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. +;; Licensed to the Free Software Foundation. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: definition, MIME, multimedia, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). @@ -33,7 +35,7 @@ (eval-when-compile (require 'cl)) ; list* (eval-and-compile - (defconst mime-library-product ["FLIM" (1 12 7) "Y.DŽþzaki"] + (defconst mime-library-product ["FLIM" (1 13 2) "Kasanui"] "Product name, version number and code name of MIME-library package.") ) @@ -57,6 +59,8 @@ ;;; @ variables ;;; +(require 'custom) + (defgroup mime '((default-mime-charset custom-variable)) "Emacs MIME Interfaces" :group 'news @@ -206,125 +210,92 @@ ;;; @ MIME entity ;;; -(defmacro make-mime-entity-internal (representation-type location - &optional content-type - children parent node-id - ;; for NOV - decoded-subject decoded-from - date message-id references - chars lines - xref - ;; for other fields - original-header parsed-header - ;; for buffer representation - buffer - header-start header-end - body-start body-end) - `(vector ,representation-type ,location - ,content-type nil nil ,children ,parent ,node-id - ;; for NOV - ,decoded-subject ,decoded-from - ,date ,message-id ,references - ,chars ,lines - ,xref - ;; for other fields - ,original-header ,parsed-header - ;; for buffer representation - ,buffer ,header-start ,header-end ,body-start ,body-end)) - -(defmacro mime-entity-representation-type-internal (entity) - `(aref ,entity 0)) -(defmacro mime-entity-set-representation-type-internal (entity type) - `(aset ,entity 0 ,type)) -(defmacro mime-entity-location-internal (entity) - `(aref ,entity 1)) -(defmacro mime-entity-set-location-internal (entity location) - `(aset ,entity 1 ,location)) - -(defmacro mime-entity-content-type-internal (entity) - `(aref ,entity 2)) -(defmacro mime-entity-set-content-type-internal (entity type) - `(aset ,entity 2 ,type)) -(defmacro mime-entity-content-disposition-internal (entity) - `(aref ,entity 3)) -(defmacro mime-entity-set-content-disposition-internal (entity disposition) - `(aset ,entity 3 ,disposition)) -(defmacro mime-entity-encoding-internal (entity) - `(aref ,entity 4)) -(defmacro mime-entity-set-encoding-internal (entity encoding) - `(aset ,entity 4 ,encoding)) - -(defmacro mime-entity-children-internal (entity) - `(aref ,entity 5)) -(defmacro mime-entity-set-children-internal (entity children) - `(aset ,entity 5 ,children)) -(defmacro mime-entity-parent-internal (entity) - `(aref ,entity 6)) -(defmacro mime-entity-node-id-internal (entity) - `(aref ,entity 7)) - -(defmacro mime-entity-decoded-subject-internal (entity) - `(aref ,entity 8)) -(defmacro mime-entity-set-decoded-subject-internal (entity subject) - `(aset ,entity 8 ,subject)) -(defmacro mime-entity-decoded-from-internal (entity) - `(aref ,entity 9)) -(defmacro mime-entity-set-decoded-from-internal (entity from) - `(aset ,entity 9 ,from)) -(defmacro mime-entity-date-internal (entity) - `(aref ,entity 10)) -(defmacro mime-entity-set-date-internal (entity date) - `(aset ,entity 10 ,date)) -(defmacro mime-entity-message-id-internal (entity) - `(aref ,entity 11)) -(defmacro mime-entity-set-message-id-internal (entity message-id) - `(aset ,entity 11 ,message-id)) -(defmacro mime-entity-references-internal (entity) - `(aref ,entity 12)) -(defmacro mime-entity-set-references-internal (entity references) - `(aset ,entity 12 ,references)) -(defmacro mime-entity-chars-internal (entity) - `(aref ,entity 13)) -(defmacro mime-entity-set-chars-internal (entity chars) - `(aset ,entity 13 ,chars)) -(defmacro mime-entity-lines-internal (entity) - `(aref ,entity 14)) -(defmacro mime-entity-set-lines-internal (entity lines) - `(aset ,entity 14 ,lines)) -(defmacro mime-entity-xref-internal (entity) - `(aref ,entity 15)) -(defmacro mime-entity-set-xref-internal (entity xref) - `(aset ,entity 15 ,xref)) - -(defmacro mime-entity-original-header-internal (entity) - `(aref ,entity 16)) -(defmacro mime-entity-set-original-header-internal (entity header) - `(aset ,entity 16 ,header)) -(defmacro mime-entity-parsed-header-internal (entity) - `(aref ,entity 17)) -(defmacro mime-entity-set-parsed-header-internal (entity header) - `(aset ,entity 17 ,header)) - -(defmacro mime-entity-buffer-internal (entity) - `(aref ,entity 18)) -(defmacro mime-entity-set-buffer-internal (entity buffer) - `(aset ,entity 18 ,buffer)) -(defmacro mime-entity-header-start-internal (entity) - `(aref ,entity 19)) -(defmacro mime-entity-set-header-start-internal (entity point) - `(aset ,entity 19 ,point)) -(defmacro mime-entity-header-end-internal (entity) - `(aref ,entity 20)) -(defmacro mime-entity-set-header-end-internal (entity point) - `(aset ,entity 20 ,point)) -(defmacro mime-entity-body-start-internal (entity) - `(aref ,entity 21)) -(defmacro mime-entity-set-body-start-internal (entity point) - `(aset ,entity 21 ,point)) -(defmacro mime-entity-body-end-internal (entity) - `(aref ,entity 22)) -(defmacro mime-entity-set-body-end-internal (entity point) - `(aset ,entity 22 ,point)) +(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 @@ -336,12 +307,7 @@ Please use reference function `mime-entity-SLOT' to get value of SLOT. Following is a list of slots of the structure: -buffer buffer includes this entity (buffer). node-id node-id (list of integers) -header-start minimum point of header in raw-buffer -header-end maximum point of header in raw-buffer -body-start minimum point of body in raw-buffer -body-end maximum point of body in raw-buffer content-type content-type (content-type) content-disposition content-disposition (content-disposition) encoding Content-Transfer-Encoding (string or nil) @@ -353,81 +319,7 @@ message/rfc822, `mime-entity' structures of them are included in (make-variable-buffer-local 'mime-message-structure) - -;;; @ for mm-backend -;;; - -(defvar mime-entity-implementation-alist nil) - -(defmacro mm-define-backend (type &optional parents) - "Define TYPE as a mm-backend. -If PARENTS is specified, TYPE inherits PARENTS. -Each parent must be backend name (symbol)." - (if parents - `(let ((rest ',(reverse parents))) - (while rest - (set-alist 'mime-entity-implementation-alist - ',type - (copy-alist - (cdr (assq (car rest) - mime-entity-implementation-alist)))) - (setq rest (cdr rest)) - )))) - -(defmacro mm-define-method (name args &rest body) - "Define NAME as a method function of (nth 1 (car ARGS)) backend. - -ARGS is like an argument list of lambda, but (car ARGS) must be -specialized parameter. (car (car ARGS)) is name of variable and (nth -1 (car ARGS)) is name of backend." - (let* ((specializer (car args)) - (class (nth 1 specializer)) - (self (car specializer))) - `(let ((imps (cdr (assq ',class mime-entity-implementation-alist))) - (func (lambda ,(if self - (cons self (cdr args)) - (cdr args)) - ,@body))) - (if imps - (set-alist 'mime-entity-implementation-alist - ',class (put-alist ',name func imps)) - (set-alist 'mime-entity-implementation-alist - ',class - (list (cons ',name func))) - )))) - -(put 'mm-define-method 'lisp-indent-function 'defun) - -(eval-when-compile - (defmacro eval-module-depended-macro (module definition) - (condition-case nil - (progn - (require (eval module)) - definition) - (error `(eval-after-load ,(symbol-name (eval module)) ',definition)) - )) - ) - -(eval-module-depended-macro - 'edebug - (def-edebug-spec mm-define-method - (&define name ((arg symbolp) - [&rest arg] - [&optional ["&optional" arg &rest arg]] - &optional ["&rest" arg] - ) - def-body)) - ) - -(defsubst mm-arglist-to-arguments (arglist) - (let (dest) - (while arglist - (let ((arg (car arglist))) - (or (memq arg '(&optional &rest)) - (setq dest (cons arg dest))) - ) - (setq arglist (cdr arglist))) - (nreverse dest))) +(make-obsolete-variable 'mime-message-structure "should not use it.") ;;; @ for mel-backend @@ -446,7 +338,7 @@ service." `((defun ,name ,args ,@rest (funcall (mel-find-function ',name ,(car (last args))) - ,@(mm-arglist-to-arguments (butlast args))) + ,@(luna-arglist-to-arguments (butlast args))) ))) )) diff --git a/mime-en.sgml b/mime-en.sgml index 3ef7f7f..a5f488e 100644 --- a/mime-en.sgml +++ b/mime-en.sgml @@ -1290,11 +1290,11 @@ be interpreted as us-ascii. Bug report

If you write bug-reports and/or suggestions for improvement, please -send them to the tm Mailing List: +send them to the EMACS-MIME Mailing List:

    -
  • Japanese bug-tm-ja@chamonix.jaist.ac.jp -
  • English bug-tm-en@chamonix.jaist.ac.jp +
  • English emacs-mime-en@m17n.org +
  • Japanese emacs-mime-ja@m17n.org

@@ -1311,16 +1311,16 @@ to send backtrace is very important. Bug may not appear only your environment, but also in a lot of environment (otherwise it might not bug). Therefor if you send mail to author directly, we must write a lot of mails. So please send mail -to address for tm bugs instead of author. +to address for EMACS-MIME Mailing List instead of author.

-Via the tm ML, you can report FLIM bugs, obtain the latest release of -FLIM, and discuss future enhancements to FLIM. To join the tm ML, -send empty e-mail to: +Via the EMACS-MIME ML, you can report FLIM bugs, obtain the latest +release of FLIM, and discuss future enhancements to FLIM. To join the +EMACS-MIME ML, send an empty e-mail to:

    -
  • Japanese tm-ja-help@chamonix.jaist.ac.jp -
  • English tm-en-help@chamonix.jaist.ac.jp +
  • English emacs-mime-en-ctl@m17n.org +
  • Japanese emacs-mime-ja-ctl@m17n.org
diff --git a/mime-en.texi b/mime-en.texi index bf1be13..f9ea11c 100644 --- a/mime-en.texi +++ b/mime-en.texi @@ -1498,13 +1498,13 @@ interpreted as us-ascii. @cindex good bug report If you write bug-reports and/or suggestions for improvement, please -send them to the tm Mailing List: +send them to the EMACS-MIME Mailing List: @itemize @bullet @item - Japanese + English @item - English + Japanese @end itemize @@ -1521,17 +1521,17 @@ is very important. (cf. @ref{(emacs)Bugs}) @refill Bug may not appear only your environment, but also in a lot of environment (otherwise it might not bug). Therefor if you send mail to author directly, we must write a lot of mails. So please send mail -to address for tm bugs instead of author. +to address for EMACS-MIME Mailing List instead of author. -Via the tm ML, you can report FLIM bugs, obtain the latest release of -FLIM, and discuss future enhancements to FLIM. To join the tm ML, -send empty e-mail to: +Via the EMACS-MIME ML, you can report FLIM bugs, obtain the latest +release of FLIM, and discuss future enhancements to FLIM. To join the +EMACS-MIME ML, send an empty e-mail to: @itemize @bullet @item - Japanese + English @item - English + Japanese @end itemize diff --git a/mime-ja.sgml b/mime-ja.sgml index e358ca0..fddf067 100644 --- a/mime-ja.sgml +++ b/mime-ja.sgml @@ -303,7 +303,7 @@ list $B$G!"$=$l$>$l!"I=<($7$?$/$J$$(B field $BL>$HI=<($7$?$$MsL>$rI=8=$7$?$b$

point $B$NA0$K(B entity $B$r(B text entity $B$H$7$FA^F~$7$^$9!#(B

-entity $B$NFbMF$O(B MIMe charset $B$H$7$FI|9f2=$5$l(B +entity $B$NFbMF$O(B MIME charset $B$H$7$FI|9f2=$5$l(B $B$^$9!#(Bentity $B$N(B Content-Type field $B$K(B charset paramter $B$,L5(B $B$$$H!"(Bdefault-mime-charset $B$,=i4|CM$H$7$F;H$o$l$^$9!#(B @@ -329,7 +329,7 @@ MIME charset. entity

-pointo $B$N0LCV$K(B entity $B$NFbMF$rA^F~$7$^$9!#(B +point $B$N0LCV$K(B entity $B$NFbMF$rA^F~$7$^$9!#(B @@ -1292,8 +1292,8 @@ Internet message $B$K$*$1$kI8=`$N(B$BId9f2=J8( FLIM $B$N%P%0$r8+$D$1$?$i!"0J2<$N(B address $B$K(B mail $B$rAw$C$F$/$@$5$$!'(B

@@ -1312,12 +1312,12 @@ file="emacs" node="Bugs"> $B$F$/$@$5$$!#(B

-tm ML $B$G$O(B FLIM $B$N%P%0>pJs$N8r49$d:G?7HG$NG[I[!"(BFLIM $B$N2~NI$K4X$9$k5D(B -$BO@$r9T$J$C$F$$$^$9!#(Btm ML $B$K;22C$7$?$$J}$O(B +EMACS-MIME ML $B$G$O(B FLIM $B$N%P%0>pJs$N8r49$d:G?7HG$NG[I[!"(BFLIM $B$N2~NI$K(B +$B4X$9$k5DO@$r9T$J$C$F$$$^$9!#(BEMACS-MIME ML $B$K;22C$7$?$$J}$O(B

    -
  • $BF|K\8l(B tm-ja-help@chamonix.jaist.ac.jp -
  • $B1Q8l(B tm-en-help@chamonix.jaist.ac.jp +
  • $B1Q8l(B emacs-mime-en-ctl@m17n.org +
  • $BF|K\8l(B emacs-mime-ja-ctl@m17n.org
diff --git a/mime-ja.texi b/mime-ja.texi index 7cd0e10..3314ed3 100644 --- a/mime-ja.texi +++ b/mime-ja.texi @@ -88,14 +88,14 @@ FLIM $B$O(B entity $B$N>pJs$rI=8=$9$k$?$a$K(B@strong{mime-entity} $B9=(B @node Entity creation, Entity hierarchy, Entity, Entity @section Entity $B$N@8@.(B -@defun mime-open-entity &optional type location +@defun mime-open-entity type location -Open an entity and return it.@refill +Entity $B$r3+$$$F!"$=$l$rJV$7$^$9!#(B@refill -@var{type} is representation-type. (cf. @ref{mm-backend}) @refill +@var{type} $B$O(B representation-type $B$G$9!#(B(cf. @ref{mm-backend}) @refill -@var{location} is location of entity. Specification of it is depended -on representation-type. +@var{location} $B$O(B entity $B$N0LCV$G$9!#;XDjJ}K!$O(B +representation-type $B$K0M$C$FJQ$o$j$^$9!#(B @end defun @@ -209,28 +209,28 @@ local $BJQ?t!#(B @defun mime-find-entity-from-number entity-number &optional message -Return entity from @var{entity-number} in @var{message}.@refill +@var{message} $B$+$i!"(B@var{enity-number} $B$N(B entity $B$rJV$7$^$9!#(B@refill -If @var{message} is not specified, @code{mime-message-structure} is -used. +@var{message} $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B +@code{mime-message-structrue} $B$,;H$o$l$^$9!#(B @end defun @defun mime-find-entity-from-node-id entity-node-id &optional message -Return entity from @var{entity-node-id} in @var{message}.@refill +@var{message} $B$+$i!"(B@var{entity-node-id} $B$N(B entity $B$rJV$7$^$9!#(B@refill -If @var{message} is not specified, @code{mime-message-structure} is -used. +@var{message} $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B +@code{mime-message-structure} $B$,;H$o$l$^$9!#(B @end defun @defun mime-find-entity-from-content-id cid &optional message -Return entity from @var{cid} in @var{message}.@refill +@var{message} $B$+$i!"(B@var{cid} $B$N(B entity $B$rJV$7$^$9!#(B@refill -If @var{message} is not specified, @code{mime-message-structure} is -used. +@var{message} $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B +@code{mime-message-structure} $B$,;H$o$l$^$9!#(B @end defun @@ -270,8 +270,8 @@ used. @defun mime-entity-cooked-p entity -Return non-nil if contents of @var{entity} has been already -code-converted. +@var{entity} $B$NFbMF$,4{$K%3!<%IJQ49$5$l$F$$$k>l9g$O(B nil $B$GL5$$CM(B +$B$rJV$9!#(B @end defun @@ -332,11 +332,11 @@ encoded-word (@ref{encoded-word}) $B$OI|9f$5$l$k!#!X@8$NHs(B us-ascii $BJ8;z! @defun mime-insert-text-content entity -Insert before point a contents of @var{entity} as text entity.@refill +point $B$NA0$K(B @var{entity} $B$r(B text entity $B$H$7$FA^F~$7$^$9!#(B@refill -Contents of the @var{entity} are decoded as MIME charset (@ref{MIME charset}). If the @var{entity} does not have charset parameter of -Content-Type field, @code{default-mime-charset} is used as default -value. +@var{entity} $B$NFbMF$O(B @ref{MIME charset} $B$H$7$FI|9f2=$5$l(B +$B$^$9!#(B@var{entity} $B$N(B Content-Type field $B$K(B charset paramter $B$,L5(B +$B$$$H!"(B@code{default-mime-charset} $B$,=i4|CM$H$7$F;H$o$l$^$9!#(B @end defun @@ -361,13 +361,13 @@ value. @defun mime-insert-entity-content entity -Insert content of @var{entity} at point. +point $B$N0LCV$K(B @var{entity} $B$NFbMF$rA^F~$7$^$9!#(B @end defun @defun mime-write-entity-content entity filename -Write content of @var{entity} into @var{filename}. +@var{entity} $B$NFbMF$r(B @var{filename} $B$K=q$-9~$_$^$9!#(B @end defun @@ -377,19 +377,19 @@ Write content of @var{entity} into @var{filename}. @defun mime-insert-entity entity -Insert header and body of @var{entity} at point. +@var{entity} $B$N(B header $B$H(B body $B$r(B point $B$N$H$3$m$KA^F~$7$^$9!#(B @end defun @defun mime-write-entity entity filename -Write representation of @var{entity} into @var{filename}. +@var{entity} $B$NI=8=$r(B @var{filename} $B$K=q$-9~$_$^$9!#(B @end defun @defun mime-write-entity-body entity filename -Write body of @var{entity} into @var{filename}. +@var{entity} $B$N(B body $B$r(B @var{filename} $B$K=q$-9~$_$^$9!#(B @end defun @@ -495,12 +495,13 @@ representation-type $B$NL>A0$N@hF,$K(B @code{mm} $B$rIU$1$?$b$N$K$J$C$F(B @defmac mm-define-backend type &optional parents -Define @var{type} as a mm-backend.@refill +@var{type} $B$r(B mm-backend $B$H$7$FDj5A$7$^$9!#(B@refill -If @var{PARENTS} is specified, @var{type} inherits parents. Each parent -must be representation-type.@refill +@var{PARENTS} $B$,;XDj$5$l$F$$$k>l9g$O!"(B@var{type} $B$O(B prents +$B$r7Q>5$7$^$9!#$=$l$>$l$N(B parent $B$O(B representation-type $B$G$"$kI,MW$,$"(B +$B$j$^$9!#(B -Example:@refill +$BNc(B:@refill @lisp (mm-define-backend chao (generic)) @@ -510,15 +511,15 @@ Example:@refill @defmac mm-define-method name args &rest body -Define @var{name} as a method function of (nth 1 (car @var{args})) -backend.@refill +@var{name} $B$r(B (nth 1 (car @var{args})) backend $B$N(B method $B4X(B +$B?t$H$7$FDj5A$7$^$9!#(B@refill -@var{args} is like an argument list of lambda, but (car @var{args}) must -be specialized parameter. (car (car @var{args})) is name of variable -and (nth 1 (car @var{args})) is name of backend -(representation-type).@refill +@var{args} $B$O(B lambda $B$N0z?t%j%9%H$N$h$&$J$b$N$G$9$,!"(B(car +@var{args}) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car +(car @var{args})) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car @var{args})) +$B$O(B backend $B$NL>A0(B (representation-type) $B$G$9!#(B@refill -Example:@refill +$BNc(B:@refill @lisp (mm-define-method entity-cooked-p ((entity chao)) nil) @@ -812,15 +813,15 @@ Content-Transfer-Encoding $BMs$,B8:_$7$J$$>l9g$O(B@var{default-encoding} $B$r @defun mime-encode-region start end encoding -Encode region @var{start} to @var{end} of current buffer using -@var{encoding}. +$B8=:_$N(B buffer $B$N(B @var{start} $B$+$i(B @var{end} $B$^$G$N(B region $B$r(B +@var{encoding} $B$r;H$C$FId9f2=$7$^$9!#(B @end defun @defun mime-decode-region start end encoding -Decode region @var{start} to @var{end} of current buffer using -@var{encoding}. +$B8=:_$N(B buffer $B$N(B @var{start} $B$+$i(B @var{end} $B$^$G$N(B region $B$r(B +@var{encoding} $B$r;H$C$FI|9f2=$7$^$9!#(B @end defun @@ -834,16 +835,17 @@ Decode region @var{start} to @var{end} of current buffer using @defun mime-insert-encoded-file filename encoding -Insert file @var{FILENAME} encoded by @var{ENCODING} format. +@var{ENCODING} format $B$GId9f2=$5$l$?(B file @var{FILENAME} $B$r(B +$BA^F~$9$k!#(B @end defun @defun mime-write-decoded-region start end filename encoding -Decode and write current region encoded by @var{encoding} into -@var{filename}.@refill +@var{encoding} $B$GId9f2=$5$l$?8=:_$N(B region $B$rI|9f2=$7$F(B +@var{filename}$B$K=q$-9~$_$^$9!#(B -@var{start} and @var{end} are buffer positions. +start $B$H(B @var{end} $B$O(B buffer $B$N0LCV$G$9!#(B @end defun @@ -853,19 +855,19 @@ Decode and write current region encoded by @var{encoding} into @defun mime-encoding-list &optional SERVICE -Return list of Content-Transfer-Encoding.@refill +Content-Transfer-Encoding $B$N(B list $B$rJV$7$^$9!#(B@refill -If @var{service} is specified, it returns available list of -Content-Transfer-Encoding for it. +@var{service} $B$,;XDj$5$l$F$$$k$H!"$=$l$KBP$9$k(B +Content-Transfer-Encoding $B$rJV$7$^$9!#(B @end defun @defun mime-encoding-alist &optional SERVICE -Return table of Content-Transfer-Encoding for completion.@refill +$BJd40$N$?$a$N(B Content-Transfer-Encoding $B$NI=$rJV$7$^$9!#(B@refill -If @var{service} is specified, it returns available list of -Content-Transfer-Encoding for it. +@var{service} $B$,;XDj$5$l$F$$$k>l9g$O$=$l$KBP$9$k(B +Content-Transfer-Encoding $B$N(B list $B$rJV$7$^$9!#(B @end defun @@ -875,15 +877,15 @@ Content-Transfer-Encoding for it. @defmac mel-define-method name args &rest body -Define @var{name} as a method function of (nth 1 (car (last -@var{args}))) backend.@refill +@var{name} $B$r(B (nth 1 (car (last @var{args}))) backend $B$N(B +method $B4X?t$H$7$FDj5A$7$^$9!#(B -@var{args} is like an argument list of lambda, but (car (last -@var{args})) must be specialized parameter. (car (car (last -@var{args}))) is name of variable and (nth 1 (car (last @var{args}))) is -name of backend (encoding).@refill +@var{args} $B$O(B lambda $B$N0z?t(B list $B$H;w$F$$$^$9$,!"(B(car (last +@var{args})) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car +(car (last @var{args}))) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car (last +@var{args}))) $B$O(B backend $B$NL>A0(B (encoding) $B$G$9!#(B@refill -Example:@refill +$BNc(B:@refill @lisp (mel-define-method mime-write-decoded-region (start end filename @@ -904,16 +906,16 @@ START and END are buffer positions." @defmac mel-define-method-function spec function -Set @var{spec}'s function definition to @var{function}.@refill +@var{spec} $B$N4X?tDj5A$r(B @var{function} $B$K@_Dj$7$^$9!#(B@refill -First element of @var{spec} is service.@refill +@var{spec} $B$N:G=i$NMWAG$O(B service $B$G$9!#(B@refill -Rest of @var{args} is like an argument list of lambda, but (car (last -@var{args})) must be specialized parameter. (car (car (last -@var{args}))) is name of variable and (nth 1 (car (last @var{args}))) is -name of backend (encoding).@refill +@var{args} $B$N;D$j$O(B lambda $B$N0z?t(B list $B;w$F$$$^$9$,!"(B(car (last +@var{args})) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car +(car (last @var{args}))) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car (last +@var{args}))) $B$O(B backend $B$NL>A0(B (encoding) $B$G$9!#(B@refill -Example:@refill +$BNc(B:@refill @lisp (mel-define-method-function (mime-encode-string string (nil "base64")) @@ -924,16 +926,17 @@ Example:@refill @node generic function for mel-backend, , mel-backend, Content-Transfer-Encoding -@section How to add encoding/decoding service +@section $BId9f2=(B/$BI|9f2=(B service $B$rDI2C$9$kJ}K!(B @defmac mel-define-service name &optional args doc-string -Define @var{name} as a service for Content-Transfer-Encodings.@refill +@var{name} $B$r(B Content-Transfer-Encoding $B$N(B service $B$H$7$FDj5A$7$^(B +$B$9!#(B@refill -If @var{args} is specified, @var{name} is defined as a generic function -for the service.@refill +@var{args} $B$,;XDj$5$l$F$$$k$H!"(B@var{name} $B$O(B service $B$N(B +generic function $B$H$7$FDj5A$5$l$^$9!#(B@refill -Example:@refill +$BNc(B:@refill @lisp (mel-define-service encoded-text-encode-string (string encoding) @@ -1001,19 +1004,19 @@ Header $B$r(B network $BI=8=$KId9f2=$9$k!#(B@refill @defvar eword-field-encoding-method-alist -Association list to specify field encoding method. Each element looks -like (FIELD . METHOD).@refill +Field $B$rId9f2=$9$kJ}K!$r;XDj$9$kO"A[(B list$B!#3F(B element $B$O(B (FIELD +. METHOD) $B$NMM$K$J$C$F$$$k!#(B@refill -If METHOD is @code{mime}, the FIELD will be encoded into MIME format -(encoded-word).@refill +METHOD $B$,(B @code{mime} $B$G$"$l$P!"(BFIELD $B$O(B MIME format $B$KId9f2=$5(B +$B$l$k(B (encoded-word)$B!#(B -If METHOD is @code{nil}, the FIELD will not be encoded.@refill +METHOD $B$,(B @code{nil} $B$G$"$l$P!"(BFIELD $B$OId9f2=$5$l$J$$!#(B -If METHOD is a MIME charset, the FIELD will be encoded as the charset -when it must be convert into network-code.@refill +METHOD $B$,(B MIME charset $B$G$"$l$P!"(BFIELD $B$O%M%C%H%o!<%/%3!<%I$KJQ49$7$J(B +$B$1$l$P$J$i$J$$$H$-$K(B charset $B$KId9f2=$5$l$k!#(B@refill -Otherwise the FIELD will be encoded as variable -@code{default-mime-charset} when it must be convert into network-code. +$B$=$&$G$J$1$l$P!"(BFIELD $B$O%M%C%H%o!<%/%3!<%I$KJQ49$7$J$1$l$P$J$i$J$$$H$-(B +$B$K(B $BJQ?t(B @code{default-mime-charset} $B$GId9f2=$5$l$k(B @end defvar @@ -1495,9 +1498,9 @@ FLIM $B$N%P%0$r8+$D$1$?$i!"0J2<$N(B address $B$K(B mail $B$rAw$C$F$/$@$5$$! @itemize @bullet @item - $BF|K\8l(B + $B1Q8l(B @item - $B1Q8l(B + $BF|K\8l(B @end itemize @@ -1515,14 +1518,14 @@ FLIM $B$N%P%0$r8+$D$1$?$i!"0J2<$N(B address $B$K(B mail $B$rAw$C$F$/$@$5$$! $B$r2?DL$b=q$/1)L\$K$J$j$^$9!#$@$+$i!"I,$:(B bug $BJs9p$O>e5-$N(B address $B$KAw$C(B $B$F$/$@$5$$!#(B -tm ML $B$G$O(B FLIM $B$N%P%0>pJs$N8r49$d:G?7HG$NG[I[!"(BFLIM $B$N2~NI$K4X$9$k5D(B -$BO@$r9T$J$C$F$$$^$9!#(Btm ML $B$K;22C$7$?$$J}$O(B +EMACS-MIME ML $B$G$O(B FLIM $B$N%P%0>pJs$N8r49$d:G?7HG$NG[I[!"(BFLIM $B$N2~NI$K(B +$B4X$9$k5DO@$r9T$J$C$F$$$^$9!#(BEMACS-MIME ML $B$K;22C$7$?$$J}$O(B @itemize @bullet @item - $BF|K\8l(B + $B1Q8l(B @item - $B1Q8l(B + $BF|K\8l(B @end itemize @noindent diff --git a/mime-parse.el b/mime-parse.el index 7d760c4..5442896 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -27,6 +27,10 @@ (require 'mime-def) (require 'std11) +(autoload 'mime-entity-body-buffer "mime") +(autoload 'mime-entity-body-start-point "mime") +(autoload 'mime-entity-body-end-point "mime") + ;;; @ lexical analyzer ;;; @@ -213,70 +217,74 @@ If is is not found, return DEFAULT-ENCODING." ;;; (defun mime-parse-multipart (entity) - (goto-char (point-min)) - (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) - )) - (header-end (mime-entity-header-end-internal entity)) - (body-end (mime-entity-body-end-internal entity))) - (save-restriction - (goto-char body-end) - (narrow-to-region header-end - (if (re-search-backward close-delimiter nil t) - (match-beginning 0) - body-end)) - (goto-char header-end) - (if (re-search-forward rsep nil t) - (let ((cb (match-end 0)) - ce ncb ret children - (node-id (mime-entity-node-id-internal entity)) - (i 0)) - (while (re-search-forward rsep nil t) - (setq ce (match-beginning 0)) - (setq ncb (match-end 0)) + (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)) - (goto-char (setq cb ncb)) - (setq i (1+ i)) + (mime-entity-set-children-internal entity (nreverse children)) ) - (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) - ))) + (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 - (save-restriction - (narrow-to-region (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity)) - (list (mime-parse-message - (mime-entity-representation-type-internal entity) nil - entity (cons 0 (mime-entity-node-id-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-message (representation-type &optional default-ctl parent node-id) @@ -301,15 +309,16 @@ If is is not found, return DEFAULT-ENCODING." )) default-ctl)) ) - (make-mime-entity-internal representation-type - (current-buffer) - content-type nil parent node-id - nil nil nil nil - nil nil nil nil - nil nil - (current-buffer) - header-start header-end - body-start body-end) + (luna-make-entity representation-type + :location (current-buffer) + :content-type content-type + :parent parent + :node-id node-id + :buffer (current-buffer) + :header-start header-start + :header-end header-end + :body-start body-start + :body-end body-end) )) @@ -323,7 +332,8 @@ 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 'buffer) nil)) + (mime-parse-message (or representation-type + 'mime-buffer-entity) nil)) )) diff --git a/mime.el b/mime.el index ce23631..63af880 100644 --- a/mime.el +++ b/mime.el @@ -1,8 +1,10 @@ ;;; 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. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). @@ -66,50 +68,18 @@ current-buffer, and return it.") ;;; @ Entity Representation and Implementation ;;; -(defsubst mime-find-function (service type) - (let ((imps (cdr (assq type mime-entity-implementation-alist)))) - (if imps - (cdr (assq service imps)) - (require (intern (format "mm%s" type))) - (cdr (assq service - (cdr (assq type mime-entity-implementation-alist)))) - ))) - -(defsubst mime-entity-function (entity service) - (mime-find-function service - (mime-entity-representation-type-internal entity))) - -(defsubst mime-entity-send (entity message &rest args) - "Send MESSAGE to ENTITY with ARGS, and return the result." - (apply (mime-find-function - message (mime-entity-representation-type-internal entity)) - entity - args)) - -(defmacro mm-define-generic (name args &optional doc) - (if doc - `(defun ,(intern (format "mime-%s" name)) ,args - ,doc - (mime-entity-send ,(car args) ',name - ,@(mm-arglist-to-arguments (cdr args))) - ) - `(defun ,(intern (format "mime-%s" name)) ,args - (mime-entity-send ,(car args) ',name - ,@(mm-arglist-to-arguments (cdr args))) - ))) - -(put 'mm-define-generic 'lisp-indent-function 'defun) +(defmacro mime-entity-send (entity message &rest args) + `(luna-send ,entity ',(intern (format "mime-%s" (eval message))) ,@args)) (defun mime-open-entity (type location) "Open an entity and return it. TYPE is representation-type. LOCATION is location of entity. Specification of it is depended on representation-type." - (let ((entity (make-mime-entity-internal type location))) - (mime-entity-send entity 'initialize-instance) - entity)) + (require (intern (format "mm%s" type))) + (luna-make-entity (mm-expand-class-name type) :location location)) -(mm-define-generic entity-cooked-p (entity) +(luna-define-generic mime-entity-cooked-p (entity) "Return non-nil if contents of ENTITY has been already code-converted.") @@ -118,7 +88,7 @@ representation-type." (defun mime-entity-children (entity) (or (mime-entity-children-internal entity) - (mime-entity-send entity 'entity-children))) + (luna-send entity 'mime-entity-children entity))) (defalias 'mime-entity-node-id 'mime-entity-node-id-internal) @@ -150,7 +120,7 @@ If MESSAGE is not specified, `mime-message-structure' is used." If MESSAGE is not specified, `mime-message-structure' is used." (or message (setq message mime-message-structure)) - (if (equal cid (mime-read-field 'Content-Id message)) + (if (equal cid (mime-entity-read-field message "Content-Id")) message (let ((children (mime-entity-children message)) ret) @@ -173,76 +143,79 @@ If MESSAGE is specified, it is regarded as root entity." (null (mime-entity-parent entity message))) -;;; @ Entity Buffer +;;; @ Header buffer ;;; -(defun mime-entity-buffer (entity) - (or (mime-entity-buffer-internal entity) - (mime-entity-send entity 'entity-buffer))) +(luna-define-generic mime-entity-header-buffer (entity)) -(mm-define-generic entity-point-min (entity) - "Return the start point of ENTITY in the buffer which contains ENTITY.") +(luna-define-generic mime-goto-header-start-point (entity) + "Set buffer and point to header-start-position of ENTITY.") -(mm-define-generic entity-point-max (entity) - "Return the end point of ENTITY in the buffer which contains ENTITY.") +(luna-define-generic mime-entity-header-start-point (entity) + "Return header-start-position of ENTITY.") -(defun mime-entity-header-start (entity) - (or (mime-entity-header-start-internal entity) - (mime-entity-send entity 'entity-header-start))) +(luna-define-generic mime-entity-header-end-point (entity) + "Return header-end-position of ENTITY.") + + +;;; @ Body buffer +;;; -(defun mime-entity-header-end (entity) - (or (mime-entity-header-end-internal entity) - (mime-entity-send entity 'entity-header-end))) +(luna-define-generic mime-entity-body-buffer (entity)) -(defun mime-entity-body-start (entity) - (or (mime-entity-body-start-internal entity) - (mime-entity-send entity 'entity-body-start))) +(luna-define-generic mime-goto-body-start-point (entity) + "Set buffer and point to body-start-position of ENTITY.") -(defun mime-entity-body-end (entity) - (or (mime-entity-body-end-internal entity) - (mime-entity-send entity 'entity-body-end))) +(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.") + +(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.") + +(define-obsolete-function-alias + 'mime-entity-body-end 'mime-entity-body-end-point) + + +;;; @ 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-point-min (entity)) +(make-obsolete 'mime-entity-point-min 'mime-entity-header-start-point) + +(luna-define-generic mime-entity-point-max (entity)) +(make-obsolete 'mime-entity-point-max 'mime-entity-body-end-point) ;;; @ Entity Header ;;; +(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) - (or (symbolp field-name) - (setq field-name (intern (capitalize (capitalize field-name))))) + "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)) - (cond ((eq field-name 'Date) - (or (mime-entity-date-internal entity) - (mime-entity-set-date-internal - entity (mime-entity-send entity 'fetch-field "Date")) - )) - ((eq field-name 'Message-Id) - (or (mime-entity-message-id-internal entity) - (mime-entity-set-message-id-internal - entity (mime-entity-send entity 'fetch-field "Message-Id")) - )) - ((eq field-name 'References) - (or (mime-entity-references-internal entity) - (mime-entity-set-references-internal - entity (mime-entity-send entity 'fetch-field "References")) - )) - (t - (let* ((header (mime-entity-original-header-internal entity)) - (field-body (cdr (assq field-name header)))) - (or field-body - (progn - (if (setq field-body - (mime-entity-send entity 'fetch-field - (symbol-name field-name))) - (mime-entity-set-original-header-internal - entity (put-alist field-name field-body header)) - ) - field-body)) - )))) + (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) - (let ((ret (mime-fetch-field 'Content-Type entity))) + (let ((ret (mime-entity-fetch-field entity "Content-Type"))) (if ret (mime-entity-set-content-type-internal entity (mime-parse-Content-Type ret)) @@ -250,7 +223,7 @@ If MESSAGE is specified, it is regarded as root entity." (defun mime-entity-content-disposition (entity) (or (mime-entity-content-disposition-internal entity) - (let ((ret (mime-fetch-field 'Content-Disposition entity))) + (let ((ret (mime-entity-fetch-field entity "Content-Disposition"))) (if ret (mime-entity-set-content-disposition-internal entity (mime-parse-Content-Disposition ret)) @@ -258,7 +231,7 @@ If MESSAGE is specified, it is regarded as root entity." (defun mime-entity-encoding (entity &optional default-encoding) (or (mime-entity-encoding-internal entity) - (let ((ret (mime-fetch-field 'Content-Transfer-Encoding entity))) + (let ((ret (mime-entity-fetch-field entity "Content-Transfer-Encoding"))) (mime-entity-set-encoding-internal entity (or (and ret (mime-parse-Content-Transfer-Encoding ret)) @@ -294,58 +267,64 @@ If MESSAGE is specified, it is regarded as root entity." (Content-Id . mime-parse-msg-id) )) +(defun mime-entity-read-field (entity field-name) + (let ((sym (if (symbolp field-name) + (prog1 + field-name + (setq field-name (symbol-name field-name))) + (capitalize (capitalize field-name))))) + (cond ((eq sym 'Content-Type) + (mime-entity-content-type entity) + ) + ((eq sym 'Content-Disposition) + (mime-entity-content-disposition entity) + ) + ((eq sym 'Content-Transfer-Encoding) + (mime-entity-encoding entity) + ) + (t + (let* ((header (mime-entity-parsed-header-internal entity)) + (field (cdr (assq sym header)))) + (or field + (let ((field-body (mime-entity-fetch-field entity field-name)) + parser) + (when field-body + (setq parser + (cdr (assq sym mime-field-parser-alist))) + (setq field + (if parser + (funcall parser + (eword-lexical-analyze field-body)) + (mime-decode-field-body field-body sym 'plain) + )) + (mime-entity-set-parsed-header-internal + entity (put-alist sym field header)) + field)))))))) + (defun mime-read-field (field-name &optional entity) - (or (symbolp field-name) - (setq field-name (capitalize (capitalize field-name)))) (or entity (setq entity mime-message-structure)) - (cond ((eq field-name 'Content-Type) - (mime-entity-content-type entity) - ) - ((eq field-name 'Content-Disposition) - (mime-entity-content-disposition entity) - ) - ((eq field-name 'Content-Transfer-Encoding) - (mime-entity-encoding entity) - ) - (t - (let* ((header (mime-entity-parsed-header-internal entity)) - (field (cdr (assq field-name header)))) - (or field - (let ((field-body (mime-fetch-field field-name entity)) - parser) - (when field-body - (setq parser - (cdr (assq field-name mime-field-parser-alist))) - (setq field - (if parser - (funcall parser - (eword-lexical-analyze field-body)) - (mime-decode-field-body - field-body field-name 'plain) - )) - (mime-entity-set-parsed-header-internal - entity (put-alist field-name field header)) - field))))))) - -(mm-define-generic insert-header (entity &optional invisible-fields - visible-fields) - "Insert before point a decoded header of ENTITY.") + (mime-entity-read-field entity field-name) + ) +(make-obsolete 'mime-read-field 'mime-entity-read-field) -(define-obsolete-function-alias - 'mime-insert-decoded-header 'mime-insert-header) +(luna-define-generic mime-insert-header (entity &optional invisible-fields + visible-fields) + "Insert before point a decoded header of ENTITY.") ;;; @ Entity Attributes ;;; +(luna-define-generic mime-entity-name (entity) + "Return name of the ENTITY.") + (defun mime-entity-uu-filename (entity) (if (member (mime-entity-encoding entity) mime-uuencode-encoding-name-list) (save-excursion - (set-buffer (mime-entity-buffer entity)) - (goto-char (mime-entity-body-start entity)) + (mime-goto-body-start-point entity) (if (re-search-forward "^begin [0-9]+ " - (mime-entity-body-end entity) t) + (mime-entity-body-end-point entity) t) (if (looking-at ".+$") (buffer-substring (match-beginning 0)(match-end 0)) ))))) @@ -376,25 +355,25 @@ If MESSAGE is specified, it is regarded as root entity." ;;; @ Entity Content ;;; -(mm-define-generic entity-content (entity) +(luna-define-generic mime-entity-content (entity) "Return content of ENTITY as byte sequence (string).") -(mm-define-generic insert-entity-content (entity) +(luna-define-generic mime-insert-entity-content (entity) "Insert content of ENTITY at point.") -(mm-define-generic write-entity-content (entity filename) +(luna-define-generic mime-write-entity-content (entity filename) "Write content of ENTITY into FILENAME.") -(mm-define-generic insert-text-content (entity) +(luna-define-generic mime-insert-text-content (entity) "Insert decoded text body of ENTITY.") -(mm-define-generic insert-entity (entity) +(luna-define-generic mime-insert-entity (entity) "Insert header and body of ENTITY at point.") -(mm-define-generic write-entity (entity filename) +(luna-define-generic mime-write-entity (entity filename) "Write header and body of ENTITY into FILENAME.") -(mm-define-generic write-entity-body (entity filename) +(luna-define-generic mime-write-entity-body (entity filename) "Write body of ENTITY into FILENAME.") diff --git a/mmbuffer.el b/mmbuffer.el index 38432fb..f014aec 100644 --- a/mmbuffer.el +++ b/mmbuffer.el @@ -1,8 +1,10 @@ ;;; 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. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). @@ -24,107 +26,262 @@ ;;; Code: -(require 'mmgeneric) +(require 'mime) -(mm-define-backend buffer (generic)) +(eval-and-compile + (luna-define-class mime-buffer-entity (mime-entity) + (buffer + header-start + header-end + body-start + body-end)) -(mm-define-method initialize-instance ((entity buffer)) - (mime-entity-set-buffer-internal - entity (mime-entity-location-internal entity)) + (luna-define-internal-accessors 'mime-buffer-entity) + ) + +(luna-define-method initialize-instance :after ((entity mime-buffer-entity) + &rest init-args) + (or (mime-buffer-entity-buffer-internal entity) + (mime-buffer-entity-set-buffer-internal + entity (mime-entity-location-internal entity))) (save-excursion - (set-buffer (mime-entity-buffer-internal entity)) - (setq mime-message-structure entity) - (let ((header-start (point-min)) - header-end - body-start - (body-end (point-max))) + (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 + entity (point-min)))) + (header-end (mime-buffer-entity-header-end-internal entity)) + (body-start (mime-buffer-entity-body-start-internal entity)) + (body-end + (or (mime-buffer-entity-body-end-internal entity) + (mime-buffer-entity-set-body-end-internal entity (point-max))))) (goto-char header-start) - (if (re-search-forward "^$" nil t) - (setq header-end (match-end 0) - body-start (if (= header-end body-end) - body-end - (1+ header-end))) - (setq header-end (point-min) - body-start (point-min))) - (save-restriction - (narrow-to-region header-start header-end) - (mime-entity-set-content-type-internal - entity - (let ((str (std11-fetch-field "Content-Type"))) - (if str - (mime-parse-Content-Type str) - ))) + (unless (and header-end body-start) + (if (re-search-forward "^$" body-end t) + (setq header-end (match-end 0) + body-start (if (= header-end body-end) + body-end + (1+ header-end))) + (setq header-end (point-min) + body-start (point-min))) + (mime-buffer-entity-set-header-end-internal entity header-end) + (mime-buffer-entity-set-body-start-internal entity body-start) ) - (mime-entity-set-header-start-internal entity header-start) - (mime-entity-set-header-end-internal entity header-end) - (mime-entity-set-body-start-internal entity body-start) - (mime-entity-set-body-end-internal entity body-end) - ))) + (or (mime-entity-content-type-internal entity) + (save-restriction + (narrow-to-region header-start header-end) + (mime-entity-set-content-type-internal + entity + (let ((str (std11-fetch-field "Content-Type"))) + (if str + (mime-parse-Content-Type str) + ))) + )) + )) + entity) -;;; redefine to speed up +(luna-define-method mime-entity-name ((entity mime-buffer-entity)) + (buffer-name (mime-buffer-entity-buffer-internal entity)) + ) -(mm-define-method entity-point-min ((entity buffer)) - (mime-entity-header-start-internal entity)) -(mm-define-method entity-point-max ((entity buffer)) - (mime-entity-body-end-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))) -(mm-define-method fetch-field ((entity buffer) field-name) - (save-excursion - (set-buffer (mime-entity-buffer-internal entity)) - (save-restriction - (narrow-to-region (mime-entity-header-start-internal entity) - (mime-entity-header-end-internal entity)) - (std11-fetch-field field-name) - ))) - -(mm-define-method entity-content ((entity buffer)) +(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-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-entity-content ((entity mime-buffer-entity)) (save-excursion - (set-buffer (mime-entity-buffer-internal entity)) + (set-buffer (mime-buffer-entity-buffer-internal entity)) (mime-decode-string - (buffer-substring (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity)) + (buffer-substring (mime-buffer-entity-body-start-internal entity) + (mime-buffer-entity-body-end-internal entity)) (mime-entity-encoding entity)))) +(luna-define-method mime-entity-fetch-field :around + ((entity mime-buffer-entity) field-name) + (or (luna-call-next-method) + (save-excursion + (set-buffer (mime-buffer-entity-buffer-internal entity)) + (save-restriction + (narrow-to-region (mime-buffer-entity-header-start-internal entity) + (mime-buffer-entity-header-end-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)))))) + (mm-define-method insert-entity-content ((entity buffer)) - (insert (with-current-buffer (mime-entity-buffer-internal entity) + (insert (with-current-buffer (mime-buffer-entity-buffer-internal entity) (mime-decode-string - (buffer-substring (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity)) + (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-entity-buffer-internal entity)) - (mime-write-decoded-region (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity) + (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-entity-buffer-internal entity) - (mime-entity-header-start-internal entity) - (mime-entity-body-end-internal entity)) + (insert-buffer-substring (mime-buffer-entity-buffer-internal entity) + (mime-buffer-entity-header-start-internal entity) + (mime-buffer-entity-body-end-internal entity)) ) (mm-define-method write-entity ((entity buffer) filename) (save-excursion - (set-buffer (mime-entity-buffer-internal entity)) - (write-region-as-raw-text-CRLF (mime-entity-header-start-internal entity) - (mime-entity-body-end-internal entity) - filename) + (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-entity-buffer-internal entity)) - (write-region-as-binary (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity) + (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-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-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-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-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) + ) + + +;;; @ buffer (obsolete) +;;; + +(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-max ((entity mime-buffer-entity)) + (mime-buffer-entity-body-end-internal entity) + ) + + ;;; @ end ;;; diff --git a/mmcooked.el b/mmcooked.el index 6995469..f55a34a 100644 --- a/mmcooked.el +++ b/mmcooked.el @@ -1,6 +1,6 @@ ;;; mmcooked.el --- MIME entity implementation for binary buffer -;; Copyright (C) 1998 Free Software Foundation, Inc. +;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news @@ -32,36 +32,40 @@ (mm-define-method write-entity-content ((entity cooked) filename) (save-excursion - (set-buffer (mime-entity-buffer-internal entity)) + (set-buffer (mime-buffer-entity-buffer-internal entity)) (let ((encoding (or (mime-entity-encoding entity) "7bit"))) (if (member encoding '("7bit" "8bit" "binary")) - (write-region (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity) filename) - (mime-write-decoded-region (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity) - filename encoding) + (write-region (mime-buffer-entity-body-start-internal entity) + (mime-buffer-entity-body-end-internal entity) filename) + (mime-write-decoded-region + (mime-buffer-entity-body-start-internal entity) + (mime-buffer-entity-body-end-internal entity) + filename encoding) )))) (mm-define-method write-entity ((entity cooked) filename) (save-excursion - (set-buffer (mime-entity-buffer-internal entity)) - (write-region (mime-entity-header-start-internal entity) - (mime-entity-body-end-internal entity) + (set-buffer (mime-buffer-entity-buffer-internal entity)) + (write-region (mime-buffer-entity-header-start-internal entity) + (mime-buffer-entity-body-end-internal entity) filename) )) (mm-define-method write-entity-body ((entity cooked) filename) (save-excursion - (set-buffer (mime-entity-buffer-internal entity)) - (write-region (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity) + (set-buffer (mime-buffer-entity-buffer-internal entity)) + (write-region (mime-buffer-entity-body-start-internal entity) + (mime-buffer-entity-body-end-internal entity) filename) )) -(mm-define-method insert-header ((entity cooked) - &optional invisible-fields visible-fields) +(luna-define-method mime-insert-header ((entity mime-cooked-entity) + &optional invisible-fields + visible-fields) (let (default-mime-charset) - (funcall (mime-find-function 'insert-decoded-header 'buffer) + (funcall (car (luna-class-find-functions + (luna-find-class 'mime-buffer-entity) + 'mime-insert-header)) entity invisible-fields visible-fields) )) diff --git a/mmdbuffer.el b/mmdbuffer.el new file mode 100644 index 0000000..637eab3 --- /dev/null +++ b/mmdbuffer.el @@ -0,0 +1,250 @@ +;;; 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. + +;; 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) + +(eval-and-compile + (luna-define-class mime-dual-entity (mime-entity) + (header-buffer + body-buffer)) + + (luna-define-internal-accessors 'mime-dual-entity) + ) + +(luna-define-method initialize-instance :after ((entity mime-dual-entity) + &rest init-args) + (let (buf) + (setq 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) + +(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) + (let* ((buf (mime-dual-entity-header-buffer-internal entity)) + header-start header-end) + (with-current-buffer buf + (setq header-start (point-min) + header-end (point-max))) + (mime-insert-header-from-buffer buf header-start header-end + invisible-fields visible-fields) + )) + +(luna-define-method mime-entity-content ((entity mime-dual-entity)) + (mime-decode-string + (with-current-buffer (mime-dual-entity-body-buffer-internal entity) + (buffer-string)) + (mime-entity-encoding entity))) + +(luna-define-method mime-entity-fetch-field :around + ((entity mime-dual-entity) field-name) + (or (luna-call-next-method) + (with-current-buffer (mime-dual-entity-header-buffer-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-entity-content ((entity mime-dual-entity)) + (insert + (mime-decode-string + (with-current-buffer (mime-dual-entity-body-buffer-internal entity) + (buffer-substring (point-min)(point-max))) + (mime-entity-encoding entity)))) + +(luna-define-method mime-write-entity-content ((entity mime-dual-entity) + filename) + (with-current-buffer (mime-dual-entity-body-buffer-internal entity) + (mime-write-decoded-region (point-min) + (point-max) + filename + (or (mime-entity-encoding entity) "7bit")))) + +(luna-define-method mime-insert-entity ((entity mime-dual-entity)) + (let (buf) + (setq buf (mime-dual-entity-header-buffer-internal entity)) + (when buf + (insert-buffer (mime-dual-entity-header-buffer-internal entity)) + (setq buf (mime-dual-entity-body-buffer-internal entity)) + (when buf + (insert "\n") + (insert-buffer buf))))) + +(luna-define-method mime-write-entity ((entity mime-dual-entity) filename) + (let (buf) + (setq buf (mime-dual-entity-header-buffer-internal entity)) + (if (null buf) + (error "No header buffer.") + (with-current-buffer buf + (write-region-as-raw-text-CRLF + (point-min)(point-max) filename)) + (setq buf (mime-dual-entity-body-buffer-internal entity)) + (when buf + (with-temp-buffer + (insert "\n") + (write-region-as-raw-text-CRLF + (point-min)(point-max) + filename 'append)) + (with-current-buffer buf + (write-region-as-raw-text-CRLF + (point-min)(point-max) + filename 'append)))))) + +(luna-define-method mime-write-entity-body ((entity mime-dual-entity) filename) + (with-current-buffer (mime-dual-entity-body-buffer-internal entity) + (write-region-as-binary (point-min)(point-max) + filename))) + + +;;; @ buffer +;;; + +(luna-define-method mime-entity-header-buffer ((entity mime-dual-entity)) + (mime-dual-entity-header-buffer-internal entity)) + +(luna-define-method mime-entity-body-buffer ((entity mime-dual-entity)) + (mime-dual-entity-body-buffer-internal entity)) + +(luna-define-method mime-entity-buffer ((entity mime-dual-entity)) + (message "mime-dual-entity does not have mime-entity-buffer.") + nil) + +(luna-define-method mime-entity-body-start-point ((entity mime-dual-entity)) + (with-current-buffer (mime-entity-body-buffer entity) + (point-min))) + +(luna-define-method mime-entity-body-end-point ((entity mime-dual-entity)) + (with-current-buffer (mime-entity-body-buffer entity) + (point-max))) + +(luna-define-method mime-entity-point-min ((entity mime-dual-entity)) + (message "mime-dual-entity does not have mime-entity-point-min.") + nil) + +(luna-define-method mime-entity-point-max ((entity mime-dual-entity)) + (message "mime-dual-entity does not have mime-entity-point-max.") + nil) + +(luna-define-method mime-goto-header-start-point ((entity mime-dual-entity)) + (set-buffer (mime-dual-entity-header-buffer-internal entity)) + (goto-char (point-min))) + +(luna-define-method mime-goto-body-start-point ((entity mime-dual-entity)) + (set-buffer (mime-dual-entity-body-buffer-internal entity)) + (goto-char (point-min))) + +(luna-define-method mime-goto-body-end-point ((entity mime-dual-entity)) + (set-buffer (mime-dual-entity-body-buffer-internal entity)) + (goto-char (point-max))) + + +;;; @ end +;;; + +(provide 'mmdual) + +;;; mmdual.el ends here diff --git a/mmgeneric.el b/mmgeneric.el deleted file mode 100644 index df11185..0000000 --- a/mmgeneric.el +++ /dev/null @@ -1,219 +0,0 @@ -;;; mmgeneric.el --- MIME entity module for generic buffer - -;; Copyright (C) 1998,1999 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 'mime-parse) - -(mm-define-backend generic) - -(mm-define-method entity-header-start ((entity generic)) - (mime-entity-set-header-start-internal - entity - (save-excursion - (set-buffer (mime-entity-buffer entity)) - (point-min) - ))) - -(mm-define-method entity-header-end ((entity generic)) - (save-excursion - (set-buffer (mime-entity-buffer entity)) - (mime-entity-header-end-internal entity) - )) - -(mm-define-method entity-body-start ((entity generic)) - (mime-entity-set-body-start-internal - entity - (save-excursion - (set-buffer (mime-entity-buffer entity)) - (mime-entity-body-start-internal entity) - ))) - -(mm-define-method entity-body-end ((entity generic)) - (mime-entity-set-body-end-internal - entity - (save-excursion - (set-buffer (mime-entity-buffer entity)) - (point-max) - ))) - -(mm-define-method entity-point-min ((entity generic)) - (or (mime-entity-header-start-internal entity) - (mime-entity-send entity 'entity-header-start))) - -(mm-define-method entity-point-max ((entity generic)) - (or (mime-entity-body-end-internal entity) - (mime-entity-send entity 'entity-body-end))) - -(mm-define-method fetch-field ((entity generic) field-name) - (save-excursion - (set-buffer (mime-entity-buffer entity)) - (save-restriction - (narrow-to-region (mime-entity-header-start-internal entity) - (mime-entity-header-end-internal entity)) - (std11-fetch-field field-name) - ))) - -(mm-define-method entity-cooked-p ((entity generic)) nil) - -(mm-define-method entity-children ((entity generic)) - (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) - )) - )) - -(mm-define-method entity-content ((entity generic)) - (save-excursion - (set-buffer (mime-entity-buffer entity)) - (mime-decode-string - (buffer-substring (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity)) - (mime-entity-encoding entity)))) - -(mm-define-method insert-entity-content ((entity generic)) - (insert (with-current-buffer (mime-entity-buffer entity) - (mime-decode-string - (buffer-substring (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity)) - (mime-entity-encoding entity))))) - -(mm-define-method write-entity-content ((entity generic) filename) - (save-excursion - (set-buffer (mime-entity-buffer entity)) - (mime-write-decoded-region (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity) - filename - (or (mime-entity-encoding entity) "7bit")) - )) - -(mm-define-method insert-entity ((entity generic)) - (insert-buffer-substring (mime-entity-buffer entity) - (mime-entity-header-start-internal entity) - (mime-entity-body-end-internal entity)) - ) - -(mm-define-method write-entity ((entity generic) filename) - (save-excursion - (set-buffer (mime-entity-buffer entity)) - (write-region-as-raw-text-CRLF (mime-entity-header-start-internal entity) - (mime-entity-body-end-internal entity) - filename) - )) - -(mm-define-method write-entity-body ((entity generic) filename) - (save-excursion - (set-buffer (mime-entity-buffer entity)) - (write-region-as-binary (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity) - filename) - )) - -(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") - ))))))) - -(mm-define-method insert-header ((entity generic) - &optional invisible-fields visible-fields) - (mime-insert-header-from-buffer - (mime-entity-buffer entity) - (mime-entity-header-start-internal entity) - (mime-entity-header-end-internal entity) - invisible-fields visible-fields) - ) - -(mm-define-method insert-text-content ((entity generic)) - (insert - (decode-mime-charset-string (mime-entity-content entity) - (or (mime-content-type-parameter - (mime-entity-content-type entity) - "charset") - default-mime-charset) - 'CRLF) - )) - - -;;; @ end -;;; - -(provide 'mmgeneric) - -;;; mmgeneric.el ends here diff --git a/smtp.el b/smtp.el index baef1ec..532bb14 100644 --- a/smtp.el +++ b/smtp.el @@ -1,11 +1,10 @@ ;;; smtp.el --- basic functions to send mail with SMTP server -;; Copyright (C) 1995, 1996, 1998 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1998, 1999 Free Software Foundation, Inc. ;; Author: Tomoji Kagatani -;; Simon Leinen (ESMTP support) -;; MORIOKA Tomohiko (separate smtp.el from smtpmail.el) -;; Shuhei KOBAYASHI +;; Simon Leinen (ESMTP support) +;; Shuhei KOBAYASHI ;; Keywords: SMTP, mail ;; This file is part of FLIM (Faithful Library about Internet Message). @@ -73,6 +72,12 @@ don't define this value." :type 'boolean :group 'smtp) +(defcustom smtp-notify-success nil + "*If non-nil, notification for successful mail delivery is returned + to user (RFC1891)." + :type 'boolean + :group 'smtp) + (defvar smtp-read-point nil) (defun smtp-make-fqdn () @@ -203,7 +208,11 @@ don't define this value." ;; RCPT TO: (while recipients (smtp-send-command process - (format "RCPT TO:<%s>" (car recipients))) + (format + (if smtp-notify-success + "RCPT TO:<%s> NOTIFY=SUCCESS" + "RCPT TO:<%s>") + (car recipients))) (setq recipients (cdr recipients)) (setq response (smtp-read-response process)) (if (or (null (car response)) diff --git a/smtpmail.el b/smtpmail.el index 1cb7a1f..74638aa 100644 --- a/smtpmail.el +++ b/smtpmail.el @@ -1,6 +1,6 @@ ;;; smtpmail.el --- SMTP interface for mail-mode -;; Copyright (C) 1995, 1996, 1998 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1998, 1999 Free Software Foundation, Inc. ;; Author: Tomoji Kagatani ;; Keywords: mail @@ -62,14 +62,14 @@ ;;; (defcustom smtpmail-queue-mail nil - "*Specify if mail is queued (if t) or sent immediately (if nil). + "Specify if mail is queued (if t) or sent immediately (if nil). If queued, it is stored in the directory `smtpmail-queue-dir' and sent with `smtpmail-send-queued-mail'." :type 'boolean :group 'smtp) (defcustom smtpmail-queue-dir "~/Mail/queued-mail/" - "*Directory where `smtpmail.el' stores queued mail." + "Directory where `smtpmail.el' stores queued mail." :type 'directory :group 'smtp) @@ -77,8 +77,9 @@ and sent with `smtpmail-send-queued-mail'." "File name of queued mail index, This is relative to `smtpmail-queue-dir'.") -(defvar smtpmail-queue-index (concat smtpmail-queue-dir - smtpmail-queue-index-file)) +(defvar smtpmail-queue-index + (concat (file-name-as-directory smtpmail-queue-dir) + smtpmail-queue-index-file)) (defvar smtpmail-recipient-address-list nil) @@ -130,7 +131,9 @@ This is relative to `smtpmail-queue-dir'.") (save-restriction (narrow-to-region (point) (save-excursion - (end-of-line) + (forward-line 1) + (while (looking-at "^[ \t]") + (forward-line 1)) (point))) (append (mail-parse-comma-list) resend-to-addresses)))) @@ -228,10 +231,11 @@ This is relative to `smtpmail-queue-dir'.") tembuf)) (error "Sending failed; SMTP protocol error")) (error "Sending failed; no recipients")) - (let* ((file-data (concat - smtpmail-queue-dir - (time-stamp-strftime - "%02y%02m%02d-%02H%02M%02S"))) + (let* ((file-data (convert-standard-filename + (concat + (file-name-as-directory smtpmail-queue-dir) + (time-stamp-yyyy-mm-dd) + "_" (time-stamp-hh:mm:ss)))) (file-elisp (concat file-data ".el")) (buffer-data (create-file-buffer file-data)) (buffer-elisp (create-file-buffer file-elisp)) @@ -240,7 +244,9 @@ This is relative to `smtpmail-queue-dir'.") (set-buffer buffer-data) (erase-buffer) (insert-buffer tembuf) - (write-file file-data) + (or (file-directory-p smtpmail-queue-dir) + (make-directory smtpmail-queue-dir t)) + (write-region-as-binary (point-min) (point-max) file-data) (set-buffer buffer-elisp) (erase-buffer) (insert (concat @@ -276,7 +282,7 @@ This is relative to `smtpmail-queue-dir'.") (end-of-line) (point)))) (load file-msg) - (setq tembuf (find-file-noselect file-msg)) + (setq tembuf (find-file-noselect-as-binary file-msg)) (if smtpmail-recipient-address-list (if (not (smtp-via-smtp user-mail-address smtpmail-recipient-address-list tembuf)) -- 1.7.10.4