From abf4090240cd16facf698a849ce99b5f98588000 Mon Sep 17 00:00:00 2001 From: morioka Date: Tue, 9 Jun 1998 08:05:07 +0000 Subject: [PATCH] Sync up with semi-1_5_4. --- Makefile | 2 +- NEWS | 56 +++++++++++++ README.en | 2 +- SEMI-ELS | 8 +- TODO | 2 - mime-edit.el | 76 ++++++++---------- mime-parse.el | 57 +++++++------- mime-play.el | 45 +++++++---- mime-text.el | 21 +---- mime-view.el | 243 ++++++++++++++++++++++++++++++++++++++++----------------- semi-setup.el | 26 +++++- 11 files changed, 355 insertions(+), 183 deletions(-) diff --git a/Makefile b/Makefile index 204d744..818dcbc 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ # Makefile for SEMI kernel. # -VERSION = 1.5.0 +VERSION = 1.5.1 PACKAGE = remi SHELL = /bin/sh diff --git a/NEWS b/NEWS index 460a94f..bde99e3 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,62 @@ SEMI NEWS --- history of major-changes. Copyright (C) 1998 Free Software Foundation, Inc. +* Changes in SEMI 1.5 + +** `pgp-elkins' -> `pgp-mime' + + Rename `pgp-elkins' -> `pgp-mime'. Variable +`mime-edit-signing-type' and `mime-edit-encrypting-type' does not +allow `pgp-elkins'. + + +** type-subtype-score + + Now MIME-View chooses one entity to display body in +multipart/alternative. In this mechanism, +`mime-view-type-subtype-score-alist' is used to specify priority of +each entity. + + Variable `mime-view-type-subtype-score-alist' is alist of +TYPE-SUBTYPE vs. SCORE. TYPE-SUBTYPE is cons pair (TYPE . SUBTYPE), +symbol TYPE or t. TYPE and SUBTYPE are symbol. `t' means default. +SCORE is integer. Larger number is larger priority. + + +** text presentation + + Change text presentation mechanism. In anything older than SEMI +1.4, text presentation mechanism is based on filter model. However it +has design problem about conversion between byte representation and +text presentation. So SEMI was changed to use +body-presentation-method to display text entity. In this purpose, old +text decoding features were abolished and introduces news features +(cf. next section). + +** mime-raw-representation-type and mime-raw-representation-type-alist + + Abolish `mime-text-decoder' and `mime-text-decoder-alist' because of +text presentation mechanism change (cf. previous section). Instead of +it, SEMI introduces variable about representation-type of +mime-raw-buffer. If it is `binary', mime-raw-buffer is as same as +network representation. If it is `cooked', mime-raw-buffer is +code-converted. + + `mime-raw-representation-type-alist' is an alist of major-mode +vs. representation-type. Each element looks like + + (SYMBOL . REPRESENTATION-TYPE). + +SYMBOL is major-mode or t. t means default. + + `mime-raw-representation-type' is a buffer local variable of +mime-raw-buffer. If it is non-nil, it overrides +`mime-raw-representation-type-alist'. + + In addition, `mime-raw-buffer-coding-system-alist' was abolished. +Because representation-type has enough information. + + * Changes in SEMI 1.4 ** mailcap diff --git a/README.en b/README.en index e3b70d3..0140795 100644 --- a/README.en +++ b/README.en @@ -44,7 +44,7 @@ Required environment nil. (Maybe non mule setting requires to modify emu. In addition, it is better to use terminal-coding-system feature) - SEMI requires APEL (8.7 or later) and FLIM (1.2.0 or later) package. + SEMI requires APEL (8.7 or later) and FLIM (1.3.0 or later) package. Please install them before installing it. APEL package is available at: diff --git a/SEMI-ELS b/SEMI-ELS index 881b6dc..c12fb0a 100644 --- a/SEMI-ELS +++ b/SEMI-ELS @@ -1,7 +1,8 @@ ;;; -*-Emacs-Lisp-*- -;;; -;;; $Id: SEMI-ELS,v 1.4 1998-04-10 15:21:15 morioka Exp $ -;;; + +;; SEMI-ELS: list of SEMI modules to install + +;;; Code: (setq semi-modules-to-compile '(signature @@ -26,6 +27,7 @@ ))) '((mailcrypt mime-pgp mime-mc) (bbdb mime-bbdb) + (w3 mime-w3) )) (if (or (string-match "XEmacs" emacs-version) diff --git a/TODO b/TODO index c3cd0b1..cb2a11c 100644 --- a/TODO +++ b/TODO @@ -3,8 +3,6 @@ * MIME-View -** Better implementation for multipart/alternative - ** dynamic configuration for 'mime-preview-condition ** Don't use filter-model diff --git a/mime-edit.el b/mime-edit.el index 4209551..56e77b0 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -536,11 +536,11 @@ If it is not specified for a major-mode, ;;; @@ about PGP ;;; -(defvar mime-edit-signing-type 'pgp-elkins - "*PGP signing type (pgp-elkins, pgp-kazu or nil).") +(defvar mime-edit-signing-type 'pgp-mime + "*PGP signing type (pgp-mime, pgp-kazu or nil).") -(defvar mime-edit-encrypting-type 'pgp-elkins - "*PGP encrypting type (pgp-elkins, pgp-kazu or nil).") +(defvar mime-edit-encrypting-type 'pgp-mime + "*PGP encrypting type (pgp-mime, pgp-kazu or nil).") ;;; @@ about tag @@ -599,13 +599,15 @@ If it is not specified for a major-mode, (substring emacs-version 0 (match-beginning 0)) emacs-version))) (if (featurep 'mule) - (concat "Emacs " ver - (if enable-multibyte-characters - (concat ", MULE " mule-version) - " (with raw setting)") - (if (featurep 'meadow) - (concat ", " (Meadow-version)) - )) + (if (boundp 'enable-multibyte-characters) + (concat "Emacs " ver + (if enable-multibyte-characters + (concat ", MULE " mule-version) + " (with raw setting)") + (if (featurep 'meadow) + (concat ", " (Meadow-version)) + )) + (concat "MULE " mule-version " based on Emacs " ver)) ver))) "Body of X-Emacs field. If variable `mime-edit-insert-x-emacs-field' is not nil, it is @@ -767,6 +769,8 @@ Tspecials means any character that matches with it in header must be quoted.") ;;; @ functions ;;; +(defvar mime-edit-touched-flag nil) + ;;;###autoload (defun mime-edit-mode () "MIME minor mode for editing the tagged MIME message. @@ -902,8 +906,7 @@ User customizable variables (not documented all of them): (interactive) (if mime-edit-mode-flag (mime-edit-exit) - (if (and (boundp 'mime-edit-touched-flag) - mime-edit-touched-flag) + (if mime-edit-touched-flag (mime-edit-again) (make-local-variable 'mime-edit-touched-flag) (setq mime-edit-touched-flag t) @@ -1574,21 +1577,17 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (let ((bb (match-beginning 0)) (be (match-end 0)) (type (buffer-substring (match-beginning 1)(match-end 1))) - end-exp eb ee) + end-exp eb) (setq end-exp (format "--}-<<%s>>\n" type)) (widen) (if (re-search-forward end-exp nil t) - (progn - (setq eb (match-beginning 0)) - (setq ee (match-end 0)) - ) + (setq eb (match-beginning 0)) (setq eb (point-max)) - (setq ee (point-max)) ) (narrow-to-region be eb) (goto-char be) (if (re-search-forward mime-edit-multipart-beginning-regexp nil t) - (let (ret) + (progn (narrow-to-region (match-beginning 0)(point-max)) (mime-edit-find-inmost) ) @@ -1622,16 +1621,16 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (mime-edit-enquote-region bb eb) ) ((string-equal type "signed") - (cond ((eq mime-edit-signing-type 'pgp-elkins) - (mime-edit-sign-pgp-elkins bb eb boundary) + (cond ((eq mime-edit-signing-type 'pgp-mime) + (mime-edit-sign-pgp-mime bb eb boundary) ) ((eq mime-edit-signing-type 'pgp-kazu) (mime-edit-sign-pgp-kazu bb eb boundary) )) ) ((string-equal type "encrypted") - (cond ((eq mime-edit-encrypting-type 'pgp-elkins) - (mime-edit-encrypt-pgp-elkins bb eb boundary) + (cond ((eq mime-edit-encrypting-type 'pgp-mime) + (mime-edit-encrypt-pgp-mime bb eb boundary) ) ((eq mime-edit-encrypting-type 'pgp-kazu) (mime-edit-encrypt-pgp-kazu bb eb boundary) @@ -1669,7 +1668,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (replace-match (concat "-" (substring tag 2))) ))))) -(defun mime-edit-sign-pgp-elkins (beg end boundary) +(defun mime-edit-sign-pgp-mime (beg end boundary) (save-excursion (save-restriction (narrow-to-region beg end) @@ -1677,9 +1676,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (mime-edit-translate-region beg end boundary)) (ctype (car ret)) (encoding (nth 1 ret)) - (parts (nth 3 ret)) - (pgp-boundary (concat "pgp-sign-" boundary)) - ) + (pgp-boundary (concat "pgp-sign-" boundary))) (goto-char beg) (insert (format "Content-Type: %s\n" ctype)) (if encoding @@ -1727,7 +1724,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (vector from recipients header) )) -(defun mime-edit-encrypt-pgp-elkins (beg end boundary) +(defun mime-edit-encrypt-pgp-mime (beg end boundary) (save-excursion (save-restriction (let (from recipients header) @@ -1741,9 +1738,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (mime-edit-translate-region beg end boundary)) (ctype (car ret)) (encoding (nth 1 ret)) - (parts (nth 3 ret)) - (pgp-boundary (concat "pgp-" boundary)) - ) + (pgp-boundary (concat "pgp-" boundary))) (goto-char beg) (insert header) (insert (format "Content-Type: %s\n" ctype)) @@ -1908,17 +1903,15 @@ Content-Transfer-Encoding: 7bit (insert encoding))) )))) -(defun mime-edit-translate-single-part-tag (&optional prefix) +(defun mime-edit-translate-single-part-tag (boundary &optional prefix) "Translate single-part-tag to MIME header." (if (re-search-forward mime-edit-single-part-tag-regexp nil t) (let* ((beg (match-beginning 0)) (end (match-end 0)) - (tag (buffer-substring beg end)) - ) + (tag (buffer-substring beg end))) (delete-region beg end) (let ((contype (mime-edit-get-contype tag)) - (encoding (mime-edit-get-encoding tag)) - ) + (encoding (mime-edit-get-encoding tag))) (insert (concat prefix "--" boundary "\n")) (save-restriction (narrow-to-region (point)(point)) @@ -1963,9 +1956,8 @@ Content-Transfer-Encoding: 7bit (t ;; It's a multipart message. (goto-char (point-min)) - (and (mime-edit-translate-single-part-tag) - (while (mime-edit-translate-single-part-tag "\n")) - ) + (and (mime-edit-translate-single-part-tag boundary) + (while (mime-edit-translate-single-part-tag boundary "\n"))) ;; Define Content-Type as "multipart/mixed". (setq contype (concat "multipart/mixed;\n boundary=\"" boundary "\"")) @@ -2098,9 +2090,7 @@ Content-Transfer-Encoding: 7bit ;; encoded. (let* ((encoding "base64") ;Encode in BASE64 by default. (beg (mime-edit-content-beginning)) - (end (mime-edit-content-end)) - (body (buffer-substring beg end)) - ) + (end (mime-edit-content-end))) (mime-encode-region beg end encoding) (mime-edit-define-encoding encoding)) (forward-line 1) diff --git a/mime-parse.el b/mime-parse.el index 7f9e4da..5ea30dd 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -180,23 +180,25 @@ If is is not found, return DEFAULT-ENCODING." ;;; @ message parser ;;; -(defsubst make-mime-entity (node-id header-start header-end - body-start body-end - content-type content-disposition - encoding children) - (vector node-id - header-start header-end body-start body-end +(defsubst make-mime-entity (buffer + node-id + header-start header-end body-start body-end + content-type content-disposition + encoding children) + (vector buffer + node-id header-start header-end body-start body-end content-type content-disposition encoding children)) -(defsubst mime-entity-node-id (entity) (aref entity 0)) -(defsubst mime-entity-header-start (entity) (aref entity 1)) -(defsubst mime-entity-header-end (entity) (aref entity 2)) -(defsubst mime-entity-body-start (entity) (aref entity 3)) -(defsubst mime-entity-body-end (entity) (aref entity 4)) -(defsubst mime-entity-content-type (entity) (aref entity 5)) -(defsubst mime-entity-content-disposition (entity) (aref entity 6)) -(defsubst mime-entity-encoding (entity) (aref entity 7)) -(defsubst mime-entity-children (entity) (aref entity 8)) +(defsubst mime-entity-buffer (entity) (aref entity 0)) +(defsubst mime-entity-node-id (entity) (aref entity 1)) +(defsubst mime-entity-header-start (entity) (aref entity 2)) +(defsubst mime-entity-header-end (entity) (aref entity 3)) +(defsubst mime-entity-body-start (entity) (aref entity 4)) +(defsubst mime-entity-body-end (entity) (aref entity 5)) +(defsubst mime-entity-content-type (entity) (aref entity 6)) +(defsubst mime-entity-content-disposition (entity) (aref entity 7)) +(defsubst mime-entity-encoding (entity) (aref entity 8)) +(defsubst mime-entity-children (entity) (aref entity 9)) (defalias 'mime-entity-point-min 'mime-entity-header-start) (defalias 'mime-entity-point-max 'mime-entity-body-end) @@ -227,12 +229,12 @@ If is is not found, return DEFAULT-ENCODING." (make-mime-content-type 'text 'plain) )) cb ce ret ncb children (i 0)) - (goto-char body-end) - (if (re-search-backward close-delimiter nil t) - (setq body-end (match-beginning 0)) - ) (save-restriction - (narrow-to-region header-end body-end) + (goto-char body-end) + (narrow-to-region header-end + (if (re-search-backward close-delimiter nil t) + (match-beginning 0) + body-end)) (goto-char header-start) (re-search-forward rsep nil t) (setq cb (match-end 0)) @@ -255,9 +257,8 @@ If is is not found, return DEFAULT-ENCODING." ) (setq children (cons ret children)) ) - (make-mime-entity node-id - header-start header-end - body-start body-end + (make-mime-entity (current-buffer) node-id + header-start header-end body-start body-end content-type content-disposition encoding (nreverse children)) )) @@ -309,9 +310,8 @@ mime-{parse|read}-Content-Type." (memq (mime-content-type-subtype content-type) '(rfc822 news) )) - (make-mime-entity node-id - header-start header-end - body-start body-end + (make-mime-entity (current-buffer) node-id + header-start header-end body-start body-end content-type content-disposition encoding (save-restriction (narrow-to-region body-start body-end) @@ -320,9 +320,8 @@ mime-{parse|read}-Content-Type." )) ) (t - (make-mime-entity node-id - header-start header-end - body-start body-end + (make-mime-entity (current-buffer) node-id + header-start header-end body-start body-end content-type content-disposition encoding nil) )) )) diff --git a/mime-play.el b/mime-play.el index cbcf623..af845c1 100644 --- a/mime-play.el +++ b/mime-play.el @@ -30,8 +30,12 @@ (require 'alist) (require 'filename) -(eval-when-compile (require 'mime-text)) - +(eval-when-compile + (require 'mime-text) + (condition-case nil + (require 'bbdb) + (error (defvar bbdb-buffer-name nil)) + )) (defvar mime-acting-situation-examples nil) @@ -116,6 +120,16 @@ If MODE is specified, play as it. Default MODE is \"play\"." ))) ) +(defsubst mime-delq-null-situation (situations field) + (let (dest) + (while situations + (let ((situation (car situations))) + (if (assq field situation) + (setq dest (cons situation dest)) + )) + (setq situations (cdr situations))) + dest)) + (defun mime-raw-play-entity (entity-info &optional mode) "Play entity specified by ENTITY-INFO. It decodes the entity to call internal or external method. The method @@ -140,10 +154,14 @@ specified, play as it. Default MODE is \"play\"." cal) cal)) (setq ret - (or (ctree-find-calist mime-acting-condition ret - mime-view-find-every-acting-situation) - (ctree-find-calist mime-acting-condition cal - mime-view-find-every-acting-situation) + (or (mime-delq-null-situation + (ctree-find-calist mime-acting-condition ret + mime-view-find-every-acting-situation) + 'method) + (mime-delq-null-situation + (ctree-find-calist mime-acting-condition cal + mime-view-find-every-acting-situation) + 'method) )) (cond ((cdr ret) (setq ret (select-menu-alist @@ -609,17 +627,12 @@ saved as binary. Otherwise the region is saved by `write-region'." (defun mime-method-to-display-caesar (start end cal) "Internal method for mime-view to display ROT13-47-48 message." (let* ((entity (mime-raw-find-entity-from-point start)) - (cnum (reverse (mime-entity-node-id entity))) - (new-name (format "%s-%s" (buffer-name) cnum)) - (the-buf (current-buffer)) - (mother mime-preview-buffer) - (charset (cdr (assoc "charset" cal))) - (encoding (cdr (assq 'encoding cal))) - (mode major-mode)) + (new-name (format "%s-%s" (buffer-name) + (reverse (mime-entity-node-id entity)))) + (mother mime-preview-buffer)) (let ((pwin (or (get-buffer-window mother) (get-largest-window))) - (buf (get-buffer-create new-name)) - ) + (buf (get-buffer-create new-name))) (set-window-buffer pwin buf) (set-buffer buf) (select-window pwin) @@ -647,7 +660,7 @@ saved as binary. Otherwise the region is saved by `write-region'." (set-buffer buffer) (erase-buffer) (insert-file-contents file) - (eval-current-buffer) + (eval-buffer) ;; format check (or (eq (car mime-acting-situation-examples) 'type) (setq mime-acting-situation-examples nil)) diff --git a/mime-text.el b/mime-text.el index c60b097..8483630 100644 --- a/mime-text.el +++ b/mime-text.el @@ -27,20 +27,6 @@ (require 'mime-view) -;;; @ buffer local variables in raw-buffer -;;; - -(defvar mime-raw-representation-type nil - "Representation-type of mime-raw-buffer. -It must be nil, `binary' or `cooked'. -If it is nil, `mime-raw-representation-type-alist' is used as default -value. -Notice that this variable is usually used as buffer local variable in -raw-buffer.") - -(make-variable-buffer-local 'mime-raw-representation-type) - - ;;; @ code conversion ;;; @@ -50,15 +36,16 @@ It decodes MIME-encoding then code-converts as MIME-charset. MIME-encoding is value of field 'encoding of SITUATION. It must be 'nil or string. MIME-charset is value of field \"charset\" of SITUATION. It must be symbol." - (let ((presentation-type + (let* ((buffer (mime-entity-buffer entity)) + (presentation-type (save-excursion - (set-buffer mime-raw-buffer) + (set-buffer buffer) (or mime-raw-representation-type (cdr (or (assq major-mode mime-raw-representation-type-alist) (assq t mime-raw-representation-type-alist))) )))) (save-restriction - (insert-buffer-substring mime-raw-buffer + (insert-buffer-substring buffer (mime-entity-body-start entity) (mime-entity-body-end entity)) (let ((encoding (mime-entity-encoding entity))) diff --git a/mime-view.el b/mime-view.el index 24a5c70..3e977e7 100644 --- a/mime-view.el +++ b/mime-view.el @@ -33,6 +33,7 @@ (require 'mime-parse) (require 'semi-def) (require 'calist) +(require 'alist) (require 'mailcap) @@ -69,32 +70,57 @@ ;;; @@ in raw-buffer ;;; -(defvar mime-raw-message-info +(defvar mime-raw-message-info nil "Information about structure of message. Please use reference function `mime-entity-SLOT' to get value of SLOT. Following is a list of slots of the structure: -node-id reversed entity-number (list of integers) -point-min beginning point of region in raw-buffer -point-max end point of region in raw-buffer -type media-type (symbol) -subtype media-subtype (symbol) -type/subtype media-type/subtype (string or nil) -parameters parameter of Content-Type field (association list) -encoding Content-Transfer-Encoding (string or nil) -children entities included in this entity (list of content-infos) +buffer buffer includes this entity (buffer). +node-id node-id (list of integers) +header-start minimum point of header in raw-buffer +header-end maximum point of header in raw-buffer +body-start minimum point of body in raw-buffer +body-end maximum point of body in raw-buffer +content-type content-type (content-type) +content-disposition content-disposition (content-disposition) +encoding Content-Transfer-Encoding (string or nil) +children entities included in this entity (list of entity) If an entity includes other entities in its body, such as multipart or message/rfc822, `mime-entity' structures of them are included in `children', so the `mime-entity' structure become a tree.") (make-variable-buffer-local 'mime-raw-message-info) + (defvar mime-preview-buffer nil "MIME-preview buffer corresponding with the (raw) buffer.") (make-variable-buffer-local 'mime-preview-buffer) +(defvar mime-raw-representation-type nil + "Representation-type of mime-raw-buffer. +It must be nil, `binary' or `cooked'. +If it is nil, `mime-raw-representation-type-alist' is used as default +value. +Notice that this variable is usually used as buffer local variable in +raw-buffer.") + +(make-variable-buffer-local 'mime-raw-representation-type) + +(defvar mime-raw-representation-type-alist + '((mime-show-message-mode . binary) + (mime-temp-message-mode . binary) + (t . cooked) + ) + "Alist of major-mode vs. representation-type of mime-raw-buffer. +Each element looks like (SYMBOL . REPRESENTATION-TYPE). SYMBOL is +major-mode or t. t means default. REPRESENTATION-TYPE must be +`binary' or `cooked'. +This value is overridden by buffer local variable +`mime-raw-representation-type' if it is not nil.") + + ;;; @@ in preview-buffer ;;; @@ -280,21 +306,6 @@ Please redefine this function if you want to change default setting." ;;; @@ entity-header ;;; -;;; @@@ predicate function -;;; - -;; (defvar mime-view-childrens-header-showing-Content-Type-list -;; '("message/rfc822" "message/news")) - -;; (defun mime-view-header-visible-p (entity message-info) -;; "Return non-nil if header of ENTITY is visible." -;; (let ((entity-node-id (mime-entity-node-id entity))) -;; (member (mime-entity-type/subtype -;; (mime-raw-find-entity-from-node-id -;; (cdr entity-node-id) message-info)) -;; mime-view-childrens-header-showing-Content-Type-list) -;; )) - ;;; @@@ entity header filter ;;; @@ -435,6 +446,12 @@ Each elements are regexp of field-name.") (body-presentation-method . mime-preview-text/plain))) (ctree-set-calist-strictly + 'mime-preview-condition + '((type . multipart)(subtype . alternative) + (body . visible) + (body-presentation-method . mime-preview-multipart/alternative))) + +(ctree-set-calist-strictly 'mime-preview-condition '((type . message)(subtype . partial) (body-presentation-method . mime-preview-message/partial-button))) @@ -452,26 +469,13 @@ Each elements are regexp of field-name.") (entity-button . invisible)))) -;;; @@@ entity filter +;;; @@@ entity presentation ;;; (autoload 'mime-preview-text/plain "mime-text") (autoload 'mime-preview-text/enriched "mime-text") (autoload 'mime-preview-text/richtext "mime-text") -(defvar mime-raw-representation-type-alist - '((mime-show-message-mode . binary) - (mime-temp-message-mode . binary) - (t . cooked) - ) - "Alist of major-mode vs. representation-type of mime-raw-buffer. -Each element looks like (SYMBOL . REPRESENTATION-TYPE). SYMBOL is -major-mode or t. t means default. REPRESENTATION-TYPE must be -`binary' or `cooked'. -This value is overridden by buffer local variable -`mime-raw-representation-type' if it is not nil.") - - (defvar mime-view-announcement-for-message/partial (if (and (>= emacs-major-version 19) window-system) "\ @@ -496,6 +500,98 @@ This value is overridden by buffer local variable #'mime-preview-play-current-entity) )) +(defun mime-preview-multipart/mixed (entity situation) + (let ((children (mime-entity-children entity)) + (default-situation + (cdr (assq 'childrens-situation situation)))) + (while children + (mime-view-display-entity (car children) + (save-excursion + (set-buffer mime-raw-buffer) + mime-raw-message-info) + mime-raw-buffer (current-buffer) + default-situation) + (setq children (cdr children)) + ))) + +(defcustom mime-view-type-subtype-score-alist + '(((text . enriched) . 3) + ((text . richtext) . 2) + ((text . plain) . 1) + (t . 0)) + "Alist MEDIA-TYPE vs corresponding score. +MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." + :group 'mime-view + :type '(repeat (cons (choice :tag "Media-Type" + (item :tag "Type/Subtype" + (cons symbol symbol)) + (item :tag "Type" symbol) + (item :tag "Default" t)) + integer))) + +(defun mime-preview-multipart/alternative (entity situation) + (let* ((children (mime-entity-children entity)) + (default-situation + (cdr (assq 'childrens-situation situation))) + (i 0) + (p 0) + (max-score 0) + (situations + (mapcar (function + (lambda (child) + (let ((situation + (or (ctree-match-calist + mime-preview-condition + (append + (or (mime-entity-content-type child) + (make-mime-content-type 'text 'plain)) + (list* (cons 'encoding + (mime-entity-encoding child)) + (cons 'major-mode major-mode) + default-situation))) + default-situation))) + (if (cdr (assq 'body-presentation-method situation)) + (let ((score + (cdr + (or (assoc + (cons + (cdr (assq 'type situation)) + (cdr (assq 'subtype situation))) + mime-view-type-subtype-score-alist) + (assq + (cdr (assq 'type situation)) + mime-view-type-subtype-score-alist) + (assq + t + mime-view-type-subtype-score-alist) + )))) + (if (> score max-score) + (setq p i + max-score score) + ))) + (setq i (1+ i)) + situation) + )) + children))) + (setq i 0) + (while children + (let ((situation (car situations))) + (mime-view-display-entity (car children) + (save-excursion + (set-buffer mime-raw-buffer) + mime-raw-message-info) + mime-raw-buffer (current-buffer) + default-situation + (if (= i p) + situation + (del-alist 'body-presentation-method + (copy-alist situation)))) + ) + (setq children (cdr children) + situations (cdr situations) + i (1+ i)) + ))) + ;;; @ acting-condition ;;; @@ -731,7 +827,8 @@ The compressed face will be piped to this command.") ) (defun mime-view-display-entity (entity message-info ibuf obuf - default-situation) + default-situation + &optional situation) (let* ((start (mime-entity-point-min entity)) (end (mime-entity-point-max entity)) (content-type (mime-entity-content-type entity)) @@ -749,22 +846,24 @@ The compressed face will be piped to this command.") (narrow-to-region start end) (setq subj (eword-decode-string (mime-raw-get-subject entity))) ) - (let* ((situation - (or - (ctree-match-calist mime-preview-condition - (append - (or content-type - (make-mime-content-type 'text 'plain)) - (list* (cons 'encoding encoding) - (cons 'major-mode major-mode) - default-situation))) - default-situation)) - (button-is-invisible - (eq (cdr (assq 'entity-button situation)) 'invisible)) - (header-is-visible - (eq (cdr (assq 'header situation)) 'visible)) - (body-presentation-method - (cdr (assq 'body-presentation-method situation)))) + (or situation + (setq situation + (or (ctree-match-calist mime-preview-condition + (append + (or content-type + (make-mime-content-type + 'text 'plain)) + (list* (cons 'encoding encoding) + (cons 'major-mode major-mode) + default-situation))) + default-situation))) + (let ((button-is-invisible + (eq (cdr (assq 'entity-button situation)) 'invisible)) + (header-is-visible + (eq (cdr (assq 'header situation)) 'visible)) + (body-presentation-method + (cdr (assq 'body-presentation-method situation))) + (children (mime-entity-children entity))) (set-buffer obuf) (setq nb (point)) (narrow-to-region nb nb) @@ -791,28 +890,32 @@ The compressed face will be piped to this command.") (insert-buffer-substring mime-raw-buffer end-of-header end) (funcall body-filter situation) ))) + (children) ((functionp body-presentation-method) (funcall body-presentation-method entity situation) + ) + (t + (when button-is-invisible + (goto-char (point-max)) + (mime-view-insert-entity-button entity message-info subj) + ) + (or header-is-visible + (progn + (goto-char (point-max)) + (insert "\n") + )) )) - (or header-is-visible - body-presentation-method - (progn - (goto-char (point-max)) - (insert "\n") - )) (setq ne (point-max)) (widen) (put-text-property nb ne 'mime-view-raw-buffer ibuf) (put-text-property nb ne 'mime-view-entity entity) (goto-char ne) - (let ((children (mime-entity-children entity)) - (default-situation - (cdr (assq 'childrens-situation situation)))) - (while children - (mime-view-display-entity (car children) message-info ibuf obuf - default-situation) - (setq children (cdr children)) - ))))) + (if children + (if (functionp body-presentation-method) + (funcall body-presentation-method entity situation) + (mime-preview-multipart/mixed entity situation) + )) + ))) (defun mime-raw-get-uu-filename () (save-excursion diff --git a/semi-setup.el b/semi-setup.el index 33ec99c..10bc81a 100644 --- a/semi-setup.el +++ b/semi-setup.el @@ -45,11 +45,35 @@ ) +;; for text/html +(defvar mime-setup-enable-inline-html + (module-installed-p 'w3) + "*If it is non-nil, semi-setup sets up to use mime-w3.") + +(if mime-setup-enable-inline-html + (call-after-loaded + 'mime-view + (function + (lambda () + (autoload 'mime-preview-text/html "mime-w3") + + (ctree-set-calist-strictly + 'mime-preview-condition + '((type . text)(subtype . html) + (body . visible) + (body-presentation-method . mime-preview-text/html))) + + (set-alist 'mime-view-type-subtype-score-alist + '(text . html) 3) + ))) + ) + + +;; for PGP (defvar mime-setup-enable-pgp (module-installed-p 'mailcrypt) "*If it is non-nil, semi-setup sets uf to use mime-pgp.") -;; for PGP (if mime-setup-enable-pgp (eval-after-load "mime-view" '(progn -- 1.7.10.4