* lisp/mouse.el (mouse-select-region-move-to-beginning): Add :group.

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

diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index 5866edfc3d663d230e2a688ad159462c7c433e6c..192cdd87acde570cee4d13e0bdd5fbfe3ae5b0b7 100644 (file)
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -1,6 +1,6 @@
 ;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms
 
 ;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms
 

-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2016 Free Software Foundation, Inc.

 
 ;; Maintainer: Geoff Voelker <voelker@cs.washington.edu>
 ;; Keywords: internal
 
 ;; Maintainer: Geoff Voelker <voelker@cs.washington.edu>
 ;; Keywords: internal


@@ -29,15 +29,14 @@
 ;;; Code:
 
 ;; Use ";" instead of ":" as a path separator (from files.el).
 ;;; Code:
 
 ;; Use ";" instead of ":" as a path separator (from files.el).

-(setq path-separator ";")
-
-(setq minibuffer-history-case-insensitive-variables
-      (cons 'file-name-history minibuffer-history-case-insensitive-variables))
-
-;; Set the null device (for compile.el).
-(setq null-device "NUL")
-
-;; For distinguishing file types based upon suffixes.
+(when (memq system-type '(ms-dos windows-nt))
+  (setq path-separator ";")
+  (push 'file-name-history minibuffer-history-case-insensitive-variables)
+  ;; Set the null device (for compile.el).
+  (setq null-device "NUL")
+  (setq-default buffer-file-coding-system 'undecided-dos))
+
+;; For distinguishing file types based upon suffixes.  DEPRECATED, DO NOT USE!

 (defcustom file-name-buffer-file-type-alist
   '(("[:/].*config.sys$" . nil)                ; config.sys text
     ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|bin\\|ico\\|pif\\|class\\)$" . t)
 (defcustom file-name-buffer-file-type-alist
   '(("[:/].*config.sys$" . nil)                ; config.sys text
     ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|bin\\|ico\\|pif\\|class\\)$" . t)


@@ -54,38 +53,18 @@
     ("\\.tp[ulpw]$" . t)               ; borland Pascal stuff
     ("[:/]tags$" . nil)                        ; emacs TAGS file
     )
     ("\\.tp[ulpw]$" . t)               ; borland Pascal stuff
     ("[:/]tags$" . nil)                        ; emacs TAGS file
     )

-  "Alist for distinguishing text files from binary files.
+  "Alist used in the past for distinguishing text files from binary files.

 Each element has the form (REGEXP . TYPE), where REGEXP is matched
 Each element has the form (REGEXP . TYPE), where REGEXP is matched

-against the file name, and TYPE is nil for text, t for binary."
+against the file name, and TYPE is nil for text, t for binary.
+
+This variable is deprecated, not used anywhere, and will soon be deleted."

   :type '(repeat (cons regexp boolean))
   :group 'dos-fns
   :group 'w32)
 
   :type '(repeat (cons regexp boolean))
   :group 'dos-fns
   :group 'w32)
 

-;; 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)))
-
-;; 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-value 'buffer-file-type)
-      (setq code (cdr match))
-      (cond ((memq code '(nil t)) code)
-           ((and (symbolp code) (fboundp code))
-            (funcall code filename))))))
-
-(setq-default buffer-file-coding-system 'undecided-dos)
+(make-obsolete-variable 'file-name-buffer-file-type-alist
+                       'file-coding-system-alist
+                       "24.4")

 
 (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.


@@ -93,42 +72,37 @@ 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

-of `untranslated-filesystem-list' and `file-name-buffer-file-type-alist',
+of `w32-untranslated-filesystem-list' and `file-name-buffer-file-type-alist',

 and whether the file exists:
 
 and whether the file exists:
 

-  If it matches in `untranslated-filesystem-list':
+  If it matches in `w32-untranslated-filesystem-list':

     If the file exists:                                        `undecided'
     If the file does not exist:                                `undecided-unix'
     If the file exists:                                        `undecided'
     If the file does not exist:                                `undecided-unix'

-  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 dos-text):                        `undecided-dos'

   Otherwise:
     If the file exists:                                        `undecided'
     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
   Otherwise:
     If the file exists:                                        `undecided'
     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
+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.
 
 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
-`buffer-file-coding-system' is non-nil, its value is used.  If it is
-nil and `buffer-file-type' is t, the coding system is `no-conversion'.
+If operation is `write-region', the coding system is chosen based
+upon the value of `buffer-file-coding-system'.  If
+`buffer-file-coding-system' is non-nil, its value is used.

 Otherwise, it is `undecided-dos'.
 
 Otherwise, it is `undecided-dos'.
 

-The two most common situations are when DOS and Unix files are read
-and written, and their names do not match in
-`untranslated-filesystem-list' and `file-name-buffer-file-type-alist'.
-In these cases, the coding system initially will be `undecided'.  As
-the file is read in the DOS case, the coding system will be changed to
-`undecided-dos' as CR/LFs are detected.  As the file is read in the
-Unix case, the coding system will be changed to `undecided-unix' as
-LFs are detected.  In both cases, `buffer-file-coding-system' will be
-set to the appropriate coding system, and the value of
-`buffer-file-coding-system' will be used when writing the file."
+The most common situation is when DOS and Unix files are read and
+written, and their names do not match in `w32-untranslated-filesystem-list'.
+In these cases, the coding system initially will be `undecided'.
+As the file is read in the DOS case, the coding system will be
+changed to `undecided-dos' as CR/LFs are detected.  As the file
+is read in the Unix case, the coding system will be changed to
+`undecided-unix' as LFs are detected.  In both cases,
+`buffer-file-coding-system' will be 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))
 
   (let ((op (nth 0 command))

-       (binary nil) (text nil)

        (undecided nil) (undecided-unix nil)
        target target-buf)
     (cond ((eq op 'insert-file-contents)
        (undecided nil) (undecided-unix nil)
        target target-buf)
     (cond ((eq op 'insert-file-contents)


@@ -144,15 +118,8 @@ set to the appropriate coding system, and the value of
                   (and (bufferp (cdr target))
                        (buffer-name (cdr target))))
             (setq target (car target)))
                   (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))
-          (cond (binary)
-                ;; Next check for files that MUST use DOS eol conversion.
-                ((find-buffer-file-type-match target)
-                 (setq text t))
-                ;; For any other existing file, decide based on contents.
-                ((or
+          (cond ((or
+                  ;; For any existing file, decide based on contents.

                   (file-exists-p target)
                   ;; If TARGET does not exist as a file, replace its
                   ;; base name with TARGET-BUF and try again.  This
                   (file-exists-p target)
                   ;; If TARGET does not exist as a file, replace its
                   ;; base name with TARGET-BUF and try again.  This


@@ -165,11 +132,9 @@ set to the appropriate coding system, and the value of
                                           (file-name-directory target)))))
                  (setq undecided t))
                 ;; Next check for a non-DOS file system.
                                           (file-name-directory target)))))
                  (setq undecided t))
                 ;; Next check for a non-DOS file system.

