X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d76bf86f438d4f5f9fe493ab76f02ffc78f3ae2e..455700d69a1a6861dc8c9b2ba19733429727d3c3:/lisp/dos-w32.el diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el index d6788ffe02..192cdd87ac 100644 --- 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 -;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2001-2016 Free Software Foundation, Inc. ;; Maintainer: Geoff Voelker ;; Keywords: internal @@ -29,13 +29,12 @@ ;;; 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") +(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 @@ -67,18 +66,16 @@ This variable is deprecated, not used anywhere, and will soon be deleted." 'file-coding-system-alist "24.4") -(setq-default buffer-file-coding-system 'undecided-dos) - (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, 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 -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: - 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' Otherwise: @@ -86,7 +83,7 @@ and whether the file exists: 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. If operation is `write-region', the coding system is chosen based @@ -95,7 +92,7 @@ upon the value of `buffer-file-coding-system'. If Otherwise, it is `undecided-dos'. The most common situation is when DOS and Unix files are read and -written, and their names do not match in `untranslated-filesystem-list'. +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 @@ -135,7 +132,7 @@ when writing the file." (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))) (cond (undecided-unix '(undecided-unix . undecided-unix)) (undecided '(undecided . undecided)) @@ -149,11 +146,14 @@ when writing the file." ;; buffer, because normally buffer-file-coding-system is non-nil ;; in a file-visiting buffer. '(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." + ;; FIXME: Why here rather than in files.el? + ;; FIXME: Can't we use find-file-literally for the same purposes? (interactive "FFind file binary: ") - (let ((coding-system-for-read 'no-conversion)) + (let ((coding-system-for-read 'no-conversion)) ;; FIXME: undecided-unix? (find-file filename))) (defun find-file-text (filename) @@ -162,7 +162,7 @@ when writing the file." (let ((coding-system-for-read 'undecided-dos)) (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 @@ -171,57 +171,60 @@ when writing the file." ;; 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))) -;;; 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 - '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. -(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.") -(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. - (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. - (if (or (string-match "^.:$" name) - (string-match "^/[^/:]+:" name)) + (if (or (string-match-p "^.:\\'" name) + (string-match-p "^/[^/:]+:" name)) 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." - (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) - (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)) -(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 @@ -230,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: ") - (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: ") - (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. -(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 @@ -256,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. -(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. @@ -288,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. - (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 - ((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 - ((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) @@ -330,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 - 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)) @@ -349,13 +358,15 @@ 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) +(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 -`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 @@ -369,7 +380,7 @@ indicates a specific program should be invoked." (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) @@ -380,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 - (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) -(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' @@ -395,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. -(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) -(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 -`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) @@ -413,11 +425,8 @@ indicates a specific program should be invoked." (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")