X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e468b87f91f26e66a8cde087c1a9c89c67b96d12..38cc06d9c47e11c8cddfa39c3e09c18bc33071f3:/lisp/dos-w32.el diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el index 0de7f09650..424ea0a701 100644 --- a/lisp/dos-w32.el +++ b/lisp/dos-w32.el @@ -1,17 +1,17 @@ ;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms ;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007 Free Software Foundation, Inc. +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: Geoff Voelker ;; Keywords: internal ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -74,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)) @@ -107,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 @@ -131,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), @@ -142,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)) @@ -151,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) @@ -160,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 @@ -188,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 @@ -206,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 @@ -370,6 +378,8 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." (defvar printer-name) +(declare-function default-printer-name "w32fns.c") + (defun direct-print-region-function (start end &optional lpr-prog delete-text buf display @@ -404,6 +414,8 @@ indicates a specific program should be invoked." (direct-print-region-helper printer start end lpr-prog delete-text buf display rest))) +(defvar print-region-function) +(defvar lpr-headers-switches) (setq print-region-function 'direct-print-region-function) ;; Set this to nil if you have a port of the `pr' program @@ -435,6 +447,7 @@ indicates a specific program should be invoked." (direct-print-region-helper printer start end lpr-prog delete-text buf display rest))) +(defvar ps-print-region-function) (setq ps-print-region-function 'direct-ps-print-region-function) ;(setq ps-lpr-command "gs") @@ -444,5 +457,5 @@ indicates a specific program should be invoked." (provide 'dos-w32) -;;; arch-tag: dcfefdd2-362f-4fbc-9141-9634f5f4d6a7 +;; arch-tag: dcfefdd2-362f-4fbc-9141-9634f5f4d6a7 ;;; dos-w32.el ends here