(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