X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5f47fb28f83cfa470c0a35df494c611ca2c461a1..7182a9a69285a1faf79c72e382ac2e3017bd7317:/lisp/w32-fns.el diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 018390d4b4..86703a3b9b 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -1,8 +1,9 @@ -;;; w32-fns.el --- Lisp routines for Windows NT. +;;; w32-fns.el --- Lisp routines for Windows NT -;; Copyright (C) 1994 Free Software Foundation, Inc. +;; Copyright (C) 1994, 2001, 2004 Free Software Foundation, Inc. ;; Author: Geoff Voelker +;; Keywords: internal ;; This file is part of GNU Emacs. @@ -42,7 +43,7 @@ ;; Ignore case on file-name completion (setq completion-ignore-case t) -;; Map all versions of a filename (8.3, longname, mixed case) to the +;; Map all versions of a filename (8.3, longname, mixed case) to the ;; same buffer. (setq find-file-visit-truename t) @@ -52,13 +53,9 @@ The value is a list of three integers: the major and minor version numbers, and the build number." (x-server-version)) -(defvar w32-system-shells '("cmd" "cmd.exe" "command" "command.com" - "4nt" "4nt.exe" "4dos" "4dos.exe" - "ndos" "ndos.exe") - "List of strings recognized as Windows NT/9X system shells.") - (defun w32-using-nt () - "Return non-nil if literally running on Windows NT (i.e., not Windows 9X)." + "Return non-nil if running on a 32-bit Windows system. +That includes all Windows systems except for 9X/Me." (and (eq system-type 'windows-nt) (getenv "SystemRoot"))) (defun w32-shell-name () @@ -71,19 +68,16 @@ numbers, and the build number." (defun w32-system-shell-p (shell-name) (and shell-name - (member (downcase (file-name-nondirectory shell-name)) + (member (downcase (file-name-nondirectory shell-name)) w32-system-shells))) (defun w32-shell-dos-semantics () - "Return t if the interactive shell being used expects msdos shell semantics." + "Return non-nil if the interactive shell being used expects MSDOS shell semantics." (or (w32-system-shell-p (w32-shell-name)) (and (member (downcase (file-name-nondirectory (w32-shell-name))) '("cmdproxy" "cmdproxy.exe")) (w32-system-shell-p (getenv "COMSPEC"))))) -(defvar w32-allow-system-shell nil - "*Disable startup warning when using \"system\" shells.") - (defun w32-check-shell-configuration () "Check the configuration of shell variables on Windows NT/9X. This function is invoked after loading the init files and processing @@ -97,15 +91,15 @@ has configured the shell with inappropriate settings." (erase-buffer) (if (w32-system-shell-p (getenv "ESHELL")) (insert (format "Warning! The ESHELL environment variable uses %s. -You probably want to change it so that it uses cmdproxy.exe instead.\n\n" +You probably want to change it so that it uses cmdproxy.exe instead.\n\n" (getenv "ESHELL")))) (if (w32-system-shell-p (getenv "SHELL")) (insert (format "Warning! The SHELL environment variable uses %s. -You probably want to change it so that it uses cmdproxy.exe instead.\n\n" +You probably want to change it so that it uses cmdproxy.exe instead.\n\n" (getenv "SHELL")))) (if (w32-system-shell-p shell-file-name) (insert (format "Warning! shell-file-name uses %s. -You probably want to change it so that it uses cmdproxy.exe instead.\n\n" +You probably want to change it so that it uses cmdproxy.exe instead.\n\n" shell-file-name))) (if (and (boundp 'explicit-shell-file-name) (w32-system-shell-p explicit-shell-file-name)) @@ -211,7 +205,7 @@ You should set this to t when using a non-system shell.\n\n")))) (dir1 (expand-file-name "../info/" instdir)) (dir2 (expand-file-name "../../../info/" instdir))) (if (file-exists-p dir1) - (setq Info-default-directory-list + (setq Info-default-directory-list (append Info-default-directory-list (list dir1))) (if (file-exists-p dir2) (setq Info-default-directory-list @@ -229,32 +223,25 @@ You should set this to t when using a non-system shell.\n\n")))) ;;; source-directory, set it to something that is a reasonable approximation ;;; on the user's machine. -;(add-hook 'before-init-hook +;(add-hook 'before-init-hook ; '(lambda () -; (setq source-directory (file-name-as-directory +; (setq source-directory (file-name-as-directory ; (expand-file-name ".." exec-directory))))) -;; Avoid creating auto-save file names containing invalid characters. -(fset 'original-make-auto-save-file-name - (symbol-function 'make-auto-save-file-name)) - -(defun make-auto-save-file-name () - "Return file name to use for auto-saves of current buffer. -Does not consider `auto-save-visited-file-name' as that variable is checked -before calling this function. You can redefine this for customization. -See also `auto-save-file-name-p'." - (let ((filename (original-make-auto-save-file-name))) - ;; Don't modify remote (ange-ftp) filenames - (if (string-match "^/\\w+@[-A-Za-z0-9._]+:" filename) - filename - (convert-standard-filename filename)))) - (defun convert-standard-filename (filename) "Convert a standard file's name to something suitable for the current OS. -This function's standard definition is trivial; it just returns the argument. -However, on some systems, the function is redefined -with a definition that really does change some file names." - (let ((name (copy-sequence filename)) +This means to guarantee valid names and perhaps to canonicalize +certain patterns. + +On Windows and DOS, replace invalid characters. On DOS, make +sure to obey the 8.3 limitations. On Windows, turn Cygwin names +into native names, and also turn slashes into backslashes if the +shell requires it (see `w32-shell-dos-semantics')." + (let ((name + (save-match-data + (if (string-match "\\`/cygdrive/\\([a-zA-Z]\\)/" filename) + (replace-match "\\1:/" t nil filename) + (copy-sequence filename)))) (start 0)) ;; leave ':' if part of drive specifier (if (and (> (length name) 1) @@ -283,20 +270,25 @@ with a definition that really does change some file names." (get 'x-selections type)) (defun set-w32-system-coding-system (coding-system) - "Set the coding system used by the Windows System to CODING-SYSTEM. + "Set the coding system used by the Windows system to CODING-SYSTEM. This is used for things like passing font names with non-ASCII characters in them to the system. For a list of possible values of -CODING-SYSTEM, use \\[list-coding-systems]." +CODING-SYSTEM, use \\[list-coding-systems]. + +This function is provided for backward compatibility, since +`w32-system-coding-system' is now an alias for `locale-coding-system'." (interactive - (list (let ((default w32-system-coding-system)) + (list (let ((default locale-coding-system)) (read-coding-system (format "Coding system for system calls (default, %s): " default) default)))) (check-coding-system coding-system) - (setq w32-system-coding-system coding-system)) -;; Set system coding system initially to iso-latin-1 -(set-w32-system-coding-system 'iso-latin-1) + (setq locale-coding-system coding-system)) + +;; locale-coding-system was introduced to do the same thing as +;; w32-system-coding-system. Use that instead. +(defvaralias 'w32-system-coding-system 'locale-coding-system) ;;; Set to a system sound if you want a fancy bell. (set-message-beep nil) @@ -339,22 +331,22 @@ CODING-SYSTEM, use \\[list-coding-systems]." ;; W32 uses different color indexes than standard: (defvar w32-tty-standard-colors - '(("white" 15 65535 65535 65535) - ("yellow" 14 65535 65535 0) ; Yellow - ("lightmagenta" 13 65535 0 65535) ; Magenta - ("lightred" 12 65535 0 0) ; Red - ("lightcyan" 11 0 65535 65535) ; Cyan - ("lightgreen" 10 0 65535 0) ; Green - ("lightblue" 9 0 0 65535) ; Blue - ("darkgray" 8 26112 26112 26112) ; Gray40 - ("lightgray" 7 48640 48640 48640) ; Gray - ("brown" 6 40960 20992 11520) ; Sienna - ("magenta" 5 35584 0 35584) ; DarkMagenta - ("red" 4 45568 8704 8704) ; FireBrick - ("cyan" 3 0 52736 53504) ; DarkTurquoise - ("green" 2 8704 35584 8704) ; ForestGreen + '(("black" 0 0 0 0) ("blue" 1 0 0 52480) ; MediumBlue - ("black" 0 0 0 0)) + ("green" 2 8704 35584 8704) ; ForestGreen + ("cyan" 3 0 52736 53504) ; DarkTurquoise + ("red" 4 45568 8704 8704) ; FireBrick + ("magenta" 5 35584 0 35584) ; DarkMagenta + ("brown" 6 40960 20992 11520) ; Sienna + ("lightgray" 7 48640 48640 48640) ; Gray + ("darkgray" 8 26112 26112 26112) ; Gray40 + ("lightblue" 9 0 0 65535) ; Blue + ("lightgreen" 10 0 65535 0) ; Green + ("lightcyan" 11 0 65535 65535) ; Cyan + ("lightred" 12 65535 0 0) ; Red + ("lightmagenta" 13 65535 0 65535) ; Magenta + ("yellow" 14 65535 65535 0) ; Yellow + ("white" 15 65535 65535 65535)) "A list of VGA console colors, their indices and 16-bit RGB values.") @@ -372,12 +364,13 @@ bit output with no translation." (cons xlfd-charset (cons windows-charset codepage))) ) -(w32-add-charset-info "iso8859-1" 'w32-charset-ansi 1252) +;; The last charset we add becomes the "preferred" charset for the return +;; value from w32-select-font etc, so list the most important charsets last. (w32-add-charset-info "iso8859-14" 'w32-charset-ansi 28604) (w32-add-charset-info "iso8859-15" 'w32-charset-ansi 28605) -(w32-add-charset-info "jisx0208-sjis" 'w32-charset-shiftjis 932) (w32-add-charset-info "jisx0201-latin" 'w32-charset-shiftjis 932) (w32-add-charset-info "jisx0201-katakana" 'w32-charset-shiftjis 932) +(w32-add-charset-info "jisx0208-sjis" 'w32-charset-shiftjis 932) (w32-add-charset-info "ksc5601.1987" 'w32-charset-hangeul 949) (w32-add-charset-info "big5" 'w32-charset-chinesebig5 950) (w32-add-charset-info "gb2312" 'w32-charset-gb2312 936) @@ -389,21 +382,23 @@ bit output with no translation." (w32-add-charset-info "iso8859-2" 'w32-charset-easteurope 28592) (w32-add-charset-info "iso8859-3" 'w32-charset-turkish 28593) (w32-add-charset-info "iso8859-4" 'w32-charset-baltic 28594) - (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595) (w32-add-charset-info "iso8859-6" 'w32-charset-arabic 28596) (w32-add-charset-info "iso8859-7" 'w32-charset-greek 28597) (w32-add-charset-info "iso8859-8" 'w32-charset-hebrew 1255) (w32-add-charset-info "iso8859-9" 'w32-charset-turkish 1254) (w32-add-charset-info "iso8859-13" 'w32-charset-baltic 1257) (w32-add-charset-info "koi8-r" 'w32-charset-russian 20866) + (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595) (w32-add-charset-info "tis620" 'w32-charset-thai 874) (w32-add-charset-info "ksc5601.1992" 'w32-charset-johab 1361) (w32-add-charset-info "mac" 'w32-charset-mac nil))) (if (boundp 'w32-unicode-charset-defined) (progn - (w32-add-charset-info "iso10646" 'w32-charset-unicode t) - (w32-add-charset-info "unicode" 'w32-charset-unicode t))) - + (w32-add-charset-info "unicode" 'w32-charset-unicode t) + (w32-add-charset-info "iso10646-1" 'w32-charset-unicode t)) + ;; If unicode windows charset is not defined, use ansi fonts. + (w32-add-charset-info "iso10646-1" 'w32-charset-ansi t)) +(w32-add-charset-info "iso8859-1" 'w32-charset-ansi 1252) (make-obsolete-variable 'w32-enable-italics 'w32-enable-synthesized-fonts "21.1") @@ -423,12 +418,6 @@ bit output with no translation." (defvar x-cut-buffer-max 20000 "Max number of characters to put in the cut buffer.") -(defcustom x-select-enable-clipboard t - "Non-nil means cutting and pasting uses the clipboard. -This is in addition to the primary selection." - :type 'boolean - :group 'killing) - (defun x-select-text (text &optional push) "Make TEXT the last selected text. If `x-select-enable-clipboard' is non-nil, copy the text to the system @@ -436,7 +425,7 @@ clipboard as well. Optional PUSH is ignored on Windows." (if x-select-enable-clipboard (w32-set-clipboard-data text)) (setq x-last-selected-text text)) - + (defun x-get-selection-value () "Return the value of the current selection. Consult the selection, then the cut buffer. Treat empty strings as if @@ -465,4 +454,5 @@ they were unset." (setq interprogram-paste-function 'x-get-selection-value) +;;; arch-tag: c49b48cc-0f4f-454f-a274-c2dc34815e14 ;;; w32-fns.el ends here