updated.
[elisp/semi.git] / mime-view.el
index 3f874b2..41264b4 100644 (file)
@@ -6,7 +6,7 @@
 ;; Created: 1994/7/13
 ;;     Renamed: 1994/8/31 from tm-body.el
 ;;     Renamed: 1997/02/19 from tm-view.el
-;; Version: $Revision: 0.83 $
+;; Version: $Revision: 0.112 $
 ;; Keywords: MIME, multimedia, mail, news
 
 ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
 ;;;
 
 (defconst mime-view-RCS-ID
-  "$Id: mime-view.el,v 0.83 1997-04-03 17:46:05 morioka Exp $")
+  "$Id: mime-view.el,v 0.112 1997-09-05 16:56:00 morioka Exp $")
 
-(defconst mime-view-version (get-version-string mime-view-RCS-ID))
+(defconst mime-view-version
+  `,(get-version-string mime-view-RCS-ID))
+
+(defconst mime-view-version-name
+  `,(concat "SEMI MIME-View " mime-view-version
+           " (" semi-version-name ")"))
 
 
 ;;; @ variables
 ;;;
 
-(defvar mime/content-decoding-condition
+(defvar mime-acting-condition
   '(((type . "text/plain")
      (method "tm-plain" nil 'file 'type 'encoding 'mode 'name)
      (mode "play" "print")
      (mode . "play")
      )
     ((type . "text/x-rot13-47")
-     (method . mime-article/decode-caesar)
+     (method . mime-display-caesar)
+     (mode . "play")
+     )
+    ((type . "text/x-rot13-47-48")
+     (method . mime-display-caesar)
      (mode . "play")
      )
     ((type . "audio/basic")
      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
      (mode "play" "print")
      )
+    ((type . "image/png")
+     (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
+     (mode "play" "print")
+     )
     ((type . "image/tiff")
      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
      (mode "play" "print")
     ;;         'file '"access-type" '"name" '"site" '"directory"))
     ((type . "message/external-body")
      ("access-type" . "anon-ftp")
-     (method . mime-article/decode-message/external-ftp)
+     (method . mime-display-message/external-ftp)
      )
     ((type . "message/rfc822")
-     (method . mime-article/view-message/rfc822)
+     (method . mime-display-message/rfc822)
      (mode . "play")
      )
     ((type . "message/partial")
-     (method . mime-article/decode-message/partial)
+     (method . mime-display-message/partial)
      (mode . "play")
      )
     
@@ -191,26 +204,22 @@ Each elements are regexp of field-name.")
 (defun mime-view-header-visible-p (rcnum cinfo)
   "Return non-nil if header of current entity is visible."
   (or (null rcnum)
-      (member (mime::content-info/type
+      (member (mime-entity-info-type/subtype
               (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo))
              mime-view-childrens-header-showing-Content-Type-list)
       ))
 
-(defun mime-view-body-visible-p (rcnum cinfo &optional ctype)
-  (let (ccinfo)
-    (or ctype
-       (setq ctype
-             (mime::content-info/type
-              (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
-              ))
-       )
+(defun mime-view-body-visible-p (rcnum cinfo media-type media-subtype)
+  (let ((ctype (if media-type
+                  (if media-subtype
+                      (format "%s/%s" media-type media-subtype)
+                    (symbol-name media-type)
+                    ))))
     (and (member ctype mime-view-visible-media-type-list)
-        (if (string-equal ctype "application/octet-stream")
-            (progn
-              (or ccinfo
-                  (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
-                  )
-              (member (mime::content-info/encoding ccinfo)
+        (if (and (eq media-type 'application)
+                 (eq media-subtype 'octet-stream))
+            (let ((ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo)))
+              (member (mime-entity-info-encoding ccinfo)
                       '(nil "7bit" "8bit"))
               )
           t))
@@ -220,71 +229,79 @@ Each elements are regexp of field-name.")
 ;;; @@ entity button
 ;;;
 
-(defun mime-view-insert-entity-button (rcnum cinfo ctype params subj encoding)
+(defun mime-view-insert-entity-button (rcnum cinfo
+                                            media-type media-subtype params
+                                            subj encoding)
   "Insert entity-button."
-  (save-restriction
-    (narrow-to-region (point)(point))
-    (let ((access-type (assoc "access-type" params))
-         (num (or (cdr (assoc "x-part-number" params))
-                  (if (consp rcnum)
-                      (mapconcat (function
-                                  (lambda (num)
-                                    (format "%s" (1+ num))
-                                    ))
-                                 (reverse rcnum) ".")
-                    "0"))
-              ))
-      (cond (access-type
-            (let ((server (assoc "server" params)))
-              (setq access-type (cdr access-type))
-              (if server
-                  (insert (format "[%s %s ([%s] %s)]\n" num subj
-                                  access-type (cdr server)))
-                (let ((site (cdr (assoc "site" params)))
-                      (dir (cdr (assoc "directory" params)))
-                      )
-                  (insert (format "[%s %s ([%s] %s:%s)]\n" num subj
-                                  access-type site dir))
-                  )))
-            )
-           (t
-            (let ((charset (cdr (assoc "charset" params))))
-              (insert (concat "[" num " " subj))
+  (mime-insert-button
+   (let ((access-type (assoc "access-type" params))
+        (num (or (cdr (assoc "x-part-number" params))
+                 (if (consp rcnum)
+                     (mapconcat (function
+                                 (lambda (num)
+                                   (format "%s" (1+ num))
+                                   ))
+                                (reverse rcnum) ".")
+                   "0"))
+             ))
+     (cond (access-type
+           (let ((server (assoc "server" params)))
+             (setq access-type (cdr access-type))
+             (if server
+                 (format "%s %s ([%s] %s)"
+                         num subj access-type (cdr server))
+               (let ((site (cdr (assoc "site" params)))
+                     (dir (cdr (assoc "directory" params)))
+                     )
+                 (format "%s %s ([%s] %s:%s)"
+                         num subj access-type site dir)
+                 )))
+           )
+          (t
+           (let ((charset (cdr (assoc "charset" params))))
+             (concat
+              num " " subj
               (let ((rest
-                     (concat " <" ctype
+                     (format " <%s/%s%s%s>"
+                             media-type media-subtype
                              (if charset
                                  (concat "; " charset)
-                               (if encoding (concat " (" encoding ")"))
-                               )
-                             ">]\n")))
+                               "")
+                             (if encoding
+                                 (concat " (" encoding ")")
+                               ""))))
                 (if (>= (+ (current-column)(length rest))(window-width))
-                    (insert "\n\t")
-                  )
-                (insert rest)
-                ))))
-      )
-    (mime-add-button (point-min)(1- (point-max))
-                    (function mime-view-play-current-entity))
-    ))
+                    "\n\t")
+                rest)))
+           )))
+   (function mime-view-play-current-entity))
+  )
 
-(defun mime-view-entity-button-function
-  (rcnum cinfo ctype params subj encoding)
+(defun mime-view-entity-button-function (rcnum cinfo
+                                              media-type media-subtype
+                                              params subj encoding)
   "Insert entity button conditionally.
 Please redefine this function if you want to change default setting."
   (or (null rcnum)
-      (string= ctype "application/x-selection")
-      (and (string= ctype "application/octet-stream")
-          (string= (mime::content-info/type
-                    (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo))
-                   "multipart/encrypted"))
-      (mime-view-insert-entity-button rcnum cinfo ctype params subj encoding)
+      (and (eq media-type 'application)
+          (or (eq media-subtype 'x-selection)
+              (and (eq media-subtype 'octet-stream)
+                   (let ((entity-info
+                          (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo)))
+                     (and (eq (mime-entity-info-media-type entity-info)
+                              'multipart)
+                          (eq (mime-entity-info-media-subtype entity-info)
+                              'encrypted)
+                          )))))
+      (mime-view-insert-entity-button
+       rcnum cinfo media-type media-subtype params subj encoding)
       ))
 
 
 ;;; @@ content header filter
 ;;;
 
-(defsubst mime-view-cut-header ()
+(defun mime-view-cut-header ()
   (goto-char (point-min))
   (while (re-search-forward mime-view-ignored-field-regexp nil t)
     (let* ((beg (match-beginning 0))
@@ -296,9 +313,10 @@ Please redefine this function if you want to change default setting."
                        (string-match regexp name)
                        )) mime-view-visible-field-list)
          (delete-region beg
-                        (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
-                            (match-beginning 0)
-                          (point-max)))
+                        (save-excursion
+                          (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
+                              (match-beginning 0)
+                            (point-max))))
          ))))
 
 (defun mime-view-default-content-header-filter ()
@@ -326,11 +344,13 @@ function.  t means default media-type.")
 ;;; @@ entity separator
 ;;;
 
-(defun mime-view-entity-separator-function (rcnum cinfo ctype params subj)
+(defun mime-view-entity-separator-function (rcnum cinfo
+                                                 media-type media-subtype
+                                                 params subj)
   "Insert entity separator conditionally.
 Please redefine this function if you want to change default setting."
   (or (mime-view-header-visible-p rcnum cinfo)
-      (mime-view-body-visible-p rcnum cinfo ctype)
+      (mime-view-body-visible-p rcnum cinfo media-type media-subtype)
       (progn
        (goto-char (point-max))
        (insert "\n")
@@ -465,18 +485,20 @@ The compressed face will be piped to this command.")
     (or obuf
        (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")))
     (set-buffer (get-buffer-create obuf))
-    (setq buffer-read-only nil)
-    (widen)
-    (erase-buffer)
-    (setq mime-raw-buffer the-buf)
-    (setq mime-view-original-major-mode mode)
-    (setq major-mode 'mime-view-mode)
-    (setq mode-name "MIME-View")
-    (while pcl
-      (mime-view-display-entity (car pcl) cinfo the-buf obuf)
-      (setq pcl (cdr pcl))
+    (let ((inhibit-read-only t))
+      ;;(setq buffer-read-only nil)
+      (widen)
+      (erase-buffer)
+      (setq mime-raw-buffer the-buf)
+      (setq mime-view-original-major-mode mode)
+      (setq major-mode 'mime-view-mode)
+      (setq mode-name "MIME-View")
+      (while pcl
+       (mime-view-display-entity (car pcl) cinfo the-buf obuf)
+       (setq pcl (cdr pcl))
+       )
+      (set-buffer-modified-p nil)
       )
-    (set-buffer-modified-p nil)
     (setq buffer-read-only t)
     (set-buffer the-buf)
     )
@@ -485,12 +507,18 @@ The compressed face will be piped to this command.")
 
 (defun mime-view-display-entity (content cinfo ibuf obuf)
   "Display entity from content-info CONTENT."
-  (let* ((beg (mime::content-info/point-min content))
-        (end (mime::content-info/point-max content))
-        (ctype (mime::content-info/type content))
-        (params (mime::content-info/parameters content))
-        (encoding (mime::content-info/encoding content))
-        (rcnum (mime::content-info/rcnum content))
+  (let* ((beg (mime-entity-info-point-min content))
+        (end (mime-entity-info-point-max content))
+        (media-type (mime-entity-info-media-type content))
+        (media-subtype (mime-entity-info-media-subtype content))
+        (ctype (if media-type
+                   (if media-subtype
+                       (format "%s/%s" media-type media-subtype)
+                     (symbol-name media-type)
+                     )))
+        (params (mime-entity-info-parameters content))
+        (encoding (mime-entity-info-encoding content))
+        (rcnum (mime-entity-info-rnum content))
         he e nb ne subj)
     (set-buffer ibuf)
     (goto-char beg)
@@ -509,9 +537,10 @@ The compressed face will be piped to this command.")
     (set-buffer obuf)
     (setq nb (point))
     (narrow-to-region nb nb)
-    (mime-view-entity-button-function rcnum cinfo ctype params subj encoding)
+    (mime-view-entity-button-function
+     rcnum cinfo media-type media-subtype params subj encoding)
     (if (mime-view-header-visible-p rcnum cinfo)
-       (mime-preview/display-header beg he)
+       (mime-view-display-header beg he)
       )
     (if (and (null rcnum)
             (member
@@ -519,23 +548,24 @@ The compressed face will be piped to this command.")
        (save-excursion
          (goto-char (point-max))
          (mime-view-insert-entity-button
-          rcnum cinfo ctype params subj encoding)
+          rcnum cinfo media-type media-subtype params subj encoding)
          ))
-    (cond ((mime-view-body-visible-p rcnum cinfo ctype)
-          (mime-preview/display-body he end
+    (cond ((mime-view-body-visible-p rcnum cinfo media-type media-subtype)
+          (mime-view-display-body he end
                                      rcnum cinfo ctype params subj encoding)
           )
-         ((equal ctype "message/partial")
-          (mime-preview/display-message/partial)
+         ((and (eq media-type 'message)(eq media-subtype 'partial))
+          (mime-view-insert-message/partial-button)
           )
          ((and (null rcnum)
-               (null (mime::content-info/children cinfo))
+               (null (mime-entity-info-children cinfo))
                )
           (goto-char (point-max))
           (mime-view-insert-entity-button
-           rcnum cinfo ctype params subj encoding)
+           rcnum cinfo media-type media-subtype params subj encoding)
           ))
-    (mime-view-entity-separator-function rcnum cinfo ctype params subj)
+    (mime-view-entity-separator-function
+     rcnum cinfo media-type media-subtype params subj)
     (setq ne (point-max))
     (widen)
     (put-text-property nb ne 'mime-view-raw-buffer ibuf)
@@ -543,7 +573,7 @@ The compressed face will be piped to this command.")
     (goto-char ne)
     ))
 
-(defun mime-preview/display-header (beg end)
+(defun mime-view-display-header (beg end)
   (save-restriction
     (narrow-to-region (point)(point))
     (insert-buffer-substring mime-raw-buffer beg end)
@@ -556,8 +586,7 @@ The compressed face will be piped to this command.")
     (run-hooks 'mime-view-content-header-filter-hook)
     ))
 
-(defun mime-preview/display-body (beg end
-                                     rcnum cinfo ctype params subj encoding)
+(defun mime-view-display-body (beg end rcnum cinfo ctype params subj encoding)
   (save-restriction
     (narrow-to-region (point-max)(point-max))
     (insert-buffer-substring mime-raw-buffer beg end)
@@ -568,18 +597,18 @@ The compressed face will be piped to this command.")
           )
       )))
 
-(defun mime-preview/display-message/partial ()
+(defun mime-view-insert-message/partial-button ()
   (save-restriction
     (goto-char (point-max))
     (if (not (search-backward "\n\n" nil t))
        (insert "\n")
       )
-    (let ((be (point-max)))
-      (narrow-to-region be be)
-      (insert mime-view-announcement-for-message/partial)
-      (mime-add-button (point-min)(point-max)
-                      (function mime-view-play-current-entity))
-      )))
+    (goto-char (point-max))
+    (narrow-to-region (point-max)(point-max))
+    (insert mime-view-announcement-for-message/partial)
+    (mime-add-button (point-min)(point-max)
+                    (function mime-view-play-current-entity))
+    ))
 
 (defun mime-article/get-uu-filename (param &optional encoding)
   (if (member (or encoding
@@ -616,9 +645,9 @@ The compressed face will be piped to this command.")
   (or cinfo
       (setq cinfo mime::article/content-info)
       )
-  (let ((b (mime::content-info/point-min cinfo))
-       (e (mime::content-info/point-max cinfo))
-       (c (mime::content-info/children cinfo))
+  (let ((b (mime-entity-info-point-min cinfo))
+       (e (mime-entity-info-point-max cinfo))
+       (c (mime-entity-info-children cinfo))
        )
     (if (and (<= b p)(<= p e))
        (or (let (co ret (sn 0))
@@ -640,7 +669,7 @@ The compressed face will be piped to this command.")
       )
   (find-if (function
            (lambda (ci)
-             (equal (mime::content-info/rcnum ci) rcnum)
+             (equal (mime-entity-info-rnum ci) rcnum)
              ))
           (mime/flatten-content-info cinfo)
           ))
@@ -654,7 +683,7 @@ The compressed face will be piped to this command.")
     (let ((sn (car cn)))
       (if (null sn)
          cinfo
-       (let ((rc (nth sn (mime::content-info/children cinfo))))
+       (let ((rc (nth sn (mime-entity-info-children cinfo))))
          (if rc
              (mime-article/cnum-to-cinfo (cdr cn) rc)
            ))
@@ -665,7 +694,7 @@ The compressed face will be piped to this command.")
       (setq cinfo mime::article/content-info)
       )
   (let ((dest (list cinfo))
-       (rcl (mime::content-info/children cinfo))
+       (rcl (mime-entity-info-children cinfo))
        )
     (while rcl
       (setq dest (nconc dest (mime/flatten-content-info (car rcl))))
@@ -750,16 +779,26 @@ The compressed face will be piped to this command.")
       "h"        (function mime-view-show-summary))
     (define-key mime-view-mode-map
       "\C-c\C-x" (function mime-view-kill-buffer))
+    ;; (define-key mime-view-mode-map
+    ;;   "<"        (function beginning-of-buffer))
+    ;; (define-key mime-view-mode-map
+    ;;   ">"        (function end-of-buffer))
+    (define-key mime-view-mode-map
+      "?"        (function describe-mode))
     (define-key mime-view-mode-map
-      "<"        (function beginning-of-buffer))
+      [tab] (function mime-view-move-to-next))
     (define-key mime-view-mode-map
-      ">"        (function end-of-buffer))
+      [delete] (function mime-view-scroll-down-entity))
     (define-key mime-view-mode-map
-      "?"        (function describe-mode))
+      [backspace] (function mime-view-scroll-down-entity))
     (if (functionp default)
-       (setq mime-view-mode-map
-             (append mime-view-mode-map (list (cons t default)))
-             ))
+       (cond (running-xemacs
+              (set-keymap-default-binding mime-view-mode-map default)
+              )
+             (t
+              (setq mime-view-mode-map
+                    (append mime-view-mode-map (list (cons t default))))
+              )))
     (if mouse-button-2
        (define-key mime-view-mode-map
          mouse-button-2 (function mime-button-dispatcher))
@@ -856,7 +895,7 @@ button-2    Move to point under the mouse cursor
   "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/content-decoding-condition'."
+`mime-acting-condition'."
   (interactive)
   (mime-view-play-current-entity "extract")
   )
@@ -865,7 +904,7 @@ It decodes current entity to call internal or external method as
   "Print current entity (maybe).
 It decodes current entity to call internal or external method as
 \"print\" mode.  The method is selected from variable
-`mime/content-decoding-condition'."
+`mime-acting-condition'."
   (interactive)
   (mime-view-play-current-entity "print")
   )
@@ -897,7 +936,7 @@ It calls following-method selected from variable
       )
     (let* ((p-beg (previous-single-property-change (point) 'mime-view-cinfo))
           p-end
-          (rcnum (mime::content-info/rcnum cinfo))
+          (rcnum (mime-entity-info-rnum cinfo))
           (len (length rcnum))
           )
       (cond ((null p-beg)
@@ -928,7 +967,7 @@ It calls following-method selected from variable
                                (next-single-property-change
                                 (point) 'mime-view-cinfo))
                     (goto-char e)
-                    (let ((rc (mime::content-info/rcnum
+                    (let ((rc (mime-entity-info-rnum
                                (get-text-property (point)
                                                   'mime-view-cinfo))))
                       (or (equal rcnum (nthcdr (- (length rc) len) rc))
@@ -959,7 +998,7 @@ It calls following-method selected from variable
          (goto-char (point-min))
          (insert "\n")
          (goto-char (point-min))
-         (let ((rcnum (mime::content-info/rcnum cinfo)) ci str)
+         (let ((rcnum (mime-entity-info-rnum cinfo)) ci str)
            (while (progn
                     (setq str
                           (save-excursion
@@ -967,15 +1006,16 @@ It calls following-method selected from variable
                             (setq ci (mime-article/rcnum-to-cinfo rcnum))
                             (save-restriction
                               (narrow-to-region
-                               (mime::content-info/point-min ci)
-                               (mime::content-info/point-max ci)
+                               (mime-entity-info-point-min ci)
+                               (mime-entity-info-point-max ci)
                                )
                               (std11-header-string-except
                                (concat "^"
                                        (apply (function regexp-or) fields)
                                        ":") ""))))
-                    (if (string= (mime::content-info/type ci)
-                                 "message/rfc822")
+                    (if (and
+                         (eq (mime-entity-info-media-type ci) 'message)
+                         (eq (mime-entity-info-media-subtype ci) 'rfc822))
                         nil
                       (if str
                           (insert str)
@@ -1039,7 +1079,7 @@ If there is no upper entity, call function `mime-view-quit'."
       (backward-char)
       )
     (let ((r (mime-article/rcnum-to-cinfo
-             (cdr (mime::content-info/rcnum cinfo))
+             (cdr (mime-entity-info-rnum cinfo))
              (get-text-property 1 'mime-view-cinfo)))
          point)
       (catch 'tag