X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=64a4d109c9f7e90b26f88b698bdb0c6b97ee0f58;hb=829bd01d607b4c46751f912e31c75e1e6d4be179;hp=b7d21d687c5082b8662a80e1df59ff92b4bfb6db;hpb=0f8c1b1683c51f6a44bc274ec196eaa60cff371f;p=elisp%2Fsemi.git

diff --git a/mime-view.el b/mime-view.el
index b7d21d6..64a4d10 100644
--- a/mime-view.el
+++ b/mime-view.el
@@ -33,6 +33,8 @@
 (require 'alist)
 (require 'mime-conf)
 
+(eval-when-compile (require 'static))
+
 
 ;;; @ version
 ;;;
@@ -66,6 +68,15 @@ buttom. Nil means don't scroll at all."
 		 (const :tag "On" t)
 		 (sexp :tag "Situation" 1)))
 
+(defcustom mime-view-mailcap-files
+  (let ((files '("/etc/mailcap" "/usr/etc/mailcap" "~/.mailcap")))
+    (or (member mime-mailcap-file files)
+	(setq files (cons mime-mailcap-file files)))
+    files)
+  "List of mailcap files."
+  :group 'mime-view
+  :type '(repeat file))
+
 
 ;;; @ in raw-buffer (representation space)
 ;;;
@@ -360,6 +371,53 @@ mother-buffer."
 (defvar mime-acting-situation-example-list-max-size 16)
 (defvar mime-situation-examples-file-coding-system nil)
 
+(defun mime-view-read-situation-examples-file (&optional file)
+  (or file
+      (setq file mime-situation-examples-file))
+  (if (and file
+	   (file-readable-p file))
+      (with-temp-buffer
+	(insert-file-contents file)
+	(setq mime-situation-examples-file-coding-system
+              (static-cond
+	       ((boundp 'buffer-file-coding-system)
+		(symbol-value 'buffer-file-coding-system))
+	       ((boundp 'file-coding-system)
+		(symbol-value 'file-coding-system))
+	       (t nil))
+	      ;; (and (boundp 'buffer-file-coding-system)
+              ;;      buffer-file-coding-system)
+	      )
+	(condition-case error
+	    (eval-buffer)
+	  (error (message "%s is broken: %s" file (cdr error))))
+	;; format check
+	(condition-case nil
+	    (let ((i 0))
+	      (while (and (> (length mime-preview-situation-example-list)
+			     mime-preview-situation-example-list-max-size)
+			  (< i 16))
+		(setq mime-preview-situation-example-list
+		      (mime-reduce-situation-examples
+		       mime-preview-situation-example-list))
+		(setq i (1+ i))))
+	  (error (setq mime-preview-situation-example-list nil)))
+	;; (let ((rest mime-preview-situation-example-list))
+	;;   (while rest
+	;;     (ctree-set-calist-strictly 'mime-preview-condition
+	;;                                (caar rest))
+	;;     (setq rest (cdr rest))))
+	(condition-case nil
+	    (let ((i 0))
+	      (while (and (> (length mime-acting-situation-example-list)
+			     mime-acting-situation-example-list-max-size)
+			  (< i 16))
+		(setq mime-acting-situation-example-list
+		      (mime-reduce-situation-examples
+		       mime-acting-situation-example-list))
+		(setq i (1+ i))))
+	  (error (setq mime-acting-situation-example-list nil))))))
+
 (defun mime-save-situation-examples ()
   (if (or mime-preview-situation-example-list
 	  mime-acting-situation-example-list)
@@ -380,13 +438,15 @@ mother-buffer."
 	  (insert "\n;;; "
 		  (file-name-nondirectory file)
 		  " ends here.\n")
-	  (static-cond
+          (static-cond
 	   ((boundp 'buffer-file-coding-system)
 	    (setq buffer-file-coding-system
 		  mime-situation-examples-file-coding-system))
 	   ((boundp 'file-coding-system)
 	    (setq file-coding-system
 		  mime-situation-examples-file-coding-system)))
+	  ;; (setq buffer-file-coding-system
+          ;;       mime-situation-examples-file-coding-system)
 	  (setq buffer-file-name file)
 	  (save-buffer)))))
 
@@ -688,6 +748,12 @@ Each elements are regexp of field-name.")
 
 (ctree-set-calist-strictly
  'mime-preview-condition
+ '((type . multipart)(subtype . related)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/related)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
  '((type . multipart)(subtype . t)
    (body . visible)
    (body-presentation-method . mime-display-multipart/mixed)))
@@ -862,6 +928,22 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 	    situations (cdr situations)
 	    i (1+ i)))))
 
+(defun mime-display-multipart/related (entity situation)
+  (let* ((param-start (mime-parse-msg-id
+		       (std11-lexical-analyze
+			(cdr (assoc "start"
+				    (mime-content-type-parameters
+				     (mime-entity-content-type entity)))))))
+	 (start (or (and param-start (mime-find-entity-from-content-id
+				      param-start
+				      entity))
+		    (car (mime-entity-children entity))))
+	 (original-major-mode-cell (assq 'major-mode situation))
+	 (default-situation (cdr (assq 'childrens-situation situation))))
+    (if original-major-mode-cell
+	(setq default-situation
+	      (cons original-major-mode-cell default-situation)))
+    (mime-display-entity start nil default-situation)))
 
 ;;; @ acting-condition
 ;;;
@@ -869,34 +951,39 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 (defvar mime-acting-condition nil
   "Condition-tree about how to process entity.")
 
-(if (file-readable-p mime-mailcap-file)
-    (let ((entries (mime-parse-mailcap-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))
+(defun mime-view-read-mailcap-files (&optional files)
+  (or files
+      (setq files mime-view-mailcap-files))
+  (let (entries file)
+    (while files
+      (setq file (car files))
+      (if (file-readable-p file)
+	  (setq entries (append entries (mime-parse-mailcap-file file))))
+      (setq files (cdr files)))
+    (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 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))
-	)))
+	  (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)))))
+
+(mime-view-read-mailcap-files)
 
 (ctree-set-calist-strictly
  'mime-acting-condition
@@ -1116,8 +1203,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 (defun mime-view-define-keymap (&optional default)
   (let ((mime-view-mode-map (if (keymapp default)
 				(copy-keymap default)
-			      (make-sparse-keymap)
-			      )))
+			      (make-sparse-keymap))))
     (define-key mime-view-mode-map
       "u"        (function mime-preview-move-to-upper))
     (define-key mime-view-mode-map
@@ -1210,15 +1296,15 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 		    (lambda (item)
 		      (define-key mime-view-mode-map
 			(vector 'menu-bar 'mime-view (car item))
-			(cons (nth 1 item)(nth 2 item))
-			)
+			(cons (nth 1 item)(nth 2 item)))
 		      ))
-		   (reverse mime-view-menu-list)
-		   )
+		   (reverse mime-view-menu-list))
 	   ))
-    (use-local-map mime-view-mode-map)
-    (run-hooks 'mime-view-define-keymap-hook)
-    ))
+    ;; (run-hooks 'mime-view-define-keymap-hook)
+    mime-view-mode-map))
+
+(defvar mime-view-mode-default-map (mime-view-define-keymap))
+
 
 (defsubst mime-maybe-hide-echo-buffer ()
   "Clear mime-echo buffer and delete window for it."
@@ -1239,7 +1325,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 ;;;###autoload
 (defun mime-display-message (message &optional preview-buffer
 				     mother default-keymap-or-function
-				     original-major-mode)
+				     original-major-mode keymap)
   "View MESSAGE in MIME-View mode.
 
 Optional argument PREVIEW-BUFFER specifies the buffer of the
@@ -1250,7 +1336,14 @@ Optional argument MOTHER specifies mother-buffer of the 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."
+keymap of MIME-View mode.
+
+Optional argument ORIGINAL-MAJOR-MODE is major-mode of representation
+buffer of MESSAGE.  If it is nil, current `major-mode' is used.
+
+Optional argument KEYMAP is keymap of MIME-View mode.  If it is
+non-nil, DEFAULT-KEYMAP-OR-FUNCTION is ignored.  If it is nil,
+`mime-view-mode-default-map' is used."
   (mime-maybe-hide-echo-buffer)
   (let ((win-conf (current-window-configuration)))
     (or preview-buffer
@@ -1263,8 +1356,7 @@ keymap of MIME-View mode."
       (widen)
       (erase-buffer)
       (if mother
-	  (setq mime-mother-buffer mother)
-	)
+	  (setq mime-mother-buffer mother))
       (setq mime-preview-original-window-configuration win-conf)
       (setq major-mode 'mime-view-mode)
       (setq mode-name "MIME-View")
@@ -1273,14 +1365,17 @@ keymap of MIME-View mode."
 			     (header . visible)
 			     (major-mode . ,original-major-mode))
 			   preview-buffer)
-      (mime-view-define-keymap default-keymap-or-function)
+      (use-local-map
+       (or keymap
+	   (if default-keymap-or-function
+	       (mime-view-define-keymap default-keymap-or-function)
+	     mime-view-mode-default-map)))
       (let ((point
 	     (next-single-property-change (point-min) 'mime-view-entity)))
 	(if point
 	    (goto-char point)
 	  (goto-char (point-min))
-	  (search-forward "\n\n" nil t)
-	  ))
+	  (search-forward "\n\n" nil t)))
       (run-hooks 'mime-view-mode-hook)
       (set-buffer-modified-p nil)
       (setq buffer-read-only t)
@@ -1786,43 +1881,11 @@ It calls function registered in variable
 
 (provide 'mime-view)
 
-(let ((file mime-situation-examples-file))
-  (if (file-readable-p file)
-      (with-temp-buffer
-	(insert-file-contents file)
-	(setq mime-situation-examples-file-coding-system
-	      (static-cond
-	       ((boundp 'buffer-file-coding-system)
-		(symbol-value 'buffer-file-coding-system))
-	       ((boundp 'file-coding-system)
-		(symbol-value 'file-coding-system))
-	       (t nil)))
-	(eval-buffer)
-	;; format check
-	(condition-case nil
-	    (let ((i 0))
-	      (while (and (> (length mime-preview-situation-example-list)
-			     mime-preview-situation-example-list-max-size)
-			  (< i 16))
-		(setq mime-preview-situation-example-list
-		      (mime-reduce-situation-examples
-		       mime-preview-situation-example-list))
-		(setq i (1+ i))))
-	  (error (setq mime-preview-situation-example-list nil)))
-	;; (let ((rest mime-preview-situation-example-list))
-	;;   (while rest
-	;;     (ctree-set-calist-strictly 'mime-preview-condition
-	;;                                (caar rest))
-	;;     (setq rest (cdr rest))))
-	(condition-case nil
-	    (let ((i 0))
-	      (while (and (> (length mime-acting-situation-example-list)
-			     mime-acting-situation-example-list-max-size)
-			  (< i 16))
-		(setq mime-acting-situation-example-list
-		      (mime-reduce-situation-examples
-		       mime-acting-situation-example-list))
-		(setq i (1+ i))))
-	  (error (setq mime-acting-situation-example-list nil))))))
+(eval-when-compile
+  (setq mime-situation-examples-file nil)
+  ;; to avoid to read situation-examples-file at compile time.
+  )
+
+(mime-view-read-situation-examples-file)
 
 ;;; mime-view.el ends here