(eword-lexical-analyze): `last' of Emacs 20.0.97 allows two arguments.
[elisp/semi.git] / mime-view.el
index deeff69..bbd01a3 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.81 $
+;; Version: $Revision: 0.97 $
 ;; 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.81 1997-03-27 22:16:53 morioka Exp $")
+  "$Id: mime-view.el,v 0.97 1997-07-14 15:15:17 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")
      )
     
@@ -222,50 +235,47 @@ Each elements are regexp of field-name.")
 
 (defun mime-view-insert-entity-button (rcnum cinfo ctype 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
                              (if charset
                                  (concat "; " charset)
                                (if encoding (concat " (" encoding ")"))
                                )
-                             ">]\n")))
+                             ">")))
                 (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)
@@ -296,9 +306,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 ()
@@ -313,10 +324,14 @@ Please redefine this function if you want to change default setting."
 ;;;
 
 (defvar mime-view-content-filter-alist
-  '(("text/enriched" . mime-preview/filter-for-text/enriched)
-    ("text/richtext" . mime-preview/filter-for-text/richtext)
-    (t . mime-preview/filter-for-text/plain)
-    ))
+  '(("text/enriched" . mime-view-filter-for-text/enriched)
+    ("text/richtext" . mime-view-filter-for-text/richtext)
+    (t . mime-view-filter-for-text/plain)
+    )
+  "Alist of media-types vs. corresponding MIME-View filter functions.
+Each element looks like (TYPE/SUBTYPE . FUNCTION) or (t . FUNCTION).
+TYPE/SUBTYPE is a string of media-type and FUNCTION is a filter
+function.  t means default media-type.")
 
 
 ;;; @@ entity separator
@@ -441,18 +456,6 @@ The compressed face will be piped to this command.")
          ))))
 
 
-;;; @@ utility
-;;;
-
-(defun mime-preview/get-original-major-mode ()
-  (if mime-mother-buffer
-      (save-excursion
-       (set-buffer mime-mother-buffer)
-       (mime-preview/get-original-major-mode)
-       )
-    mime-view-original-major-mode))
-
-
 ;;; @ buffer setup
 ;;;
 
@@ -473,18 +476,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)
     )
@@ -534,7 +539,7 @@ The compressed face will be piped to this command.")
                                      rcnum cinfo ctype params subj encoding)
           )
          ((equal ctype "message/partial")
-          (mime-preview/display-message/partial)
+          (mime-view-insert-message/partial-button)
           )
          ((and (null rcnum)
                (null (mime::content-info/children cinfo))
@@ -576,18 +581,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
@@ -758,16 +763,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))
@@ -854,13 +869,17 @@ button-2  Move to point under the mouse cursor
       (run-hooks 'mime-view-mode-hook)
       )))
 
+
+;;; @@ playing
+;;;
+
 (autoload 'mime-view-play-current-entity "mime-play" "Play current entity." t)
 
 (defun mime-view-extract-current-entity ()
   "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")
   )
@@ -869,11 +888,26 @@ 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")
   )
 
+
+;;; @@ following
+;;;
+
+(defun mime-view-get-original-major-mode ()
+  "Return major-mode of original buffer.
+If a current buffer has mime-mother-buffer, return original major-mode
+of the mother-buffer."
+  (if mime-mother-buffer
+      (save-excursion
+       (set-buffer mime-mother-buffer)
+       (mime-view-get-original-major-mode)
+       )
+    mime-view-original-major-mode))
+
 (defun mime-view-follow-current-entity ()
   "Write follow message to current entity.
 It calls following-method selected from variable
@@ -928,7 +962,7 @@ It calls following-method selected from variable
                 (setq p-end (point-max))
                 ))
             ))
-      (let* ((mode (mime-preview/get-original-major-mode))
+      (let* ((mode (mime-view-get-original-major-mode))
             (new-name (format "%s-%s" (buffer-name) (reverse rcnum)))
             new-buf
             (the-buf (current-buffer))
@@ -1004,6 +1038,10 @@ It calls following-method selected from variable
            ))
        ))))
 
+
+;;; @@ X-Face
+;;;
+
 (defun mime-view-display-x-face ()
   (interactive)
   (save-window-excursion
@@ -1011,6 +1049,10 @@ It calls following-method selected from variable
     (mime-view-x-face-function)
     ))
 
+
+;;; @@ moving
+;;;
+
 (defun mime-view-move-to-upper ()
   "Move to upper entity.
 If there is no upper entity, call function `mime-view-quit'."
@@ -1132,6 +1174,10 @@ If reached to (point-min), it calls function registered in variable
   (mime-view-scroll-down-entity 1)
   )
 
+
+;;; @@ quitting
+;;;
+
 (defun mime-view-quit ()
   "Quit from MIME-View buffer.
 It calls function registered in variable