(tar): fixed.
[elisp/semi.git] / mime-view.el
index d1ef548..c9a29ed 100644 (file)
 ;;; @ version
 ;;;
 
-(defconst mime-view-version-string
-  `,(concat (car mime-user-interface-version) " MIME-View "
+(defconst mime-view-version
+  (eval-when-compile
+    (concat (mime-product-name mime-user-interface-product) " MIME-View "
            (mapconcat #'number-to-string
-                      (cddr mime-user-interface-version) ".")
-           " (" (cadr mime-user-interface-version) ")"))
+                      (mime-product-version mime-user-interface-product) ".")
+           " (" (mime-product-code-name mime-user-interface-product) ")")))
 
 
 ;;; @ variables
 (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)
@@ -88,9 +79,7 @@ raw-buffer.")
   "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.")
+`binary' or `cooked'.")
 
 
 (defun mime-raw-find-entity-from-point (point &optional message-info)
@@ -150,15 +139,6 @@ mother-buffer."
 ;;; @ entity information
 ;;;
 
-(defsubst mime-entity-representation-type (entity)
-  (with-current-buffer (mime-entity-buffer entity)
-    (or mime-raw-representation-type
-       (cdr (or (assq major-mode mime-raw-representation-type-alist)
-                (assq t mime-raw-representation-type-alist))))))
-
-(defsubst mime-entity-cooked-p (entity)
-  (eq (mime-entity-representation-type entity) 'cooked))
-
 (defun mime-entity-situation (entity)
   "Return situation of ENTITY."
   (append (or (mime-entity-content-type entity)
@@ -315,15 +295,15 @@ SYMBOL must be major mode in raw-buffer or t.  t means default.
 Interface of FUNCTION must be (ENTITY SITUATION).")
 
 (defvar mime-view-ignored-field-list
-  '(".*Received" ".*Path" ".*Id" "References"
-    "Replied" "Errors-To"
-    "Lines" "Sender" ".*Host" "Xref"
-    "Content-Type" "Precedence"
-    "Status" "X-VM-.*")
+  '(".*Received:" ".*Path:" ".*Id:" "^References:"
+    "^Replied:" "^Errors-To:"
+    "^Lines:" "^Sender:" ".*Host:" "^Xref:"
+    "^Content-Type:" "^Precedence:"
+    "^Status:" "^X-VM-.*:")
   "All fields that match this list will be hidden in MIME preview buffer.
 Each elements are regexp of field-name.")
 
-(defvar mime-view-visible-field-list '("Dnas.*" "Message-Id")
+(defvar mime-view-visible-field-list '("^Dnas.*:" "^Message-Id:")
   "All fields that match this list will be displayed in MIME preview buffer.
 Each elements are regexp of field-name.")
 
@@ -441,9 +421,38 @@ Each elements are regexp of field-name.")
 ;;; @@@ entity presentation
 ;;;
 
-(autoload 'mime-display-text/plain "mime-text")
-(autoload 'mime-display-text/enriched "mime-text")
-(autoload 'mime-display-text/richtext "mime-text")
+(defun mime-display-text/plain (entity situation)
+  (save-restriction
+    (narrow-to-region (point-max)(point-max))
+    (mime-insert-text-content entity)
+    (run-hooks 'mime-text-decode-hook)
+    (goto-char (point-max))
+    (if (not (eq (char-after (1- (point))) ?\n))
+       (insert "\n")
+      )
+    (mime-add-url-buttons)
+    (run-hooks 'mime-display-text/plain-hook)
+    ))
+
+(defun mime-display-text/richtext (entity situation)
+  (save-restriction
+    (narrow-to-region (point-max)(point-max))
+    (mime-insert-text-content entity)
+    (run-hooks 'mime-text-decode-hook)
+    (let ((beg (point-min)))
+      (remove-text-properties beg (point-max) '(face nil))
+      (richtext-decode beg (point-max))
+      )))
+
+(defun mime-display-text/enriched (entity situation)
+  (save-restriction
+    (narrow-to-region (point-max)(point-max))
+    (mime-insert-text-content entity)
+    (run-hooks 'mime-text-decode-hook)
+    (let ((beg (point-min)))
+      (remove-text-properties beg (point-max) '(face nil))
+      (enriched-decode beg (point-max))
+      )))
 
 (defvar mime-view-announcement-for-message/partial
   (if (and (>= emacs-major-version 19) window-system)
@@ -487,10 +496,11 @@ Each elements are regexp of field-name.")
 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))
+                              (cons :tag "Type/Subtype"
+                                    (symbol :tag "Primary-type")
+                                    (symbol :tag "Subtype"))
+                              (symbol :tag "Type")
+                              (const :tag "Default" t))
                       integer)))
 
 (defun mime-display-multipart/alternative (entity situation)
@@ -620,7 +630,14 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
  'mime-acting-condition
  '((type . message)(subtype . external-body)
    ("access-type" . "anon-ftp")
-   (method . mime-view-message/external-ftp)
+   (method . mime-view-message/external-anon-ftp)
+   ))
+
+(ctree-set-calist-strictly
+ 'mime-acting-condition
+ '((type . message)(subtype . external-body)
+   ("access-type" . "url")
+   (method . mime-view-message/external-url)
    ))
 
 (ctree-set-calist-strictly
@@ -693,13 +710,9 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
       (when header-is-visible
        (if header-presentation-method
            (funcall header-presentation-method entity situation)
-         (mime-insert-decoded-header entity
-                                     mime-view-ignored-field-list
-                                     mime-view-visible-field-list
-                                     (if (mime-entity-cooked-p entity)
-                                         nil
-                                       default-mime-charset))
-         )
+         (mime-insert-header entity
+                             mime-view-ignored-field-list
+                             mime-view-visible-field-list))
        (goto-char (point-max))
        (insert "\n")
        (run-hooks 'mime-display-header-hook)
@@ -747,7 +760,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
     )
   "Menu for MIME Viewer")
 
-(cond (running-xemacs
+(cond ((featurep 'xemacs)
        (defvar mime-view-xemacs-popup-menu
         (cons mime-view-menu-title
               (mapcar (function
@@ -817,7 +830,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
     (define-key mime-view-mode-map
       [backspace] (function mime-preview-scroll-down-entity))
     (if (functionp default)
-       (cond (running-xemacs
+       (cond ((featurep 'xemacs)
               (set-keymap-default-binding mime-view-mode-map default)
               )
              (t
@@ -828,7 +841,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
        (define-key mime-view-mode-map
          mouse-button-2 (function mime-button-dispatcher))
       )
-    (cond (running-xemacs
+    (cond ((featurep 'xemacs)
           (define-key mime-view-mode-map
             mouse-button-3 (function mime-view-xemacs-popup-menu))
           )
@@ -906,15 +919,41 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
          (let ((r-win (get-buffer-window raw-buffer)))
            (if r-win
                (set-window-buffer r-win preview-buffer)
-             (switch-to-buffer preview-buffer)
-             )))
+             (let ((m-win (and mother (get-buffer-window mother))))
+               (if m-win
+                   (set-window-buffer m-win preview-buffer)
+                 (switch-to-buffer preview-buffer)
+                 )))))
       )))
 
 (defun mime-view-buffer (&optional raw-buffer preview-buffer mother
-                                  default-keymap-or-function)
+                                  default-keymap-or-function
+                                  representation-type)
+  "View RAW-BUFFER in MIME-View mode.
+Optional argument PREVIEW-BUFFER is either nil or a name of preview
+buffer.
+Optional argument DEFAULT-KEYMAP-OR-FUNCTION is nil, keymap or
+function.  If it is a keymap, keymap of MIME-View mode will be added
+to it.  If it is a function, it will be bound as default binding of
+keymap of MIME-View mode.
+Optional argument REPRESENTATION-TYPE is representation-type of
+message.  It must be nil, `binary' or `cooked'.  If it is nil,
+`cooked' is used as default."
   (interactive)
+  (or raw-buffer
+      (setq raw-buffer (current-buffer)))
+  (or representation-type
+      (setq representation-type
+           (save-excursion
+             (set-buffer raw-buffer)
+             (cdr (or (assq major-mode mime-raw-representation-type-alist)
+                      (assq t mime-raw-representation-type-alist)))
+             )))
+  (if (eq representation-type 'binary)
+      (setq representation-type 'buffer)
+    )
   (mime-display-message
-   (mime-parse-buffer raw-buffer)
+   (mime-open-entity representation-type raw-buffer)
    preview-buffer mother default-keymap-or-function))
 
 (defun mime-view-mode (&optional mother ctl encoding
@@ -943,13 +982,27 @@ button-2  Move to point under the mouse cursor
                and decode current content as `play mode'
 "
   (interactive)
-  (mime-display-message
-   (save-excursion
-     (if raw-buffer (set-buffer raw-buffer))
-     (or mime-view-redisplay
-        (setq mime-message-structure (mime-parse-message ctl encoding)))
-     )
-   preview-buffer mother default-keymap-or-function))
+  (unless mime-view-redisplay
+    (save-excursion
+      (if raw-buffer (set-buffer raw-buffer))
+      (let ((type
+            (cdr
+             (or (assq major-mode mime-raw-representation-type-alist)
+                 (assq t mime-raw-representation-type-alist)))))
+       (if (eq type 'binary)
+           (setq type 'buffer)
+         )
+       (setq mime-message-structure (mime-open-entity type raw-buffer))
+       (or (mime-entity-content-type mime-message-structure)
+           (mime-entity-set-content-type-internal
+            mime-message-structure ctl))
+       )
+      (or (mime-entity-encoding mime-message-structure)
+         (mime-entity-set-encoding-internal mime-message-structure encoding))
+      ))
+  (mime-display-message mime-message-structure preview-buffer
+                       mother default-keymap-or-function)
+  )
 
 
 ;;; @@ playing
@@ -958,22 +1011,22 @@ button-2 Move to point under the mouse cursor
 (autoload 'mime-preview-play-current-entity "mime-play"
   "Play current entity." t)
 
-(defun mime-preview-extract-current-entity ()
+(defun mime-preview-extract-current-entity (&optional ignore-examples)
   "Extract current entity into file (maybe).
 It decodes current entity to call internal or external method as
 \"extract\" mode.  The method is selected from variable
 `mime-acting-condition'."
-  (interactive)
-  (mime-preview-play-current-entity "extract")
+  (interactive "P")
+  (mime-preview-play-current-entity ignore-examples "extract")
   )
 
-(defun mime-preview-print-current-entity ()
+(defun mime-preview-print-current-entity (&optional ignore-examples)
   "Print current entity (maybe).
 It decodes current entity to call internal or external method as
 \"print\" mode.  The method is selected from variable
 `mime-acting-condition'."
-  (interactive)
-  (mime-preview-play-current-entity "print")
+  (interactive "P")
+  (mime-preview-play-current-entity ignore-examples "print")
   )
 
 
@@ -1095,7 +1148,7 @@ It calls following-method selected from variable
                    ))
              (setq rest (cdr rest))
              ))
-         (eword-decode-header)
+         (mime-decode-header-in-buffer)
          )
        (let ((f (cdr (assq mode mime-preview-following-method-alist))))
          (if (functionp f)