From: morioka Date: Tue, 7 Jul 1998 08:25:37 +0000 (+0000) Subject: Use `mm-define-backend' and `mm-define-method'. X-Git-Tag: chao-1_8-199811302358~33 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=5e4876a10201bdddf1d50b92f46488663512e0dd;p=elisp%2Fflim.git Use `mm-define-backend' and `mm-define-method'. --- diff --git a/mmbuffer.el b/mmbuffer.el index e9d24b5..4f4bd71 100644 --- a/mmbuffer.el +++ b/mmbuffer.el @@ -26,19 +26,18 @@ (require 'mime) -(defun mmbuffer-open-entity (location) - (mime-parse-buffer location) - ) +(mm-define-backend buffer) -(defsubst mmbuffer-entity-point-min (entity) - (mime-entity-header-start-internal entity) - ) +(mm-define-method open-entity ((nil buffer) location) + (mime-parse-buffer location)) -(defsubst mmbuffer-entity-point-max (entity) - (mime-entity-body-end-internal entity) - ) +(mm-define-method point-min ((entity buffer)) + (mime-entity-header-start-internal entity)) -(defun mmbuffer-fetch-field (entity field-name) +(mm-define-method point-max ((entity buffer)) + (mime-entity-body-end-internal entity)) + +(mm-define-method fetch-field ((entity buffer) field-name) (save-excursion (set-buffer (mime-entity-buffer-internal entity)) (save-restriction @@ -47,9 +46,9 @@ (std11-fetch-field field-name) ))) -(defun mmbuffer-cooked-p () nil) +(mm-define-method cooked-p ((entity buffer)) nil) -(defun mmbuffer-entity-content (entity) +(mm-define-method entity-content ((entity buffer)) (save-excursion (set-buffer (mime-entity-buffer-internal entity)) (mime-decode-string @@ -57,7 +56,7 @@ (mime-entity-body-end-internal entity)) (mime-entity-encoding entity)))) -(defun mmbuffer-write-entity-content (entity filename) +(mm-define-method write-entity-content ((entity buffer) filename) (save-excursion (set-buffer (mime-entity-buffer-internal entity)) (mime-write-decoded-region (mime-entity-body-start-internal entity) @@ -66,22 +65,25 @@ (or (mime-entity-encoding entity) "7bit")) )) -(defun mmbuffer-write-entity (entity filename) +(mm-define-method write-entity ((entity buffer) filename) (save-excursion (set-buffer (mime-entity-buffer-internal entity)) - (write-region-as-binary (mmbuffer-entity-point-min entity) - (mmbuffer-entity-point-max entity) filename) + (write-region-as-binary (mime-entity-header-start-internal entity) + (mime-entity-body-end-internal entity) + filename) )) -(defun mmbuffer-write-entity-body (entity filename) +(mm-define-method write-entity-body ((entity buffer) filename) (save-excursion (set-buffer (mime-entity-buffer-internal entity)) (write-region-as-binary (mime-entity-body-start-internal entity) - (mime-entity-body-end-internal entity) filename) + (mime-entity-body-end-internal entity) + filename) )) -(defun mmbuffer-insert-decoded-header (entity &optional invisible-fields - visible-fields) +(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)) diff --git a/mmcooked.el b/mmcooked.el index d9d6608..1db5052 100644 --- a/mmcooked.el +++ b/mmcooked.el @@ -26,19 +26,14 @@ (require 'mmbuffer) -(defun mmcooked-open-entity (location) - (mime-parse-buffer location 'cooked) - ) +(mm-define-backend cooked (buffer)) -(defalias 'mmcooked-entity-point-min 'mmbuffer-entity-point-min) -(defalias 'mmcooked-entity-point-max 'mmbuffer-entity-point-max) -(defalias 'mmcooked-fetch-field 'mmbuffer-fetch-field) +(mm-define-method open-entity ((nil cooked) location) + (mime-parse-buffer location 'cooked)) -(defun mmcooked-cooked-p () t) +(mm-define-method cooked-p ((entity cooked)) t) -(defalias 'mmcooked-entity-content 'mmbuffer-entity-content) - -(defun mmcooked-write-entity-content (entity filename) +(mm-define-method write-entity-content ((entity cooked) filename) (save-excursion (set-buffer (mime-entity-buffer-internal entity)) (let ((encoding (or (mime-entity-encoding entity) "7bit"))) @@ -50,72 +45,29 @@ filename encoding) )))) -(defun mmcooked-write-entity (entity filename) +(mm-define-method write-entity ((entity cooked) filename) (save-excursion - (set-buffer (mime-entity-buffer entity)) - (write-region (mime-entity-point-min entity) - (mime-entity-point-max entity) filename) + (set-buffer (mime-entity-buffer-internal entity)) + (write-region (mime-entity-header-start-internal entity) + (mime-entity-body-end-internal entity) + filename) )) -(defun mmcooked-write-entity-body (entity filename) +(mm-define-method write-entity-body ((entity cooked) filename) (save-excursion - (set-buffer (mime-entity-buffer entity)) - (write-region (mime-entity-body-start entity) - (mime-entity-body-end entity) filename) + (set-buffer (mime-entity-buffer-internal entity)) + (write-region (mime-entity-body-start-internal entity) + (mime-entity-body-end-internal entity) + filename) )) -(defun mmcooked-insert-decoded-header (entity &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 entity)) - beg p end field-name len field) - (save-excursion - (set-buffer src-buf) - (goto-char (mime-entity-header-start 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 (eword-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) - )) - default-mime-charset) - (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) - )) - default-mime-charset) - (insert (eword-decode-unstructured-field-body - body (1+ len))) - ))) - (insert "\n") - )))))))) +(mm-define-method insert-decoded-header ((entity cooked) + &optional invisible-fields + visible-fields) + (let (default-mime-charset) + (funcall (mime-find-function 'insert-decoded-header 'buffer) + entity invisible-fields visible-fields) + )) ;;; @ end