w32-win.el

Revision 4220, 31.6 kB (checked in by miyoshi, 9 months ago)
Sync up with Emacs22.2.
Property svn:eol-style set to `LF`

Line
1	;;; w32-win.el --- parse switches controlling interface with W32 window system
2
3	;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
4	;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5
6	;; Author: Kevin Gallo
7	;; Keywords: terminals
8
9	;; This file is part of GNU Emacs.
10
11	;; GNU Emacs is free software; you can redistribute it and/or modify
12	;; it under the terms of the GNU General Public License as published by
13	;; the Free Software Foundation; either version 3, or (at your option)
14	;; any later version.
15
16	;; GNU Emacs is distributed in the hope that it will be useful,
17	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19	;; GNU General Public License for more details.
20
21	;; You should have received a copy of the GNU General Public License
22	;; along with GNU Emacs; see the file COPYING. If not, write to the
23	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24	;; Boston, MA 02110-1301, USA.
25
26	;;; Commentary:
27
28	;; w32-win.el: this file is loaded from ../lisp/startup.el when it recognizes
29	;; that W32 windows are to be used. Command line switches are parsed and those
30	;; pertaining to W32 are processed and removed from the command line. The
31	;; W32 display is opened and hooks are set for popping up the initial window.
32
33	;; startup.el will then examine startup files, and eventually call the hooks
34	;; which create the first window (s).
35
36	;;; Code:
37
38
39	;; These are the standard X switches from the Xt Initialize.c file of
40	;; Release 4.
41
42	;; Command line Resource Manager string
43
44	;; +rv reverseVideo*
45	;; +synchronous synchronous*
46	;; -background background*
47	;; -bd borderColor*
48	;; -bg background*
49	;; -bordercolor borderColor*
50	;; -borderwidth .borderWidth
51	;; -bw .borderWidth
52	;; -display .display
53	;; -fg foreground*
54	;; -fn font*
55	;; -font font*
56	;; -foreground foreground*
57	;; -geometry .geometry
58	;; -i .iconType
59	;; -itype .iconType
60	;; -iconic .iconic
61	;; -name .name
62	;; -reverse reverseVideo*
63	;; -rv reverseVideo*
64	;; -selectionTimeout .selectionTimeout
65	;; -synchronous synchronous*
66	;; -xrm
67
68	;; An alist of X options and the function which handles them. See
69	;; ../startup.el.
70
71	(if (not (eq window-system 'w32))
72	(error "%s: Loading w32-win.el but not compiled for w32" (invocation-name)))
73
74	(require 'frame)
75	(require 'mouse)
76	(require 'scroll-bar)
77	(require 'faces)
78	(require 'select)
79	(require 'menu-bar)
80	(require 'dnd)
81	(require 'code-pages)
82
83	(defvar xlfd-regexp-registry-subnum)
84
85	;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
86	(if (fboundp 'new-fontset)
87	(require 'fontset))
88
89	;; The following definition is used for debugging scroll bar events.
90	;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event))
91
92	;; Handle mouse-wheel events with mwheel.
93	(mouse-wheel-mode 1)
94
95	(defun w32-drag-n-drop-debug (event)
96	"Print the drag-n-drop EVENT in a readable form."
97	(interactive "e")
98	(princ event))
99
100	(defun w32-drag-n-drop (event)
101	"Edit the files listed in the drag-n-drop EVENT.
102	Switch to a buffer editing the last file dropped."
103	(interactive "e")
104	(save-excursion
105	;; Make sure the drop target has positive co-ords
106	;; before setting the selected frame - otherwise it
107	;; won't work. <skx@tardis.ed.ac.uk>
108	(let* ((window (posn-window (event-start event)))
109	(coords (posn-x-y (event-start event)))
110	(x (car coords))
111	(y (cdr coords)))
112	(if (and (> x 0) (> y 0))
113	(set-frame-selected-window nil window))
114	(mapcar (lambda (file-name)
115	(let ((f (subst-char-in-string ?\\ ?/ file-name))
116	(coding (or file-name-coding-system
117	default-file-name-coding-system)))
118	(setq file-name
119	(mapconcat 'url-hexify-string
120	(split-string (encode-coding-string f coding)
121	"/")
122	"/")))
123	(dnd-handle-one-url window 'private
124	(concat "file:" file-name)))
125	(car (cdr (cdr event)))))
126	(raise-frame)))
127
128	(defun w32-drag-n-drop-other-frame (event)
129	"Edit the files listed in the drag-n-drop EVENT, in other frames.
130	May create new frames, or reuse existing ones. The frame editing
131	the last file dropped is selected."
132	(interactive "e")
133	(mapcar 'find-file-other-frame (car (cdr (cdr event)))))
134
135	;; Bind the drag-n-drop event.
136	(global-set-key [drag-n-drop] 'w32-drag-n-drop)
137	(global-set-key [C-drag-n-drop] 'w32-drag-n-drop-other-frame)
138
139	;; Keyboard layout/language change events
140	;; For now ignore language-change events; in the future
141	;; we should switch the Emacs Input Method to match the
142	;; new layout/language selected by the user.
143	(global-set-key [language-change] 'ignore)
144
145	(defvar x-invocation-args)
146
147	(defvar x-command-line-resources nil)
148
149	(defun x-handle-switch (switch)
150	"Handle SWITCH of the form \"-switch value\" or \"-switch\"."
151	(let ((aelt (assoc switch command-line-x-option-alist)))
152	(if aelt
153	(push (cons (nth 3 aelt) (or (nth 4 aelt) (pop x-invocation-args)))
154	default-frame-alist))))
155
156	(defun x-handle-numeric-switch (switch)
157	"Handle SWITCH of the form \"-switch n\"."
158	(let ((aelt (assoc switch command-line-x-option-alist)))
159	(if aelt
160	(push (cons (nth 3 aelt) (string-to-number (pop x-invocation-args)))
161	default-frame-alist))))
162
163	;; Handle options that apply to initial frame only
164	(defun x-handle-initial-switch (switch)
165	(let ((aelt (assoc switch command-line-x-option-alist)))
166	(if aelt
167	(push (cons (nth 3 aelt) (or (nth 4 aelt) (pop x-invocation-args)))
168	initial-frame-alist))))
169
170	(defun x-handle-iconic (switch)
171	"Make \"-iconic\" SWITCH apply only to the initial frame."
172	(push '(visibility . icon) initial-frame-alist))
173
174	(defun x-handle-xrm-switch (switch)
175	"Handle the \"-xrm\" SWITCH."
176	(or (consp x-invocation-args)
177	(error "%s: missing argument to `%s' option" (invocation-name) switch))
178	(setq x-command-line-resources
179	(if (null x-command-line-resources)
180	(car x-invocation-args)
181	(concat x-command-line-resources "\n" (car x-invocation-args))))
182	(setq x-invocation-args (cdr x-invocation-args)))
183
184	(defun x-handle-geometry (switch)
185	"Handle the \"-geometry\" SWITCH."
186	(let* ((geo (x-parse-geometry (car x-invocation-args)))
187	(left (assq 'left geo))
188	(top (assq 'top geo))
189	(height (assq 'height geo))
190	(width (assq 'width geo)))
191	(if (or height width)
192	(setq default-frame-alist
193	(append default-frame-alist
194	'((user-size . t))
195	(if height (list height))
196	(if width (list width)))
197	initial-frame-alist
198	(append initial-frame-alist
199	'((user-size . t))
200	(if height (list height))
201	(if width (list width)))))
202	(if (or left top)
203	(setq initial-frame-alist
204	(append initial-frame-alist
205	'((user-position . t))
206	(if left (list left))
207	(if top (list top)))))
208	(setq x-invocation-args (cdr x-invocation-args))))
209
210	(defun x-handle-name-switch (switch)
211	"Handle the \"-name\" SWITCH."
212	;; Handle the -name option. Set the variable x-resource-name
213	;; to the option's operand; set the name of the initial frame, too.
214	(or (consp x-invocation-args)
215	(error "%s: missing argument to `%s' option" (invocation-name) switch))
216	(setq x-resource-name (pop x-invocation-args))
217	(push (cons 'name x-resource-name) initial-frame-alist))
218
219	(defvar x-display-name nil
220	"The display name specifying server and frame.")
221
222	(defun x-handle-display (switch)
223	"Handle the \"-display\" SWITCH."
224	(setq x-display-name (pop x-invocation-args)))
225
226	(defun x-handle-args (args)
227	"Process the X-related command line options in ARGS.
228	This is done before the user's startup file is loaded. They are copied to
229	`x-invocation args' from which the X-related things are extracted, first
230	the switch (e.g., \"-fg\") in the following code, and possible values
231	\(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
232	This returns ARGS with the arguments that have been processed removed."
233	;; We use ARGS to accumulate the args that we don't handle here, to return.
234	(setq x-invocation-args args
235	args nil)
236	(while (and x-invocation-args
237	(not (equal (car x-invocation-args) "--")))
238	(let* ((this-switch (car x-invocation-args))
239	(orig-this-switch this-switch)
240	completion argval aelt handler)
241	(setq x-invocation-args (cdr x-invocation-args))
242	;; Check for long options with attached arguments
243	;; and separate out the attached option argument into argval.
244	(if (string-match *"^--[^=]="** this-switch)
245	(setq argval (substring this-switch (match-end 0))
246	this-switch (substring this-switch 0 (1- (match-end 0)))))
247	;; Complete names of long options.
248	(if (string-match "^--" this-switch)
249	(progn
250	(setq completion (try-completion this-switch command-line-x-option-alist))
251	(if (eq completion t)
252	;; Exact match for long option.
253	nil
254	(if (stringp completion)
255	(let ((elt (assoc completion command-line-x-option-alist)))
256	;; Check for abbreviated long option.
257	(or elt
258	(error "Option `%s' is ambiguous" this-switch))
259	(setq this-switch completion))))))
260	(setq aelt (assoc this-switch command-line-x-option-alist))
261	(if aelt (setq handler (nth 2 aelt)))
262	(if handler
263	(if argval
264	(let ((x-invocation-args
265	(cons argval x-invocation-args)))
266	(funcall handler this-switch))
267	(funcall handler this-switch))
268	(push orig-this-switch args))))
269	(nconc (nreverse args) x-invocation-args))
270
271	;;
272	;; Available colors
273	;;
274
275	(defvar x-colors '("LightGreen"
276	"light green"
277	"DarkRed"
278	"dark red"
279	"DarkMagenta"
280	"dark magenta"
281	"DarkCyan"
282	"dark cyan"
283	"DarkBlue"
284	"dark blue"
285	"DarkGray"
286	"dark gray"
287	"DarkGrey"
288	"dark grey"
289	"grey100"
290	"gray100"
291	"grey99"
292	"gray99"
293	"grey98"
294	"gray98"
295	"grey97"
296	"gray97"
297	"grey96"
298	"gray96"
299	"grey95"
300	"gray95"
301	"grey94"
302	"gray94"
303	"grey93"
304	"gray93"
305	"grey92"
306	"gray92"
307	"grey91"
308	"gray91"
309	"grey90"
310	"gray90"
311	"grey89"
312	"gray89"
313	"grey88"
314	"gray88"
315	"grey87"
316	"gray87"
317	"grey86"
318	"gray86"
319	"grey85"
320	"gray85"
321	"grey84"
322	"gray84"
323	"grey83"
324	"gray83"
325	"grey82"
326	"gray82"
327	"grey81"
328	"gray81"
329	"grey80"
330	"gray80"
331	"grey79"
332	"gray79"
333	"grey78"
334	"gray78"
335	"grey77"
336	"gray77"
337	"grey76"
338	"gray76"
339	"grey75"
340	"gray75"
341	"grey74"
342	"gray74"
343	"grey73"
344	"gray73"
345	"grey72"
346	"gray72"
347	"grey71"
348	"gray71"
349	"grey70"
350	"gray70"
351	"grey69"
352	"gray69"
353	"grey68"
354	"gray68"
355	"grey67"
356	"gray67"
357	"grey66"
358	"gray66"
359	"grey65"
360	"gray65"
361	"grey64"
362	"gray64"
363	"grey63"
364	"gray63"
365	"grey62"
366	"gray62"
367	"grey61"
368	"gray61"
369	"grey60"
370	"gray60"
371	"grey59"
372	"gray59"
373	"grey58"
374	"gray58"
375	"grey57"
376	"gray57"
377	"grey56"
378	"gray56"
379	"grey55"
380	"gray55"
381	"grey54"
382	"gray54"
383	"grey53"
384	"gray53"
385	"grey52"
386	"gray52"
387	"grey51"
388	"gray51"
389	"grey50"
390	"gray50"
391	"grey49"
392	"gray49"
393	"grey48"
394	"gray48"
395	"grey47"
396	"gray47"
397	"grey46"
398	"gray46"
399	"grey45"
400	"gray45"
401	"grey44"
402	"gray44"
403	"grey43"
404	"gray43"
405	"grey42"
406	"gray42"
407	"grey41"
408	"gray41"
409	"grey40"
410	"gray40"
411	"grey39"
412	"gray39"
413	"grey38"
414	"gray38"
415	"grey37"
416	"gray37"
417	"grey36"
418	"gray36"
419	"grey35"
420	"gray35"
421	"grey34"
422	"gray34"
423	"grey33"
424	"gray33"
425	"grey32"
426	"gray32"
427	"grey31"
428	"gray31"
429	"grey30"
430	"gray30"
431	"grey29"
432	"gray29"
433	"grey28"
434	"gray28"
435	"grey27"
436	"gray27"
437	"grey26"
438	"gray26"
439	"grey25"
440	"gray25"
441	"grey24"
442	"gray24"
443	"grey23"
444	"gray23"
445	"grey22"
446	"gray22"
447	"grey21"
448	"gray21"
449	"grey20"
450	"gray20"
451	"grey19"
452	"gray19"
453	"grey18"
454	"gray18"
455	"grey17"
456	"gray17"
457	"grey16"
458	"gray16"
459	"grey15"
460	"gray15"
461	"grey14"
462	"gray14"
463	"grey13"
464	"gray13"
465	"grey12"
466	"gray12"
467	"grey11"
468	"gray11"
469	"grey10"
470	"gray10"
471	"grey9"
472	"gray9"
473	"grey8"
474	"gray8"
475	"grey7"
476	"gray7"
477	"grey6"
478	"gray6"
479	"grey5"
480	"gray5"
481	"grey4"
482	"gray4"
483	"grey3"
484	"gray3"
485	"grey2"
486	"gray2"
487	"grey1"
488	"gray1"
489	"grey0"
490	"gray0"
491	"thistle4"
492	"thistle3"
493	"thistle2"
494	"thistle1"
495	"MediumPurple4"
496	"MediumPurple3"
497	"MediumPurple2"
498	"MediumPurple1"
499	"purple4"
500	"purple3"
501	"purple2"
502	"purple1"
503	"DarkOrchid4"
504	"DarkOrchid3"
505	"DarkOrchid2"
506	"DarkOrchid1"
507	"MediumOrchid4"
508	"MediumOrchid3"
509	"MediumOrchid2"
510	"MediumOrchid1"
511	"plum4"
512	"plum3"
513	"plum2"
514	"plum1"
515	"orchid4"
516	"orchid3"
517	"orchid2"
518	"orchid1"
519	"magenta4"
520	"magenta3"
521	"magenta2"
522	"magenta1"
523	"VioletRed4"
524	"VioletRed3"
525	"VioletRed2"
526	"VioletRed1"
527	"maroon4"
528	"maroon3"
529	"maroon2"
530	"maroon1"
531	"PaleVioletRed4"
532	"PaleVioletRed3"
533	"PaleVioletRed2"
534	"PaleVioletRed1"
535	"LightPink4"
536	"LightPink3"
537	"LightPink2"
538	"LightPink1"
539	"pink4"
540	"pink3"
541	"pink2"
542	"pink1"
543	"HotPink4"
544	"HotPink3"
545	"HotPink2"
546	"HotPink1"
547	"DeepPink4"
548	"DeepPink3"
549	"DeepPink2"
550	"DeepPink1"
551	"red4"
552	"red3"
553	"red2"
554	"red1"
555	"OrangeRed4"
556	"OrangeRed3"
557	"OrangeRed2"
558	"OrangeRed1"
559	"tomato4"
560	"tomato3"
561	"tomato2"
562	"tomato1"
563	"coral4"
564	"coral3"
565	"coral2"
566	"coral1"
567	"DarkOrange4"
568	"DarkOrange3"
569	"DarkOrange2"
570	"DarkOrange1"
571	"orange4"
572	"orange3"
573	"orange2"
574	"orange1"
575	"LightSalmon4"
576	"LightSalmon3"
577	"LightSalmon2"
578	"LightSalmon1"
579	"salmon4"
580	"salmon3"
581	"salmon2"
582	"salmon1"
583	"brown4"
584	"brown3"
585	"brown2"
586	"brown1"
587	"firebrick4"
588	"firebrick3"
589	"firebrick2"
590	"firebrick1"
591	"chocolate4"
592	"chocolate3"
593	"chocolate2"
594	"chocolate1"
595	"tan4"
596	"tan3"
597	"tan2"
598	"tan1"
599	"wheat4"
600	"wheat3"
601	"wheat2"
602	"wheat1"
603	"burlywood4"
604	"burlywood3"
605	"burlywood2"
606	"burlywood1"
607	"sienna4"
608	"sienna3"
609	"sienna2"
610	"sienna1"
611	"IndianRed4"
612	"IndianRed3"
613	"IndianRed2"
614	"IndianRed1"
615	"RosyBrown4"
616	"RosyBrown3"
617	"RosyBrown2"
618	"RosyBrown1"
619	"DarkGoldenrod4"
620	"DarkGoldenrod3"
621	"DarkGoldenrod2"
622	"DarkGoldenrod1"
623	"goldenrod4"
624	"goldenrod3"
625	"goldenrod2"
626	"goldenrod1"
627	"gold4"
628	"gold3"
629	"gold2"
630	"gold1"
631	"yellow4"
632	"yellow3"
633	"yellow2"
634	"yellow1"
635	"LightYellow4"
636	"LightYellow3"
637	"LightYellow2"
638	"LightYellow1"
639	"LightGoldenrod4"
640	"LightGoldenrod3"
641	"LightGoldenrod2"
642	"LightGoldenrod1"
643	"khaki4"
644	"khaki3"
645	"khaki2"
646	"khaki1"
647	"DarkOliveGreen4"
648	"DarkOliveGreen3"
649	"DarkOliveGreen2"
650	"DarkOliveGreen1"
651	"OliveDrab4"
652	"OliveDrab3"
653	"OliveDrab2"
654	"OliveDrab1"
655	"chartreuse4"
656	"chartreuse3"
657	"chartreuse2"
658	"chartreuse1"
659	"green4"
660	"green3"
661	"green2"
662	"green1"
663	"SpringGreen4"
664	"SpringGreen3"
665	"SpringGreen2"
666	"SpringGreen1"
667	"PaleGreen4"
668	"PaleGreen3"
669	"PaleGreen2"
670	"PaleGreen1"
671	"SeaGreen4"
672	"SeaGreen3"
673	"SeaGreen2"
674	"SeaGreen1"
675	"DarkSeaGreen4"
676	"DarkSeaGreen3"
677	"DarkSeaGreen2"
678	"DarkSeaGreen1"
679	"aquamarine4"
680	"aquamarine3"
681	"aquamarine2"
682	"aquamarine1"
683	"DarkSlateGray4"
684	"DarkSlateGray3"
685	"DarkSlateGray2"
686	"DarkSlateGray1"
687	"cyan4"
688	"cyan3"
689	"cyan2"
690	"cyan1"
691	"turquoise4"
692	"turquoise3"
693	"turquoise2"
694	"turquoise1"
695	"CadetBlue4"
696	"CadetBlue3"
697	"CadetBlue2"
698	"CadetBlue1"
699	"PaleTurquoise4"
700	"PaleTurquoise3"
701	"PaleTurquoise2"
702	"PaleTurquoise1"
703	"LightCyan4"
704	"LightCyan3"
705	"LightCyan2"
706	"LightCyan1"
707	"LightBlue4"</