Apply Simon Josefsson <jas@pdc.kth.se>'s patch.
[elisp/semi.git] / mime-view.el
index 16c4a1d..e401ed4 100644 (file)
@@ -33,6 +33,7 @@
 (require 'mime-parse)
 (require 'semi-def)
 (require 'calist)
+(require 'mailcap)
 
 
 ;;; @ version
            " (" (cadr mime-module-version) ")"))
 
 
+;;; @ variables
+;;;
+
+(defgroup mime-view nil
+  "MIME view mode"
+  :group 'mime)
+
+(defcustom mime-view-find-every-acting-situation t
+  "*Find every available acting-situation if non-nil."
+  :group 'mime-view
+  :type 'boolean)
+
+(defcustom mime-acting-situation-examples-file "~/.mime-example"
+  "*File name of example about acting-situation demonstrated by user."
+  :group 'mime-view
+  :type 'file)
+
+
 ;;; @ buffer local variables
 ;;;
 
@@ -489,27 +508,59 @@ if it is not nil.")
 (defvar mime-acting-condition nil
   "Condition-tree about how to process entity.")
 
-(ctree-set-calist-strictly
+(if (file-readable-p mailcap-file)
+    (let ((entries (mailcap-parse-file)))
+      (while entries
+       (let ((entry (car entries))
+             view print shared)
+         (while entry
+           (let* ((field (car entry))
+                  (field-type (car field)))
+             (cond ((eq field-type 'view)  (setq view field))
+                   ((eq field-type 'print) (setq print field))
+                   ((memq field-type '(compose composetyped edit)))
+                   (t (setq shared (cons field shared))))
+             )
+           (setq entry (cdr entry))
+           )
+         (setq shared (nreverse shared))
+         (ctree-set-calist-with-default
+          'mime-acting-condition
+          (append shared (list '(mode . "play")(cons 'method (cdr view)))))
+         (if print
+             (ctree-set-calist-with-default
+              'mime-acting-condition
+              (append shared
+                      (list '(mode . "print")(cons 'method (cdr view))))
+              ))
+         )
+       (setq entries (cdr entries))
+       )))
+
+;; (ctree-set-calist-strictly
+;;  'mime-acting-condition
+;;  '((type . t)(subtype . t)(mode . "extract")
+;;    (method . mime-method-to-save)))
+(ctree-set-calist-with-default
  'mime-acting-condition
- '((type . text)(subtype . t)(mode . "play")
-   (method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)
-   ))
+ '((mode . "extract")
+   (method . mime-method-to-save)))
 
-(ctree-set-calist-strictly
- 'mime-acting-condition
- '((type . text)(subtype . plain)(mode . "play")
-   (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
-   ))
-(ctree-set-calist-strictly
- 'mime-acting-condition
- '((type . text)(subtype . plain)(mode . "print")
-   (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
-   ))
-(ctree-set-calist-strictly
- 'mime-acting-condition
- '((type . text)(subtype . html)(mode . "play")
-   (method "tm-html" nil 'file "" 'encoding 'mode 'name)
-   ))
+;; (ctree-set-calist-strictly
+;;  'mime-acting-condition
+;;  '((type . text)(subtype . plain)(mode . "play")
+;;    (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
+;;    ))
+;; (ctree-set-calist-strictly
+;;  'mime-acting-condition
+;;  '((type . text)(subtype . plain)(mode . "print")
+;;    (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
+;;    ))
+;; (ctree-set-calist-strictly
+;;  'mime-acting-condition
+;;  '((type . text)(subtype . html)(mode . "play")
+;;    (method "tm-html" nil 'file "" 'encoding 'mode 'name)
+;;    ))
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . text)(subtype . x-rot13-47)(mode . "play")
@@ -521,39 +572,39 @@ if it is not nil.")
    (method . mime-method-to-display-caesar)
    ))
 
-(ctree-set-calist-strictly
- 'mime-acting-condition
- '((type . audio)(subtype . basic)(mode . "play")
-   (method "tm-au" nil 'file "" 'encoding 'mode 'name)
-   ))
-
-(ctree-set-calist-strictly
- 'mime-acting-condition
- '((type . image)(mode . "play")
-   (method "tm-image" nil 'file "" 'encoding 'mode 'name)
-   ))
-(ctree-set-calist-strictly
- 'mime-acting-condition
- '((type . image)(mode . "print")
-   (method "tm-image" nil 'file "" 'encoding 'mode 'name)
-   ))
-
-(ctree-set-calist-strictly
- 'mime-acting-condition
- '((type . video)(subtype . mpeg)(mode . "play")
-   (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name)
-   ))
-
-(ctree-set-calist-strictly
- 'mime-acting-condition
- '((type . application)(subtype . postscript)(mode . "play")
-   (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
-   ))
-(ctree-set-calist-strictly
- 'mime-acting-condition
- '((type . application)(subtype . postscript)(mode . "print")
-   (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
-   ))
+;; (ctree-set-calist-strictly
+;;  'mime-acting-condition
+;;  '((type . audio)(subtype . basic)(mode . "play")
+;;    (method "tm-au" nil 'file "" 'encoding 'mode 'name)
+;;    ))
+
+;; (ctree-set-calist-strictly
+;;  'mime-acting-condition
+;;  '((type . image)(mode . "play")
+;;    (method "tm-image" nil 'file "" 'encoding 'mode 'name)
+;;    ))
+;; (ctree-set-calist-strictly
+;;  'mime-acting-condition
+;;  '((type . image)(mode . "print")
+;;    (method "tm-image" nil 'file "" 'encoding 'mode 'name)
+;;    ))
+
+;; (ctree-set-calist-strictly
+;;  'mime-acting-condition
+;;  '((type . video)(subtype . mpeg)(mode . "play")
+;;    (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name)
+;;    ))
+
+;; (ctree-set-calist-strictly
+;;  'mime-acting-condition
+;;  '((type . application)(subtype . postscript)(mode . "play")
+;;    (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
+;;    ))
+;; (ctree-set-calist-strictly
+;;  'mime-acting-condition
+;;  '((type . application)(subtype . postscript)(mode . "print")
+;;    (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
+;;    ))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
@@ -568,11 +619,6 @@ if it is not nil.")
 
 (ctree-set-calist-strictly
  'mime-acting-condition
- '((mode . "extract")
-   (method . mime-method-to-save)))
-
-(ctree-set-calist-strictly
- 'mime-acting-condition
  '((type . message)(subtype . external-body)
    ("access-type" . "anon-ftp")
    (method . mime-method-to-display-message/external-ftp)
@@ -1112,8 +1158,7 @@ of the mother-buffer."
 It calls following-method selected from variable
 `mime-view-following-method-alist'."
   (interactive)
-  (let ((message-info (get-text-property (point-min) 'mime-view-entity))
-       entity)
+  (let (entity)
     (while (null (setq entity
                       (get-text-property (point) 'mime-view-entity)))
       (backward-char)
@@ -1176,16 +1221,7 @@ It calls following-method selected from variable
          (erase-buffer)
          (insert-buffer-substring the-buf p-beg p-end)
          (goto-char (point-min))
-          ;; (if (mime-view-header-visible-p entity message-info)
-          ;;     (delete-region (goto-char (point-min))
-          ;;                    (if (re-search-forward "^$" nil t)
-          ;;                        (match-end 0)
-          ;;                      (point-min)))
-          ;;   )
-         ;;(goto-char (point-min))
-         ;;(insert "\n")
-         (goto-char (point-min))
-         (let ((entity-node-id (mime-entity-node-id entity)) ci str)
+          (let ((entity-node-id (mime-entity-node-id entity)) ci str)
            (while (progn
                     (setq
                      str
@@ -1292,9 +1328,8 @@ variable `mime-view-over-to-previous-method-alist'."
   (while (null (get-text-property (point) 'mime-view-entity))
     (backward-char)
     )
-  (let ((point
-        (previous-single-property-change (point) 'mime-view-entity)))
-    (if point
+  (let ((point (previous-single-property-change (point) 'mime-view-entity)))
+    (if (and point (get-text-property (- point 1) 'mime-view-entity))
        (goto-char point)
       (let ((f (assq mime-preview-original-major-mode
                     mime-view-over-to-previous-method-alist)))
@@ -1308,8 +1343,11 @@ variable `mime-view-over-to-previous-method-alist'."
 If there is no previous entity, it calls function registered in
 variable `mime-view-over-to-next-method-alist'."
   (interactive)
+  (while (null (get-text-property (point) 'mime-view-entity))
+    (forward-char)
+    )
   (let ((point (next-single-property-change (point) 'mime-view-entity)))
-    (if point
+    (if (and point (get-text-property point 'mime-view-entity))
        (goto-char point)
       (let ((f (assq mime-preview-original-major-mode
                     mime-view-over-to-next-method-alist)))