-                ((untranslated-file-p target)
+                ((w32-untranslated-file-p target)

                  (setq undecided-unix t)))
                  (setq undecided-unix t)))

-          (cond (binary '(no-conversion . no-conversion))
-                (text '(undecided-dos . undecided-dos))
-                (undecided-unix '(undecided-unix . undecided-unix))
+          (cond (undecided-unix '(undecided-unix . undecided-unix))

                 (undecided '(undecided . undecided))
                 (t (cons (default-value 'buffer-file-coding-system)
                          (default-value 'buffer-file-coding-system)))))
                 (undecided '(undecided . undecided))
                 (t (cons (default-value 'buffer-file-coding-system)
                          (default-value 'buffer-file-coding-system)))))


@@ -180,25 +145,24 @@ set to the appropriate coding system, and the value of
             ;; Normally this is used only in a non-file-visiting
             ;; buffer, because normally buffer-file-coding-system is non-nil
             ;; in a file-visiting buffer.
             ;; Normally this is used only in a non-file-visiting
             ;; buffer, because normally buffer-file-coding-system is non-nil
             ;; in a file-visiting buffer.

-            (if buffer-file-type
-                '(no-conversion . no-conversion)
-              '(undecided-dos . undecided-dos)))))))
-
-(modify-coding-system-alist 'file "" 'find-buffer-file-type-coding-system)
+            '(undecided-dos . undecided-dos))))))
+(make-obsolete 'find-buffer-file-type-coding-system nil "24.4")

 
 (defun find-file-binary (filename)
   "Visit file FILENAME and treat it as binary."
 
 (defun find-file-binary (filename)
   "Visit file FILENAME and treat it as binary."

+  ;; FIXME: Why here rather than in files.el?
+  ;; FIXME: Can't we use find-file-literally for the same purposes?

   (interactive "FFind file binary: ")
   (interactive "FFind file binary: ")

-  (let ((file-name-buffer-file-type-alist '(("" . t))))
+  (let ((coding-system-for-read 'no-conversion))  ;; FIXME: undecided-unix?

     (find-file filename)))
 
 (defun find-file-text (filename)
   "Visit file FILENAME and treat it as a text file."
   (interactive "FFind file text: ")
     (find-file filename)))
 
 (defun find-file-text (filename)
   "Visit file FILENAME and treat it as a text file."
   (interactive "FFind file text: ")

-  (let ((file-name-buffer-file-type-alist '(("" . nil))))
+  (let ((coding-system-for-read 'undecided-dos))

     (find-file filename)))
 
     (find-file filename)))
 

-(defun find-file-not-found-set-buffer-file-coding-system ()
+(defun w32-find-file-not-found-set-buffer-file-coding-system ()

   (with-current-buffer (current-buffer)
     (let ((coding buffer-file-coding-system))
       ;; buffer-file-coding-system is already set by
   (with-current-buffer (current-buffer)
     (let ((coding buffer-file-coding-system))
       ;; buffer-file-coding-system is already set by


@@ -207,57 +171,60 @@ set to the appropriate coding system, and the value of
       ;; the EOL conversion, if required by the user.
       (when (and (null coding-system-for-read)
                 (or inhibit-eol-conversion
       ;; the EOL conversion, if required by the user.
       (when (and (null coding-system-for-read)
                 (or inhibit-eol-conversion

-                    (untranslated-file-p (buffer-file-name))))
+                    (w32-untranslated-file-p (buffer-file-name))))

        (setq coding (coding-system-change-eol-conversion coding 0))
        (setq buffer-file-coding-system coding))
       nil)))
 
        (setq coding (coding-system-change-eol-conversion coding 0))
        (setq buffer-file-coding-system coding))
       nil)))
 

-;;; To set the default coding system on new files.
+;; To set the default coding system on new files.

 (add-hook 'find-file-not-found-functions
 (add-hook 'find-file-not-found-functions

-         'find-file-not-found-set-buffer-file-coding-system)
+         'w32-find-file-not-found-set-buffer-file-coding-system)

 
 ;;; To accommodate filesystems that do not require CR/LF translation.
 
 ;;; To accommodate filesystems that do not require CR/LF translation.

-(defvar untranslated-filesystem-list nil
+(define-obsolete-variable-alias 'untranslated-filesystem-list
+  'w32-untranslated-filesystem-list "24.4")
+(defvar w32-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
 the directory prefix corresponding to the filesystem.")
 
   "List of filesystems that require no CR/LF translation when reading
 and writing files.  Each filesystem in the list is a string naming
 the directory prefix corresponding to the filesystem.")
 

-(defun untranslated-canonical-name (filename)
+(defun w32-untranslated-canonical-name (filename)

   "Return FILENAME in a canonicalized form for use with the functions
 dealing with untranslated filesystems."
   (if (memq system-type '(ms-dos windows-nt cygwin))
       ;; The canonical form for DOS/W32 is with A-Z downcased and all
       ;; directory separators changed to directory-sep-char.
   "Return FILENAME in a canonicalized form for use with the functions
 dealing with untranslated filesystems."
   (if (memq system-type '(ms-dos windows-nt cygwin))
       ;; The canonical form for DOS/W32 is with A-Z downcased and all
       ;; 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)))
-                   filename nil))
+      (let ((name
+             (mapconcat (lambda (char)
+                          (char-to-string (if (and (<= ?A char ?Z))
+                                              (+ (- char ?A) ?a)
+                                            char)))
+                        filename nil)))

        ;; Use expand-file-name to canonicalize directory separators, except
        ;; with bare drive letters (which would have the cwd appended).
        ;; Avoid expanding names that could trigger ange-ftp to prompt
        ;; for passwords, though.
        ;; Use expand-file-name to canonicalize directory separators, except
        ;; with bare drive letters (which would have the cwd appended).
        ;; Avoid expanding names that could trigger ange-ftp to prompt
        ;; for passwords, though.

-       (if (or (string-match "^.:$" name)
-               (string-match "^/[^/:]+:" name))
+       (if (or (string-match-p "^.:\\'" name)
+               (string-match-p "^/[^/:]+:" name))

            name
          (expand-file-name name)))
     filename))
 
            name
          (expand-file-name name)))
     filename))
 

-(defun untranslated-file-p (filename)
+(defun w32-untranslated-file-p (filename)

   "Return t if FILENAME is on a filesystem that does not require
 CR/LF translation, and nil otherwise."
   "Return t if FILENAME is on a filesystem that does not require
 CR/LF translation, and nil otherwise."

-  (let ((fs (untranslated-canonical-name filename))
-       (ufs-list untranslated-filesystem-list)
+  (let ((fs (w32-untranslated-canonical-name filename))
+       (ufs-list w32-untranslated-filesystem-list)

        (found nil))
     (while (and (not found) ufs-list)
        (found nil))
     (while (and (not found) ufs-list)

-      (if (string-match (concat "^" (car ufs-list)) fs)
+      (if (string-match-p (concat "^" (car ufs-list)) fs)

          (setq found t)
        (setq ufs-list (cdr ufs-list))))
     found))
 
          (setq found t)
        (setq ufs-list (cdr ufs-list))))
     found))
 

-(defun add-untranslated-filesystem (filesystem)
+(define-obsolete-function-alias 'add-untranslated-filesystem
+  'w32-add-untranslated-filesystem "24.4")
+(defun w32-add-untranslated-filesystem (filesystem)

   "Add FILESYSTEM to the list of filesystems that do not require
 CR/LF translation.  FILESYSTEM is a string containing the directory
 prefix corresponding to the filesystem.  For example, for a Unix
   "Add FILESYSTEM to the list of filesystems that do not require
 CR/LF translation.  FILESYSTEM is a string containing the directory
 prefix corresponding to the filesystem.  For example, for a Unix


@@ -266,25 +233,29 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
   ;; with a directory, but RET returns the current buffer's file, not
   ;; its directory.
   (interactive "DUntranslated file system: ")
   ;; with a directory, but RET returns the current buffer's file, not
   ;; its directory.
   (interactive "DUntranslated file system: ")

-  (let ((fs (untranslated-canonical-name filesystem)))
-    (if (member fs untranslated-filesystem-list)
-       untranslated-filesystem-list
-      (setq untranslated-filesystem-list
-           (cons fs untranslated-filesystem-list)))))
+  (let ((fs (w32-untranslated-canonical-name filesystem)))
+    (if (member fs w32-untranslated-filesystem-list)
+       w32-untranslated-filesystem-list
+      (push fs w32-untranslated-filesystem-list))))

 
 

-(defun remove-untranslated-filesystem (filesystem)
+
+(define-obsolete-function-alias 'remove-untranslated-filesystem
+  'w32-remove-untranslated-filesystem "24.4")
+(defun w32-remove-untranslated-filesystem (filesystem)

   "Remove FILESYSTEM from the list of filesystems that do not require
 CR/LF translation.  FILESYSTEM is a string containing the directory
 prefix corresponding to the filesystem.  For example, for a Unix
 filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
   (interactive "fUntranslated file system: ")
   "Remove FILESYSTEM from the list of filesystems that do not require
 CR/LF translation.  FILESYSTEM is a string containing the directory
 prefix corresponding to the filesystem.  For example, for a Unix
 filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
   (interactive "fUntranslated file system: ")

-  (setq untranslated-filesystem-list
-       (delete (untranslated-canonical-name filesystem)
-               untranslated-filesystem-list)))
+  (setq w32-untranslated-filesystem-list
+       (delete (w32-untranslated-canonical-name filesystem)
+               w32-untranslated-filesystem-list)))

 
 ;;; Support for printing under DOS/Windows, see lpr.el and ps-print.el.
 
 
 ;;; Support for printing under DOS/Windows, see lpr.el and ps-print.el.
 

-(defcustom direct-print-region-use-command-dot-com t
+(define-obsolete-variable-alias 'direct-print-region-use-command-dot-com
+  'w32-direct-print-region-use-command-dot-com "24.4")
+(defcustom w32-direct-print-region-use-command-dot-com t

   "If non-nil, use command.com to print on Windows 9x."
   :type 'boolean
   :group 'dos-fns
   "If non-nil, use command.com to print on Windows 9x."
   :type 'boolean
   :group 'dos-fns


@@ -292,11 +263,11 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
 
 ;; Function to actually send data to the printer port.
 ;; Supports writing directly, and using various programs.
 
 ;; Function to actually send data to the printer port.
 ;; Supports writing directly, and using various programs.

-(defun direct-print-region-helper (printer
-                                  start end
-                                  lpr-prog
-                                  _delete-text _buf _display
-                                  rest)
+(defun w32-direct-print-region-helper (printer
+                                   start end
+                                   lpr-prog
+                                   _delete-text _buf _display
+                                   rest)

   (let* (;; Ignore case when matching known external program names.
         (case-fold-search t)
         ;; Convert / to \ in printer name, for sake of external programs.
   (let* (;; Ignore case when matching known external program names.
         (case-fold-search t)
         ;; Convert / to \ in printer name, for sake of external programs.


@@ -324,19 +295,21 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
     ;; asking command.com to copy the file.
     ;; No action is needed for UNC printer names, which is just as well
     ;; because `expand-file-name' doesn't support UNC names on MS-DOS.
     ;; asking command.com to copy the file.
     ;; No action is needed for UNC printer names, which is just as well
     ;; because `expand-file-name' doesn't support UNC names on MS-DOS.

-    (if (and (stringp printer) (not (string-match "^\\\\" printer)))
+    (if (and (stringp printer) (not (string-match-p "^\\\\" printer)))

        (setq printer
              (subst-char-in-string ?/ ?\\ (expand-file-name printer safe-dir))))
     ;; Handle known programs specially where necessary.
     (unwind-protect
        (cond
         ;; nprint.exe is the standard print command on Netware
        (setq printer
              (subst-char-in-string ?/ ?\\ (expand-file-name printer safe-dir))))
     ;; Handle known programs specially where necessary.
     (unwind-protect
        (cond
         ;; nprint.exe is the standard print command on Netware

-        ((string-match "^nprint\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog))
+        ((string-match-p "\\`nprint\\(\\.exe\\)?\\'"
+                          (file-name-nondirectory lpr-prog))

          (write-region start end tempfile nil 0)
          (call-process lpr-prog nil errbuf nil
                        tempfile (concat "P=" printer)))
         ;; print.exe is a standard command on NT
          (write-region start end tempfile nil 0)
          (call-process lpr-prog nil errbuf nil
                        tempfile (concat "P=" printer)))
         ;; print.exe is a standard command on NT

-        ((string-match "^print\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog))
+        ((string-match-p "\\`print\\(\\.exe\\)?\\'"
+                          (file-name-nondirectory lpr-prog))

          ;; Be careful not to invoke print.exe on MS-DOS or Windows 9x
          ;; though, because it is a TSR program there (hangs Emacs).
          (or (and (eq system-type 'windows-nt)
          ;; Be careful not to invoke print.exe on MS-DOS or Windows 9x
          ;; though, because it is a TSR program there (hangs Emacs).
          (or (and (eq system-type 'windows-nt)


@@ -366,7 +339,7 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
         ((and (eq system-type 'windows-nt)
               (getenv "winbootdir")
               ;; Allow cop-out so command.com isn't invoked
         ((and (eq system-type 'windows-nt)
               (getenv "winbootdir")
               ;; Allow cop-out so command.com isn't invoked

-              direct-print-region-use-command-dot-com
+              w32-direct-print-region-use-command-dot-com

               ;; file-attributes fails on LPT ports on Windows 9x but
               ;; not on NT, so handle both cases for safety.
               (eq (or (nth 7 (file-attributes printer)) 0) 0))
               ;; file-attributes fails on LPT ports on Windows 9x but
               ;; not on NT, so handle both cases for safety.
               (eq (or (nth 7 (file-attributes printer)) 0) 0))


@@ -385,13 +358,15 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
 
 (declare-function default-printer-name "w32fns.c")
 
 
 (declare-function default-printer-name "w32fns.c")
 

-(defun direct-print-region-function (start end
-                                     &optional lpr-prog
-                                     delete-text buf display
-                                     &rest rest)
+(define-obsolete-function-alias 'direct-print-region-function
+  'w32-direct-print-region-function "24.4")
+(defun w32-direct-print-region-function (start end
+                                               &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
   "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'
+`printer-name' (which see), unless the value of `lpr-command'

 indicates a specific program should be invoked."
 
   ;; DOS printers need the lines to end with CR-LF pairs, so make
 indicates a specific program should be invoked."
 
   ;; DOS printers need the lines to end with CR-LF pairs, so make


@@ -405,7 +380,7 @@ indicates a specific program should be invoked."
         (write-region-annotate-functions
          (cons
           (lambda (_start end)
         (write-region-annotate-functions
          (cons
           (lambda (_start end)

-            (if (not (char-equal (char-before end) ?\C-l))
+            (if (not (char-equal (char-before end) ?\f))

                 `((,end . "\f"))))
           write-region-annotate-functions))
         (printer (or (and (boundp 'dos-printer)
                 `((,end . "\f"))))
           write-region-annotate-functions))
         (printer (or (and (boundp 'dos-printer)


@@ -416,12 +391,10 @@ indicates a specific program should be invoked."
     (or (eq coding-system-for-write 'no-conversion)
        (setq coding-system-for-write
              (aref eol-type 1)))       ; force conversion to DOS EOLs
     (or (eq coding-system-for-write 'no-conversion)
        (setq coding-system-for-write
              (aref eol-type 1)))       ; force conversion to DOS EOLs

-    (direct-print-region-helper printer start end lpr-prog
-                               delete-text buf display rest)))
+    (w32-direct-print-region-helper printer start end lpr-prog
+                                    delete-text buf display rest)))

 
 

-(defvar print-region-function)

 (defvar lpr-headers-switches)
 (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
 ;; (e.g., from GNU Textutils), or if you have an `lpr'
 
 ;; Set this to nil if you have a port of the `pr' program
 ;; (e.g., from GNU Textutils), or if you have an `lpr'


@@ -431,17 +404,20 @@ indicates a specific program should be invoked."
 ;; then requests to print page headers will be silently
 ;; ignored, and `print-buffer' and `print-region' produce
 ;; the same output as `lpr-buffer' and `lpr-region', accordingly.
 ;; then requests to print page headers will be silently
 ;; ignored, and `print-buffer' and `print-region' produce
 ;; the same output as `lpr-buffer' and `lpr-region', accordingly.

-(setq lpr-headers-switches "(page headers are not supported)")
+(when (memq system-type '(ms-dos windows-nt))
+  (setq lpr-headers-switches "(page headers are not supported)"))

 
 (defvar ps-printer-name)
 
 
 (defvar ps-printer-name)
 

-(defun direct-ps-print-region-function (start end
-                                             &optional lpr-prog
-                                             delete-text buf display
-                                             &rest rest)
+(define-obsolete-function-alias 'direct-ps-print-region-function
+  'w32-direct-ps-print-region-function "24.4")
+(defun w32-direct-ps-print-region-function (start end
+                                                  &optional lpr-prog
+                                                  delete-text buf display
+                                                  &rest rest)

   "DOS/Windows-specific function to print the region on a PostScript printer.
 Writes the region to the device or file which is a value of
   "DOS/Windows-specific function to print the region on a PostScript printer.
 Writes the region to the device or file which is a value of

-`ps-printer-name' \(which see\), unless the value of `ps-lpr-command'
+`ps-printer-name' (which see), unless the value of `ps-lpr-command'

 indicates a specific program should be invoked."
 
   (let ((printer (or (and (boundp 'dos-ps-printer)
 indicates a specific program should be invoked."
 
   (let ((printer (or (and (boundp 'dos-ps-printer)


@@ -449,11 +425,8 @@ indicates a specific program should be invoked."
                          (symbol-value 'dos-ps-printer))
                     ps-printer-name
                     (default-printer-name))))
                          (symbol-value 'dos-ps-printer))
                     ps-printer-name
                     (default-printer-name))))

-    (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)
+    (w32-direct-print-region-helper printer start end lpr-prog
+                                    delete-text buf display rest)))

 
 ;(setq ps-lpr-command "gs")
 
 
 ;(setq ps-lpr-command "gs")