From: morioka Date: Wed, 14 Oct 1998 06:18:20 +0000 (+0000) Subject: Merge flim-chao-1_11_5. X-Git-Tag: flim-1_11_0~22 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=d02a90e6a4e48be72f8b2030c78c03e28f8bd30a;p=elisp%2Fflim.git Merge flim-chao-1_11_5. --- diff --git a/ChangeLog b/ChangeLog index f356ee4..13c08db 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,78 @@ +1998-10-02 MORIOKA Tomohiko + + * std11.el (std11-unfold-string): New implementation. + +1998-10-02 MORIOKA Tomohiko + + * mmgeneric.el: New module. + + * mmbuffer.el: Use `generic' as mother backend. + + * FLIM-ELS (flim-modules): Add mmgeneric. + +1998-10-01 MORIOKA Tomohiko + + * mime-parse.el (mime-parse-message): Modify for + `make-mime-entity-internal'. + + * mime-def.el (make-mime-entity-internal): Change interface to be + able to specify original-header and parsed-header. + +1998-09-30 MORIOKA Tomohiko + + * eword-decode.el (eword-decode-and-unfold-unstructured-field): + New function. + +1998-09-30 MORIOKA Tomohiko + + * mime.el (mime-entity-content-type): New implementation. + (mime-entity-content-disposition): New implementation. + (mime-entity-encoding): New implementation. + + * mime.el (mime-fetch-field): Refer internal slots for Date, + Message-Id and References fields. + + * mime-parse.el (mime-parse-message): Modify for + `make-mime-entity-internal'. + + * mime-def.el: Change `mime-entity-*-internal' and + `mime-entity-set-*-internal' to macro. + (make-mime-entity-internal): Change interface and data format for + NOV data; changed to macro. + (mime-entity-set-location-internal): New macro. + (mime-entity-decoded-subject-internal): New macro. + (mime-entity-set-decoded-subject-internal): New macro. + (mime-entity-decoded-from-internal): New macro. + (mime-entity-set-decoded-from-internal): New macro. + (mime-entity-date-internal): New macro. + (mime-entity-set-date-internal): New macro. + (mime-entity-message-id-internal): New macro. + (mime-entity-set-message-id-internal): New macro. + (mime-entity-references-internal): New macro. + (mime-entity-set-references-internal): New macro. + (mime-entity-chars-internal): New macro. + (mime-entity-set-chars-internal): New macro. + (mime-entity-lines-internal): New macro. + (mime-entity-set-lines-internal): New macro. + (mime-entity-xref-internal): New macro. + (mime-entity-set-xref-internal): New macro. + (mime-entity-original-header-internal): Modify for new structure; + changed to macro. + (mime-entity-set-original-header-internal): Likewise. + (mime-entity-parsed-header-internal): Likewise. + (mime-entity-set-parsed-header-internal): Likewise. + (mime-entity-buffer-internal): Likewise. + (mime-entity-set-buffer-internal): Likewise. + (mime-entity-header-start-internal): Likewise. + (mime-entity-set-header-start-internal): Likewise. + (mime-entity-header-end-internal): Likewise. + (mime-entity-set-header-end-internal): Likewise. + (mime-entity-body-start-internal): Likewise. + (mime-entity-set-body-start-internal): Likewise. + (mime-entity-body-end-internal): Likewise. + (mime-entity-set-body-end-internal): Likewise. + + 1998-10-14 MORIOKA Tomohiko * FLIM: Version 1.10.5 (Kizugawadai) was released. diff --git a/FLIM-ELS b/FLIM-ELS index 5c232f2..3e8e347 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -8,7 +8,7 @@ mime-def mel mel-b mel-q mel-u mel-g eword-decode eword-encode - mime mime-parse mmbuffer mmcooked + mime mime-parse mmgeneric mmbuffer mmcooked mailcap)) (if (fboundp 'dynamic-link) diff --git a/FLIM-MK b/FLIM-MK index 25552c7..e381f48 100644 --- a/FLIM-MK +++ b/FLIM-MK @@ -1,7 +1,8 @@ ;;; -*-Emacs-Lisp-*- -;;; -;;; $Id: FLIM-MK,v 1.4 1998-10-12 13:58:19 morioka Exp $ -;;; + +;; FLIM-MK: installer for FLIM. + +;;; Code: (defun config-flim () (let (prefix lisp-dir version-specific-lisp-dir) diff --git a/FLIM-VERSION b/FLIM-VERSION index 9f82250..2eba772 100644 --- a/FLIM-VERSION +++ b/FLIM-VERSION @@ -28,7 +28,7 @@ 1.10.3 Komada $(B9}ED(B 1.10.4 Shin-H-Dòsono-A $(B?7=K1`(B ; <=> JR $(BJRD.@~(B $(B=K1`(B 1.10.5 Kizugawadai $(BLZDE@nBf(B ------ Yamadagawa $(B;3ED@n(B +1.11.0 Yamadagawa $(B;3ED@n(B ----- Takanohara $(B9b$N86(B ----- Heij-Dò-A $(BJ?>k(B ----- Saidaiji $(B@>Bg;{(B @@ -59,4 +59,10 @@ 1.7.0 Goj-Dò-A $(B8^>r(B 1.8.0 Shij-Dò-A $(B;M>r(B ; <=> $(B:e5^(B $(B5~ET@~(B 1.9.0 Karasuma Oike $(B1(4]8fCS(B ; = $(B5~ET;T8rDL6I(B $(BEl@>@~(B ------ Marutamach $(B4]B@D.(B +1.10.0 Marutamach $(B4]B@D.(B +1.11.0 Imadegawa $(B:#=P@n(B +1.11.1 Kuramaguchi $(B0HGO8}(B +1.11.2 Kita-Dòji-A $(BKLBgO)(B +1.11.3 Kitayama $(BKL;3(B +1.11.4 Matugasaki $(B>>%v:j(B +1.11.5 Kokusaikaikan $(B9q:]2q4[(B diff --git a/Makefile b/Makefile index 8d6ec88..c9ea336 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ # PACKAGE = flim -VERSION = 1.10.5 +VERSION = 1.11.0 TAR = tar RM = /bin/rm -f diff --git a/eword-decode.el b/eword-decode.el index 02e1c9a..2414a7a 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -218,6 +218,19 @@ such as a version of Net$cape)." (decode-mime-charset-string string default-mime-charset) must-unfold)) +(defun eword-decode-and-unfold-unstructured-field (string) + "Decode and unfold STRING as unstructured field body. +It decodes non us-ascii characters in FULL-NAME encoded as +encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii +characters are regarded as variable `default-mime-charset'. + +If an encoded-word is broken or your emacs implementation can not +decode the charset included in it, it is not decoded." + (eword-decode-string + (decode-mime-charset-string (std11-unfold-string string) + default-mime-charset) + 'must-unfold)) + ;;; @ for region ;;; diff --git a/mime-def.el b/mime-def.el index fade20f..f4bfe65 100644 --- a/mime-def.el +++ b/mime-def.el @@ -25,7 +25,7 @@ ;;; Code: (eval-and-compile - (defconst mime-library-product ["FLIM" (1 10 5) "Kizugawadai"] + (defconst mime-library-product ["FLIM" (1 11 0) "Yamadagawa"] "Product name, version number and code name of MIME-library package.") ) @@ -214,75 +214,125 @@ ;;; @ MIME entity ;;; -(defsubst make-mime-entity-internal (representation-type location +(defmacro make-mime-entity-internal (representation-type location &optional content-type children parent node-id + ;; for NOV + decoded-subject decoded-from + date message-id references + chars lines + xref + ;; for other fields + original-header parsed-header + ;; for buffer representation buffer header-start header-end body-start body-end) - (vector representation-type location - content-type nil nil children parent node-id - buffer header-start header-end body-start body-end - nil nil)) - -(defsubst mime-entity-representation-type-internal (entity) - (aref entity 0)) -(defsubst mime-entity-set-representation-type-internal (entity type) - (aset entity 0 type)) -(defsubst mime-entity-location-internal (entity) - (aref entity 1)) - -(defsubst mime-entity-content-type-internal (entity) - (aref entity 2)) -(defsubst mime-entity-set-content-type-internal (entity type) - (aset entity 2 type)) -(defsubst mime-entity-content-disposition-internal (entity) - (aref entity 3)) -(defsubst mime-entity-set-content-disposition-internal (entity disposition) - (aset entity 3 disposition)) -(defsubst mime-entity-encoding-internal (entity) - (aref entity 4)) -(defsubst mime-entity-set-encoding-internal (entity encoding) - (aset entity 4 encoding)) - -(defsubst mime-entity-children-internal (entity) - (aref entity 5)) -(defsubst mime-entity-set-children-internal (entity children) - (aset entity 5 children)) -(defsubst mime-entity-parent-internal (entity) - (aref entity 6)) -(defsubst mime-entity-node-id-internal (entity) - (aref entity 7)) - -(defsubst mime-entity-buffer-internal (entity) - (aref entity 8)) -(defsubst mime-entity-set-buffer-internal (entity buffer) - (aset entity 8 buffer)) -(defsubst mime-entity-header-start-internal (entity) - (aref entity 9)) -(defsubst mime-entity-set-header-start-internal (entity point) - (aset entity 9 point)) -(defsubst mime-entity-header-end-internal (entity) - (aref entity 10)) -(defsubst mime-entity-set-header-end-internal (entity point) - (aset entity 10 point)) -(defsubst mime-entity-body-start-internal (entity) - (aref entity 11)) -(defsubst mime-entity-set-body-start-internal (entity point) - (aset entity 11 point)) -(defsubst mime-entity-body-end-internal (entity) - (aref entity 12)) -(defsubst mime-entity-set-body-end-internal (entity point) - (aset entity 12 point)) - -(defsubst mime-entity-original-header-internal (entity) - (aref entity 13)) -(defsubst mime-entity-set-original-header-internal (entity header) - (aset entity 13 header)) -(defsubst mime-entity-parsed-header-internal (entity) - (aref entity 14)) -(defsubst mime-entity-set-parsed-header-internal (entity header) - (aset entity 14 header)) + `(vector ,representation-type ,location + ,content-type nil nil ,children ,parent ,node-id + ;; for NOV + ,decoded-subject ,decoded-from + ,date ,message-id ,references + ,chars ,lines + ,xref + ;; for other fields + ,original-header ,parsed-header + ;; for buffer representation + ,buffer ,header-start ,header-end ,body-start ,body-end)) + +(defmacro mime-entity-representation-type-internal (entity) + `(aref ,entity 0)) +(defmacro mime-entity-set-representation-type-internal (entity type) + `(aset ,entity 0 ,type)) +(defmacro mime-entity-location-internal (entity) + `(aref ,entity 1)) +(defmacro mime-entity-set-location-internal (entity location) + `(aset ,entity 1 ,location)) + +(defmacro mime-entity-content-type-internal (entity) + `(aref ,entity 2)) +(defmacro mime-entity-set-content-type-internal (entity type) + `(aset ,entity 2 ,type)) +(defmacro mime-entity-content-disposition-internal (entity) + `(aref ,entity 3)) +(defmacro mime-entity-set-content-disposition-internal (entity disposition) + `(aset ,entity 3 ,disposition)) +(defmacro mime-entity-encoding-internal (entity) + `(aref ,entity 4)) +(defmacro mime-entity-set-encoding-internal (entity encoding) + `(aset ,entity 4 ,encoding)) + +(defmacro mime-entity-children-internal (entity) + `(aref ,entity 5)) +(defmacro mime-entity-set-children-internal (entity children) + `(aset ,entity 5 ,children)) +(defmacro mime-entity-parent-internal (entity) + `(aref ,entity 6)) +(defmacro mime-entity-node-id-internal (entity) + `(aref ,entity 7)) + +(defmacro mime-entity-decoded-subject-internal (entity) + `(aref ,entity 8)) +(defmacro mime-entity-set-decoded-subject-internal (entity subject) + `(aset ,entity 8 ,subject)) +(defmacro mime-entity-decoded-from-internal (entity) + `(aref ,entity 9)) +(defmacro mime-entity-set-decoded-from-internal (entity from) + `(aset ,entity 9 ,from)) +(defmacro mime-entity-date-internal (entity) + `(aref ,entity 10)) +(defmacro mime-entity-set-date-internal (entity date) + `(aset ,entity 10 ,date)) +(defmacro mime-entity-message-id-internal (entity) + `(aref ,entity 11)) +(defmacro mime-entity-set-message-id-internal (entity message-id) + `(aset ,entity 11 ,message-id)) +(defmacro mime-entity-references-internal (entity) + `(aref ,entity 12)) +(defmacro mime-entity-set-references-internal (entity references) + `(aset ,entity 12 ,references)) +(defmacro mime-entity-chars-internal (entity) + `(aref ,entity 13)) +(defmacro mime-entity-set-chars-internal (entity chars) + `(aset ,entity 13 ,chars)) +(defmacro mime-entity-lines-internal (entity) + `(aref ,entity 14)) +(defmacro mime-entity-set-lines-internal (entity lines) + `(aset ,entity 14 ,lines)) +(defmacro mime-entity-xref-internal (entity) + `(aref ,entity 15)) +(defmacro mime-entity-set-xref-internal (entity xref) + `(aset ,entity 15 ,xref)) + +(defmacro mime-entity-original-header-internal (entity) + `(aref ,entity 16)) +(defmacro mime-entity-set-original-header-internal (entity header) + `(aset ,entity 16 ,header)) +(defmacro mime-entity-parsed-header-internal (entity) + `(aref ,entity 17)) +(defmacro mime-entity-set-parsed-header-internal (entity header) + `(aset ,entity 17 ,header)) + +(defmacro mime-entity-buffer-internal (entity) + `(aref ,entity 18)) +(defmacro mime-entity-set-buffer-internal (entity buffer) + `(aset ,entity 18 ,buffer)) +(defmacro mime-entity-header-start-internal (entity) + `(aref ,entity 19)) +(defmacro mime-entity-set-header-start-internal (entity point) + `(aset ,entity 19 ,point)) +(defmacro mime-entity-header-end-internal (entity) + `(aref ,entity 20)) +(defmacro mime-entity-set-header-end-internal (entity point) + `(aset ,entity 20 ,point)) +(defmacro mime-entity-body-start-internal (entity) + `(aref ,entity 21)) +(defmacro mime-entity-set-body-start-internal (entity point) + `(aset ,entity 21 ,point)) +(defmacro mime-entity-body-end-internal (entity) + `(aref ,entity 22)) +(defmacro mime-entity-set-body-end-internal (entity point) + `(aset ,entity 22 ,point)) ;;; @ message structure diff --git a/mime-parse.el b/mime-parse.el index fa20a85..8951509 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -242,6 +242,9 @@ If is is not found, return DEFAULT-ENCODING." (make-mime-entity-internal representation-type (current-buffer) content-type nil parent node-id + nil nil nil nil + nil nil nil nil + nil nil (current-buffer) header-start header-end body-start body-end) diff --git a/mime.el b/mime.el index bc38dae..a0211ef 100644 --- a/mime.el +++ b/mime.el @@ -190,39 +190,59 @@ If MESSAGE is specified, it is regarded as root entity." (setq field-name (intern (capitalize (capitalize field-name))))) (or entity (setq entity mime-message-structure)) - (let* ((header (mime-entity-original-header-internal entity)) - (field-body (cdr (assq field-name header)))) - (or field-body - (progn - (if (setq field-body - (mime-entity-send entity 'fetch-field - (symbol-name field-name))) - (mime-entity-set-original-header-internal - entity (put-alist field-name field-body header)) - ) - field-body)))) - -(defalias 'mime-entity-content-type 'mime-entity-content-type-internal) + (cond ((eq field-name 'Date) + (or (mime-entity-date-internal entity) + (mime-entity-set-date-internal + entity (mime-entity-send entity 'fetch-field "Date")) + )) + ((eq field-name 'Message-Id) + (or (mime-entity-message-id-internal entity) + (mime-entity-set-message-id-internal + entity (mime-entity-send entity 'fetch-field "Message-Id")) + )) + ((eq field-name 'References) + (or (mime-entity-references-internal entity) + (mime-entity-set-references-internal + entity (mime-entity-send entity 'fetch-field "References")) + )) + (t + (let* ((header (mime-entity-original-header-internal entity)) + (field-body (cdr (assq field-name header)))) + (or field-body + (progn + (if (setq field-body + (mime-entity-send entity 'fetch-field + (symbol-name field-name))) + (mime-entity-set-original-header-internal + entity (put-alist field-name field-body header)) + ) + field-body)) + )))) + +(defun mime-entity-content-type (entity) + (or (mime-entity-content-type-internal entity) + (let ((ret (mime-fetch-field 'Content-Type entity))) + (if ret + (mime-entity-set-content-type-internal + entity (mime-parse-Content-Type ret)) + )))) (defun mime-entity-content-disposition (entity) (or (mime-entity-content-disposition-internal entity) (let ((ret (mime-fetch-field 'Content-Disposition entity))) (if ret - (let ((disposition (mime-parse-Content-Disposition ret))) - (when disposition - (mime-entity-set-content-disposition-internal - entity disposition) - disposition)))))) + (mime-entity-set-content-disposition-internal + entity (mime-parse-Content-Disposition ret)) + )))) (defun mime-entity-encoding (entity &optional default-encoding) (or (mime-entity-encoding-internal entity) - (let ((encoding - (or (let ((ret (mime-fetch-field - 'Content-Transfer-Encoding entity))) - (and ret (mime-parse-Content-Transfer-Encoding ret))) - default-encoding "7bit"))) - (mime-entity-set-encoding-internal entity encoding) - encoding))) + (let ((ret (mime-fetch-field 'Content-Transfer-Encoding entity))) + (mime-entity-set-encoding-internal + entity + (or (and ret (mime-parse-Content-Transfer-Encoding ret)) + default-encoding "7bit")) + ))) (defun mime-read-field (field-name &optional entity) (or (symbolp field-name) diff --git a/mmbuffer.el b/mmbuffer.el index 7982db9..93b2ff3 100644 --- a/mmbuffer.el +++ b/mmbuffer.el @@ -24,10 +24,9 @@ ;;; Code: -(require 'mime) -(require 'mime-parse) +(require 'mmgeneric) -(mm-define-backend buffer) +(mm-define-backend buffer (generic)) (mm-define-method initialize-instance ((entity buffer)) (mime-entity-set-buffer-internal @@ -62,6 +61,8 @@ (mime-entity-set-body-end-internal entity body-end) ))) +;;; redefine to speed up + (mm-define-method entity-point-min ((entity buffer)) (mime-entity-header-start-internal entity)) @@ -77,22 +78,6 @@ (std11-fetch-field field-name) ))) -(mm-define-method entity-cooked-p ((entity buffer)) nil) - -(mm-define-method entity-children ((entity buffer)) - (let* ((content-type (mime-entity-content-type entity)) - (primary-type (mime-content-type-primary-type content-type))) - (cond ((eq primary-type 'multipart) - (mime-parse-multipart entity) - ) - ((and (eq primary-type 'message) - (memq (mime-content-type-subtype content-type) - '(rfc822 news external-body) - )) - (mime-parse-encapsulated entity) - )) - )) - (mm-define-method entity-content ((entity buffer)) (save-excursion (set-buffer (mime-entity-buffer-internal entity)) @@ -126,77 +111,6 @@ filename) )) -(defun mime-visible-field-p (field-name visible-fields invisible-fields) - (or (catch 'found - (while visible-fields - (let ((regexp (car visible-fields))) - (if (string-match regexp field-name) - (throw 'found t) - )) - (setq visible-fields (cdr visible-fields)) - )) - (catch 'found - (while invisible-fields - (let ((regexp (car invisible-fields))) - (if (string-match regexp field-name) - (throw 'found nil) - )) - (setq invisible-fields (cdr invisible-fields)) - ) - t))) - -(mm-define-method insert-decoded-header ((entity buffer) - &optional invisible-fields - visible-fields) - (save-restriction - (narrow-to-region (point)(point)) - (let ((the-buf (current-buffer)) - (src-buf (mime-entity-buffer-internal entity)) - (h-end (mime-entity-header-end-internal entity)) - beg p end field-name len field) - (save-excursion - (set-buffer src-buf) - (goto-char (mime-entity-header-start-internal entity)) - (save-restriction - (narrow-to-region (point) h-end) - (while (re-search-forward std11-field-head-regexp nil t) - (setq beg (match-beginning 0) - p (match-end 0) - field-name (buffer-substring beg (1- p)) - len (string-width field-name) - end (std11-field-end)) - (when (mime-visible-field-p field-name - visible-fields invisible-fields) - (setq field (intern (capitalize field-name))) - (save-excursion - (set-buffer the-buf) - (insert field-name) - (insert ":") - (cond ((memq field eword-decode-ignored-field-list) - ;; Don't decode - (insert-buffer-substring src-buf p end) - ) - ((memq field eword-decode-structured-field-list) - ;; Decode as structured field - (let ((body (save-excursion - (set-buffer src-buf) - (buffer-substring p end) - ))) - (insert (eword-decode-and-fold-structured-field - body (1+ len))) - )) - (t - ;; Decode as unstructured field - (let ((body (save-excursion - (set-buffer src-buf) - (buffer-substring p end) - ))) - (insert (eword-decode-unstructured-field-body - body (1+ len))) - ))) - (insert "\n") - )))))))) - ;;; @ end ;;; diff --git a/mmgeneric.el b/mmgeneric.el new file mode 100644 index 0000000..d68c9bd --- /dev/null +++ b/mmgeneric.el @@ -0,0 +1,205 @@ +;;; mmgeneric.el --- MIME entity module for generic buffer + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: MIME, multimedia, mail, news + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'mime) +(require 'mime-parse) + +(mm-define-backend generic) + +(mm-define-method entity-header-start ((entity generic)) + (mime-entity-set-header-start-internal + entity + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (point-min) + ))) + +(mm-define-method entity-header-end ((entity generic)) + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (mime-entity-header-end-internal entity) + )) + +(mm-define-method entity-body-start ((entity generic)) + (mime-entity-set-body-start-internal + entity + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (mime-entity-body-start-internal entity) + ))) + +(mm-define-method entity-body-end ((entity generic)) + (mime-entity-set-body-end-internal + entity + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (point-max) + ))) + +(mm-define-method entity-point-min ((entity generic)) + (or (mime-entity-header-start-internal entity) + (mime-entity-send entity 'entity-header-start))) + +(mm-define-method entity-point-max ((entity generic)) + (or (mime-entity-body-end-internal entity) + (mime-entity-send entity 'entity-body-end))) + +(mm-define-method fetch-field ((entity generic) field-name) + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (save-restriction + (narrow-to-region (mime-entity-header-start-internal entity) + (mime-entity-header-end-internal entity)) + (std11-fetch-field field-name) + ))) + +(mm-define-method entity-cooked-p ((entity generic)) nil) + +(mm-define-method entity-children ((entity generic)) + (let* ((content-type (mime-entity-content-type entity)) + (primary-type (mime-content-type-primary-type content-type))) + (cond ((eq primary-type 'multipart) + (mime-parse-multipart entity) + ) + ((and (eq primary-type 'message) + (memq (mime-content-type-subtype content-type) + '(rfc822 news external-body) + )) + (mime-parse-encapsulated entity) + )) + )) + +(mm-define-method entity-content ((entity generic)) + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (mime-decode-string + (buffer-substring (mime-entity-body-start-internal entity) + (mime-entity-body-end-internal entity)) + (mime-entity-encoding entity)))) + +(mm-define-method write-entity-content ((entity generic) filename) + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (mime-write-decoded-region (mime-entity-body-start-internal entity) + (mime-entity-body-end-internal entity) + filename + (or (mime-entity-encoding entity) "7bit")) + )) + +(mm-define-method write-entity ((entity generic) filename) + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (write-region-as-raw-text-CRLF (mime-entity-header-start-internal entity) + (mime-entity-body-end-internal entity) + filename) + )) + +(mm-define-method write-entity-body ((entity generic) filename) + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (write-region-as-binary (mime-entity-body-start-internal entity) + (mime-entity-body-end-internal entity) + filename) + )) + +(defun mime-visible-field-p (field-name visible-fields invisible-fields) + (or (catch 'found + (while visible-fields + (let ((regexp (car visible-fields))) + (if (string-match regexp field-name) + (throw 'found t) + )) + (setq visible-fields (cdr visible-fields)) + )) + (catch 'found + (while invisible-fields + (let ((regexp (car invisible-fields))) + (if (string-match regexp field-name) + (throw 'found nil) + )) + (setq invisible-fields (cdr invisible-fields)) + ) + t))) + +(mm-define-method insert-decoded-header ((entity generic) + &optional invisible-fields + visible-fields) + (save-restriction + (narrow-to-region (point)(point)) + (let ((the-buf (current-buffer)) + (src-buf (mime-entity-buffer entity)) + (h-end (mime-entity-header-end-internal entity)) + beg p end field-name len field) + (save-excursion + (set-buffer src-buf) + (goto-char (mime-entity-header-start-internal entity)) + (save-restriction + (narrow-to-region (point) h-end) + (while (re-search-forward std11-field-head-regexp nil t) + (setq beg (match-beginning 0) + p (match-end 0) + field-name (buffer-substring beg (1- p)) + len (string-width field-name) + end (std11-field-end)) + (when (mime-visible-field-p field-name + visible-fields invisible-fields) + (setq field (intern (capitalize field-name))) + (save-excursion + (set-buffer the-buf) + (insert field-name) + (insert ":") + (cond ((memq field eword-decode-ignored-field-list) + ;; Don't decode + (insert-buffer-substring src-buf p end) + ) + ((memq field eword-decode-structured-field-list) + ;; Decode as structured field + (let ((body (save-excursion + (set-buffer src-buf) + (buffer-substring p end) + ))) + (insert (eword-decode-and-fold-structured-field + body (1+ len))) + )) + (t + ;; Decode as unstructured field + (let ((body (save-excursion + (set-buffer src-buf) + (buffer-substring p end) + ))) + (insert (eword-decode-unstructured-field-body + body (1+ len))) + ))) + (insert "\n") + )))))))) + + +;;; @ end +;;; + +(provide 'mmgeneric) + +;;; mmgeneric.el ends here diff --git a/std11.el b/std11.el index d62b88b..616d3ad 100644 --- a/std11.el +++ b/std11.el @@ -116,16 +116,18 @@ header separator. [std11.el]" ;;; (defun std11-unfold-string (string) - "Unfold STRING as message header field. [std11.el]" - (let ((dest "")) - (while (string-match "\n\\([ \t]\\)" string) + "Unfold STRING as message header field." + (let ((dest "") + (p 0)) + (while (string-match "\n\\([ \t]\\)" string p) (setq dest (concat dest - (substring string 0 (match-beginning 0)) - (match-string 1 string) + (substring string p (match-beginning 0)) + (substring string + (match-beginning 1) + (setq p (match-end 0))) )) - (setq string (substring string (match-end 0))) ) - (concat dest string) + (concat dest (substring string p)) ))