From: teranisi <teranisi>
Date: Fri, 20 Feb 2004 16:15:42 +0000 (+0000)
Subject: * elmo.el (elmo-message-match-condition): Use elmo-message-fetch
X-Git-Tag: wl-2_11_25~51
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=7f6e08e4f77e07def1bf4b57e7676da25b727b05;p=elisp%2Fwanderlust.git

* elmo.el (elmo-message-match-condition): Use elmo-message-fetch
instead of insert-file-contents-as-binary.
(elmo-message-set-field): New generic function.

* elmo-localdir.el (elmo-folder-expand-msgdb-path): Follow the
behavior change on `split-string'.

* elmo-file.el (elmo-file-find): New function.
(elmo-file-command): New user option.
(elmo-file-command-argument): Ditto.
(elmo-file-fetch-max-size): Ditto.
(elmo-file-detect-format): New function.
(elmo-map-message-fetch): Use elmo-file-fetch-max-size;
Use elmo-file-detect-format.
(elmo-map-folder-list-message-locations): Don't treat directories.
---

diff --git a/elmo/ChangeLog b/elmo/ChangeLog
index 8a1e7ac..2274b75 100644
--- a/elmo/ChangeLog
+++ b/elmo/ChangeLog
@@ -1,3 +1,21 @@
+2004-02-20  Yuuichi Teranishi  <teranisi@gohome.org>
+
+	* elmo.el (elmo-message-match-condition): Use elmo-message-fetch
+	instead of insert-file-contents-as-binary.
+	(elmo-message-set-field): New generic function.
+
+	* elmo-localdir.el (elmo-folder-expand-msgdb-path): Follow the
+	behavior change on `split-string'.
+
+	* elmo-file.el (elmo-file-find): New function.
+	(elmo-file-command): New user option.
+	(elmo-file-command-argument): Ditto.
+	(elmo-file-fetch-max-size): Ditto.
+	(elmo-file-detect-format): New function.
+	(elmo-map-message-fetch): Use elmo-file-fetch-max-size;
+	Use elmo-file-detect-format.
+	(elmo-map-folder-list-message-locations): Don't treat directories.
+
 2004-02-19  TAKAHASHI Kaoru  <kaoru@kaisei.org>
 
 	* elmo-util.el (elmo-string-partial-p): Removed unused function.
