X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/022b8155041236e19a745482591ab968250c86cf..ae95a95a9c144a8ceefb9b2c9c09497705209ab1:/lisp/w32-fns.el diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 0f30dd63be..52bd0f97a8 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 Free Software Foundation, Inc. ;; Author: Geoff Voelker +;; Keywords: internal ;; This file is part of GNU Emacs. @@ -46,6 +47,12 @@ ;; same buffer. (setq find-file-visit-truename t) +(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)) + (defvar w32-system-shells '("cmd" "cmd.exe" "command" "command.com" "4nt" "4nt.exe" "4dos" "4dos.exe" "ndos" "ndos.exe") @@ -251,7 +258,8 @@ with a definition that really does change some file names." (let ((name (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) @@ -259,11 +267,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) @@ -349,58 +358,112 @@ CODING-SYSTEM, use \\[list-coding-systems]." ("black" 0 0 0 0)) "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) + +(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))) + ) + +(w32-add-charset-info "iso8859-1" 'w32-charset-ansi 1252) +(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 "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-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 "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))) + + +(make-obsolete-variable 'w32-enable-italics + 'w32-enable-synthesized-fonts "21.1") (make-obsolete-variable 'w32-charset-to-codepage-alist - "w32-charset-to-codepage-alist has been replaced by the more extensive -w32-charset-info-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.") + +(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 +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) + ;;; w32-fns.el ends here