X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d4b7d6b4944e4b639eafbc49284e0233009b0820..ca088b04376178d1305ff9d0866c20263f4a79bf:/lisp/w32-fns.el diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 32c66a9174..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,17 +43,19 @@ ;; 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) -(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-version () + "Return the MS-Windows version numbers. +The value is a list of three integers: the major and minor version +numbers, and the build number." + (x-server-version)) (defun w32-using-nt () - "Return t 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 () @@ -65,19 +68,16 @@ (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 @@ -91,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)) @@ -205,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 @@ -223,31 +223,29 @@ 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 - '(lambda () - (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'." - (convert-standard-filename (original-make-auto-save-file-name))) +;(add-hook 'before-init-hook +; '(lambda () +; (setq source-directory (file-name-as-directory +; (expand-file-name ".." exec-directory))))) (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 (eq (aref name 1) ?:) + (if (and (> (length name) 1) + (eq (aref name 1) ?:)) (setq start 2)) ;; destructively replace invalid filename characters with ! (while (string-match "[?*:<>|\"\000-\037]" name start) @@ -255,11 +253,12 @@ with a definition that really does change some file names." (setq start (match-end 0))) ;; convert directory separators to Windows format ;; (but only if the shell in use requires it) - (if (w32-shell-dos-semantics) - (while (string-match "/" name start) - (aset name (match-beginning 0) ?\\) - (setq start (match-end 0)))) - name)) + (when (w32-shell-dos-semantics) + (setq start 0) + (while (string-match "/" name start) + (aset name (match-beginning 0) ?\\) + (setq start (match-end 0)))) + name)) ;;; Fix interface to (X-specific) mouse.el (defun x-set-selection (type data) @@ -271,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) @@ -327,76 +331,128 @@ 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.") -;; w32term.c sets this to nil, but if it has been overridden before we -;; get here, we should not try to set it again. -(if (not w32-charset-info-alist) - (progn (setq w32-charset-info-alist - '(("iso8859-1" . (w32-charset-ansi . 1252)) - ("jisx0208-sjis" . (w32-charset-shiftjis . 932)) - ("jisx0201-latin" . (w32-charset-shiftjis . 932)) - ("jisx0201-katakana" . (w32-charset-shiftjis . 932)) - ("ksc5601.1987" . (w32-charset-hangul . 949)) - ("big5" . (w32-charset-chinesebig5 . 950)) - ("gb2312" . (w32-charset-gb2312 . 936)) - ("ms-symbol" . (w32-charset-symbol . nil)) - ("ms-oem" . (w32-charset-oem . 437)) - ("ms-oemlatin" . (w32-charset-oem . 850)))) - (if (boundp 'w32-extra-charsets-defined) - (progn - (add-to-list 'w32-charset-info-alist - '("iso8859-2" . (w32-charset-easteurope . 28592))) - (add-to-list 'w32-charset-info-alist - '("iso8859-3" . (w32-charset-turkish . 28593))) - (add-to-list 'w32-charset-info-alist - '("iso8859-4" . (w32-charset-baltic . 28594))) - (add-to-list 'w32-charset-info-alist - '("iso8859-5" . (w32-charset-russian . 28595))) - (add-to-list 'w32-charset-info-alist - '("iso8859-6" . (w32-charset-arabic . 28596))) - (add-to-list 'w32-charset-info-alist - '("iso8859-7" . (w32-charset-greek . 28597))) - (add-to-list 'w32-charset-info-alist - '("iso8859-8" . (w32-charset-hebrew . 1255))) - (add-to-list 'w32-charset-info-alist - '("iso8859-9" . (w32-charset-turkish . 1254))) - (add-to-list 'w32-charset-info-alist - '("iso8859-13" . (w32-charset-baltic . 1257))) - (add-to-list 'w32-charset-info-alist - '("koi8-r" . (w32-charset-russian . 20866))) - (add-to-list 'w32-charset-info-alist - '("tis620" . (w32-charset-thai . 874))) - (add-to-list 'w32-charset-info-alist - '("ksc5601.1992" . (w32-charset-johab . 1361))) - (add-to-list 'w32-charset-info-alist - '("mac" . (w32-charset-mac . nil)))))) - (if (boundp 'w32-unicode-charset-defined) - (progn - (add-to-list 'w32-charset-info-alist - '("iso10646" . (w32-charset-unicode . t))) - (add-to-list 'w32-charset-info-alist - '("unicode" . (w32-charset-unicode . t)))))) - -(make-obsolete-variable 'w32-enable-italics 'w32-enable-synthesized-fonts) -(make-obsolete-variable 'w32-charset-to-codepage-alist - "w32-charset-to-codepage-alist has been replaced by the more extensive -w32-charset-info-alist") +(defun w32-add-charset-info (xlfd-charset windows-charset codepage) + "Function to add character sets to display with Windows fonts. +Creates entries in `w32-charset-info-alist'. +XLFD-CHARSET is a string which will appear in the XLFD font name to +identify the character set. WINDOWS-CHARSET is a symbol identifying +the Windows character set this maps to. For the list of possible +values, see the documentation for `w32-charset-info-alist'. CODEPAGE +can be a numeric codepage that Windows uses to display the character +set, t for Unicode output with no codepage translation or nil for 8 +bit output with no translation." + (add-to-list 'w32-charset-info-alist + (cons xlfd-charset (cons windows-charset codepage))) + ) + +;; 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 "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) +(w32-add-charset-info "ms-symbol" 'w32-charset-symbol nil) +(w32-add-charset-info "ms-oem" 'w32-charset-oem 437) +(w32-add-charset-info "ms-oemlatin" 'w32-charset-oem 850) +(if (boundp 'w32-extra-charsets-defined) + (progn + (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-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 "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") +(make-obsolete-variable 'w32-charset-to-codepage-alist + 'w32-charset-info-alist "21.1") + + +;;;; Selections and cut buffers + +;;; We keep track of the last text selected here, so we can check the +;;; current selection against it, and avoid passing back our own text +;;; from x-cut-buffer-or-selection-value. +(defvar x-last-selected-text nil) + +;;; It is said that overlarge strings are slow to put into the cut buffer. +;;; Note this value is overridden below. +(defvar x-cut-buffer-max 20000 + "Max number of characters to put in the cut buffer.") + +(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 +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 +they were unset." + (if x-select-enable-clipboard + (let (text) + ;; Don't die if x-get-selection signals an error. + (condition-case c + (setq text (w32-get-clipboard-data)) + (error (message "w32-get-clipboard-data:%s" c))) + (if (string= text "") (setq text nil)) + (cond + ((not text) nil) + ((eq text x-last-selected-text) nil) + ((string= text x-last-selected-text) + ;; Record the newer string, so subsequent calls can use the 'eq' test. + (setq x-last-selected-text text) + nil) + (t + (setq x-last-selected-text text)))))) + +(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value) + +;;; Arrange for the kill and yank functions to set and check the clipboard. +(setq interprogram-cut-function 'x-select-text) +(setq interprogram-paste-function 'x-get-selection-value) + + +;;; arch-tag: c49b48cc-0f4f-454f-a274-c2dc34815e14 ;;; w32-fns.el ends here