diff --git a/elmo/elmo-file.el b/elmo/elmo-file.el
index 4f259e7..3a5acad 100644
--- a/elmo/elmo-file.el
+++ b/elmo/elmo-file.el
@@ -32,6 +32,37 @@
 (require 'elmo-map)
 (require 'mime-edit)
 
+(defun elmo-file-find (files)
+  "Return the first existing filename in the FILES."
+  (let (file)
+    (while files
+      (when (file-exists-p (car files))
+	(setq file (car files)
+	      files nil))
+      (setq files (cdr files)))
+    file))
+
+(defcustom elmo-file-command (exec-installed-p "file")
+  "*Program name of the file type detection command `file'."
+  :type '(string :tag "Program name of the file")
+  :group 'elmo)
+
+(defcustom elmo-file-command-argument
+  `("-m"
+    ,(elmo-file-find
+      '("/usr/share/magic.mime"
+	"/usr/share/file/magic.mime"
+	"/cygwin/usr/share/file/magic.mime")))
+  "*Argument list for the `file' command.
+\(It should return the MIME content type\)"
+  :type '(repeat string)
+  :group 'elmo)
+
+(defcustom elmo-file-fetch-max-size (* 1024 1024)
+  "*Max size of the message fetching."
+  :type 'integer
+  :group 'elmo)
+
 (eval-and-compile
   (luna-define-class elmo-file-folder (elmo-map-folder) (file-path))
   (luna-define-internal-accessors 'elmo-file-folder))
@@ -55,6 +86,36 @@
     (concat (elmo-match-string 1 s) ", "
 	    (timezone-make-date-arpa-standard s (current-time-zone)))))
 
+(defun elmo-file-detect-format (file)
+  "Return content-type of the FILE."
+  (if (or (not (file-exists-p file))
+	  (file-directory-p file))
+      "application/octet-stream"
+    (let (type)
+      (setq type (mime-find-file-type file))
+      (if (and (string= (nth 0 type) "application")
+	       (string= (nth 1 type) "octet-stream"))
+	  (if elmo-file-command
+	      (with-temp-buffer
+		(when
+		    (zerop (apply 'call-process elmo-file-command
+				  nil `(,(current-buffer) nil)
+				  nil (append elmo-file-command-argument
+					      (list (expand-file-name file)))))
+		  (goto-char (point-min))
+		  (when (re-search-forward ": *" nil t)
+		    (setq type (buffer-substring (match-end 0)
+						 (point-at-eol))))
+		  (cond
+		   ((string= "empty" type)
+		    "application/octet-stream")
+		   ((string-match "text" type)
+		    "text/plain")
+		   (t
+		    (car (split-string type))))))
+	    (concat (nth 0 type) "/" (nth 1 type)))
+	(concat (nth 0 type) "/" (nth 1 type))))))
+
 (defun elmo-file-msgdb-create-entity (msgdb folder number)
   "Create msgdb entity for the message in the FOLDER with NUMBER."
   (let* ((file (elmo-message-file-name folder number))
@@ -133,16 +194,17 @@
 					    &optional section unseen)
   (let ((file (expand-file-name (car (split-string location "/"))
 				(elmo-file-folder-file-path-internal folder)))
-	charset guess uid)
+	charset guess uid is-text)
     (when (file-exists-p file)
       (set-buffer-multibyte nil)
       (prog1
-	  (insert-file-contents-as-binary file)
+	  (insert-file-contents-as-binary file nil 0 elmo-file-fetch-max-size)
 	(unless (or (std11-field-body "To")
 		    (std11-field-body "Cc")
 		    (std11-field-body "Subject"))
-	  (setq guess (mime-find-file-type file))
-	  (when (string= (nth 0 guess) "text")
+	  (setq guess (elmo-file-detect-format file))
+	  (setq is-text (string-match "^text/" guess))
+	  (when is-text
 	    (set-buffer-multibyte t)
 	    (decode-coding-region
 	     (point-min) (point-max)
@@ -162,30 +224,32 @@
 		  (concat "<" (elmo-replace-in-string file "/" ":")
 			  "@" (system-name) ">\n"))
 	  (insert "Content-Type: "
-		  (concat (nth 0 guess) "/" (nth 1 guess))
-		  (or (and (string= (nth 0 guess) "text")
+		  guess
+		  (or (and is-text
 			   (concat
 			    "; charset=" (upcase (symbol-name charset))))
 		      "")
 		  "\nMIME-Version: 1.0\n\n")
-	  (when (string= (nth 0 guess) "text")
+	  (when is-text
 	    (encode-mime-charset-region (point-min) (point-max) charset))
 	  (set-buffer-multibyte nil))))))
 
 (luna-define-method elmo-map-folder-list-message-locations
   ((folder elmo-file-folder))
-  (mapcar
-   (lambda (file)
-     (concat
-      file "/"
-      (mapconcat
-       'number-to-string
-       (nth 5 (file-attributes (expand-file-name
-				file
-				(elmo-file-folder-file-path-internal
-				 folder))))
-       ":")))
-   (directory-files (elmo-file-folder-file-path-internal folder))))
+  (delq nil
+	(mapcar
+	 (lambda (file)
+	   (when (not (file-directory-p file))
+	     (concat
+	      file "/"
+	      (mapconcat
+	       'number-to-string
+	       (nth 5 (file-attributes (expand-file-name
+					file
+					(elmo-file-folder-file-path-internal
+					 folder))))
+	       ":"))))
+	 (directory-files (elmo-file-folder-file-path-internal folder)))))
 
 (luna-define-method elmo-folder-exists-p ((folder elmo-file-folder))
   (file-directory-p (elmo-file-folder-file-path-internal folder)))
diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el
index a9a038e..5456bcc 100644
--- a/elmo/elmo-localdir.el
+++ b/elmo/elmo-localdir.el
@@ -89,14 +89,15 @@
   (expand-file-name
    (mapconcat
     'identity
-    (mapcar
-     'elmo-replace-string-as-filename
-     (split-string
-      (let ((dir-name (elmo-localdir-folder-dir-name-internal folder)))
-	(if (file-name-absolute-p dir-name)
-	    (expand-file-name dir-name)
-	  dir-name))
-      "/"))
+    (delete ""
+	    (mapcar
+	     'elmo-replace-string-as-filename
+	     (split-string
+	      (let ((dir-name (elmo-localdir-folder-dir-name-internal folder)))
+		(if (file-name-absolute-p dir-name)
+		    (expand-file-name dir-name)
+		  dir-name))
+	      "/")))
     "/")
    (expand-file-name ;;"localdir"
     (symbol-name (elmo-folder-type-internal folder))
diff --git a/elmo/elmo.el b/elmo/elmo.el
index 80ba5fc..b933422 100644
--- a/elmo/elmo.el
+++ b/elmo/elmo.el
@@ -774,22 +774,30 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).")
 (luna-define-method elmo-message-match-condition ((folder elmo-folder)
 						  number condition
 						  numbers)
-  (let ((filename (cond
-		   ((elmo-message-file-name folder number))
-		   ((let* ((cache (elmo-file-cache-get
-				   (elmo-message-field folder number
-						       'message-id)))
-			   (cache-path (elmo-file-cache-path cache)))
-		      (when (and cache-path
-				 (not (elmo-cache-path-section-p cache-path)))
-			cache-path))))))
-    (when (and filename
-	       (file-readable-p filename))
+  (let* (cache cache-path
+	 (filename (cond
+		    ((elmo-message-file-name folder number))
+		    ((progn
+		       (setq cache (elmo-file-cache-get
+				    (elmo-message-field folder number
+							'message-id)))
+		       (setq cache-path (elmo-file-cache-path cache))
+		       (and cache-path
+			    (not (elmo-cache-path-section-p cache-path))))
+		     cache-path))))
+    (when (and filename (file-readable-p filename))
       (with-temp-buffer
-	(insert-file-contents-as-binary filename)
+	(elmo-set-buffer-multibyte nil)
+	;;(insert-file-contents-as-binary filename)
+	(elmo-message-fetch folder number
+			    (elmo-make-fetch-strategy 'entire
+						      (and cache t)
+						      nil
+						      cache-path)
+			    nil (current-buffer) t)
 	(elmo-set-buffer-multibyte default-enable-multibyte-characters)
-	;; Should consider charset?
-	(decode-mime-charset-region (point-min) (point-max) elmo-mime-charset)
+	(decode-coding-region (point-min) (point-max)
+			      elmo-mime-display-as-is-coding-system)
 	(elmo-buffer-field-condition-match condition number numbers)))))
 
 (luna-define-method elmo-folder-pack-numbers ((folder elmo-folder))
@@ -1178,6 +1186,18 @@ FIELD is a symbol of the field.")
 (luna-define-method elmo-message-field ((folder elmo-folder) number field)
   (elmo-message-entity-field (elmo-message-entity folder number) field))
 
+(luna-define-generic elmo-message-field (folder number field value)
+  "Set message field value in the msgdb.
+FOLDER is the ELMO folder structure.
+NUMBER is a number of the message.
+FIELD is a symbol of the field.
+VALUE is a value to set.")
+
+(luna-define-method elmo-message-set-field ((folder elmo-folder) number
+					    field value)
+  (elmo-message-entity-set-field (elmo-message-entity folder number)
+				 field value))
+
 (luna-define-method elmo-message-use-cache-p ((folder elmo-folder) number)
   nil) ; default is not use cache.