From: okada Date: Fri, 23 Jun 2000 19:09:49 +0000 (+0000) Subject: sync up to chao-1_14_0-1 X-Git-Tag: slim-1_14_0~8 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=9493d6d8b5093832c72dab98c19ca3ae20aaf21e;p=elisp%2Fflim.git sync up to chao-1_14_0-1 --- diff --git a/ChangeLog b/ChangeLog index bb7178d..e4eb83f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,78 @@ * mime-def.el (mime-library-product): Up. +2000-06-23 MORIOKA Tomohiko + + * mmexternal.el (initialize-instance): New method. + (mime-entity-name): Fixed. + (mmexternal-require-buffer): New function. + (mime-insert-entity): New implementation. + (mime-write-entity): Likewise. + (mime-entity-body): New method. + (mime-insert-entity-body): New method. + (mime-write-entity-body): New implementation. + (mime-entity-content): Likewise. + (mime-insert-entity-content): Likewise. + (mime-write-entity-content): Likewise. + (mime-entity-fetch-field): Likewise. + (mime-insert-header): Likewise. + + * mmbuffer.el (initialize-instance): Store buffer instead of name + of buffer to `buffer' slot. + +2000-06-21 MORIOKA Tomohiko + + * mmgeneric.el (mime-entity-children): Deleted. + + * mmbuffer.el (mime-insert-entity-body): New method. + (mmbuffer-parse-multipart): New function. + (mmbuffer-parse-encapsulated): New function. + (mime-entity-children): New function. + +2000-06-21 MORIOKA Tomohiko + + * mime.el (mime-find-root-entity): New function. + (mime-entity-header-buffer): Comment out. + (mime-goto-header-start-point): Likewise. + (mime-entity-header-start-point): Likewise. + (mime-entity-header-end-point): Likewise. + (mime-entity-body-buffer): Likewise. + (mime-goto-body-start-point): Likewise. + (mime-goto-body-end-point): Likewise. + (mime-entity-body-start-point): Likewise. + (mime-entity-body-end-point): Likewise. + (mime-entity-body-start): Likewise. + (mime-entity-body-end): Likewise. + (mime-entity-buffer): Likewise. + (mime-entity-point-min): Likewise. + (mime-entity-point-max): Likewise. + (mime-insert-entity-body): New generic function. + (mime-entity-uu-filename): Use `mime-insert-entity-body'. + (mime-entity-set-content-type): New function. + (mime-entity-set-encoding): New function. + + * mime-parse.el (mime-parse-multipart): Comment out. + (mime-parse-encapsulated): Likewise. + (mime-parse-external): Likewise. + + * mmbuffer.el (mime-entity-header-buffer): Comment out. + (mime-goto-header-start-point): Likewise. + (mime-entity-header-start-point): Likewise. + (mime-entity-header-end-point): Likewise. + (mime-entity-body-buffer): Likewise. + (mime-goto-body-start-point): Likewise. + (mime-goto-body-end-point): Likewise. + (mime-entity-body-start-point): Likewise. + (mime-entity-body-end-point): Likewise. + (mime-entity-buffer): Likewise. + (mime-entity-point-min): Likewise. + (mime-entity-point-max): Likewise. + +2000-05-30 MORIOKA Tomohiko + + * eword-encode.el (eword-charset-encoding-alist): Add + `iso-2022-jp-3'. + 2000-05-25 Tanaka Akira * mime-en.sgml, mime-ja.sgml: Update for CVS via SSH. @@ -11,11 +83,17 @@ * smtp.el (smtp-deduce-address-list): Set `case-fold-search' to `t' in the working buffer. +2000-04-26 Yoshiki Hayashi + + * mime.el (mime-entity-body): New function. + * mmbuffer.el (mime-entity-body): Implement it. + 2000-04-17 Yoshiki Hayashi * mel.el (mime-decode-string): Return original string when it failed to decode. + 2000-04-16 Kenichi OKADA * SLIM: Version 1.13.7 released. @@ -25,6 +103,74 @@ * sasl.el (sasl-scram-md5-client-security-info): eval-when-compile. +2000-03-03 Keiichi Suzuki + + * mime.el (mime-entity-node-id): Change to function. + +2000-03-03 MORIOKA Tomohiko + + * mmdbuffer.el, mmbuffer.el (initialize-instance): Don't setup + `mime-message-structure'. + + * mime-parse.el (mime-parse-buffer): Don't setup + `mime-message-structure'. + +2000-03-02 MORIOKA Tomohiko + + * mmgeneric.el (mime-visible-field-p): Moved from mmbuffer.el. + (mime-insert-header-from-buffer): Moved from mmbuffer.el. + + * mmexternal.el, mmdbuffer.el, mmbuffer.el (mime-visible-field-p): + Moved to mmgeneric.el. + (mime-insert-header-from-buffer): Moved to mmgeneric.el. + +2000-03-02 MORIOKA Tomohiko + + * FLIM-ELS (flim-modules): Add `mmgeneric'. + + * mmgeneric.el: New file. + + * mmbuffer.el: Require `mmgeneric'. + + * mime.el: Require `mmgeneric' when compiling. + + * mime-def.el: Move mime-entity related definitions to + mmgeneric.el. + +2000-03-01 MORIOKA Tomohiko + + * mime.el (mime-find-entity-from-number): Now second argument + `message' is not an optional argument. + (mime-find-entity-from-node-id): Likewise. + (mime-find-entity-from-content-id): Likewise. + (mime-fetch-field): Delete obsolete function. + (mime-read-field): Likewise. + +2000-03-01 MORIOKA Tomohiko + + * mime.el (mime-entity-header-buffer): Mark it as obsolete. + (mime-goto-header-start-point): Likewise. + (mime-entity-header-start-point): Likewise. + (mime-entity-header-end-point): Likewise. + (mime-entity-body-start): Use `defalias'; don't recommend to use + `mime-entity-body-start-point' instead. + (mime-entity-body-end): Use `defalias'; don't recommend to use + `mime-entity-body-end-point' instead. + (mime-entity-body-buffer): Mark it as obsolete. + (mime-goto-body-start-point): Likewise. + (mime-goto-body-end-point): Likewise. + (mime-entity-body-start-point): Likewise. + (mime-entity-body-end-point): Likewise. + (mime-entity-buffer): Don't recommend to use + `mime-entity-header-buffer' or `mime-entity-body-buffer' instead. + (mime-entity-point-min): Don't recommend to use + `mime-entity-header-start-point' instead. + (mime-entity-point-max): Don't recommend to use + `mime-entity-body-end-point' instead. + + * mime-def.el (mime-library-version): update to 1.14.1. + - Add autoload setting for `mime-parse-external'. + 2000-02-03 Kenichi OKADA * smtp.el (TopLevel): Autoload `sasl-digest-md5-digest-response'. @@ -136,6 +282,17 @@ (base64-internal-encode-region): Likewise. (base64-encode-string): Likewise. +1999-12-16 MORIOKA Tomohiko + + * FLIM-ELS (flim-modules): Add `mmexternal'. + + * mime-parse.el (mime-parse-external): New function. + + * mime-def.el (mime-entity-children [mime-entity]): Use + `mime-parse-external' for message/external-body. + + * mmexternal.el: New module. + 1999-12-13 Kenichi OKADA * smtp.el (smtp-aut-login): Update to new api. @@ -491,7 +648,45 @@ * smtp.el (smtp-via-smtp): Use sasl.el for SASL. * FLIM-ELS (flim-modules): Add `sasl'. +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'. + +>>>>>>> 1.134.2.18 1999-08-17 MORIOKA Tomohiko * FLIM: Version 1.13.2 (Kasanui) released. diff --git a/FLIM-ELS b/FLIM-ELS index d03d26a..63ee339 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -8,7 +8,8 @@ luna mime-def mel mel-q mel-u mel-g eword-decode eword-encode - mime mime-parse mmbuffer mmcooked mmdbuffer + mime mime-parse mmgeneric + mmbuffer mmcooked mmdbuffer mmexternal mailcap smtp smtpmail sasl md5 md5-el md5-dl @@ -17,8 +18,9 @@ scram-md5 digest-md5 unique-id starttls)) -(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 12f0d2c..6c4ad57 100644 --- a/Makefile +++ b/Makefile @@ -3,8 +3,8 @@ # PACKAGE = slim -API = 1.13 -RELEASE = 6 +API = 1.14 +RELEASE = 0 TAR = tar RM = /bin/rm -f @@ -26,7 +26,7 @@ FILES = README.?? Makefile FLIM-MK FLIM-CFG FLIM-ELS *.el ChangeLog VERSION = $(API).$(RELEASE) ARC_DIR = /ftp/pub/mule/flim/flim-$(API) -SEMI_ARC_DIR = /ftp/pub/mule/semi/semi-1.13-for-flim-$(API) +SEMI_ARC_DIR = /ftp/pub/mule/semi/semi-1.14-for-flim-$(API) elc: $(EMACS) $(FLAGS) -f compile-flim $(PREFIX) $(LISPDIR) \ diff --git a/VERSION b/VERSION index 173b421..6719e47 100644 --- a/VERSION +++ b/VERSION @@ -87,3 +87,5 @@ 1.12.1 T-Dòfukuji-A $(BElJ!;{(B ; <=> $(B5~:e(B 1.12.2 Inari $(B0p2Y(B 1.13.0 JR Fujinomori JR $(BF#?9(B +1.14.0 Momoyama $(BEm;3(B +1.14.1 Rokujiz-Dò-A $(BO;COB"(B diff --git a/eword-encode.el b/eword-encode.el index 4f45c6f..5735e04 100644 --- a/eword-encode.el +++ b/eword-encode.el @@ -77,6 +77,7 @@ If method is nil, this field will not be encoded." (iso-8859-8 . "Q") (iso-8859-9 . "Q") (iso-2022-jp . "B") + (iso-2022-jp-3 . "B") (iso-2022-kr . "B") (gb2312 . "B") (cn-gb . "B") diff --git a/mailcap.el b/mailcap.el index eb1c093..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 ?\\) ) diff --git a/mime-def.el b/mime-def.el index dd43d35..e0bdc23 100644 --- a/mime-def.el +++ b/mime-def.el @@ -1,8 +1,6 @@ -;;; mime-def.el --- definition module about MIME +;;; mime-def.el --- definition module about MIME -*- coding: iso-8859-4; -*- -;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. -;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. +;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: definition, MIME, multimedia, mail, news @@ -32,12 +30,14 @@ (require 'mcharset) (require 'alist) -(eval-when-compile (require 'cl)) ; list* +(eval-when-compile + (require 'cl) ; list* + (require 'luna) ; luna-arglist-to-arguments + ) (eval-and-compile - (defconst mime-library-product ["SLIM" (1 14 0) "$B0BIt$J$D$_(B"] - "Product name, version number and code name of MIME-library package.") - ) + (defconst mime-library-product ["SLIM" (1 14 0) "$(B0BIt$J$D$_(B"] + "Product name, version number and code name of MIME-library package.")) (defmacro mime-product-name (product) `(aref ,product 0)) @@ -207,97 +207,6 @@ (mime-content-disposition-parameter content-disposition "filename")) -;;; @ MIME entity -;;; - -(require 'luna) - -(autoload 'mime-entity-content-type "mime") -(autoload 'mime-parse-multipart "mime-parse") -(autoload 'mime-parse-encapsulated "mime-parse") -(autoload 'mime-entity-content "mime") - -(luna-define-class mime-entity () - (location - content-type children parent - node-id - content-disposition encoding - ;; for other fields - original-header parsed-header)) - -(defalias 'mime-entity-representation-type-internal 'luna-class-name) -(defalias 'mime-entity-set-representation-type-internal 'luna-set-class-name) - -(luna-define-internal-accessors 'mime-entity) - -(luna-define-method mime-entity-fetch-field ((entity mime-entity) - field-name) - (or (symbolp field-name) - (setq field-name (intern (capitalize (capitalize field-name))))) - (cdr (assq field-name - (mime-entity-original-header-internal entity)))) - -(luna-define-method mime-entity-children ((entity mime-entity)) - (let* ((content-type (mime-entity-content-type entity)) - (primary-type (mime-content-type-primary-type content-type))) - (cond ((eq primary-type 'multipart) - (mime-parse-multipart entity) - ) - ((and (eq primary-type 'message) - (memq (mime-content-type-subtype content-type) - '(rfc822 news external-body) - )) - (mime-parse-encapsulated entity) - )) - )) - -(luna-define-method mime-insert-text-content ((entity mime-entity)) - (insert - (decode-mime-charset-string (mime-entity-content entity) - (or (mime-content-type-parameter - (mime-entity-content-type entity) - "charset") - default-mime-charset) - 'CRLF) - )) - - -;;; @ for mm-backend -;;; - -(defmacro mm-expand-class-name (type) - `(intern (format "mime-%s-entity" ,type))) - -(defmacro mm-define-backend (type &optional parents) - `(luna-define-class ,(mm-expand-class-name type) - ,(nconc (mapcar (lambda (parent) - (mm-expand-class-name parent) - ) - parents) - '(mime-entity)))) - -(defmacro mm-define-method (name args &rest body) - (or (eq name 'initialize-instance) - (setq name (intern (format "mime-%s" name)))) - (let ((spec (car args))) - (setq args - (cons (list (car spec) - (mm-expand-class-name (nth 1 spec))) - (cdr args))) - `(luna-define-method ,name ,args ,@body) - )) - -(put 'mm-define-method 'lisp-indent-function 'defun) - -(def-edebug-spec mm-define-method - (&define name ((arg symbolp) - [&rest arg] - [&optional ["&optional" arg &rest arg]] - &optional ["&rest" arg] - ) - def-body)) - - ;;; @ message structure ;;; diff --git a/mime-parse.el b/mime-parse.el index 5442896..4aeb30c 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -216,75 +216,89 @@ If is is not found, return DEFAULT-ENCODING." ;;; @ message parser ;;; -(defun mime-parse-multipart (entity) - (with-current-buffer (mime-entity-body-buffer entity) - (let* ((representation-type - (mime-entity-representation-type-internal entity)) - (content-type (mime-entity-content-type-internal entity)) - (dash-boundary - (concat "--" - (mime-content-type-parameter content-type "boundary"))) - (delimiter (concat "\n" (regexp-quote dash-boundary))) - (close-delimiter (concat delimiter "--[ \t]*$")) - (rsep (concat delimiter "[ \t]*\n")) - (dc-ctl - (if (eq (mime-content-type-subtype content-type) 'digest) - (make-mime-content-type 'message 'rfc822) - (make-mime-content-type 'text 'plain) - )) - (body-start (mime-entity-body-start-point entity)) - (body-end (mime-entity-body-end-point entity))) - (save-restriction - (goto-char body-end) - (narrow-to-region body-start - (if (re-search-backward close-delimiter nil t) - (match-beginning 0) - body-end)) - (goto-char body-start) - (if (re-search-forward - (concat "^" (regexp-quote dash-boundary) "[ \t]*\n") - nil t) - (let ((cb (match-end 0)) - ce ncb ret children - (node-id (mime-entity-node-id-internal entity)) - (i 0)) - (while (re-search-forward rsep nil t) - (setq ce (match-beginning 0)) - (setq ncb (match-end 0)) - (save-restriction - (narrow-to-region cb ce) - (setq ret (mime-parse-message representation-type dc-ctl - entity (cons i node-id))) - ) - (setq children (cons ret children)) - (goto-char (setq cb ncb)) - (setq i (1+ i)) - ) - (setq ce (point-max)) - (save-restriction - (narrow-to-region cb ce) - (setq ret (mime-parse-message representation-type dc-ctl - entity (cons i node-id))) - ) - (setq children (cons ret children)) - (mime-entity-set-children-internal entity (nreverse children)) - ) - (mime-entity-set-content-type-internal - entity (make-mime-content-type 'message 'x-broken)) - nil) - )))) - -(defun mime-parse-encapsulated (entity) - (mime-entity-set-children-internal - entity - (with-current-buffer (mime-entity-body-buffer entity) - (save-restriction - (narrow-to-region (mime-entity-body-start-point entity) - (mime-entity-body-end-point entity)) - (list (mime-parse-message - (mime-entity-representation-type-internal entity) nil - entity (cons 0 (mime-entity-node-id-internal entity)))) - )))) +;; (defun mime-parse-multipart (entity) +;; (with-current-buffer (mime-entity-body-buffer entity) +;; (let* ((representation-type +;; (mime-entity-representation-type-internal entity)) +;; (content-type (mime-entity-content-type-internal entity)) +;; (dash-boundary +;; (concat "--" +;; (mime-content-type-parameter content-type "boundary"))) +;; (delimiter (concat "\n" (regexp-quote dash-boundary))) +;; (close-delimiter (concat delimiter "--[ \t]*$")) +;; (rsep (concat delimiter "[ \t]*\n")) +;; (dc-ctl +;; (if (eq (mime-content-type-subtype content-type) 'digest) +;; (make-mime-content-type 'message 'rfc822) +;; (make-mime-content-type 'text 'plain) +;; )) +;; (body-start (mime-entity-body-start-point entity)) +;; (body-end (mime-entity-body-end-point entity))) +;; (save-restriction +;; (goto-char body-end) +;; (narrow-to-region body-start +;; (if (re-search-backward close-delimiter nil t) +;; (match-beginning 0) +;; body-end)) +;; (goto-char body-start) +;; (if (re-search-forward +;; (concat "^" (regexp-quote dash-boundary) "[ \t]*\n") +;; nil t) +;; (let ((cb (match-end 0)) +;; ce ncb ret children +;; (node-id (mime-entity-node-id-internal entity)) +;; (i 0)) +;; (while (re-search-forward rsep nil t) +;; (setq ce (match-beginning 0)) +;; (setq ncb (match-end 0)) +;; (save-restriction +;; (narrow-to-region cb ce) +;; (setq ret (mime-parse-message representation-type dc-ctl +;; entity (cons i node-id))) +;; ) +;; (setq children (cons ret children)) +;; (goto-char (setq cb ncb)) +;; (setq i (1+ i)) +;; ) +;; (setq ce (point-max)) +;; (save-restriction +;; (narrow-to-region cb ce) +;; (setq ret (mime-parse-message representation-type dc-ctl +;; entity (cons i node-id))) +;; ) +;; (setq children (cons ret children)) +;; (mime-entity-set-children-internal entity (nreverse children)) +;; ) +;; (mime-entity-set-content-type-internal +;; entity (make-mime-content-type 'message 'x-broken)) +;; nil) +;; )))) + +;; (defun mime-parse-encapsulated (entity) +;; (mime-entity-set-children-internal +;; entity +;; (with-current-buffer (mime-entity-body-buffer entity) +;; (save-restriction +;; (narrow-to-region (mime-entity-body-start-point entity) +;; (mime-entity-body-end-point entity)) +;; (list (mime-parse-message +;; (mime-entity-representation-type-internal entity) nil +;; entity (cons 0 (mime-entity-node-id-internal entity)))) +;; )))) + +;; (defun mime-parse-external (entity) +;; (require 'mmexternal) +;; (mime-entity-set-children-internal +;; entity +;; (with-current-buffer (mime-entity-body-buffer entity) +;; (save-restriction +;; (narrow-to-region (mime-entity-body-start-point entity) +;; (mime-entity-body-end-point entity)) +;; (list (mime-parse-message +;; 'mime-external-entity nil +;; entity (cons 0 (mime-entity-node-id-internal entity)))) +;; ;; [tomo] Should we unify with `mime-parse-encapsulated'? +;; )))) (defun mime-parse-message (representation-type &optional default-ctl parent node-id) @@ -331,10 +345,8 @@ If is is not found, return DEFAULT-ENCODING." If buffer is omitted, it parses current-buffer." (save-excursion (if buffer (set-buffer buffer)) - (setq mime-message-structure - (mime-parse-message (or representation-type - 'mime-buffer-entity) nil)) - )) + (mime-parse-message (or representation-type + 'mime-buffer-entity) nil))) ;;; @ end diff --git a/mime.el b/mime.el index 63af880..0f9ea4a 100644 --- a/mime.el +++ b/mime.el @@ -1,8 +1,6 @@ ;;; mime.el --- MIME library module -;; Copyright (C) 1998,1999 Free Software Foundation, Inc. -;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. +;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news @@ -31,6 +29,8 @@ (require 'mime-def) (require 'eword-decode) +(eval-when-compile (require 'mmgeneric)) + (eval-and-compile (autoload 'eword-encode-header "eword-encode" @@ -90,17 +90,15 @@ representation-type." (or (mime-entity-children-internal entity) (luna-send entity 'mime-entity-children entity))) -(defalias 'mime-entity-node-id 'mime-entity-node-id-internal) +(defun mime-entity-node-id (entity) + (mime-entity-node-id-internal entity)) (defun mime-entity-number (entity) "Return entity-number of ENTITY." (reverse (mime-entity-node-id-internal entity))) -(defun mime-find-entity-from-number (entity-number &optional message) - "Return entity from ENTITY-NUMBER in MESSAGE. -If MESSAGE is not specified, `mime-message-structure' is used." - (or message - (setq message mime-message-structure)) +(defun mime-find-entity-from-number (entity-number message) + "Return entity from ENTITY-NUMBER in MESSAGE." (let ((sn (car entity-number))) (if (null sn) message @@ -110,16 +108,12 @@ If MESSAGE is not specified, `mime-message-structure' is used." )) ))) -(defun mime-find-entity-from-node-id (entity-node-id &optional message) - "Return entity from ENTITY-NODE-ID in MESSAGE. -If MESSAGE is not specified, `mime-message-structure' is used." +(defun mime-find-entity-from-node-id (entity-node-id message) + "Return entity from ENTITY-NODE-ID in MESSAGE." (mime-find-entity-from-number (reverse entity-node-id) message)) -(defun mime-find-entity-from-content-id (cid &optional message) - "Return entity from CID in MESSAGE. -If MESSAGE is not specified, `mime-message-structure' is used." - (or message - (setq message mime-message-structure)) +(defun mime-find-entity-from-content-id (cid message) + "Return entity from CID in MESSAGE." (if (equal cid (mime-entity-read-field message "Content-Id")) message (let ((children (mime-entity-children message)) @@ -142,76 +136,131 @@ If MESSAGE is specified, it is regarded as root entity." If MESSAGE is specified, it is regarded as root entity." (null (mime-entity-parent entity message))) +(defun mime-find-root-entity (entity) + "Return root entity of ENTITY." + (let ((p (mime-entity-parent entity))) + (if (null p) + entity + (mime-entity-parent p)))) + -;;; @ Header buffer +;;; @ Header buffer (obsolete) ;;; -(luna-define-generic mime-entity-header-buffer (entity)) +;; (luna-define-generic mime-entity-header-buffer (entity)) -(luna-define-generic mime-goto-header-start-point (entity) - "Set buffer and point to header-start-position of ENTITY.") +;; (luna-define-generic mime-goto-header-start-point (entity) +;; "Set buffer and point to header-start-position of ENTITY.") -(luna-define-generic mime-entity-header-start-point (entity) - "Return header-start-position of ENTITY.") +;; (luna-define-generic mime-entity-header-start-point (entity) +;; "Return header-start-position of ENTITY.") -(luna-define-generic mime-entity-header-end-point (entity) - "Return header-end-position of ENTITY.") +;; (luna-define-generic mime-entity-header-end-point (entity) +;; "Return header-end-position of ENTITY.") +;; (make-obsolete 'mime-entity-header-buffer "don't use it.") +;; (make-obsolete 'mime-goto-header-start-point "don't use it.") +;; (make-obsolete 'mime-entity-header-start-point "don't use it.") +;; (make-obsolete 'mime-entity-header-end-point "don't use it.") -;;; @ Body buffer + +;;; @ Body buffer (obsolete) ;;; -(luna-define-generic mime-entity-body-buffer (entity)) +;; (luna-define-generic mime-entity-body-buffer (entity)) -(luna-define-generic mime-goto-body-start-point (entity) - "Set buffer and point to body-start-position of ENTITY.") +;; (luna-define-generic mime-goto-body-start-point (entity) +;; "Set buffer and point to body-start-position of ENTITY.") -(luna-define-generic mime-goto-body-end-point (entity) - "Set buffer and point to body-end-position of ENTITY.") +;; (luna-define-generic mime-goto-body-end-point (entity) +;; "Set buffer and point to body-end-position of ENTITY.") -(luna-define-generic mime-entity-body-start-point (entity) - "Return body-start-position of ENTITY.") +;; (luna-define-generic mime-entity-body-start-point (entity) +;; "Return body-start-position of ENTITY.") -(define-obsolete-function-alias - 'mime-entity-body-start 'mime-entity-body-start-point) +;; (luna-define-generic mime-entity-body-end-point (entity) +;; "Return body-end-position of ENTITY.") -(luna-define-generic mime-entity-body-end-point (entity) - "Return body-end-position of ENTITY.") +;; (defalias 'mime-entity-body-start 'mime-entity-body-start-point) +;; (defalias 'mime-entity-body-end 'mime-entity-body-end-point) -(define-obsolete-function-alias - 'mime-entity-body-end 'mime-entity-body-end-point) +;; (make-obsolete 'mime-entity-body-buffer "don't use it.") +;; (make-obsolete 'mime-goto-body-start-point "don't use it.") +;; (make-obsolete 'mime-goto-body-end-point "don't use it.") +;; (make-obsolete 'mime-entity-body-start-point "don't use it.") +;; (make-obsolete 'mime-entity-body-end-point "don't use it.") +;; (make-obsolete 'mime-entity-body-start "don't use it.") +;; (make-obsolete 'mime-entity-body-end "don't use it.") ;;; @ Entity buffer (obsolete) ;;; -(luna-define-generic mime-entity-buffer (entity)) -(make-obsolete 'mime-entity-buffer - "use mime-entity-header-buffer or mime-entity-body-buffer instead.") +;; (luna-define-generic mime-entity-buffer (entity)) +;; (make-obsolete 'mime-entity-buffer "don't use it.") + +;; (luna-define-generic mime-entity-point-min (entity)) +;; (make-obsolete 'mime-entity-point-min "don't use it.") + +;; (luna-define-generic mime-entity-point-max (entity)) +;; (make-obsolete 'mime-entity-point-max "don't use it.") + + +;;; @ Entity +;;; + +(luna-define-generic mime-insert-entity (entity) + "Insert header and body of ENTITY at point.") + +(luna-define-generic mime-write-entity (entity filename) + "Write header and body of ENTITY into FILENAME.") + + +;;; @ Entity Body +;;; + +(luna-define-generic mime-entity-body (entity) + "Return network representation of ENTITY body.") -(luna-define-generic mime-entity-point-min (entity)) -(make-obsolete 'mime-entity-point-min 'mime-entity-header-start-point) +(luna-define-generic mime-insert-entity-body (entity) + "Insert network representation of ENTITY body at point.") -(luna-define-generic mime-entity-point-max (entity)) -(make-obsolete 'mime-entity-point-max 'mime-entity-body-end-point) +(luna-define-generic mime-write-entity-body (entity filename) + "Write body of ENTITY into FILENAME.") -;;; @ Entity Header +;;; @ Entity Content +;;; + +(luna-define-generic mime-entity-content (entity) + "Return content of ENTITY as byte sequence (string).") + +(luna-define-generic mime-insert-entity-content (entity) + "Insert content of ENTITY at point.") + +(luna-define-generic mime-write-entity-content (entity filename) + "Write content of ENTITY into FILENAME.") + +(luna-define-generic mime-insert-text-content (entity) + "Insert decoded text body of ENTITY.") + + +;;; @ Header fields ;;; (luna-define-generic mime-entity-fetch-field (entity field-name) "Return the value of the ENTITY's header field whose type is FIELD-NAME.") -(defun mime-fetch-field (field-name &optional entity) - "Return the value of the ENTITY's header field whose type is FIELD-NAME." - (if (symbolp field-name) - (setq field-name (symbol-name field-name)) - ) - (or entity - (setq entity mime-message-structure)) - (mime-entity-fetch-field entity field-name) - ) -(make-obsolete 'mime-fetch-field 'mime-entity-fetch-field) +;; (defun mime-fetch-field (field-name &optional entity) +;; "Return the value of the ENTITY's header field whose type is FIELD-NAME." +;; (if (symbolp field-name) +;; (setq field-name (symbol-name field-name)) +;; ) +;; (or entity +;; (setq entity mime-message-structure)) +;; (mime-entity-fetch-field entity field-name) +;; ) +;; (make-obsolete 'mime-fetch-field 'mime-entity-fetch-field) (defun mime-entity-content-type (entity) (or (mime-entity-content-type-internal entity) @@ -301,12 +350,12 @@ If MESSAGE is specified, it is regarded as root entity." entity (put-alist sym field header)) field)))))))) -(defun mime-read-field (field-name &optional entity) - (or entity - (setq entity mime-message-structure)) - (mime-entity-read-field entity field-name) - ) -(make-obsolete 'mime-read-field 'mime-entity-read-field) +;; (defun mime-read-field (field-name &optional entity) +;; (or entity +;; (setq entity mime-message-structure)) +;; (mime-entity-read-field entity field-name) +;; ) +;; (make-obsolete 'mime-read-field 'mime-entity-read-field) (luna-define-generic mime-insert-header (entity &optional invisible-fields visible-fields) @@ -321,10 +370,9 @@ If MESSAGE is specified, it is regarded as root entity." (defun mime-entity-uu-filename (entity) (if (member (mime-entity-encoding entity) mime-uuencode-encoding-name-list) - (save-excursion - (mime-goto-body-start-point entity) - (if (re-search-forward "^begin [0-9]+ " - (mime-entity-body-end-point entity) t) + (with-temp-buffer + (mime-insert-entity-body entity) + (if (re-search-forward "^begin [0-9]+ " nil t) (if (looking-at ".+$") (buffer-substring (match-beginning 0)(match-end 0)) ))))) @@ -351,30 +399,11 @@ If MESSAGE is specified, it is regarded as root entity." (mime-type/subtype-string (mime-entity-media-type entity-info) (mime-entity-media-subtype entity-info))) +(defun mime-entity-set-content-type (entity content-type) + (mime-entity-set-content-type-internal entity content-type)) -;;; @ Entity Content -;;; - -(luna-define-generic mime-entity-content (entity) - "Return content of ENTITY as byte sequence (string).") - -(luna-define-generic mime-insert-entity-content (entity) - "Insert content of ENTITY at point.") - -(luna-define-generic mime-write-entity-content (entity filename) - "Write content of ENTITY into FILENAME.") - -(luna-define-generic mime-insert-text-content (entity) - "Insert decoded text body of ENTITY.") - -(luna-define-generic mime-insert-entity (entity) - "Insert header and body of ENTITY at point.") - -(luna-define-generic mime-write-entity (entity filename) - "Write header and body of ENTITY into FILENAME.") - -(luna-define-generic mime-write-entity-body (entity filename) - "Write body of ENTITY into FILENAME.") +(defun mime-entity-set-encoding (entity encoding) + (mime-entity-set-encoding-internal entity encoding)) ;;; @ end diff --git a/mmbuffer.el b/mmbuffer.el index f014aec..97fc783 100644 --- a/mmbuffer.el +++ b/mmbuffer.el @@ -1,8 +1,6 @@ ;;; mmbuffer.el --- MIME entity module for binary buffer -;; Copyright (C) 1998,1999 Free Software Foundation, Inc. -;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. +;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news @@ -26,6 +24,7 @@ ;;; Code: +(require 'mmgeneric) (require 'mime) (eval-and-compile @@ -43,11 +42,9 @@ &rest init-args) (or (mime-buffer-entity-buffer-internal entity) (mime-buffer-entity-set-buffer-internal - entity (mime-entity-location-internal entity))) + entity (get-buffer (mime-entity-location-internal entity)))) (save-excursion (set-buffer (mime-buffer-entity-buffer-internal entity)) - (if (mime-root-entity-p entity) - (setq mime-message-structure entity)) (let ((header-start (or (mime-buffer-entity-header-start-internal entity) (mime-buffer-entity-set-header-start-internal @@ -87,69 +84,57 @@ ) -(defun mime-visible-field-p (field-name visible-fields invisible-fields) - (or (catch 'found - (while visible-fields - (let ((regexp (car visible-fields))) - (if (string-match regexp field-name) - (throw 'found t) - )) - (setq visible-fields (cdr visible-fields)) - )) - (catch 'found - (while invisible-fields - (let ((regexp (car invisible-fields))) - (if (string-match regexp field-name) - (throw 'found nil) - )) - (setq invisible-fields (cdr invisible-fields)) - ) - t))) - -(defun mime-insert-header-from-buffer (buffer start end - &optional invisible-fields - visible-fields) - (let ((the-buf (current-buffer)) - (mode-obj (mime-find-field-presentation-method 'wide)) - field-decoder - f-b p f-e field-name len field field-body) - (save-excursion - (set-buffer buffer) - (save-restriction - (narrow-to-region start end) - (goto-char start) - (while (re-search-forward std11-field-head-regexp nil t) - (setq f-b (match-beginning 0) - p (match-end 0) - field-name (buffer-substring f-b p) - len (string-width field-name) - f-e (std11-field-end)) - (when (mime-visible-field-p field-name - visible-fields invisible-fields) - (setq field (intern - (capitalize (buffer-substring f-b (1- p)))) - field-body (buffer-substring p f-e) - field-decoder (inline (mime-find-field-decoder-internal - field mode-obj))) - (with-current-buffer the-buf - (insert field-name) - (insert (if field-decoder - (funcall field-decoder field-body len) - ;; Don't decode - field-body)) - (insert "\n") - ))))))) +;;; @ entity +;;; -(luna-define-method mime-insert-header ((entity mime-buffer-entity) - &optional invisible-fields - visible-fields) - (mime-insert-header-from-buffer - (mime-buffer-entity-buffer-internal entity) - (mime-buffer-entity-header-start-internal entity) - (mime-buffer-entity-header-end-internal entity) - invisible-fields visible-fields) +(luna-define-method mime-insert-entity ((entity mime-buffer-entity)) + (insert-buffer-substring (mime-buffer-entity-buffer-internal entity) + (mime-buffer-entity-header-start-internal entity) + (mime-buffer-entity-body-end-internal entity)) ) +(luna-define-method mime-write-entity ((entity mime-buffer-entity) filename) + (save-excursion + (set-buffer (mime-buffer-entity-buffer-internal entity)) + (write-region-as-raw-text-CRLF + (mime-buffer-entity-header-start-internal entity) + (mime-buffer-entity-body-end-internal entity) + filename) + )) + + +;;; @ entity header +;;; + + +;;; @ entity body +;;; + +(luna-define-method mime-entity-body ((entity mime-buffer-entity)) + (save-excursion + (set-buffer (mime-buffer-entity-buffer-internal entity)) + (buffer-substring (mime-buffer-entity-body-start-internal entity) + (mime-buffer-entity-body-end-internal entity)))) + +(luna-define-method mime-insert-entity-body ((entity mime-buffer-entity)) + (insert-buffer-substring (mime-buffer-entity-buffer-internal entity) + (mime-buffer-entity-body-start-internal entity) + (mime-buffer-entity-body-end-internal entity)) + ) + +(luna-define-method mime-write-entity-body ((entity mime-buffer-entity) + filename) + (save-excursion + (set-buffer (mime-buffer-entity-buffer-internal entity)) + (write-region-as-binary (mime-buffer-entity-body-start-internal entity) + (mime-buffer-entity-body-end-internal entity) + filename) + )) + + +;;; @ entity content +;;; + (luna-define-method mime-entity-content ((entity mime-buffer-entity)) (save-excursion (set-buffer (mime-buffer-entity-buffer-internal entity)) @@ -158,6 +143,27 @@ (mime-buffer-entity-body-end-internal entity)) (mime-entity-encoding entity)))) +(luna-define-method mime-insert-entity-content ((entity mime-buffer-entity)) + (insert (with-current-buffer (mime-buffer-entity-buffer-internal entity) + (mime-decode-string + (buffer-substring (mime-buffer-entity-body-start-internal entity) + (mime-buffer-entity-body-end-internal entity)) + (mime-entity-encoding entity))))) + +(luna-define-method mime-write-entity-content ((entity mime-buffer-entity) + filename) + (save-excursion + (set-buffer (mime-buffer-entity-buffer-internal entity)) + (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity) + (mime-buffer-entity-body-end-internal entity) + filename + (or (mime-entity-encoding entity) "7bit")) + )) + + +;;; @ header field +;;; + (luna-define-method mime-entity-fetch-field :around ((entity mime-buffer-entity) field-name) (or (luna-call-next-method) @@ -177,109 +183,171 @@ (mime-entity-original-header-internal entity))) ret)))))) -(mm-define-method insert-entity-content ((entity buffer)) - (insert (with-current-buffer (mime-buffer-entity-buffer-internal entity) - (mime-decode-string - (buffer-substring (mime-buffer-entity-body-start-internal entity) - (mime-buffer-entity-body-end-internal entity)) - (mime-entity-encoding entity))))) - -(mm-define-method write-entity-content ((entity buffer) filename) - (save-excursion - (set-buffer (mime-buffer-entity-buffer-internal entity)) - (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity) - (mime-buffer-entity-body-end-internal entity) - filename - (or (mime-entity-encoding entity) "7bit")) - )) - -(mm-define-method insert-entity ((entity buffer)) - (insert-buffer-substring (mime-buffer-entity-buffer-internal entity) - (mime-buffer-entity-header-start-internal entity) - (mime-buffer-entity-body-end-internal entity)) +(luna-define-method mime-insert-header ((entity mime-buffer-entity) + &optional invisible-fields + visible-fields) + (mime-insert-header-from-buffer + (mime-buffer-entity-buffer-internal entity) + (mime-buffer-entity-header-start-internal entity) + (mime-buffer-entity-header-end-internal entity) + invisible-fields visible-fields) ) -(mm-define-method write-entity ((entity buffer) filename) - (save-excursion - (set-buffer (mime-buffer-entity-buffer-internal entity)) - (write-region-as-raw-text-CRLF - (mime-buffer-entity-header-start-internal entity) - (mime-buffer-entity-body-end-internal entity) - filename) - )) - -(mm-define-method write-entity-body ((entity buffer) filename) - (save-excursion - (set-buffer (mime-buffer-entity-buffer-internal entity)) - (write-region-as-binary (mime-buffer-entity-body-start-internal entity) - (mime-buffer-entity-body-end-internal entity) - filename) - )) - ;;; @ header buffer ;;; -(luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity)) - (mime-buffer-entity-buffer-internal entity) - ) +;; (luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity)) +;; (mime-buffer-entity-buffer-internal entity) +;; ) -(luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity)) - (set-buffer (mime-buffer-entity-buffer-internal entity)) - (goto-char (mime-buffer-entity-header-start-internal entity)) - ) +;; (luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity)) +;; (set-buffer (mime-buffer-entity-buffer-internal entity)) +;; (goto-char (mime-buffer-entity-header-start-internal entity)) +;; ) -(luna-define-method mime-entity-header-start-point ((entity - mime-buffer-entity)) - (mime-buffer-entity-header-start-internal entity) - ) +;; (luna-define-method mime-entity-header-start-point ((entity +;; mime-buffer-entity)) +;; (mime-buffer-entity-header-start-internal entity) +;; ) -(luna-define-method mime-entity-header-end-point ((entity - mime-buffer-entity)) - (mime-buffer-entity-header-end-internal entity) - ) +;; (luna-define-method mime-entity-header-end-point ((entity +;; mime-buffer-entity)) +;; (mime-buffer-entity-header-end-internal entity) +;; ) ;;; @ body buffer ;;; -(luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity)) - (mime-buffer-entity-buffer-internal entity) - ) +;; (luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity)) +;; (mime-buffer-entity-buffer-internal entity) +;; ) -(luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity)) - (set-buffer (mime-buffer-entity-buffer-internal entity)) - (goto-char (mime-buffer-entity-body-start-internal entity)) - ) +;; (luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity)) +;; (set-buffer (mime-buffer-entity-buffer-internal entity)) +;; (goto-char (mime-buffer-entity-body-start-internal entity)) +;; ) -(luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity)) - (set-buffer (mime-buffer-entity-buffer-internal entity)) - (goto-char (mime-buffer-entity-body-end-internal entity)) - ) +;; (luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity)) +;; (set-buffer (mime-buffer-entity-buffer-internal entity)) +;; (goto-char (mime-buffer-entity-body-end-internal entity)) +;; ) -(luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity)) - (mime-buffer-entity-body-start-internal entity) - ) +;; (luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity)) +;; (mime-buffer-entity-body-start-internal entity) +;; ) -(luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity)) - (mime-buffer-entity-body-end-internal entity) - ) +;; (luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity)) +;; (mime-buffer-entity-body-end-internal entity) +;; ) ;;; @ buffer (obsolete) ;;; -(luna-define-method mime-entity-buffer ((entity mime-buffer-entity)) - (mime-buffer-entity-buffer-internal entity) - ) +;; (luna-define-method mime-entity-buffer ((entity mime-buffer-entity)) +;; (mime-buffer-entity-buffer-internal entity) +;; ) -(luna-define-method mime-entity-point-min ((entity mime-buffer-entity)) - (mime-buffer-entity-header-start-internal entity) - ) +;; (luna-define-method mime-entity-point-min ((entity mime-buffer-entity)) +;; (mime-buffer-entity-header-start-internal entity) +;; ) -(luna-define-method mime-entity-point-max ((entity mime-buffer-entity)) - (mime-buffer-entity-body-end-internal entity) - ) +;; (luna-define-method mime-entity-point-max ((entity mime-buffer-entity)) +;; (mime-buffer-entity-body-end-internal entity) +;; ) + + +;;; @ children +;;; + +(defun mmbuffer-parse-multipart (entity) + (with-current-buffer (mime-buffer-entity-buffer-internal entity) + (let* ((representation-type + (mime-entity-representation-type-internal entity)) + (content-type (mime-entity-content-type-internal entity)) + (dash-boundary + (concat "--" + (mime-content-type-parameter content-type "boundary"))) + (delimiter (concat "\n" (regexp-quote dash-boundary))) + (close-delimiter (concat delimiter "--[ \t]*$")) + (rsep (concat delimiter "[ \t]*\n")) + (dc-ctl + (if (eq (mime-content-type-subtype content-type) 'digest) + (make-mime-content-type 'message 'rfc822) + (make-mime-content-type 'text 'plain) + )) + (body-start (mime-buffer-entity-body-start-internal entity)) + (body-end (mime-buffer-entity-body-end-internal entity))) + (save-restriction + (goto-char body-end) + (narrow-to-region body-start + (if (re-search-backward close-delimiter nil t) + (match-beginning 0) + body-end)) + (goto-char body-start) + (if (re-search-forward + (concat "^" (regexp-quote dash-boundary) "[ \t]*\n") + nil t) + (let ((cb (match-end 0)) + ce ncb ret children + (node-id (mime-entity-node-id-internal entity)) + (i 0)) + (while (re-search-forward rsep nil t) + (setq ce (match-beginning 0)) + (setq ncb (match-end 0)) + (save-restriction + (narrow-to-region cb ce) + (setq ret (mime-parse-message representation-type dc-ctl + entity (cons i node-id))) + ) + (setq children (cons ret children)) + (goto-char (setq cb ncb)) + (setq i (1+ i)) + ) + (setq ce (point-max)) + (save-restriction + (narrow-to-region cb ce) + (setq ret (mime-parse-message representation-type dc-ctl + entity (cons i node-id))) + ) + (setq children (cons ret children)) + (mime-entity-set-children-internal entity (nreverse children)) + ) + (mime-entity-set-content-type-internal + entity (make-mime-content-type 'message 'x-broken)) + nil) + )))) + +(defun mmbuffer-parse-encapsulated (entity &optional external) + (mime-entity-set-children-internal + entity + (with-current-buffer (mime-buffer-entity-buffer-internal entity) + (save-restriction + (narrow-to-region (mime-buffer-entity-body-start-internal entity) + (mime-buffer-entity-body-end-internal entity)) + (list (mime-parse-message + (if external + (progn + (require 'mmexternal) + 'mime-external-entity) + (mime-entity-representation-type-internal entity)) + nil + entity (cons 0 (mime-entity-node-id-internal entity)))))))) + +(luna-define-method mime-entity-children ((entity mime-buffer-entity)) + (let* ((content-type (mime-entity-content-type entity)) + (primary-type (mime-content-type-primary-type content-type)) + sub-type) + (cond ((eq primary-type 'multipart) + (mmbuffer-parse-multipart entity)) + ((eq primary-type 'message) + (setq sub-type (mime-content-type-subtype content-type)) + (cond ((eq sub-type 'external-body) + (mmbuffer-parse-encapsulated entity 'external)) + ((memq sub-type '(rfc822 news)) + (mmbuffer-parse-encapsulated entity))))))) ;;; @ end diff --git a/mmdbuffer.el b/mmdbuffer.el index 637eab3..5a1ae20 100644 --- a/mmdbuffer.el +++ b/mmdbuffer.el @@ -1,8 +1,6 @@ ;;; mmdual.el --- MIME entity module for dual buffers -;; Copyright (C) 1998,1999 Free Software Foundation, Inc. -;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. +;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news @@ -38,84 +36,23 @@ (luna-define-method initialize-instance :after ((entity mime-dual-entity) &rest init-args) - (let (buf) - (setq buf (mime-dual-entity-header-buffer-internal entity)) + (let ((buf (mime-dual-entity-header-buffer-internal entity))) (if buf (with-current-buffer buf - (if (mime-root-entity-p entity) - (setq mime-message-structure entity)) (or (mime-entity-content-type-internal entity) (mime-entity-set-content-type-internal entity (let ((str (std11-fetch-field "Content-Type"))) (if str (mime-parse-Content-Type str) - )))))) - (setq buf (mime-dual-entity-body-buffer-internal entity)) - (if buf - (with-current-buffer buf - (if (mime-root-entity-p entity) - (setq mime-message-structure entity)))) - ) entity) + ))))))) + entity) (luna-define-method mime-entity-name ((entity mime-dual-entity)) (buffer-name (mime-dual-entity-header-buffer-internal entity)) ) -(defun mime-visible-field-p (field-name visible-fields invisible-fields) - (or (catch 'found - (while visible-fields - (let ((regexp (car visible-fields))) - (if (string-match regexp field-name) - (throw 'found t) - )) - (setq visible-fields (cdr visible-fields)) - )) - (catch 'found - (while invisible-fields - (let ((regexp (car invisible-fields))) - (if (string-match regexp field-name) - (throw 'found nil) - )) - (setq invisible-fields (cdr invisible-fields)) - ) - t))) - -(defun mime-insert-header-from-buffer (buffer start end - &optional invisible-fields - visible-fields) - (let ((the-buf (current-buffer)) - (mode-obj (mime-find-field-presentation-method 'wide)) - field-decoder - f-b p f-e field-name len field field-body) - (save-excursion - (set-buffer buffer) - (save-restriction - (narrow-to-region start end) - (goto-char start) - (while (re-search-forward std11-field-head-regexp nil t) - (setq f-b (match-beginning 0) - p (match-end 0) - field-name (buffer-substring f-b p) - len (string-width field-name) - f-e (std11-field-end)) - (when (mime-visible-field-p field-name - visible-fields invisible-fields) - (setq field (intern - (capitalize (buffer-substring f-b (1- p)))) - field-body (buffer-substring p f-e) - field-decoder (inline (mime-find-field-decoder-internal - field mode-obj))) - (with-current-buffer the-buf - (insert field-name) - (insert (if field-decoder - (funcall field-decoder field-body len) - ;; Don't decode - field-body)) - (insert "\n") - ))))))) - (luna-define-method mime-insert-header ((entity mime-dual-entity) &optional invisible-fields visible-fields) diff --git a/mmexternal.el b/mmexternal.el new file mode 100644 index 0000000..b7befaf --- /dev/null +++ b/mmexternal.el @@ -0,0 +1,181 @@ +;;; mmexternal.el --- MIME entity module for external buffer + +;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: MIME, multimedia, mail, news + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'mime) +(require 'pces) + +(eval-and-compile + (luna-define-class mime-external-entity (mime-entity) + (body-buffer + body-file)) + (luna-define-internal-accessors 'mime-external-entity) + + ;; In an external entity, information of media-type or other + ;; information which are represented in a header in a non-external + ;; entity are in the body of the parent entity. + ) + +(luna-define-method initialize-instance :after ((entity mime-external-entity) + &rest init-args) + (or (mime-external-entity-body-file-internal entity) + (let* ((ct (mime-entity-content-type + (mime-entity-parent-internal entity))) + (access-type (mime-content-type-parameter ct "access-type"))) + (if (and access-type + (string= access-type "anon-ftp")) + (let ((site (mime-content-type-parameter ct "site")) + (directory (mime-content-type-parameter ct "directory")) + (name (mime-content-type-parameter ct "name"))) + (mime-external-entity-set-body-file-internal + entity + (expand-file-name + name + (concat "/anonymous@" site ":" directory))))))) + entity) + +(luna-define-method mime-entity-name ((entity mime-external-entity)) + (concat "child of " + (mime-entity-name + (mime-entity-parent-internal entity)))) + + +(defun mmexternal-require-buffer (entity) + (unless (and (mime-external-entity-body-buffer-internal entity) + (buffer-live-p + (mime-external-entity-body-buffer-internal entity))) + (condition-case nil + (mime-external-entity-set-body-buffer-internal + entity + (with-current-buffer (get-buffer-create + (concat " *Body of " + (mime-entity-name entity) + "*")) + (insert-file-contents-as-binary + (mime-external-entity-body-file-internal entity)) + (current-buffer))) + (error (message "Can't get external-body."))))) + + +;;; @ entity +;;; + +(luna-define-method mime-insert-entity ((entity mime-external-entity)) + (mime-insert-entity-body (mime-entity-parent-internal entity)) + (insert "\n") + (mime-insert-entity-body entity)) + +(luna-define-method mime-write-entity ((entity mime-external-entity) filename) + (with-temp-buffer + (mime-insert-entity entity) + (write-region-as-raw-text-CRLF (point-min) (point-max) filename))) + + +;;; @ entity header +;;; + + +;;; @ entity body +;;; + +(luna-define-method mime-entity-body ((entity mime-external-entity)) + (mmexternal-require-buffer entity) + (with-current-buffer (mime-external-entity-body-buffer-internal entity) + (buffer-string))) + +(luna-define-method mime-insert-entity-body ((entity mime-external-entity)) + (mmexternal-require-buffer entity) + (insert-buffer-substring + (mime-external-entity-body-buffer-internal entity))) + +(luna-define-method mime-write-entity-body ((entity mime-external-entity) + filename) + (mmexternal-require-buffer entity) + (with-current-buffer (mime-external-entity-body-buffer-internal entity) + (write-region-as-binary (point-min) (point-max) filename))) + + +;;; @ entity content +;;; + +(luna-define-method mime-entity-content ((entity mime-external-entity)) + (let ((ret (mime-entity-body entity))) + (if ret + (mime-decode-string ret (mime-entity-encoding entity)) + (message "Cannot get content") + nil))) + +(luna-define-method mime-insert-entity-content ((entity mime-external-entity)) + (insert (mime-entity-content entity))) + +(luna-define-method mime-write-entity-content ((entity mime-external-entity) + filename) + (mmexternal-require-buffer entity) + (with-current-buffer (mime-external-entity-body-buffer-internal entity) + (mime-write-decoded-region (point-min) (point-max) + filename + (or (mime-entity-encoding entity) "7bit")))) + + +;;; @ header field +;;; + +(luna-define-method mime-entity-fetch-field :around + ((entity mime-external-entity) field-name) + (or (luna-call-next-method) + (with-temp-buffer + (mime-insert-entity-body (mime-entity-parent-internal entity)) + (let ((ret (std11-fetch-field field-name))) + (when ret + (or (symbolp field-name) + (setq field-name + (intern (capitalize (capitalize field-name))))) + (mime-entity-set-original-header-internal + entity + (put-alist field-name ret + (mime-entity-original-header-internal entity))) + ret))))) + +(luna-define-method mime-insert-header ((entity mime-external-entity) + &optional invisible-fields + visible-fields) + (let ((the-buf (current-buffer)) + buf p-min p-max) + (with-temp-buffer + (mime-insert-entity-body (mime-entity-parent-internal entity)) + (setq buf (current-buffer) + p-min (point-min) + p-max (point-max)) + (set-buffer the-buf) + (mime-insert-header-from-buffer buf p-min p-max + invisible-fields visible-fields)))) + + +;;; @ end +;;; + +(provide 'mmexternal) + +;;; mmexternal.el ends here diff --git a/mmgeneric.el b/mmgeneric.el new file mode 100644 index 0000000..84d481b --- /dev/null +++ b/mmgeneric.el @@ -0,0 +1,172 @@ +;;; mmgeneric.el --- MIME generic entity module + +;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: definition, MIME, multimedia, mail, news + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'luna) + + +;;; @ MIME entity +;;; + +(autoload 'mime-entity-content-type "mime") +(autoload 'mime-parse-multipart "mime-parse") +(autoload 'mime-parse-message "mime-parse") +;; (autoload 'mime-parse-encapsulated "mime-parse") +;; (autoload 'mime-parse-external "mime-parse") +(autoload 'mime-entity-content "mime") + +(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-insert-text-content ((entity mime-entity)) + (insert + (decode-mime-charset-string (mime-entity-content entity) + (or (mime-content-type-parameter + (mime-entity-content-type entity) + "charset") + default-mime-charset) + 'CRLF) + )) + + +;;; @ for mm-backend +;;; + +(defmacro mm-expand-class-name (type) + `(intern (format "mime-%s-entity" ,type))) + +(defmacro mm-define-backend (type &optional parents) + `(luna-define-class ,(mm-expand-class-name type) + ,(nconc (mapcar (lambda (parent) + (mm-expand-class-name parent) + ) + parents) + '(mime-entity)))) + +(defmacro mm-define-method (name args &rest body) + (or (eq name 'initialize-instance) + (setq name (intern (format "mime-%s" name)))) + (let ((spec (car args))) + (setq args + (cons (list (car spec) + (mm-expand-class-name (nth 1 spec))) + (cdr args))) + `(luna-define-method ,name ,args ,@body) + )) + +(put 'mm-define-method 'lisp-indent-function 'defun) + +(def-edebug-spec mm-define-method + (&define name ((arg symbolp) + [&rest arg] + [&optional ["&optional" arg &rest arg]] + &optional ["&rest" arg] + ) + def-body)) + + +;;; @ header filter +;;; + +;; [tomo] We should think about specification of better filtering +;; mechanism. Please discuss in the emacs-mime mailing lists. + +(defun mime-visible-field-p (field-name visible-fields invisible-fields) + (or (catch 'found + (while visible-fields + (let ((regexp (car visible-fields))) + (if (string-match regexp field-name) + (throw 'found t) + )) + (setq visible-fields (cdr visible-fields)) + )) + (catch 'found + (while invisible-fields + (let ((regexp (car invisible-fields))) + (if (string-match regexp field-name) + (throw 'found nil) + )) + (setq invisible-fields (cdr invisible-fields)) + ) + t))) + +(defun mime-insert-header-from-buffer (buffer start end + &optional invisible-fields + visible-fields) + (let ((the-buf (current-buffer)) + (mode-obj (mime-find-field-presentation-method 'wide)) + field-decoder + f-b p f-e field-name len field field-body) + (save-excursion + (set-buffer buffer) + (save-restriction + (narrow-to-region start end) + (goto-char start) + (while (re-search-forward std11-field-head-regexp nil t) + (setq f-b (match-beginning 0) + p (match-end 0) + field-name (buffer-substring f-b p) + len (string-width field-name) + f-e (std11-field-end)) + (when (mime-visible-field-p field-name + visible-fields invisible-fields) + (setq field (intern + (capitalize (buffer-substring f-b (1- p)))) + field-body (buffer-substring p f-e) + field-decoder (inline (mime-find-field-decoder-internal + field mode-obj))) + (with-current-buffer the-buf + (insert field-name) + (insert (if field-decoder + (funcall field-decoder field-body len) + ;; Don't decode + field-body)) + (insert "\n") + ))))))) + + +;;; @ end +;;; + +(provide 'mmgeneric) + +;;; mmgeneric.el ends here diff --git a/smtpmail.el b/smtpmail.el index e5fbe5a..74638aa 100644 --- a/smtpmail.el +++ b/smtpmail.el @@ -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) @@ -230,11 +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 - (mapconcat - (lambda (arg) (format "%x" arg)) - (current-time) ""))) + (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)) @@ -243,6 +244,8 @@ This is relative to `smtpmail-queue-dir'.") (set-buffer buffer-data) (erase-buffer) (insert-buffer tembuf) + (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)