X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ecae6af979abcbb5b45c33ee05ceb297678ec9a0..0d4afaf7ffb6d1881c9acf9ef03f386cc87254e6:/lisp/dos-w32.el diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el index a292f54fc2..0962ae5f13 100644 --- a/lisp/dos-w32.el +++ b/lisp/dos-w32.el @@ -1,10 +1,11 @@ ;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms ;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: Geoff Voelker ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -72,15 +73,12 @@ against the file name, and TYPE is nil for text, t for binary.") (setq alist (cdr alist))) found))) -;; Silence compiler. Defined in src/buffer.c on DOS_NT. -(defvar default-buffer-file-type) - ;; Don't check for untranslated file systems here. (defun find-buffer-file-type (filename) (let ((match (find-buffer-file-type-match filename)) (code)) (if (not match) - default-buffer-file-type + (default-value 'buffer-file-type) (setq code (cdr match)) (cond ((memq code '(nil t)) code) ((and (symbolp code) (fboundp code)) @@ -105,7 +103,7 @@ and whether the file exists: If the match is nil (for dos-text): `undecided-dos' Otherwise: If the file exists: `undecided' - If the file does not exist: default-buffer-file-coding-system + If the file does not exist default value of `buffer-file-coding-system' Note that the CAR of arguments to `insert-file-contents' operation could be a cons cell of the form \(FILENAME . BUFFER\), where BUFFER is a buffer @@ -129,9 +127,9 @@ set to the appropriate coding system, and the value of `buffer-file-coding-system' will be used when writing the file." (let ((op (nth 0 command)) - (target) (binary nil) (text nil) - (undecided nil) (undecided-unix nil)) + (undecided nil) (undecided-unix nil) + target target-buf) (cond ((eq op 'insert-file-contents) (setq target (nth 1 command)) ;; If TARGET is a cons cell, it has the form (FILENAME . BUFFER), @@ -140,7 +138,11 @@ set to the appropriate coding system, and the value of ;; arguments is used, e.g., in arc-mode.el.) This function ;; doesn't care about the contents, it only looks at the file's ;; name, which is the CAR of the cons cell. - (if (consp target) (setq target (car target))) + (when (consp target) + (setq target-buf + (and (bufferp (cdr target)) + (buffer-name (cdr target)))) + (setq target (car target))) ;; First check for a file name that indicates ;; it is truly binary. (setq binary (find-buffer-file-type target)) @@ -149,7 +151,17 @@ set to the appropriate coding system, and the value of ((find-buffer-file-type-match target) (setq text t)) ;; For any other existing file, decide based on contents. - ((file-exists-p target) + ((or + (file-exists-p target) + ;; If TARGET does not exist as a file, replace its + ;; base name with TARGET-BUF and try again. This + ;; is for jka-compr's sake, which strips the + ;; compression (.gz etc.) extension from the + ;; FILENAME, but leaves it in the BUFFER's name. + (and (stringp target-buf) + (file-exists-p + (expand-file-name target-buf + (file-name-directory target))))) (setq undecided t)) ;; Next check for a non-DOS file system. ((untranslated-file-p target) @@ -158,8 +170,8 @@ set to the appropriate coding system, and the value of (text '(undecided-dos . undecided-dos)) (undecided-unix '(undecided-unix . undecided-unix)) (undecided '(undecided . undecided)) - (t (cons default-buffer-file-coding-system - default-buffer-file-coding-system)))) + (t (cons (default-value 'buffer-file-coding-system) + (default-value 'buffer-file-coding-system))))) ((eq op 'write-region) (if buffer-file-coding-system (cons buffer-file-coding-system @@ -186,8 +198,7 @@ set to the appropriate coding system, and the value of (find-file filename))) (defun find-file-not-found-set-buffer-file-coding-system () - (save-excursion - (set-buffer (current-buffer)) + (with-current-buffer (current-buffer) (let ((coding buffer-file-coding-system)) ;; buffer-file-coding-system is already set by ;; find-operation-coding-system, which was called from @@ -204,7 +215,7 @@ set to the appropriate coding system, and the value of (add-hook 'find-file-not-found-functions 'find-file-not-found-set-buffer-file-coding-system) -;;; To accomodate filesystems that do not require CR/LF translation. +;;; To accommodate filesystems that do not require CR/LF translation. (defvar untranslated-filesystem-list nil "List of filesystems that require no CR/LF translation when reading and writing files. Each filesystem in the list is a string naming