From: morioka Date: Fri, 2 Oct 1998 19:28:23 +0000 (+0000) Subject: New module. X-Git-Tag: flim-chao-1_11_1~4 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=178a37a68c18254731b6e191e49bea5322f69e28;p=elisp%2Fflim.git New module. --- 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