X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mmbuffer.el;h=38432fb6aec0b6d921f1d7b324ea411fe5f1d6c4;hb=41fe6bdf8523a73c43e73612b5df85caa5622081;hp=448d88eb772e992fdacf501face84f580e1710c9;hpb=9cf6838bc986b73bc83955794f7424e9d3e1539d;p=elisp%2Fflim.git diff --git a/mmbuffer.el b/mmbuffer.el index 448d88e..38432fb 100644 --- a/mmbuffer.el +++ b/mmbuffer.el @@ -1,6 +1,6 @@ ;;; mmbuffer.el --- MIME entity module for binary buffer -;; Copyright (C) 1998 Free Software Foundation, Inc. +;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news @@ -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,24 +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) - (mime-entity-children-internal entity) - ) - ((and (eq primary-type 'message) - (memq (mime-content-type-subtype content-type) - '(rfc822 news external-body) - )) - (mime-parse-encapsulated entity) - (mime-entity-children-internal entity) - ) - ))) - (mm-define-method entity-content ((entity buffer)) (save-excursion (set-buffer (mime-entity-buffer-internal entity)) @@ -103,6 +86,13 @@ (mime-entity-body-end-internal entity)) (mime-entity-encoding entity)))) +(mm-define-method insert-entity-content ((entity buffer)) + (insert (with-current-buffer (mime-entity-buffer-internal 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 buffer) filename) (save-excursion (set-buffer (mime-entity-buffer-internal entity)) @@ -112,12 +102,18 @@ (or (mime-entity-encoding entity) "7bit")) )) +(mm-define-method insert-entity ((entity buffer)) + (insert-buffer-substring (mime-entity-buffer-internal entity) + (mime-entity-header-start-internal entity) + (mime-entity-body-end-internal entity)) + ) + (mm-define-method write-entity ((entity buffer) filename) (save-excursion (set-buffer (mime-entity-buffer-internal entity)) - (write-region-as-binary (mime-entity-header-start-internal entity) - (mime-entity-body-end-internal entity) - filename) + (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 buffer) filename) @@ -128,77 +124,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 ;;;