X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mmbuffer.el;h=93b2ff300b8792efe0236b801703bd15d1a088be;hb=refs%2Fheads%2Fchaotzu;hp=7982db9d27b6605df7728069aaf8609dc88f4b60;hpb=23852858a3dbd40759b51d9fc8231e06fb3e81c9;p=elisp%2Fflim.git 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 ;;;