Add arch taglines
[bpt/emacs.git] / lisp / w32-fns.el
CommitLineData
e8af40ee 1;;; w32-fns.el --- Lisp routines for Windows NT
b578f267 2
284b3043 3;; Copyright (C) 1994, 2001 Free Software Foundation, Inc.
95ed0025 4
68429d86 5;; Author: Geoff Voelker <voelker@cs.washington.edu>
284b3043 6;; Keywords: internal
95ed0025
RS
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
b578f267
EN
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA.
95ed0025
RS
24
25;;; Commentary:
26
27;; (August 12, 1993)
81b38822 28;; Created.
95ed0025 29
81b38822
KH
30;; (November 21, 1994)
31;; [C-M-backspace] defined.
32;; mode-line-format defined to show buffer file type.
33;; audio bell initialized.
95ed0025
RS
34
35;;; Code:
36
37;; Map delete and backspace
38(define-key function-key-map [backspace] "\177")
39(define-key function-key-map [delete] "\C-d")
40(define-key function-key-map [M-backspace] [?\M-\177])
81b38822
KH
41(define-key function-key-map [C-M-backspace] [\C-\M-delete])
42
95ed0025
RS
43;; Ignore case on file-name completion
44(setq completion-ignore-case t)
45
bcaf1c36 46;; Map all versions of a filename (8.3, longname, mixed case) to the
d234707d
GV
47;; same buffer.
48(setq find-file-visit-truename t)
49
161ab819
AI
50(defun w32-version ()
51 "Return the MS-Windows version numbers.
52The value is a list of three integers: the major and minor version
53numbers, and the build number."
54 (x-server-version))
55
ee82af56 56(defun w32-using-nt ()
9be978ba 57 "Return non-nil if literally running on Windows NT (i.e., not Windows 9X)."
ee82af56
GV
58 (and (eq system-type 'windows-nt) (getenv "SystemRoot")))
59
60(defun w32-shell-name ()
d234707d 61 "Return the name of the shell being used."
ee82af56
GV
62 (or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name)
63 (getenv "ESHELL")
64 (getenv "SHELL")
65 (and (w32-using-nt) "cmd.exe")
66 "command.com"))
67
d234707d
GV
68(defun w32-system-shell-p (shell-name)
69 (and shell-name
bcaf1c36 70 (member (downcase (file-name-nondirectory shell-name))
d234707d 71 w32-system-shells)))
ee82af56 72
f3e62da2
GV
73(defun w32-shell-dos-semantics ()
74 "Return t if the interactive shell being used expects msdos shell semantics."
75 (or (w32-system-shell-p (w32-shell-name))
76 (and (member (downcase (file-name-nondirectory (w32-shell-name)))
77 '("cmdproxy" "cmdproxy.exe"))
78 (w32-system-shell-p (getenv "COMSPEC")))))
79
d234707d
GV
80(defun w32-check-shell-configuration ()
81 "Check the configuration of shell variables on Windows NT/9X.
ee82af56 82This function is invoked after loading the init files and processing
d234707d
GV
83the command line arguments. It issues a warning if the user or site
84has configured the shell with inappropriate settings."
85f568ec 85 (interactive)
d234707d
GV
86 (let ((prev-buffer (current-buffer))
87 (buffer (get-buffer-create "*Shell Configuration*"))
88 (system-shell))
89 (set-buffer buffer)
90 (erase-buffer)
91 (if (w32-system-shell-p (getenv "ESHELL"))
92 (insert (format "Warning! The ESHELL environment variable uses %s.
bcaf1c36 93You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
d234707d
GV
94 (getenv "ESHELL"))))
95 (if (w32-system-shell-p (getenv "SHELL"))
96 (insert (format "Warning! The SHELL environment variable uses %s.
bcaf1c36 97You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
d234707d
GV
98 (getenv "SHELL"))))
99 (if (w32-system-shell-p shell-file-name)
100 (insert (format "Warning! shell-file-name uses %s.
bcaf1c36 101You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
d234707d
GV
102 shell-file-name)))
103 (if (and (boundp 'explicit-shell-file-name)
104 (w32-system-shell-p explicit-shell-file-name))
105 (insert (format "Warning! explicit-shell-file-name uses %s.
106You probably want to change it so that it uses cmdproxy.exe instead.\n\n"
107 explicit-shell-file-name)))
108 (setq system-shell (> (buffer-size) 0))
85f568ec
GV
109
110 ;; Allow user to specify that they really do want to use one of the
111 ;; "system" shells, despite the drawbacks, but still warn if
112 ;; shell-command-switch doesn't match.
113 (if w32-allow-system-shell
114 (erase-buffer))
115
d234707d
GV
116 (cond (system-shell
117 ;; System shells.
118 (if (string-equal "-c" shell-command-switch)
119 (insert "Warning! shell-command-switch is \"-c\".
120You should set this to \"/c\" when using a system shell.\n\n"))
121 (if w32-quote-process-args
122 (insert "Warning! w32-quote-process-args is t.
123You should set this to nil when using a system shell.\n\n")))
124 ;; Non-system shells.
125 (t
126 (if (string-equal "/c" shell-command-switch)
127 (insert "Warning! shell-command-switch is \"/c\".
128You should set this to \"-c\" when using a non-system shell.\n\n"))
129 (if (not w32-quote-process-args)
130 (insert "Warning! w32-quote-process-args is nil.
131You should set this to t when using a non-system shell.\n\n"))))
132 (if (> (buffer-size) 0)
133 (display-buffer buffer)
134 (kill-buffer buffer))
135 (set-buffer prev-buffer)))
136
137(add-hook 'after-init-hook 'w32-check-shell-configuration)
138
b1ed8648
AI
139;;; Override setting chosen at startup.
140(defun set-default-process-coding-system ()
141 ;; Most programs on Windows will accept Unix line endings on input
142 ;; (and some programs ported from Unix require it) but most will
143 ;; produce DOS line endings on output.
144 (setq default-process-coding-system
145 (if default-enable-multibyte-characters
146 '(undecided-dos . undecided-unix)
147 '(raw-text-dos . raw-text-unix)))
148 (or (w32-using-nt)
149 ;; On Windows 9x, make cmdproxy default to using DOS line endings
150 ;; for input, because command.com requires this.
151 (setq process-coding-system-alist
152 `(("[cC][mM][dD][pP][rR][oO][xX][yY]"
153 . ,(if default-enable-multibyte-characters
154 '(undecided-dos . undecided-dos)
155 '(raw-text-dos . raw-text-dos)))))))
156
157(add-hook 'before-init-hook 'set-default-process-coding-system)
158
85f568ec
GV
159
160;;; Basic support functions for managing Emacs' locale setting
161
162(defvar w32-valid-locales nil
163 "List of locale ids known to be supported.")
164
165;;; This is the brute-force version; an efficient version is now
166;;; built-in though.
167(if (not (fboundp 'w32-get-valid-locale-ids))
168 (defun w32-get-valid-locale-ids ()
169 "Return list of all valid Windows locale ids."
170 (let ((i 65535)
171 locales)
172 (while (> i 0)
173 (if (w32-get-locale-info i)
174 (setq locales (cons i locales)))
175 (setq i (1- i)))
176 locales)))
177
178(defun w32-list-locales ()
179 "List the name and id of all locales supported by Windows."
180 (interactive)
181 (if (null w32-valid-locales)
182 (setq w32-valid-locales (w32-get-valid-locale-ids)))
183 (switch-to-buffer-other-window (get-buffer-create "*Supported Locales*"))
184 (erase-buffer)
185 (insert "LCID\tAbbrev\tFull name\n\n")
186 (insert (mapconcat
187 '(lambda (x)
188 (format "%d\t%s\t%s"
189 x
190 (w32-get-locale-info x)
191 (w32-get-locale-info x t)))
192 w32-valid-locales "\n"))
193 (insert "\n")
194 (goto-char (point-min)))
195
196
d234707d
GV
197;;; Setup Info-default-directory-list to include the info directory
198;;; near where Emacs executable was installed. We used to set INFOPATH,
199;;; but when this is set Info-default-directory-list is ignored. We
200;;; also cannot rely upon what is set in paths.el because they assume
201;;; that configuration during build time is correct for runtime.
202(defun w32-init-info ()
203 (let* ((instdir (file-name-directory invocation-directory))
85f568ec 204 (dir1 (expand-file-name "../info/" instdir))
d234707d
GV
205 (dir2 (expand-file-name "../../../info/" instdir)))
206 (if (file-exists-p dir1)
bcaf1c36 207 (setq Info-default-directory-list
d234707d
GV
208 (append Info-default-directory-list (list dir1)))
209 (if (file-exists-p dir2)
210 (setq Info-default-directory-list
211 (append Info-default-directory-list (list dir2)))))))
212
213(add-hook 'before-init-hook 'w32-init-info)
3eab6a03 214
8929f478
GV
215;;; The variable source-directory is used to initialize Info-directory-list.
216;;; However, the common case is that Emacs is being used from a binary
217;;; distribution, and the value of source-directory is meaningless in that
218;;; case. Even worse, source-directory can refer to a directory on a drive
219;;; on the build machine that happens to be a removable drive on the user's
220;;; machine. When this happens, Emacs tries to access the removable drive
221;;; and produces the abort/retry/ignore dialog. Since we do not use
222;;; source-directory, set it to something that is a reasonable approximation
223;;; on the user's machine.
224
bcaf1c36 225;(add-hook 'before-init-hook
1198514b 226; '(lambda ()
bcaf1c36 227; (setq source-directory (file-name-as-directory
1198514b 228; (expand-file-name ".." exec-directory)))))
8929f478 229
d234707d
GV
230(defun convert-standard-filename (filename)
231 "Convert a standard file's name to something suitable for the current OS.
232This function's standard definition is trivial; it just returns the argument.
233However, on some systems, the function is redefined
234with a definition that really does change some file names."
bcaf1c36
SS
235 (let ((name
236 (save-match-data
237 (if (string-match "\\`/cygdrive/\\([a-zA-Z]\\)/" filename)
238 (replace-match "\\1:/" t nil filename)
239 (copy-sequence filename))))
4e0cd0df 240 (start 0))
d234707d 241 ;; leave ':' if part of drive specifier
82d5a7b2
AI
242 (if (and (> (length name) 1)
243 (eq (aref name 1) ?:))
d234707d
GV
244 (setq start 2))
245 ;; destructively replace invalid filename characters with !
246 (while (string-match "[?*:<>|\"\000-\037]" name start)
247 (aset name (match-beginning 0) ?!)
248 (setq start (match-end 0)))
dd89ee95 249 ;; convert directory separators to Windows format
105adfb5 250 ;; (but only if the shell in use requires it)
5f47fb28
EZ
251 (when (w32-shell-dos-semantics)
252 (setq start 0)
253 (while (string-match "/" name start)
254 (aset name (match-beginning 0) ?\\)
255 (setq start (match-end 0))))
256 name))
4e0cd0df 257
95ed0025 258;;; Fix interface to (X-specific) mouse.el
bffcf874
RS
259(defun x-set-selection (type data)
260 (or type (setq type 'PRIMARY))
261 (put 'x-selections type data))
262
263(defun x-get-selection (&optional type data-type)
264 (or type (setq type 'PRIMARY))
265 (get 'x-selections type))
266
1b42a753
GV
267(defun set-w32-system-coding-system (coding-system)
268 "Set the coding system used by the Windows System to CODING-SYSTEM.
269This is used for things like passing font names with non-ASCII
270characters in them to the system. For a list of possible values of
086ceb30
JR
271CODING-SYSTEM, use \\[list-coding-systems].
272
273This function is provided for backward compatibility, since
274w32-system-coding-system is now an alias for `locale-coding-system'."
1b42a753 275 (interactive
086ceb30 276 (list (let ((default locale-coding-system))
1b42a753
GV
277 (read-coding-system
278 (format "Coding system for system calls (default, %s): "
279 default)
280 default))))
281 (check-coding-system coding-system)
086ceb30
JR
282 (setq locale-coding-system coding-system))
283
284;; locale-coding-system was introduced to do the same thing as
285;; w32-system-coding-system. Use that instead.
286(defvaralias 'w32-system-coding-system 'locale-coding-system)
1b42a753 287
81b38822
KH
288;;; Set to a system sound if you want a fancy bell.
289(set-message-beep nil)
290
d234707d
GV
291;;; The "Windows" keys on newer keyboards bring up the Start menu
292;;; whether you want it or not - make Emacs ignore these keystrokes
293;;; rather than beep.
294(global-set-key [lwindow] 'ignore)
295(global-set-key [rwindow] 'ignore)
296
297;; Map certain keypad keys into ASCII characters
298;; that people usually expect.
299(define-key function-key-map [tab] [?\t])
300(define-key function-key-map [linefeed] [?\n])
301(define-key function-key-map [clear] [11])
302(define-key function-key-map [return] [13])
303(define-key function-key-map [escape] [?\e])
304(define-key function-key-map [M-tab] [?\M-\t])
305(define-key function-key-map [M-linefeed] [?\M-\n])
306(define-key function-key-map [M-clear] [?\M-\013])
307(define-key function-key-map [M-return] [?\M-\015])
308(define-key function-key-map [M-escape] [?\M-\e])
309
310;; These don't do the right thing (voelker)
311;(define-key function-key-map [backspace] [127])
312;(define-key function-key-map [delete] [127])
313;(define-key function-key-map [M-backspace] [?\M-\d])
314;(define-key function-key-map [M-delete] [?\M-\d])
315
316;; These tell read-char how to convert
317;; these special chars to ASCII.
318(put 'tab 'ascii-character ?\t)
319(put 'linefeed 'ascii-character ?\n)
320(put 'clear 'ascii-character 12)
321(put 'return 'ascii-character 13)
322(put 'escape 'ascii-character ?\e)
323(put 'backspace 'ascii-character 127)
324(put 'delete 'ascii-character 127)
325
5e568214
JR
326;; W32 uses different color indexes than standard:
327
328(defvar w32-tty-standard-colors
f5e4bd09 329 '(("black" 0 0 0 0)
5e568214 330 ("blue" 1 0 0 52480) ; MediumBlue
f5e4bd09
EZ
331 ("green" 2 8704 35584 8704) ; ForestGreen
332 ("cyan" 3 0 52736 53504) ; DarkTurquoise
333 ("red" 4 45568 8704 8704) ; FireBrick
334 ("magenta" 5 35584 0 35584) ; DarkMagenta
335 ("brown" 6 40960 20992 11520) ; Sienna
336 ("lightgray" 7 48640 48640 48640) ; Gray
337 ("darkgray" 8 26112 26112 26112) ; Gray40
338 ("lightblue" 9 0 0 65535) ; Blue
339 ("lightgreen" 10 0 65535 0) ; Green
340 ("lightcyan" 11 0 65535 65535) ; Cyan
341 ("lightred" 12 65535 0 0) ; Red
342 ("lightmagenta" 13 65535 0 65535) ; Magenta
343 ("yellow" 14 65535 65535 0) ; Yellow
344 ("white" 15 65535 65535 65535))
5e568214
JR
345"A list of VGA console colors, their indices and 16-bit RGB values.")
346
15fa6efb
JR
347
348(defun w32-add-charset-info (xlfd-charset windows-charset codepage)
349 "Function to add character sets to display with Windows fonts.
350Creates entries in `w32-charset-info-alist'.
351XLFD-CHARSET is a string which will appear in the XLFD font name to
352identify the character set. WINDOWS-CHARSET is a symbol identifying
353the Windows character set this maps to. For the list of possible
354values, see the documentation for `w32-charset-info-alist'. CODEPAGE
355can be a numeric codepage that Windows uses to display the character
356set, t for Unicode output with no codepage translation or nil for 8
357bit output with no translation."
358 (add-to-list 'w32-charset-info-alist
359 (cons xlfd-charset (cons windows-charset codepage)))
360 )
361
4c7ec703
JR
362;; The last charset we add becomes the "preferred" charset for the return
363;; value from w32-select-font etc, so list the most important charsets last.
15fa6efb
JR
364(w32-add-charset-info "iso8859-14" 'w32-charset-ansi 28604)
365(w32-add-charset-info "iso8859-15" 'w32-charset-ansi 28605)
15fa6efb
JR
366(w32-add-charset-info "jisx0201-latin" 'w32-charset-shiftjis 932)
367(w32-add-charset-info "jisx0201-katakana" 'w32-charset-shiftjis 932)
4c7ec703 368(w32-add-charset-info "jisx0208-sjis" 'w32-charset-shiftjis 932)
15fa6efb
JR
369(w32-add-charset-info "ksc5601.1987" 'w32-charset-hangeul 949)
370(w32-add-charset-info "big5" 'w32-charset-chinesebig5 950)
371(w32-add-charset-info "gb2312" 'w32-charset-gb2312 936)
372(w32-add-charset-info "ms-symbol" 'w32-charset-symbol nil)
373(w32-add-charset-info "ms-oem" 'w32-charset-oem 437)
374(w32-add-charset-info "ms-oemlatin" 'w32-charset-oem 850)
375(if (boundp 'w32-extra-charsets-defined)
376 (progn
377 (w32-add-charset-info "iso8859-2" 'w32-charset-easteurope 28592)
378 (w32-add-charset-info "iso8859-3" 'w32-charset-turkish 28593)
379 (w32-add-charset-info "iso8859-4" 'w32-charset-baltic 28594)
15fa6efb
JR
380 (w32-add-charset-info "iso8859-6" 'w32-charset-arabic 28596)
381 (w32-add-charset-info "iso8859-7" 'w32-charset-greek 28597)
382 (w32-add-charset-info "iso8859-8" 'w32-charset-hebrew 1255)
383 (w32-add-charset-info "iso8859-9" 'w32-charset-turkish 1254)
384 (w32-add-charset-info "iso8859-13" 'w32-charset-baltic 1257)
385 (w32-add-charset-info "koi8-r" 'w32-charset-russian 20866)
4c7ec703 386 (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595)
15fa6efb
JR
387 (w32-add-charset-info "tis620" 'w32-charset-thai 874)
388 (w32-add-charset-info "ksc5601.1992" 'w32-charset-johab 1361)
389 (w32-add-charset-info "mac" 'w32-charset-mac nil)))
390(if (boundp 'w32-unicode-charset-defined)
391 (progn
4c7ec703
JR
392 (w32-add-charset-info "unicode" 'w32-charset-unicode t)
393 (w32-add-charset-info "iso10646-1" 'w32-charset-unicode t))
ac169f7b
JR
394 ;; If unicode windows charset is not defined, use ansi fonts.
395 (w32-add-charset-info "iso10646-1" 'w32-charset-ansi t))
4c7ec703 396(w32-add-charset-info "iso8859-1" 'w32-charset-ansi 1252)
52f32671 397
47092217
JR
398(make-obsolete-variable 'w32-enable-italics
399 'w32-enable-synthesized-fonts "21.1")
d4b7d6b4 400(make-obsolete-variable 'w32-charset-to-codepage-alist
47092217 401 'w32-charset-info-alist "21.1")
d4b7d6b4 402
3b4cf5db
AI
403\f
404;;;; Selections and cut buffers
405
406;;; We keep track of the last text selected here, so we can check the
407;;; current selection against it, and avoid passing back our own text
408;;; from x-cut-buffer-or-selection-value.
409(defvar x-last-selected-text nil)
410
411;;; It is said that overlarge strings are slow to put into the cut buffer.
412;;; Note this value is overridden below.
413(defvar x-cut-buffer-max 20000
414 "Max number of characters to put in the cut buffer.")
415
3b4cf5db
AI
416(defun x-select-text (text &optional push)
417 "Make TEXT the last selected text.
418If `x-select-enable-clipboard' is non-nil, copy the text to the system
419clipboard as well. Optional PUSH is ignored on Windows."
420 (if x-select-enable-clipboard
421 (w32-set-clipboard-data text))
422 (setq x-last-selected-text text))
bcaf1c36 423
3b4cf5db
AI
424(defun x-get-selection-value ()
425 "Return the value of the current selection.
426Consult the selection, then the cut buffer. Treat empty strings as if
427they were unset."
428 (if x-select-enable-clipboard
429 (let (text)
430 ;; Don't die if x-get-selection signals an error.
431 (condition-case c
432 (setq text (w32-get-clipboard-data))
433 (error (message "w32-get-clipboard-data:%s" c)))
434 (if (string= text "") (setq text nil))
435 (cond
436 ((not text) nil)
437 ((eq text x-last-selected-text) nil)
438 ((string= text x-last-selected-text)
439 ;; Record the newer string, so subsequent calls can use the 'eq' test.
440 (setq x-last-selected-text text)
441 nil)
442 (t
443 (setq x-last-selected-text text))))))
444\f
445(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value)
446
447;;; Arrange for the kill and yank functions to set and check the clipboard.
448(setq interprogram-cut-function 'x-select-text)
449(setq interprogram-paste-function 'x-get-selection-value)
450
451
ab5796a9 452;;; arch-tag: c49b48cc-0f4f-454f-a274-c2dc34815e14
a0d14345 453;;; w32-fns.el ends here