X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b35f288d478ef137a4d9e8e5a6a5f368a86b01f5..5d8e0d43b0fdc1b67f745e66c1539c5135fb2808:/lisp/dos-w32.el diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el index a292f54fc2..5dac6d2272 100644 --- a/lisp/dos-w32.el +++ b/lisp/dos-w32.el @@ -1,10 +1,10 @@ ;; 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. +;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc. ;; Maintainer: Geoff Voelker ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -72,15 +72,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 +102,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 +126,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 +137,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 +150,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 +169,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 +197,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 +214,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 @@ -218,10 +228,10 @@ dealing with untranslated filesystems." ;; directory separators changed to directory-sep-char. (let ((name nil)) (setq name (mapconcat - '(lambda (char) - (if (and (<= ?A char) (<= char ?Z)) - (char-to-string (+ (- char ?A) ?a)) - (char-to-string char))) + (lambda (char) + (if (and (<= ?A char) (<= char ?Z)) + (char-to-string (+ (- char ?A) ?a)) + (char-to-string char))) filename nil)) ;; Use expand-file-name to canonicalize directory separators, except ;; with bare drive letters (which would have the cwd appended). @@ -280,7 +290,7 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." (defun direct-print-region-helper (printer start end lpr-prog - delete-text buf display + _delete-text _buf _display rest) (let* (;; Ignore case when matching known external program names. (case-fold-search t) @@ -371,9 +381,9 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." (declare-function default-printer-name "w32fns.c") (defun direct-print-region-function (start end - &optional lpr-prog - delete-text buf display - &rest rest) + &optional lpr-prog + delete-text buf display + &rest rest) "DOS/Windows-specific function to print the region on a printer. Writes the region to the device or file which is a value of `printer-name' \(which see\), unless the value of `lpr-command' @@ -389,7 +399,7 @@ indicates a specific program should be invoked." ;; paper if the file ends with a form-feed already. (write-region-annotate-functions (cons - (lambda (start end) + (lambda (_start end) (if (not (char-equal (char-before end) ?\C-l)) `((,end . "\f")))) write-region-annotate-functions)) @@ -447,5 +457,4 @@ indicates a specific program should be invoked." (provide 'dos-w32) -;; arch-tag: dcfefdd2-362f-4fbc-9141-9634f5f4d6a7 ;;; dos-w32.el ends here