* mime-def.el (mime-library-product): Up.
+2000-06-23 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mmexternal.el (initialize-instance): New method.
+ (mime-entity-name): Fixed.
+ (mmexternal-require-buffer): New function.
+ (mime-insert-entity): New implementation.
+ (mime-write-entity): Likewise.
+ (mime-entity-body): New method.
+ (mime-insert-entity-body): New method.
+ (mime-write-entity-body): New implementation.
+ (mime-entity-content): Likewise.
+ (mime-insert-entity-content): Likewise.
+ (mime-write-entity-content): Likewise.
+ (mime-entity-fetch-field): Likewise.
+ (mime-insert-header): Likewise.
+
+ * mmbuffer.el (initialize-instance): Store buffer instead of name
+ of buffer to `buffer' slot.
+
+2000-06-21 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mmgeneric.el (mime-entity-children): Deleted.
+
+ * mmbuffer.el (mime-insert-entity-body): New method.
+ (mmbuffer-parse-multipart): New function.
+ (mmbuffer-parse-encapsulated): New function.
+ (mime-entity-children): New function.
+
+2000-06-21 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * mime.el (mime-find-root-entity): New function.
+ (mime-entity-header-buffer): Comment out.
+ (mime-goto-header-start-point): Likewise.
+ (mime-entity-header-start-point): Likewise.
+ (mime-entity-header-end-point): Likewise.
+ (mime-entity-body-buffer): Likewise.
+ (mime-goto-body-start-point): Likewise.
+ (mime-goto-body-end-point): Likewise.
+ (mime-entity-body-start-point): Likewise.
+ (mime-entity-body-end-point): Likewise.
+ (mime-entity-body-start): Likewise.
+ (mime-entity-body-end): Likewise.
+ (mime-entity-buffer): Likewise.
+ (mime-entity-point-min): Likewise.
+ (mime-entity-point-max): Likewise.
+ (mime-insert-entity-body): New generic function.
+ (mime-entity-uu-filename): Use `mime-insert-entity-body'.
+ (mime-entity-set-content-type): New function.
+ (mime-entity-set-encoding): New function.
+
+ * mime-parse.el (mime-parse-multipart): Comment out.
+ (mime-parse-encapsulated): Likewise.
+ (mime-parse-external): Likewise.
+
+ * mmbuffer.el (mime-entity-header-buffer): Comment out.
+ (mime-goto-header-start-point): Likewise.
+ (mime-entity-header-start-point): Likewise.
+ (mime-entity-header-end-point): Likewise.
+ (mime-entity-body-buffer): Likewise.
+ (mime-goto-body-start-point): Likewise.
+ (mime-goto-body-end-point): Likewise.
+ (mime-entity-body-start-point): Likewise.
+ (mime-entity-body-end-point): Likewise.
+ (mime-entity-buffer): Likewise.
+ (mime-entity-point-min): Likewise.
+ (mime-entity-point-max): Likewise.
+
+2000-05-30 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+ * eword-encode.el (eword-charset-encoding-alist): Add
+ `iso-2022-jp-3'.
+
2000-05-25 Tanaka Akira <akr@m17n.org>
* mime-en.sgml, mime-ja.sgml: Update for CVS via SSH.
* smtp.el (smtp-deduce-address-list): Set `case-fold-search' to `t'
in the working buffer.
+2000-04-26 Yoshiki Hayashi <yoshiki@xemacs.org>
+
+ * mime.el (mime-entity-body): New function.
+ * mmbuffer.el (mime-entity-body): Implement it.
+
2000-04-17 Yoshiki Hayashi <yoshiki@xemacs.org>
* mel.el (mime-decode-string): Return original string
when it failed to decode.
+\f
2000-04-16 Kenichi OKADA <okada@opaopa.org>
* SLIM: Version 1.13.7 released.
* sasl.el (sasl-scram-md5-client-security-info): eval-when-compile.
+2000-03-03 Keiichi Suzuki <keiichi@nanap.org>
+
+ * mime.el (mime-entity-node-id): Change to function.
+
+2000-03-03 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mmdbuffer.el, mmbuffer.el (initialize-instance): Don't setup
+ `mime-message-structure'.
+
+ * mime-parse.el (mime-parse-buffer): Don't setup
+ `mime-message-structure'.
+
+2000-03-02 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mmgeneric.el (mime-visible-field-p): Moved from mmbuffer.el.
+ (mime-insert-header-from-buffer): Moved from mmbuffer.el.
+
+ * mmexternal.el, mmdbuffer.el, mmbuffer.el (mime-visible-field-p):
+ Moved to mmgeneric.el.
+ (mime-insert-header-from-buffer): Moved to mmgeneric.el.
+
+2000-03-02 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * FLIM-ELS (flim-modules): Add `mmgeneric'.
+
+ * mmgeneric.el: New file.
+
+ * mmbuffer.el: Require `mmgeneric'.
+
+ * mime.el: Require `mmgeneric' when compiling.
+
+ * mime-def.el: Move mime-entity related definitions to
+ mmgeneric.el.
+
+2000-03-01 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime.el (mime-find-entity-from-number): Now second argument
+ `message' is not an optional argument.
+ (mime-find-entity-from-node-id): Likewise.
+ (mime-find-entity-from-content-id): Likewise.
+ (mime-fetch-field): Delete obsolete function.
+ (mime-read-field): Likewise.
+
+2000-03-01 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime.el (mime-entity-header-buffer): Mark it as obsolete.
+ (mime-goto-header-start-point): Likewise.
+ (mime-entity-header-start-point): Likewise.
+ (mime-entity-header-end-point): Likewise.
+ (mime-entity-body-start): Use `defalias'; don't recommend to use
+ `mime-entity-body-start-point' instead.
+ (mime-entity-body-end): Use `defalias'; don't recommend to use
+ `mime-entity-body-end-point' instead.
+ (mime-entity-body-buffer): Mark it as obsolete.
+ (mime-goto-body-start-point): Likewise.
+ (mime-goto-body-end-point): Likewise.
+ (mime-entity-body-start-point): Likewise.
+ (mime-entity-body-end-point): Likewise.
+ (mime-entity-buffer): Don't recommend to use
+ `mime-entity-header-buffer' or `mime-entity-body-buffer' instead.
+ (mime-entity-point-min): Don't recommend to use
+ `mime-entity-header-start-point' instead.
+ (mime-entity-point-max): Don't recommend to use
+ `mime-entity-body-end-point' instead.
+
+ * mime-def.el (mime-library-version): update to 1.14.1.
+ - Add autoload setting for `mime-parse-external'.
+
2000-02-03 Kenichi OKADA <okada@opaopa.org>
* smtp.el (TopLevel): Autoload `sasl-digest-md5-digest-response'.
(base64-internal-encode-region): Likewise.
(base64-encode-string): Likewise.
+1999-12-16 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * FLIM-ELS (flim-modules): Add `mmexternal'.
+
+ * mime-parse.el (mime-parse-external): New function.
+
+ * mime-def.el (mime-entity-children [mime-entity]): Use
+ `mime-parse-external' for message/external-body.
+
+ * mmexternal.el: New module.
+
1999-12-13 Kenichi OKADA <okada@opaopa.org>
* smtp.el (smtp-aut-login): Update to new api.
* smtp.el (smtp-via-smtp): Use sasl.el for SASL.
* FLIM-ELS (flim-modules): Add `sasl'.
+1999-10-17 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
+
+ * FLIM-MK (install-flim-package): Delete auto-autoloads.el
+ and custom-load.el
+
+1999-09-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mailcap.el (mailcap-look-at-schar): Protect against unexpected
+ eof. [cf. <tm-ja:5177>]
+
+1999-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * smtpmail.el (smtpmail-send-it): Remove needless `concat'.
+
+1999-09-08 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
+
+ * mime-ja.sgml, mime-en.sgml (Entity creation): Fix typo.
+
+1999-09-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <yamaoka@jpl.org>
+
+ * 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 <yamaoka@jpl.org>
+
+ * FLIM-ELS: Use `if' instead of `unless'.
+
\f
+>>>>>>> 1.134.2.18
1999-08-17 MORIOKA Tomohiko <tomo@m17n.org>
* FLIM: Version 1.13.2 (Kasanui) released.
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
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))
)
(expand-file-name FLIM_PREFIX
(expand-file-name "lisp"
PACKAGEDIR)))
+ (delete-file "./auto-autoloads.el")
+ (delete-file "./custom-load.el")
)
;;; FLIM-MK ends here
#
PACKAGE = slim
-API = 1.13
-RELEASE = 6
+API = 1.14
+RELEASE = 0
TAR = tar
RM = /bin/rm -f
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) \
1.12.1 T\e-Dòfukuji\e-A \e$(BElJ!;{\e(B ; <=> \e$(B5~:e\e(B
1.12.2 Inari \e$(B0p2Y\e(B
1.13.0 JR Fujinomori JR \e$(BF#?9\e(B
+1.14.0 Momoyama \e$(BEm;3\e(B
+1.14.1 Rokujiz\e-Dò\e-A \e$(BO;COB"\e(B
(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")
(defsubst mailcap-look-at-schar ()
(let ((chr (char-after (point))))
- (if (and (>= chr ? )
+ (if (and chr
+ (>= chr ? )
(/= chr ?\;)
(/= chr ?\\)
)
-;;; mime-def.el --- definition module about MIME
+;;; mime-def.el --- definition module about MIME -*- coding: iso-8859-4; -*-
-;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
-;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: definition, MIME, multimedia, mail, news
(require 'mcharset)
(require 'alist)
-(eval-when-compile (require 'cl)) ; list*
+(eval-when-compile
+ (require 'cl) ; list*
+ (require 'luna) ; luna-arglist-to-arguments
+ )
(eval-and-compile
- (defconst mime-library-product ["SLIM" (1 14 0) "\e$B0BIt$J$D$_\e(B"]
- "Product name, version number and code name of MIME-library package.")
- )
+ (defconst mime-library-product ["SLIM" (1 14 0) "\e$(B0BIt$J$D$_\e(B"]
+ "Product name, version number and code name of MIME-library package."))
(defmacro mime-product-name (product)
`(aref ,product 0))
(mime-content-disposition-parameter content-disposition "filename"))
-;;; @ MIME entity
-;;;
-
-(require 'luna)
-
-(autoload 'mime-entity-content-type "mime")
-(autoload 'mime-parse-multipart "mime-parse")
-(autoload 'mime-parse-encapsulated "mime-parse")
-(autoload 'mime-entity-content "mime")
-
-(luna-define-class mime-entity ()
- (location
- content-type children parent
- node-id
- content-disposition encoding
- ;; for other fields
- original-header parsed-header))
-
-(defalias 'mime-entity-representation-type-internal 'luna-class-name)
-(defalias 'mime-entity-set-representation-type-internal 'luna-set-class-name)
-
-(luna-define-internal-accessors 'mime-entity)
-
-(luna-define-method mime-entity-fetch-field ((entity mime-entity)
- field-name)
- (or (symbolp field-name)
- (setq field-name (intern (capitalize (capitalize field-name)))))
- (cdr (assq field-name
- (mime-entity-original-header-internal entity))))
-
-(luna-define-method mime-entity-children ((entity mime-entity))
- (let* ((content-type (mime-entity-content-type entity))
- (primary-type (mime-content-type-primary-type content-type)))
- (cond ((eq primary-type 'multipart)
- (mime-parse-multipart entity)
- )
- ((and (eq primary-type 'message)
- (memq (mime-content-type-subtype content-type)
- '(rfc822 news external-body)
- ))
- (mime-parse-encapsulated entity)
- ))
- ))
-
-(luna-define-method mime-insert-text-content ((entity mime-entity))
- (insert
- (decode-mime-charset-string (mime-entity-content entity)
- (or (mime-content-type-parameter
- (mime-entity-content-type entity)
- "charset")
- default-mime-charset)
- 'CRLF)
- ))
-
-
-;;; @ for mm-backend
-;;;
-
-(defmacro mm-expand-class-name (type)
- `(intern (format "mime-%s-entity" ,type)))
-
-(defmacro mm-define-backend (type &optional parents)
- `(luna-define-class ,(mm-expand-class-name type)
- ,(nconc (mapcar (lambda (parent)
- (mm-expand-class-name parent)
- )
- parents)
- '(mime-entity))))
-
-(defmacro mm-define-method (name args &rest body)
- (or (eq name 'initialize-instance)
- (setq name (intern (format "mime-%s" name))))
- (let ((spec (car args)))
- (setq args
- (cons (list (car spec)
- (mm-expand-class-name (nth 1 spec)))
- (cdr args)))
- `(luna-define-method ,name ,args ,@body)
- ))
-
-(put 'mm-define-method 'lisp-indent-function 'defun)
-
-(def-edebug-spec mm-define-method
- (&define name ((arg symbolp)
- [&rest arg]
- [&optional ["&optional" arg &rest arg]]
- &optional ["&rest" arg]
- )
- def-body))
-
-
;;; @ message structure
;;;
;;; @ message parser
;;;
-(defun mime-parse-multipart (entity)
- (with-current-buffer (mime-entity-body-buffer entity)
- (let* ((representation-type
- (mime-entity-representation-type-internal entity))
- (content-type (mime-entity-content-type-internal entity))
- (dash-boundary
- (concat "--"
- (mime-content-type-parameter content-type "boundary")))
- (delimiter (concat "\n" (regexp-quote dash-boundary)))
- (close-delimiter (concat delimiter "--[ \t]*$"))
- (rsep (concat delimiter "[ \t]*\n"))
- (dc-ctl
- (if (eq (mime-content-type-subtype content-type) 'digest)
- (make-mime-content-type 'message 'rfc822)
- (make-mime-content-type 'text 'plain)
- ))
- (body-start (mime-entity-body-start-point entity))
- (body-end (mime-entity-body-end-point entity)))
- (save-restriction
- (goto-char body-end)
- (narrow-to-region body-start
- (if (re-search-backward close-delimiter nil t)
- (match-beginning 0)
- body-end))
- (goto-char body-start)
- (if (re-search-forward
- (concat "^" (regexp-quote dash-boundary) "[ \t]*\n")
- nil t)
- (let ((cb (match-end 0))
- ce ncb ret children
- (node-id (mime-entity-node-id-internal entity))
- (i 0))
- (while (re-search-forward rsep nil t)
- (setq ce (match-beginning 0))
- (setq ncb (match-end 0))
- (save-restriction
- (narrow-to-region cb ce)
- (setq ret (mime-parse-message representation-type dc-ctl
- entity (cons i node-id)))
- )
- (setq children (cons ret children))
- (goto-char (setq cb ncb))
- (setq i (1+ i))
- )
- (setq ce (point-max))
- (save-restriction
- (narrow-to-region cb ce)
- (setq ret (mime-parse-message representation-type dc-ctl
- entity (cons i node-id)))
- )
- (setq children (cons ret children))
- (mime-entity-set-children-internal entity (nreverse children))
- )
- (mime-entity-set-content-type-internal
- entity (make-mime-content-type 'message 'x-broken))
- nil)
- ))))
-
-(defun mime-parse-encapsulated (entity)
- (mime-entity-set-children-internal
- entity
- (with-current-buffer (mime-entity-body-buffer entity)
- (save-restriction
- (narrow-to-region (mime-entity-body-start-point entity)
- (mime-entity-body-end-point entity))
- (list (mime-parse-message
- (mime-entity-representation-type-internal entity) nil
- entity (cons 0 (mime-entity-node-id-internal entity))))
- ))))
+;; (defun mime-parse-multipart (entity)
+;; (with-current-buffer (mime-entity-body-buffer entity)
+;; (let* ((representation-type
+;; (mime-entity-representation-type-internal entity))
+;; (content-type (mime-entity-content-type-internal entity))
+;; (dash-boundary
+;; (concat "--"
+;; (mime-content-type-parameter content-type "boundary")))
+;; (delimiter (concat "\n" (regexp-quote dash-boundary)))
+;; (close-delimiter (concat delimiter "--[ \t]*$"))
+;; (rsep (concat delimiter "[ \t]*\n"))
+;; (dc-ctl
+;; (if (eq (mime-content-type-subtype content-type) 'digest)
+;; (make-mime-content-type 'message 'rfc822)
+;; (make-mime-content-type 'text 'plain)
+;; ))
+;; (body-start (mime-entity-body-start-point entity))
+;; (body-end (mime-entity-body-end-point entity)))
+;; (save-restriction
+;; (goto-char body-end)
+;; (narrow-to-region body-start
+;; (if (re-search-backward close-delimiter nil t)
+;; (match-beginning 0)
+;; body-end))
+;; (goto-char body-start)
+;; (if (re-search-forward
+;; (concat "^" (regexp-quote dash-boundary) "[ \t]*\n")
+;; nil t)
+;; (let ((cb (match-end 0))
+;; ce ncb ret children
+;; (node-id (mime-entity-node-id-internal entity))
+;; (i 0))
+;; (while (re-search-forward rsep nil t)
+;; (setq ce (match-beginning 0))
+;; (setq ncb (match-end 0))
+;; (save-restriction
+;; (narrow-to-region cb ce)
+;; (setq ret (mime-parse-message representation-type dc-ctl
+;; entity (cons i node-id)))
+;; )
+;; (setq children (cons ret children))
+;; (goto-char (setq cb ncb))
+;; (setq i (1+ i))
+;; )
+;; (setq ce (point-max))
+;; (save-restriction
+;; (narrow-to-region cb ce)
+;; (setq ret (mime-parse-message representation-type dc-ctl
+;; entity (cons i node-id)))
+;; )
+;; (setq children (cons ret children))
+;; (mime-entity-set-children-internal entity (nreverse children))
+;; )
+;; (mime-entity-set-content-type-internal
+;; entity (make-mime-content-type 'message 'x-broken))
+;; nil)
+;; ))))
+
+;; (defun mime-parse-encapsulated (entity)
+;; (mime-entity-set-children-internal
+;; entity
+;; (with-current-buffer (mime-entity-body-buffer entity)
+;; (save-restriction
+;; (narrow-to-region (mime-entity-body-start-point entity)
+;; (mime-entity-body-end-point entity))
+;; (list (mime-parse-message
+;; (mime-entity-representation-type-internal entity) nil
+;; entity (cons 0 (mime-entity-node-id-internal entity))))
+;; ))))
+
+;; (defun mime-parse-external (entity)
+;; (require 'mmexternal)
+;; (mime-entity-set-children-internal
+;; entity
+;; (with-current-buffer (mime-entity-body-buffer entity)
+;; (save-restriction
+;; (narrow-to-region (mime-entity-body-start-point entity)
+;; (mime-entity-body-end-point entity))
+;; (list (mime-parse-message
+;; 'mime-external-entity nil
+;; entity (cons 0 (mime-entity-node-id-internal entity))))
+;; ;; [tomo] Should we unify with `mime-parse-encapsulated'?
+;; ))))
(defun mime-parse-message (representation-type &optional default-ctl
parent node-id)
If buffer is omitted, it parses current-buffer."
(save-excursion
(if buffer (set-buffer buffer))
- (setq mime-message-structure
- (mime-parse-message (or representation-type
- 'mime-buffer-entity) nil))
- ))
+ (mime-parse-message (or representation-type
+ 'mime-buffer-entity) nil)))
;;; @ end
;;; mime.el --- MIME library module
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
-;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: MIME, multimedia, mail, news
(require 'mime-def)
(require 'eword-decode)
+(eval-when-compile (require 'mmgeneric))
+
(eval-and-compile
(autoload 'eword-encode-header "eword-encode"
(or (mime-entity-children-internal entity)
(luna-send entity 'mime-entity-children entity)))
-(defalias 'mime-entity-node-id 'mime-entity-node-id-internal)
+(defun mime-entity-node-id (entity)
+ (mime-entity-node-id-internal entity))
(defun mime-entity-number (entity)
"Return entity-number of ENTITY."
(reverse (mime-entity-node-id-internal entity)))
-(defun mime-find-entity-from-number (entity-number &optional message)
- "Return entity from ENTITY-NUMBER in MESSAGE.
-If MESSAGE is not specified, `mime-message-structure' is used."
- (or message
- (setq message mime-message-structure))
+(defun mime-find-entity-from-number (entity-number message)
+ "Return entity from ENTITY-NUMBER in MESSAGE."
(let ((sn (car entity-number)))
(if (null sn)
message
))
)))
-(defun mime-find-entity-from-node-id (entity-node-id &optional message)
- "Return entity from ENTITY-NODE-ID in MESSAGE.
-If MESSAGE is not specified, `mime-message-structure' is used."
+(defun mime-find-entity-from-node-id (entity-node-id message)
+ "Return entity from ENTITY-NODE-ID in MESSAGE."
(mime-find-entity-from-number (reverse entity-node-id) message))
-(defun mime-find-entity-from-content-id (cid &optional message)
- "Return entity from CID in MESSAGE.
-If MESSAGE is not specified, `mime-message-structure' is used."
- (or message
- (setq message mime-message-structure))
+(defun mime-find-entity-from-content-id (cid message)
+ "Return entity from CID in MESSAGE."
(if (equal cid (mime-entity-read-field message "Content-Id"))
message
(let ((children (mime-entity-children message))
If MESSAGE is specified, it is regarded as root entity."
(null (mime-entity-parent entity message)))
+(defun mime-find-root-entity (entity)
+ "Return root entity of ENTITY."
+ (let ((p (mime-entity-parent entity)))
+ (if (null p)
+ entity
+ (mime-entity-parent p))))
+
-;;; @ Header buffer
+;;; @ Header buffer (obsolete)
;;;
-(luna-define-generic mime-entity-header-buffer (entity))
+;; (luna-define-generic mime-entity-header-buffer (entity))
-(luna-define-generic mime-goto-header-start-point (entity)
- "Set buffer and point to header-start-position of ENTITY.")
+;; (luna-define-generic mime-goto-header-start-point (entity)
+;; "Set buffer and point to header-start-position of ENTITY.")
-(luna-define-generic mime-entity-header-start-point (entity)
- "Return header-start-position of ENTITY.")
+;; (luna-define-generic mime-entity-header-start-point (entity)
+;; "Return header-start-position of ENTITY.")
-(luna-define-generic mime-entity-header-end-point (entity)
- "Return header-end-position of ENTITY.")
+;; (luna-define-generic mime-entity-header-end-point (entity)
+;; "Return header-end-position of ENTITY.")
+;; (make-obsolete 'mime-entity-header-buffer "don't use it.")
+;; (make-obsolete 'mime-goto-header-start-point "don't use it.")
+;; (make-obsolete 'mime-entity-header-start-point "don't use it.")
+;; (make-obsolete 'mime-entity-header-end-point "don't use it.")
-;;; @ Body buffer
+
+;;; @ Body buffer (obsolete)
;;;
-(luna-define-generic mime-entity-body-buffer (entity))
+;; (luna-define-generic mime-entity-body-buffer (entity))
-(luna-define-generic mime-goto-body-start-point (entity)
- "Set buffer and point to body-start-position of ENTITY.")
+;; (luna-define-generic mime-goto-body-start-point (entity)
+;; "Set buffer and point to body-start-position of ENTITY.")
-(luna-define-generic mime-goto-body-end-point (entity)
- "Set buffer and point to body-end-position of ENTITY.")
+;; (luna-define-generic mime-goto-body-end-point (entity)
+;; "Set buffer and point to body-end-position of ENTITY.")
-(luna-define-generic mime-entity-body-start-point (entity)
- "Return body-start-position of ENTITY.")
+;; (luna-define-generic mime-entity-body-start-point (entity)
+;; "Return body-start-position of ENTITY.")
-(define-obsolete-function-alias
- 'mime-entity-body-start 'mime-entity-body-start-point)
+;; (luna-define-generic mime-entity-body-end-point (entity)
+;; "Return body-end-position of ENTITY.")
-(luna-define-generic mime-entity-body-end-point (entity)
- "Return body-end-position of ENTITY.")
+;; (defalias 'mime-entity-body-start 'mime-entity-body-start-point)
+;; (defalias 'mime-entity-body-end 'mime-entity-body-end-point)
-(define-obsolete-function-alias
- 'mime-entity-body-end 'mime-entity-body-end-point)
+;; (make-obsolete 'mime-entity-body-buffer "don't use it.")
+;; (make-obsolete 'mime-goto-body-start-point "don't use it.")
+;; (make-obsolete 'mime-goto-body-end-point "don't use it.")
+;; (make-obsolete 'mime-entity-body-start-point "don't use it.")
+;; (make-obsolete 'mime-entity-body-end-point "don't use it.")
+;; (make-obsolete 'mime-entity-body-start "don't use it.")
+;; (make-obsolete 'mime-entity-body-end "don't use it.")
;;; @ Entity buffer (obsolete)
;;;
-(luna-define-generic mime-entity-buffer (entity))
-(make-obsolete 'mime-entity-buffer
- "use mime-entity-header-buffer or mime-entity-body-buffer instead.")
+;; (luna-define-generic mime-entity-buffer (entity))
+;; (make-obsolete 'mime-entity-buffer "don't use it.")
+
+;; (luna-define-generic mime-entity-point-min (entity))
+;; (make-obsolete 'mime-entity-point-min "don't use it.")
+
+;; (luna-define-generic mime-entity-point-max (entity))
+;; (make-obsolete 'mime-entity-point-max "don't use it.")
+
+
+;;; @ Entity
+;;;
+
+(luna-define-generic mime-insert-entity (entity)
+ "Insert header and body of ENTITY at point.")
+
+(luna-define-generic mime-write-entity (entity filename)
+ "Write header and body of ENTITY into FILENAME.")
+
+
+;;; @ Entity Body
+;;;
+
+(luna-define-generic mime-entity-body (entity)
+ "Return network representation of ENTITY body.")
-(luna-define-generic mime-entity-point-min (entity))
-(make-obsolete 'mime-entity-point-min 'mime-entity-header-start-point)
+(luna-define-generic mime-insert-entity-body (entity)
+ "Insert network representation of ENTITY body at point.")
-(luna-define-generic mime-entity-point-max (entity))
-(make-obsolete 'mime-entity-point-max 'mime-entity-body-end-point)
+(luna-define-generic mime-write-entity-body (entity filename)
+ "Write body of ENTITY into FILENAME.")
-;;; @ Entity Header
+;;; @ Entity Content
+;;;
+
+(luna-define-generic mime-entity-content (entity)
+ "Return content of ENTITY as byte sequence (string).")
+
+(luna-define-generic mime-insert-entity-content (entity)
+ "Insert content of ENTITY at point.")
+
+(luna-define-generic mime-write-entity-content (entity filename)
+ "Write content of ENTITY into FILENAME.")
+
+(luna-define-generic mime-insert-text-content (entity)
+ "Insert decoded text body of ENTITY.")
+
+
+;;; @ Header fields
;;;
(luna-define-generic mime-entity-fetch-field (entity field-name)
"Return the value of the ENTITY's header field whose type is FIELD-NAME.")
-(defun mime-fetch-field (field-name &optional entity)
- "Return the value of the ENTITY's header field whose type is FIELD-NAME."
- (if (symbolp field-name)
- (setq field-name (symbol-name field-name))
- )
- (or entity
- (setq entity mime-message-structure))
- (mime-entity-fetch-field entity field-name)
- )
-(make-obsolete 'mime-fetch-field 'mime-entity-fetch-field)
+;; (defun mime-fetch-field (field-name &optional entity)
+;; "Return the value of the ENTITY's header field whose type is FIELD-NAME."
+;; (if (symbolp field-name)
+;; (setq field-name (symbol-name field-name))
+;; )
+;; (or entity
+;; (setq entity mime-message-structure))
+;; (mime-entity-fetch-field entity field-name)
+;; )
+;; (make-obsolete 'mime-fetch-field 'mime-entity-fetch-field)
(defun mime-entity-content-type (entity)
(or (mime-entity-content-type-internal entity)
entity (put-alist sym field header))
field))))))))
-(defun mime-read-field (field-name &optional entity)
- (or entity
- (setq entity mime-message-structure))
- (mime-entity-read-field entity field-name)
- )
-(make-obsolete 'mime-read-field 'mime-entity-read-field)
+;; (defun mime-read-field (field-name &optional entity)
+;; (or entity
+;; (setq entity mime-message-structure))
+;; (mime-entity-read-field entity field-name)
+;; )
+;; (make-obsolete 'mime-read-field 'mime-entity-read-field)
(luna-define-generic mime-insert-header (entity &optional invisible-fields
visible-fields)
(defun mime-entity-uu-filename (entity)
(if (member (mime-entity-encoding entity) mime-uuencode-encoding-name-list)
- (save-excursion
- (mime-goto-body-start-point entity)
- (if (re-search-forward "^begin [0-9]+ "
- (mime-entity-body-end-point entity) t)
+ (with-temp-buffer
+ (mime-insert-entity-body entity)
+ (if (re-search-forward "^begin [0-9]+ " nil t)
(if (looking-at ".+$")
(buffer-substring (match-beginning 0)(match-end 0))
)))))
(mime-type/subtype-string (mime-entity-media-type entity-info)
(mime-entity-media-subtype entity-info)))
+(defun mime-entity-set-content-type (entity content-type)
+ (mime-entity-set-content-type-internal entity content-type))
-;;; @ Entity Content
-;;;
-
-(luna-define-generic mime-entity-content (entity)
- "Return content of ENTITY as byte sequence (string).")
-
-(luna-define-generic mime-insert-entity-content (entity)
- "Insert content of ENTITY at point.")
-
-(luna-define-generic mime-write-entity-content (entity filename)
- "Write content of ENTITY into FILENAME.")
-
-(luna-define-generic mime-insert-text-content (entity)
- "Insert decoded text body of ENTITY.")
-
-(luna-define-generic mime-insert-entity (entity)
- "Insert header and body of ENTITY at point.")
-
-(luna-define-generic mime-write-entity (entity filename)
- "Write header and body of ENTITY into FILENAME.")
-
-(luna-define-generic mime-write-entity-body (entity filename)
- "Write body of ENTITY into FILENAME.")
+(defun mime-entity-set-encoding (entity encoding)
+ (mime-entity-set-encoding-internal entity encoding))
;;; @ end
;;; mmbuffer.el --- MIME entity module for binary buffer
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
-;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: MIME, multimedia, mail, news
;;; Code:
+(require 'mmgeneric)
(require 'mime)
(eval-and-compile
&rest init-args)
(or (mime-buffer-entity-buffer-internal entity)
(mime-buffer-entity-set-buffer-internal
- entity (mime-entity-location-internal entity)))
+ entity (get-buffer (mime-entity-location-internal entity))))
(save-excursion
(set-buffer (mime-buffer-entity-buffer-internal entity))
- (if (mime-root-entity-p entity)
- (setq mime-message-structure entity))
(let ((header-start
(or (mime-buffer-entity-header-start-internal entity)
(mime-buffer-entity-set-header-start-internal
)
-(defun mime-visible-field-p (field-name visible-fields invisible-fields)
- (or (catch 'found
- (while visible-fields
- (let ((regexp (car visible-fields)))
- (if (string-match regexp field-name)
- (throw 'found t)
- ))
- (setq visible-fields (cdr visible-fields))
- ))
- (catch 'found
- (while invisible-fields
- (let ((regexp (car invisible-fields)))
- (if (string-match regexp field-name)
- (throw 'found nil)
- ))
- (setq invisible-fields (cdr invisible-fields))
- )
- t)))
-
-(defun mime-insert-header-from-buffer (buffer start end
- &optional invisible-fields
- visible-fields)
- (let ((the-buf (current-buffer))
- (mode-obj (mime-find-field-presentation-method 'wide))
- field-decoder
- f-b p f-e field-name len field field-body)
- (save-excursion
- (set-buffer buffer)
- (save-restriction
- (narrow-to-region start end)
- (goto-char start)
- (while (re-search-forward std11-field-head-regexp nil t)
- (setq f-b (match-beginning 0)
- p (match-end 0)
- field-name (buffer-substring f-b p)
- len (string-width field-name)
- f-e (std11-field-end))
- (when (mime-visible-field-p field-name
- visible-fields invisible-fields)
- (setq field (intern
- (capitalize (buffer-substring f-b (1- p))))
- field-body (buffer-substring p f-e)
- field-decoder (inline (mime-find-field-decoder-internal
- field mode-obj)))
- (with-current-buffer the-buf
- (insert field-name)
- (insert (if field-decoder
- (funcall field-decoder field-body len)
- ;; Don't decode
- field-body))
- (insert "\n")
- )))))))
+;;; @ entity
+;;;
-(luna-define-method mime-insert-header ((entity mime-buffer-entity)
- &optional invisible-fields
- visible-fields)
- (mime-insert-header-from-buffer
- (mime-buffer-entity-buffer-internal entity)
- (mime-buffer-entity-header-start-internal entity)
- (mime-buffer-entity-header-end-internal entity)
- invisible-fields visible-fields)
+(luna-define-method mime-insert-entity ((entity mime-buffer-entity))
+ (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
+ (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))
)
+(luna-define-method mime-write-entity ((entity mime-buffer-entity) filename)
+ (save-excursion
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (write-region-as-raw-text-CRLF
+ (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity)
+ filename)
+ ))
+
+
+;;; @ entity header
+;;;
+
+
+;;; @ entity body
+;;;
+
+(luna-define-method mime-entity-body ((entity mime-buffer-entity))
+ (save-excursion
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (buffer-substring (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))))
+
+(luna-define-method mime-insert-entity-body ((entity mime-buffer-entity))
+ (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
+ (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))
+ )
+
+(luna-define-method mime-write-entity-body ((entity mime-buffer-entity)
+ filename)
+ (save-excursion
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (write-region-as-binary (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity)
+ filename)
+ ))
+
+
+;;; @ entity content
+;;;
+
(luna-define-method mime-entity-content ((entity mime-buffer-entity))
(save-excursion
(set-buffer (mime-buffer-entity-buffer-internal entity))
(mime-buffer-entity-body-end-internal entity))
(mime-entity-encoding entity))))
+(luna-define-method mime-insert-entity-content ((entity mime-buffer-entity))
+ (insert (with-current-buffer (mime-buffer-entity-buffer-internal entity)
+ (mime-decode-string
+ (buffer-substring (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))
+ (mime-entity-encoding entity)))))
+
+(luna-define-method mime-write-entity-content ((entity mime-buffer-entity)
+ filename)
+ (save-excursion
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity)
+ filename
+ (or (mime-entity-encoding entity) "7bit"))
+ ))
+
+
+;;; @ header field
+;;;
+
(luna-define-method mime-entity-fetch-field :around
((entity mime-buffer-entity) field-name)
(or (luna-call-next-method)
(mime-entity-original-header-internal entity)))
ret))))))
-(mm-define-method insert-entity-content ((entity buffer))
- (insert (with-current-buffer (mime-buffer-entity-buffer-internal entity)
- (mime-decode-string
- (buffer-substring (mime-buffer-entity-body-start-internal entity)
- (mime-buffer-entity-body-end-internal entity))
- (mime-entity-encoding entity)))))
-
-(mm-define-method write-entity-content ((entity buffer) filename)
- (save-excursion
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity)
- (mime-buffer-entity-body-end-internal entity)
- filename
- (or (mime-entity-encoding entity) "7bit"))
- ))
-
-(mm-define-method insert-entity ((entity buffer))
- (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
- (mime-buffer-entity-header-start-internal entity)
- (mime-buffer-entity-body-end-internal entity))
+(luna-define-method mime-insert-header ((entity mime-buffer-entity)
+ &optional invisible-fields
+ visible-fields)
+ (mime-insert-header-from-buffer
+ (mime-buffer-entity-buffer-internal entity)
+ (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-header-end-internal entity)
+ invisible-fields visible-fields)
)
-(mm-define-method write-entity ((entity buffer) filename)
- (save-excursion
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (write-region-as-raw-text-CRLF
- (mime-buffer-entity-header-start-internal entity)
- (mime-buffer-entity-body-end-internal entity)
- filename)
- ))
-
-(mm-define-method write-entity-body ((entity buffer) filename)
- (save-excursion
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (write-region-as-binary (mime-buffer-entity-body-start-internal entity)
- (mime-buffer-entity-body-end-internal entity)
- filename)
- ))
-
;;; @ header buffer
;;;
-(luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity))
- (mime-buffer-entity-buffer-internal entity)
- )
+;; (luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity))
+;; (mime-buffer-entity-buffer-internal entity)
+;; )
-(luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity))
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (goto-char (mime-buffer-entity-header-start-internal entity))
- )
+;; (luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity))
+;; (set-buffer (mime-buffer-entity-buffer-internal entity))
+;; (goto-char (mime-buffer-entity-header-start-internal entity))
+;; )
-(luna-define-method mime-entity-header-start-point ((entity
- mime-buffer-entity))
- (mime-buffer-entity-header-start-internal entity)
- )
+;; (luna-define-method mime-entity-header-start-point ((entity
+;; mime-buffer-entity))
+;; (mime-buffer-entity-header-start-internal entity)
+;; )
-(luna-define-method mime-entity-header-end-point ((entity
- mime-buffer-entity))
- (mime-buffer-entity-header-end-internal entity)
- )
+;; (luna-define-method mime-entity-header-end-point ((entity
+;; mime-buffer-entity))
+;; (mime-buffer-entity-header-end-internal entity)
+;; )
;;; @ body buffer
;;;
-(luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity))
- (mime-buffer-entity-buffer-internal entity)
- )
+;; (luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity))
+;; (mime-buffer-entity-buffer-internal entity)
+;; )
-(luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity))
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (goto-char (mime-buffer-entity-body-start-internal entity))
- )
+;; (luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity))
+;; (set-buffer (mime-buffer-entity-buffer-internal entity))
+;; (goto-char (mime-buffer-entity-body-start-internal entity))
+;; )
-(luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity))
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (goto-char (mime-buffer-entity-body-end-internal entity))
- )
+;; (luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity))
+;; (set-buffer (mime-buffer-entity-buffer-internal entity))
+;; (goto-char (mime-buffer-entity-body-end-internal entity))
+;; )
-(luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity))
- (mime-buffer-entity-body-start-internal entity)
- )
+;; (luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity))
+;; (mime-buffer-entity-body-start-internal entity)
+;; )
-(luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity))
- (mime-buffer-entity-body-end-internal entity)
- )
+;; (luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity))
+;; (mime-buffer-entity-body-end-internal entity)
+;; )
;;; @ buffer (obsolete)
;;;
-(luna-define-method mime-entity-buffer ((entity mime-buffer-entity))
- (mime-buffer-entity-buffer-internal entity)
- )
+;; (luna-define-method mime-entity-buffer ((entity mime-buffer-entity))
+;; (mime-buffer-entity-buffer-internal entity)
+;; )
-(luna-define-method mime-entity-point-min ((entity mime-buffer-entity))
- (mime-buffer-entity-header-start-internal entity)
- )
+;; (luna-define-method mime-entity-point-min ((entity mime-buffer-entity))
+;; (mime-buffer-entity-header-start-internal entity)
+;; )
-(luna-define-method mime-entity-point-max ((entity mime-buffer-entity))
- (mime-buffer-entity-body-end-internal entity)
- )
+;; (luna-define-method mime-entity-point-max ((entity mime-buffer-entity))
+;; (mime-buffer-entity-body-end-internal entity)
+;; )
+
+
+;;; @ children
+;;;
+
+(defun mmbuffer-parse-multipart (entity)
+ (with-current-buffer (mime-buffer-entity-buffer-internal entity)
+ (let* ((representation-type
+ (mime-entity-representation-type-internal entity))
+ (content-type (mime-entity-content-type-internal entity))
+ (dash-boundary
+ (concat "--"
+ (mime-content-type-parameter content-type "boundary")))
+ (delimiter (concat "\n" (regexp-quote dash-boundary)))
+ (close-delimiter (concat delimiter "--[ \t]*$"))
+ (rsep (concat delimiter "[ \t]*\n"))
+ (dc-ctl
+ (if (eq (mime-content-type-subtype content-type) 'digest)
+ (make-mime-content-type 'message 'rfc822)
+ (make-mime-content-type 'text 'plain)
+ ))
+ (body-start (mime-buffer-entity-body-start-internal entity))
+ (body-end (mime-buffer-entity-body-end-internal entity)))
+ (save-restriction
+ (goto-char body-end)
+ (narrow-to-region body-start
+ (if (re-search-backward close-delimiter nil t)
+ (match-beginning 0)
+ body-end))
+ (goto-char body-start)
+ (if (re-search-forward
+ (concat "^" (regexp-quote dash-boundary) "[ \t]*\n")
+ nil t)
+ (let ((cb (match-end 0))
+ ce ncb ret children
+ (node-id (mime-entity-node-id-internal entity))
+ (i 0))
+ (while (re-search-forward rsep nil t)
+ (setq ce (match-beginning 0))
+ (setq ncb (match-end 0))
+ (save-restriction
+ (narrow-to-region cb ce)
+ (setq ret (mime-parse-message representation-type dc-ctl
+ entity (cons i node-id)))
+ )
+ (setq children (cons ret children))
+ (goto-char (setq cb ncb))
+ (setq i (1+ i))
+ )
+ (setq ce (point-max))
+ (save-restriction
+ (narrow-to-region cb ce)
+ (setq ret (mime-parse-message representation-type dc-ctl
+ entity (cons i node-id)))
+ )
+ (setq children (cons ret children))
+ (mime-entity-set-children-internal entity (nreverse children))
+ )
+ (mime-entity-set-content-type-internal
+ entity (make-mime-content-type 'message 'x-broken))
+ nil)
+ ))))
+
+(defun mmbuffer-parse-encapsulated (entity &optional external)
+ (mime-entity-set-children-internal
+ entity
+ (with-current-buffer (mime-buffer-entity-buffer-internal entity)
+ (save-restriction
+ (narrow-to-region (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))
+ (list (mime-parse-message
+ (if external
+ (progn
+ (require 'mmexternal)
+ 'mime-external-entity)
+ (mime-entity-representation-type-internal entity))
+ nil
+ entity (cons 0 (mime-entity-node-id-internal entity))))))))
+
+(luna-define-method mime-entity-children ((entity mime-buffer-entity))
+ (let* ((content-type (mime-entity-content-type entity))
+ (primary-type (mime-content-type-primary-type content-type))
+ sub-type)
+ (cond ((eq primary-type 'multipart)
+ (mmbuffer-parse-multipart entity))
+ ((eq primary-type 'message)
+ (setq sub-type (mime-content-type-subtype content-type))
+ (cond ((eq sub-type 'external-body)
+ (mmbuffer-parse-encapsulated entity 'external))
+ ((memq sub-type '(rfc822 news))
+ (mmbuffer-parse-encapsulated entity)))))))
;;; @ end
;;; mmdual.el --- MIME entity module for dual buffers
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
-;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: MIME, multimedia, mail, news
(luna-define-method initialize-instance :after ((entity mime-dual-entity)
&rest init-args)
- (let (buf)
- (setq buf (mime-dual-entity-header-buffer-internal entity))
+ (let ((buf (mime-dual-entity-header-buffer-internal entity)))
(if buf
(with-current-buffer buf
- (if (mime-root-entity-p entity)
- (setq mime-message-structure entity))
(or (mime-entity-content-type-internal entity)
(mime-entity-set-content-type-internal
entity
(let ((str (std11-fetch-field "Content-Type")))
(if str
(mime-parse-Content-Type str)
- ))))))
- (setq buf (mime-dual-entity-body-buffer-internal entity))
- (if buf
- (with-current-buffer buf
- (if (mime-root-entity-p entity)
- (setq mime-message-structure entity))))
- ) entity)
+ )))))))
+ entity)
(luna-define-method mime-entity-name ((entity mime-dual-entity))
(buffer-name (mime-dual-entity-header-buffer-internal entity))
)
-(defun mime-visible-field-p (field-name visible-fields invisible-fields)
- (or (catch 'found
- (while visible-fields
- (let ((regexp (car visible-fields)))
- (if (string-match regexp field-name)
- (throw 'found t)
- ))
- (setq visible-fields (cdr visible-fields))
- ))
- (catch 'found
- (while invisible-fields
- (let ((regexp (car invisible-fields)))
- (if (string-match regexp field-name)
- (throw 'found nil)
- ))
- (setq invisible-fields (cdr invisible-fields))
- )
- t)))
-
-(defun mime-insert-header-from-buffer (buffer start end
- &optional invisible-fields
- visible-fields)
- (let ((the-buf (current-buffer))
- (mode-obj (mime-find-field-presentation-method 'wide))
- field-decoder
- f-b p f-e field-name len field field-body)
- (save-excursion
- (set-buffer buffer)
- (save-restriction
- (narrow-to-region start end)
- (goto-char start)
- (while (re-search-forward std11-field-head-regexp nil t)
- (setq f-b (match-beginning 0)
- p (match-end 0)
- field-name (buffer-substring f-b p)
- len (string-width field-name)
- f-e (std11-field-end))
- (when (mime-visible-field-p field-name
- visible-fields invisible-fields)
- (setq field (intern
- (capitalize (buffer-substring f-b (1- p))))
- field-body (buffer-substring p f-e)
- field-decoder (inline (mime-find-field-decoder-internal
- field mode-obj)))
- (with-current-buffer the-buf
- (insert field-name)
- (insert (if field-decoder
- (funcall field-decoder field-body len)
- ;; Don't decode
- field-body))
- (insert "\n")
- )))))))
-
(luna-define-method mime-insert-header ((entity mime-dual-entity)
&optional invisible-fields
visible-fields)
--- /dev/null
+;;; mmexternal.el --- MIME entity module for external buffer
+
+;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; Keywords: MIME, multimedia, mail, news
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'mime)
+(require 'pces)
+
+(eval-and-compile
+ (luna-define-class mime-external-entity (mime-entity)
+ (body-buffer
+ body-file))
+ (luna-define-internal-accessors 'mime-external-entity)
+
+ ;; In an external entity, information of media-type or other
+ ;; information which are represented in a header in a non-external
+ ;; entity are in the body of the parent entity.
+ )
+
+(luna-define-method 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
--- /dev/null
+;;; mmgeneric.el --- MIME generic entity module
+
+;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; Keywords: definition, MIME, multimedia, mail, news
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'luna)
+
+
+;;; @ MIME entity
+;;;
+
+(autoload 'mime-entity-content-type "mime")
+(autoload 'mime-parse-multipart "mime-parse")
+(autoload 'mime-parse-message "mime-parse")
+;; (autoload 'mime-parse-encapsulated "mime-parse")
+;; (autoload 'mime-parse-external "mime-parse")
+(autoload 'mime-entity-content "mime")
+
+(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
;;;
(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)
"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)
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))
(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)
projects / elisp / flim.git / commitdiff