merge trunk

[gnu-emacs] / lisp / dos-w32.el

diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index 94ba5def7b5f731f0ad10a0d571d049933705034..424ea0a701dd7a3b373c96bf1f6e521ad776d63c 100644 (file)
--- 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,
 ;; 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 <voelker@cs.washington.edu>
 ;; Keywords: internal
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Maintainer: Geoff Voelker <voelker@cs.washington.edu>
 ;; 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
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 2, 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
 
 ;; 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
 ;; 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 <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -79,7 +77,7 @@ against the file name, and TYPE is nil for text, t for binary.")
   (let ((match (find-buffer-file-type-match filename))
        (code))
     (if (not match)
   (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))
       (setq code (cdr match))
       (cond ((memq code '(nil t)) code)
            ((and (symbolp code) (fboundp code))


@@ -89,7 +87,7 @@ against the file name, and TYPE is nil for text, t for binary.")
 
 (defun find-buffer-file-type-coding-system (command)
   "Choose a coding system for a file operation in COMMAND.
 
 (defun find-buffer-file-type-coding-system (command)
   "Choose a coding system for a file operation in COMMAND.

-COMMAND is a list that specifies the operation, and I/O primitive as its
+COMMAND is a list that specifies the operation, an I/O primitive, as its

 CAR, and the arguments that might be given to that operation as its CDR.
 If operation is `insert-file-contents', the coding system is chosen based
 upon the filename (the CAR of the arguments beyond the operation), the contents
 CAR, and the arguments that might be given to that operation as its CDR.
 If operation is `insert-file-contents', the coding system is chosen based
 upon the filename (the CAR of the arguments beyond the operation), the contents


@@ -104,7 +102,11 @@ and whether the file exists:
     If the match is nil (for dos-text):                        `undecided-dos'
   Otherwise:
     If the file exists:                                        `undecided'
     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
+into which the file's contents were already read, but not yet decoded.

 
 If operation is `write-region', the coding system is chosen based upon
 the value of `buffer-file-coding-system' and `buffer-file-type'. If
 
 If operation is `write-region', the coding system is chosen based upon
 the value of `buffer-file-coding-system' and `buffer-file-type'. If


@@ -124,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))
 `buffer-file-coding-system' will be used when writing the file."
 
   (let ((op (nth 0 command))

-       (target)

        (binary nil) (text nil)
        (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),
     (cond ((eq op 'insert-file-contents)
           (setq target (nth 1 command))
           ;; If TARGET is a cons cell, it has the form (FILENAME . BUFFER),


@@ -135,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.
           ;; 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))
           ;; First check for a file name that indicates
           ;; it is truly binary.
           (setq binary (find-buffer-file-type target))


@@ -144,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.
                 ((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)
                  (setq undecided t))
                 ;; Next check for a non-DOS file system.
                 ((untranslated-file-p target)


@@ -153,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))
                 (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
          ((eq op 'write-region)
           (if buffer-file-coding-system
               (cons buffer-file-coding-system


@@ -181,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 ()
     (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
     (let ((coding buffer-file-coding-system))
       ;; buffer-file-coding-system is already set by
       ;; find-operation-coding-system, which was called from


@@ -199,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)
 
 (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
 (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


@@ -363,6 +378,8 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
 
 (defvar printer-name)
 
 
 (defvar printer-name)
 

+(declare-function default-printer-name "w32fns.c")
+

 (defun direct-print-region-function (start end
                                           &optional lpr-prog
                                           delete-text buf display
 (defun direct-print-region-function (start end
                                           &optional lpr-prog
                                           delete-text buf display


@@ -397,6 +414,8 @@ indicates a specific program should be invoked."
     (direct-print-region-helper printer start end lpr-prog
                                delete-text buf display rest)))
 
     (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
 (setq print-region-function 'direct-print-region-function)
 
 ;; Set this to nil if you have a port of the `pr' program


@@ -428,6 +447,7 @@ indicates a specific program should be invoked."
     (direct-print-region-helper printer start end lpr-prog
                                delete-text buf display rest)))
 
     (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")
 (setq ps-print-region-function 'direct-ps-print-region-function)
 
 ;(setq ps-lpr-command "gs")


@@ -437,5 +457,5 @@ indicates a specific program should be invoked."
 
 (provide 'dos-w32)
 
 
 (provide 'dos-w32)
 

-;;; arch-tag: dcfefdd2-362f-4fbc-9141-9634f5f4d6a7
+;; arch-tag: dcfefdd2-362f-4fbc-9141-9634f5f4d6a7

 ;;; dos-w32.el ends here
 ;;; dos-w32.el ends here