(find-buffer-file-type-coding-system)

(find-binary-process-coding-system, find-buffer-file-type-match):
New functions.

(find-buffer-file-type): Use find-buffer-file-type-match.
Add find-buffer-file-type-coding-system to file-coding-system-alist
as the default entry.
Add find-binary-process-coding-system to process-coding-system-alist
as the default entry.

1 files changed, 76 insertions, 15 deletions

diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index a617bbec74e..cb159e6fc6d 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -64,25 +64,67 @@
 Each element has the form (REGEXP . TYPE), where REGEXP is matched
 against the file name, and TYPE is nil for text, t for binary.")
 
+;; Return the pair matching filename on file-name-buffer-file-type-alist,
+;; or nil otherwise.
+(defun find-buffer-file-type-match (filename)
+  (let ((alist file-name-buffer-file-type-alist)
+	(found nil))
+    (let ((case-fold-search t))
+      (setq filename (file-name-sans-versions filename))
+      (while (and (not found) alist)
+	(if (string-match (car (car alist)) filename)
+	    (setq found (car alist)))
+	(setq alist (cdr alist)))
+      found)))
+
 (defun find-buffer-file-type (filename)
   ;; First check if file is on an untranslated filesystem, then on the alist.
   (if (untranslated-file-p filename)
       t ; for binary
-    (let ((alist file-name-buffer-file-type-alist)
-	  (found nil)
-	  (code nil))
-      (let ((case-fold-search t))
-	(setq filename (file-name-sans-versions filename))
-	(while (and (not found) alist)
-	  (if (string-match (car (car alist)) filename)
-	      (setq code (cdr (car alist))
-		    found t))
-	  (setq alist (cdr alist))))
-      (if found
-	  (cond ((memq code '(nil t)) code)
-		((and (symbolp code) (fboundp code))
-		 (funcall code filename)))
-	default-buffer-file-type))))
+    (let ((match (find-buffer-file-type-match filename))
+	  (code))
+      (if (not match)
+	  default-buffer-file-type
+	(setq code (cdr match))
+	(cond ((memq code '(nil t)) code)
+	      ((and (symbolp code) (fboundp code))
+	       (funcall code filename)))))))
+
+(defun find-buffer-file-type-coding-system (command args)
+  "Choose a coding system for a file operation.
+If COMMAND is 'insert-file-contents', the coding system is chosen based
+upon the filename, the contents of 'untranslated-filesystem-list' and
+'file-name-buffer-file-type-alist', and whether the file exists:
+
+  If it matches in 'untranslated-filesystem-list':	'no-conversion'
+  If it matches in 'file-name-buffer-file-type-alist':
+    If the match is t (for binary):			'no-conversion'
+    If the match is nil (for text):			'emacs-mule-dos'
+  Otherwise:
+    If the file exists:					'undecided'
+    If the file does not exist:				'emacs-mule-dos'
+
+If COMMAND is 'write-region', the coding system is chosen based
+upon the value of 'buffer-file-type': If t, the coding system is
+'no-conversion', otherwise it is 'emacs-mule-dos'."
+  (let ((op (nth 0 command))
+	(target)
+	(binary)
+	(undecided nil))
+    (cond ((eq op 'insert-file-contents) 
+	   (setq target (nth 1 command))
+	   (setq binary (find-buffer-file-type target))
+	   (if (not binary)
+	       (setq undecided 
+		     (and (file-exists-p target)
+			  (not (find-buffer-file-type-match target))))))
+	  ((eq op 'write-region) 
+	   (setq binary buffer-file-type)))
+    (cond (binary '(no-conversion . no-conversion))
+	  (undecided '(undecided . undecided))
+	  (t '(emacs-mule-dos . emacs-mule-dos)))))
+
+(modify-coding-system-alist 'file "" 'find-buffer-file-type-coding-system)
 
 (defun find-file-binary (filename) 
   "Visit file FILENAME and treat it as binary."
@@ -166,6 +208,25 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
 	(delete (untranslated-canonical-name filesystem)
 		untranslated-filesystem-list)))
 
+;; Process I/O decoding and encoding.
+
+(defun find-binary-process-coding-system (op args)
+  "Choose a coding system for process I/O.
+The coding system for decode is 'no-conversion' if 'binary-process-output'
+is non-nil, and 'emacs-mule-dos' otherwise.  Similarly, the coding system 
+for encode is 'no-conversion' if 'binary-process-input' is non-nil,
+and 'emacs-mule-dos' otherwise."
+  (let ((decode 'emacs-mule-dos)
+	(encode 'emacs-mule-dos))
+    (if binary-process-output
+	(setq decode 'no-conversion))
+    (if binary-process-input
+	(setq encode 'no-conversion))
+    (cons decode encode)))
+
+(modify-coding-system-alist 'process "" 'find-binary-process-coding-system)
+
+
 (provide 'dos-w32)
 
 ;;; dos-w32.el ends here