HCoop / bpt / emacs.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
(w32_list_fonts): Report an error if a frame has not
[bpt/emacs.git] / src / w32fns.c
1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Added by Kevin Gallo */
22
23 #include <config.h>
24
25 #include <signal.h>
26 #include <stdio.h>
27 #include <limits.h>
28 #include <errno.h>
29
30 #include "lisp.h"
31 #include "charset.h"
32 #include "fontset.h"
33 #include "w32term.h"
34 #include "frame.h"
35 #include "window.h"
36 #include "buffer.h"
37 #include "dispextern.h"
38 #include "keyboard.h"
39 #include "blockinput.h"
40 #include "paths.h"
41 #include "w32heap.h"
42 #include "termhooks.h"
43 #include "coding.h"
44
45 #include <commdlg.h>
46 #include <shellapi.h>
47
48 extern void abort ();
49 extern void free_frame_menubar ();
50 extern struct scroll_bar *x_window_to_scroll_bar ();
51 extern int quit_char;
52
53 /* The colormap for converting color names to RGB values */
54 Lisp_Object Vw32_color_map;
55
56 /* Non nil if alt key presses are passed on to Windows. */
57 Lisp_Object Vw32_pass_alt_to_system;
58
59 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
60 to alt_modifier. */
61 Lisp_Object Vw32_alt_is_meta;
62
63 /* Non nil if left window, right window, and application key events
64 are passed on to Windows. */
65 Lisp_Object Vw32_pass_optional_keys_to_system;
66
67 /* Switch to control whether we inhibit requests for italicised fonts (which
68 are synthesized, look ugly, and are trashed by cursor movement under NT). */
69 Lisp_Object Vw32_enable_italics;
70
71 /* Enable palette management. */
72 Lisp_Object Vw32_enable_palette;
73
74 /* Control how close left/right button down events must be to
75 be converted to a middle button down event. */
76 Lisp_Object Vw32_mouse_button_tolerance;
77
78 /* Minimum interval between mouse movement (and scroll bar drag)
79 events that are passed on to the event loop. */
80 Lisp_Object Vw32_mouse_move_interval;
81
82 /* The name we're using in resource queries. */
83 Lisp_Object Vx_resource_name;
84
85 /* Non nil if no window manager is in use. */
86 Lisp_Object Vx_no_window_manager;
87
88 /* The background and shape of the mouse pointer, and shape when not
89 over text or in the modeline. */
90 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
91 /* The shape when over mouse-sensitive text. */
92 Lisp_Object Vx_sensitive_text_pointer_shape;
93
94 /* Color of chars displayed in cursor box. */
95 Lisp_Object Vx_cursor_fore_pixel;
96
97 /* Nonzero if using Windows. */
98 static int w32_in_use;
99
100 /* Search path for bitmap files. */
101 Lisp_Object Vx_bitmap_file_path;
102
103 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
104 Lisp_Object Vx_pixel_size_width_font_regexp;
105
106 /* A flag to control how to display unibyte 8-bit character. */
107 int unibyte_display_via_language_environment;
108
109 /* Evaluate this expression to rebuild the section of syms_of_w32fns
110 that initializes and staticpros the symbols declared below. Note
111 that Emacs 18 has a bug that keeps C-x C-e from being able to
112 evaluate this expression.
113
114 (progn
115 ;; Accumulate a list of the symbols we want to initialize from the
116 ;; declarations at the top of the file.
117 (goto-char (point-min))
118 (search-forward "/\*&&& symbols declared here &&&*\/\n")
119 (let (symbol-list)
120 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
121 (setq symbol-list
122 (cons (buffer-substring (match-beginning 1) (match-end 1))
123 symbol-list))
124 (forward-line 1))
125 (setq symbol-list (nreverse symbol-list))
126 ;; Delete the section of syms_of_... where we initialize the symbols.
127 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
128 (let ((start (point)))
129 (while (looking-at "^ Q")
130 (forward-line 2))
131 (kill-region start (point)))
132 ;; Write a new symbol initialization section.
133 (while symbol-list
134 (insert (format " %s = intern (\"" (car symbol-list)))
135 (let ((start (point)))
136 (insert (substring (car symbol-list) 1))
137 (subst-char-in-region start (point) ?_ ?-))
138 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
139 (setq symbol-list (cdr symbol-list)))))
140
141 */
142
143 /*&&& symbols declared here &&&*/
144 Lisp_Object Qauto_raise;
145 Lisp_Object Qauto_lower;
146 Lisp_Object Qbackground_color;
147 Lisp_Object Qbar;
148 Lisp_Object Qborder_color;
149 Lisp_Object Qborder_width;
150 Lisp_Object Qbox;
151 Lisp_Object Qcursor_color;
152 Lisp_Object Qcursor_type;
153 Lisp_Object Qforeground_color;
154 Lisp_Object Qgeometry;
155 Lisp_Object Qicon_left;
156 Lisp_Object Qicon_top;
157 Lisp_Object Qicon_type;
158 Lisp_Object Qicon_name;
159 Lisp_Object Qinternal_border_width;
160 Lisp_Object Qleft;
161 Lisp_Object Qright;
162 Lisp_Object Qmouse_color;
163 Lisp_Object Qnone;
164 Lisp_Object Qparent_id;
165 Lisp_Object Qscroll_bar_width;
166 Lisp_Object Qsuppress_icon;
167 Lisp_Object Qtop;
168 Lisp_Object Qundefined_color;
169 Lisp_Object Qvertical_scroll_bars;
170 Lisp_Object Qvisibility;
171 Lisp_Object Qwindow_id;
172 Lisp_Object Qx_frame_parameter;
173 Lisp_Object Qx_resource_name;
174 Lisp_Object Quser_position;
175 Lisp_Object Quser_size;
176 Lisp_Object Qdisplay;
177
178 /* State variables for emulating a three button mouse. */
179 #define LMOUSE 1
180 #define MMOUSE 2
181 #define RMOUSE 4
182
183 static int button_state = 0;
184 static W32Msg saved_mouse_button_msg;
185 static unsigned mouse_button_timer; /* non-zero when timer is active */
186 static W32Msg saved_mouse_move_msg;
187 static unsigned mouse_move_timer;
188
189 /* W95 mousewheel handler */
190 unsigned int msh_mousewheel = 0;
191
192 #define MOUSE_BUTTON_ID 1
193 #define MOUSE_MOVE_ID 2
194
195 /* The below are defined in frame.c. */
196 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
197 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
198
199 extern Lisp_Object Vwindow_system_version;
200
201 Lisp_Object Qface_set_after_frame_default;
202
203 extern Lisp_Object last_mouse_scroll_bar;
204 extern int last_mouse_scroll_bar_pos;
205
206 /* From w32term.c. */
207 extern Lisp_Object Vw32_num_mouse_buttons;
208
209 \f
210 /* Error if we are not connected to MS-Windows. */
211 void
212 check_w32 ()
213 {
214 if (! w32_in_use)
215 error ("MS-Windows not in use or not initialized");
216 }
217
218 /* Nonzero if we can use mouse menus.
219 You should not call this unless HAVE_MENUS is defined. */
220
221 int
222 have_menus_p ()
223 {
224 return w32_in_use;
225 }
226
227 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
228 and checking validity for W32. */
229
230 FRAME_PTR
231 check_x_frame (frame)
232 Lisp_Object frame;
233 {
234 FRAME_PTR f;
235
236 if (NILP (frame))
237 f = selected_frame;
238 else
239 {
240 CHECK_LIVE_FRAME (frame, 0);
241 f = XFRAME (frame);
242 }
243 if (! FRAME_W32_P (f))
244 error ("non-w32 frame used");
245 return f;
246 }
247
248 /* Let the user specify an display with a frame.
249 nil stands for the selected frame--or, if that is not a w32 frame,
250 the first display on the list. */
251
252 static struct w32_display_info *
253 check_x_display_info (frame)
254 Lisp_Object frame;
255 {
256 if (NILP (frame))
257 {
258 if (FRAME_W32_P (selected_frame))
259 return FRAME_W32_DISPLAY_INFO (selected_frame);
260 else
261 return &one_w32_display_info;
262 }
263 else if (STRINGP (frame))
264 return x_display_info_for_name (frame);
265 else
266 {
267 FRAME_PTR f;
268
269 CHECK_LIVE_FRAME (frame, 0);
270 f = XFRAME (frame);
271 if (! FRAME_W32_P (f))
272 error ("non-w32 frame used");
273 return FRAME_W32_DISPLAY_INFO (f);
274 }
275 }
276 \f
277 /* Return the Emacs frame-object corresponding to an w32 window.
278 It could be the frame's main window or an icon window. */
279
280 /* This function can be called during GC, so use GC_xxx type test macros. */
281
282 struct frame *
283 x_window_to_frame (dpyinfo, wdesc)
284 struct w32_display_info *dpyinfo;
285 HWND wdesc;
286 {
287 Lisp_Object tail, frame;
288 struct frame *f;
289
290 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
291 {
292 frame = XCONS (tail)->car;
293 if (!GC_FRAMEP (frame))
294 continue;
295 f = XFRAME (frame);
296 if (f->output_data.nothing == 1
297 || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
298 continue;
299 if (FRAME_W32_WINDOW (f) == wdesc)
300 return f;
301 }
302 return 0;
303 }
304
305 \f
306
307 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
308 id, which is just an int that this section returns. Bitmaps are
309 reference counted so they can be shared among frames.
310
311 Bitmap indices are guaranteed to be > 0, so a negative number can
312 be used to indicate no bitmap.
313
314 If you use x_create_bitmap_from_data, then you must keep track of
315 the bitmaps yourself. That is, creating a bitmap from the same
316 data more than once will not be caught. */
317
318
319 /* Functions to access the contents of a bitmap, given an id. */
320
321 int
322 x_bitmap_height (f, id)
323 FRAME_PTR f;
324 int id;
325 {
326 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].height;
327 }
328
329 int
330 x_bitmap_width (f, id)
331 FRAME_PTR f;
332 int id;
333 {
334 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].width;
335 }
336
337 int
338 x_bitmap_pixmap (f, id)
339 FRAME_PTR f;
340 int id;
341 {
342 return (int) FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
343 }
344
345
346 /* Allocate a new bitmap record. Returns index of new record. */
347
348 static int
349 x_allocate_bitmap_record (f)
350 FRAME_PTR f;
351 {
352 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
353 int i;
354
355 if (dpyinfo->bitmaps == NULL)
356 {
357 dpyinfo->bitmaps_size = 10;
358 dpyinfo->bitmaps
359 = (struct w32_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
360 dpyinfo->bitmaps_last = 1;
361 return 1;
362 }
363
364 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
365 return ++dpyinfo->bitmaps_last;
366
367 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
368 if (dpyinfo->bitmaps[i].refcount == 0)
369 return i + 1;
370
371 dpyinfo->bitmaps_size *= 2;
372 dpyinfo->bitmaps
373 = (struct w32_bitmap_record *) xrealloc (dpyinfo->bitmaps,
374 dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
375 return ++dpyinfo->bitmaps_last;
376 }
377
378 /* Add one reference to the reference count of the bitmap with id ID. */
379
380 void
381 x_reference_bitmap (f, id)
382 FRAME_PTR f;
383 int id;
384 {
385 ++FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
386 }
387
388 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
389
390 int
391 x_create_bitmap_from_data (f, bits, width, height)
392 struct frame *f;
393 char *bits;
394 unsigned int width, height;
395 {
396 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
397 Pixmap bitmap;
398 int id;
399
400 bitmap = CreateBitmap (width, height,
401 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes,
402 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits,
403 bits);
404
405 if (! bitmap)
406 return -1;
407
408 id = x_allocate_bitmap_record (f);
409 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
410 dpyinfo->bitmaps[id - 1].file = NULL;
411 dpyinfo->bitmaps[id - 1].hinst = NULL;
412 dpyinfo->bitmaps[id - 1].refcount = 1;
413 dpyinfo->bitmaps[id - 1].depth = 1;
414 dpyinfo->bitmaps[id - 1].height = height;
415 dpyinfo->bitmaps[id - 1].width = width;
416
417 return id;
418 }
419
420 /* Create bitmap from file FILE for frame F. */
421
422 int
423 x_create_bitmap_from_file (f, file)
424 struct frame *f;
425 Lisp_Object file;
426 {
427 return -1;
428 #if 0
429 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
430 unsigned int width, height;
431 Pixmap bitmap;
432 int xhot, yhot, result, id;
433 Lisp_Object found;
434 int fd;
435 char *filename;
436 HINSTANCE hinst;
437
438 /* Look for an existing bitmap with the same name. */
439 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
440 {
441 if (dpyinfo->bitmaps[id].refcount
442 && dpyinfo->bitmaps[id].file
443 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
444 {
445 ++dpyinfo->bitmaps[id].refcount;
446 return id + 1;
447 }
448 }
449
450 /* Search bitmap-file-path for the file, if appropriate. */
451 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
452 if (fd < 0)
453 return -1;
454 /* LoadLibraryEx won't handle special files handled by Emacs handler. */
455 if (fd == 0)
456 return -1;
457 close (fd);
458
459 filename = (char *) XSTRING (found)->data;
460
461 hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
462
463 if (hinst == NULL)
464 return -1;
465
466
467 result = XReadBitmapFile (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
468 filename, &width, &height, &bitmap, &xhot, &yhot);
469 if (result != BitmapSuccess)
470 return -1;
471
472 id = x_allocate_bitmap_record (f);
473 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
474 dpyinfo->bitmaps[id - 1].refcount = 1;
475 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
476 dpyinfo->bitmaps[id - 1].depth = 1;
477 dpyinfo->bitmaps[id - 1].height = height;
478 dpyinfo->bitmaps[id - 1].width = width;
479 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
480
481 return id;
482 #endif
483 }
484
485 /* Remove reference to bitmap with id number ID. */
486
487 int
488 x_destroy_bitmap (f, id)
489 FRAME_PTR f;
490 int id;
491 {
492 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
493
494 if (id > 0)
495 {
496 --dpyinfo->bitmaps[id - 1].refcount;
497 if (dpyinfo->bitmaps[id - 1].refcount == 0)
498 {
499 BLOCK_INPUT;
500 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
501 if (dpyinfo->bitmaps[id - 1].file)
502 {
503 free (dpyinfo->bitmaps[id - 1].file);
504 dpyinfo->bitmaps[id - 1].file = NULL;
505 }
506 UNBLOCK_INPUT;
507 }
508 }
509 }
510
511 /* Free all the bitmaps for the display specified by DPYINFO. */
512
513 static void
514 x_destroy_all_bitmaps (dpyinfo)
515 struct w32_display_info *dpyinfo;
516 {
517 int i;
518 for (i = 0; i < dpyinfo->bitmaps_last; i++)
519 if (dpyinfo->bitmaps[i].refcount > 0)
520 {
521 DeleteObject (dpyinfo->bitmaps[i].pixmap);
522 if (dpyinfo->bitmaps[i].file)
523 free (dpyinfo->bitmaps[i].file);
524 }
525 dpyinfo->bitmaps_last = 0;
526 }
527 \f
528 /* Connect the frame-parameter names for W32 frames
529 to the ways of passing the parameter values to the window system.
530
531 The name of a parameter, as a Lisp symbol,
532 has an `x-frame-parameter' property which is an integer in Lisp
533 but can be interpreted as an `enum x_frame_parm' in C. */
534
535 enum x_frame_parm
536 {
537 X_PARM_FOREGROUND_COLOR,
538 X_PARM_BACKGROUND_COLOR,
539 X_PARM_MOUSE_COLOR,
540 X_PARM_CURSOR_COLOR,
541 X_PARM_BORDER_COLOR,
542 X_PARM_ICON_TYPE,
543 X_PARM_FONT,
544 X_PARM_BORDER_WIDTH,
545 X_PARM_INTERNAL_BORDER_WIDTH,
546 X_PARM_NAME,
547 X_PARM_AUTORAISE,
548 X_PARM_AUTOLOWER,
549 X_PARM_VERT_SCROLL_BAR,
550 X_PARM_VISIBILITY,
551 X_PARM_MENU_BAR_LINES
552 };
553
554
555 struct x_frame_parm_table
556 {
557 char *name;
558 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
559 };
560
561 void x_set_foreground_color ();
562 void x_set_background_color ();
563 void x_set_mouse_color ();
564 void x_set_cursor_color ();
565 void x_set_border_color ();
566 void x_set_cursor_type ();
567 void x_set_icon_type ();
568 void x_set_icon_name ();
569 void x_set_font ();
570 void x_set_border_width ();
571 void x_set_internal_border_width ();
572 void x_explicitly_set_name ();
573 void x_set_autoraise ();
574 void x_set_autolower ();
575 void x_set_vertical_scroll_bars ();
576 void x_set_visibility ();
577 void x_set_menu_bar_lines ();
578 void x_set_scroll_bar_width ();
579 void x_set_title ();
580 void x_set_unsplittable ();
581
582 static struct x_frame_parm_table x_frame_parms[] =
583 {
584 "auto-raise", x_set_autoraise,
585 "auto-lower", x_set_autolower,
586 "background-color", x_set_background_color,
587 "border-color", x_set_border_color,
588 "border-width", x_set_border_width,
589 "cursor-color", x_set_cursor_color,
590 "cursor-type", x_set_cursor_type,
591 "font", x_set_font,
592 "foreground-color", x_set_foreground_color,
593 "icon-name", x_set_icon_name,
594 "icon-type", x_set_icon_type,
595 "internal-border-width", x_set_internal_border_width,
596 "menu-bar-lines", x_set_menu_bar_lines,
597 "mouse-color", x_set_mouse_color,
598 "name", x_explicitly_set_name,
599 "scroll-bar-width", x_set_scroll_bar_width,
600 "title", x_set_title,
601 "unsplittable", x_set_unsplittable,
602 "vertical-scroll-bars", x_set_vertical_scroll_bars,
603 "visibility", x_set_visibility,
604 };
605
606 /* Attach the `x-frame-parameter' properties to
607 the Lisp symbol names of parameters relevant to W32. */
608
609 init_x_parm_symbols ()
610 {
611 int i;
612
613 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
614 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
615 make_number (i));
616 }
617 \f
618 /* Change the parameters of FRAME as specified by ALIST.
619 If a parameter is not specially recognized, do nothing;
620 otherwise call the `x_set_...' function for that parameter. */
621
622 void
623 x_set_frame_parameters (f, alist)
624 FRAME_PTR f;
625 Lisp_Object alist;
626 {
627 Lisp_Object tail;
628
629 /* If both of these parameters are present, it's more efficient to
630 set them both at once. So we wait until we've looked at the
631 entire list before we set them. */
632 int width, height;
633
634 /* Same here. */
635 Lisp_Object left, top;
636
637 /* Same with these. */
638 Lisp_Object icon_left, icon_top;
639
640 /* Record in these vectors all the parms specified. */
641 Lisp_Object *parms;
642 Lisp_Object *values;
643 int i;
644 int left_no_change = 0, top_no_change = 0;
645 int icon_left_no_change = 0, icon_top_no_change = 0;
646
647 i = 0;
648 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
649 i++;
650
651 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
652 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
653
654 /* Extract parm names and values into those vectors. */
655
656 i = 0;
657 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
658 {
659 Lisp_Object elt, prop, val;
660
661 elt = Fcar (tail);
662 parms[i] = Fcar (elt);
663 values[i] = Fcdr (elt);
664 i++;
665 }
666
667 top = left = Qunbound;
668 icon_left = icon_top = Qunbound;
669
670 /* Provide default values for HEIGHT and WIDTH. */
671 width = FRAME_WIDTH (f);
672 height = FRAME_HEIGHT (f);
673
674 /* Now process them in reverse of specified order. */
675 for (i--; i >= 0; i--)
676 {
677 Lisp_Object prop, val;
678
679 prop = parms[i];
680 val = values[i];
681
682 if (EQ (prop, Qwidth) && NUMBERP (val))
683 width = XFASTINT (val);
684 else if (EQ (prop, Qheight) && NUMBERP (val))
685 height = XFASTINT (val);
686 else if (EQ (prop, Qtop))
687 top = val;
688 else if (EQ (prop, Qleft))
689 left = val;
690 else if (EQ (prop, Qicon_top))
691 icon_top = val;
692 else if (EQ (prop, Qicon_left))
693 icon_left = val;
694 else
695 {
696 register Lisp_Object param_index, old_value;
697
698 param_index = Fget (prop, Qx_frame_parameter);
699 old_value = get_frame_param (f, prop);
700 store_frame_param (f, prop, val);
701 if (NATNUMP (param_index)
702 && (XFASTINT (param_index)
703 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
704 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
705 }
706 }
707
708 /* Don't die if just one of these was set. */
709 if (EQ (left, Qunbound))
710 {
711 left_no_change = 1;
712 if (f->output_data.w32->left_pos < 0)
713 left = Fcons (Qplus, Fcons (make_number (f->output_data.w32->left_pos), Qnil));
714 else
715 XSETINT (left, f->output_data.w32->left_pos);
716 }
717 if (EQ (top, Qunbound))
718 {
719 top_no_change = 1;
720 if (f->output_data.w32->top_pos < 0)
721 top = Fcons (Qplus, Fcons (make_number (f->output_data.w32->top_pos), Qnil));
722 else
723 XSETINT (top, f->output_data.w32->top_pos);
724 }
725
726 /* If one of the icon positions was not set, preserve or default it. */
727 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
728 {
729 icon_left_no_change = 1;
730 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
731 if (NILP (icon_left))
732 XSETINT (icon_left, 0);
733 }
734 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
735 {
736 icon_top_no_change = 1;
737 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
738 if (NILP (icon_top))
739 XSETINT (icon_top, 0);
740 }
741
742 /* Don't set these parameters unless they've been explicitly
743 specified. The window might be mapped or resized while we're in
744 this function, and we don't want to override that unless the lisp
745 code has asked for it.
746
747 Don't set these parameters unless they actually differ from the
748 window's current parameters; the window may not actually exist
749 yet. */
750 {
751 Lisp_Object frame;
752
753 check_frame_size (f, &height, &width);
754
755 XSETFRAME (frame, f);
756
757 if (XINT (width) != FRAME_WIDTH (f)
758 || XINT (height) != FRAME_HEIGHT (f))
759 Fset_frame_size (frame, make_number (width), make_number (height));
760
761 if ((!NILP (left) || !NILP (top))
762 && ! (left_no_change && top_no_change)
763 && ! (NUMBERP (left) && XINT (left) == f->output_data.w32->left_pos
764 && NUMBERP (top) && XINT (top) == f->output_data.w32->top_pos))
765 {
766 int leftpos = 0;
767 int toppos = 0;
768
769 /* Record the signs. */
770 f->output_data.w32->size_hint_flags &= ~ (XNegative | YNegative);
771 if (EQ (left, Qminus))
772 f->output_data.w32->size_hint_flags |= XNegative;
773 else if (INTEGERP (left))
774 {
775 leftpos = XINT (left);
776 if (leftpos < 0)
777 f->output_data.w32->size_hint_flags |= XNegative;
778 }
779 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
780 && CONSP (XCONS (left)->cdr)
781 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
782 {
783 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
784 f->output_data.w32->size_hint_flags |= XNegative;
785 }
786 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
787 && CONSP (XCONS (left)->cdr)
788 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
789 {
790 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
791 }
792
793 if (EQ (top, Qminus))
794 f->output_data.w32->size_hint_flags |= YNegative;
795 else if (INTEGERP (top))
796 {
797 toppos = XINT (top);
798 if (toppos < 0)
799 f->output_data.w32->size_hint_flags |= YNegative;
800 }
801 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
802 && CONSP (XCONS (top)->cdr)
803 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
804 {
805 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
806 f->output_data.w32->size_hint_flags |= YNegative;
807 }
808 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
809 && CONSP (XCONS (top)->cdr)
810 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
811 {
812 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
813 }
814
815
816 /* Store the numeric value of the position. */
817 f->output_data.w32->top_pos = toppos;
818 f->output_data.w32->left_pos = leftpos;
819
820 f->output_data.w32->win_gravity = NorthWestGravity;
821
822 /* Actually set that position, and convert to absolute. */
823 x_set_offset (f, leftpos, toppos, -1);
824 }
825
826 if ((!NILP (icon_left) || !NILP (icon_top))
827 && ! (icon_left_no_change && icon_top_no_change))
828 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
829 }
830 }
831
832 /* Store the screen positions of frame F into XPTR and YPTR.
833 These are the positions of the containing window manager window,
834 not Emacs's own window. */
835
836 void
837 x_real_positions (f, xptr, yptr)
838 FRAME_PTR f;
839 int *xptr, *yptr;
840 {
841 POINT pt;
842
843 {
844 RECT rect;
845
846 GetClientRect(FRAME_W32_WINDOW(f), &rect);
847 AdjustWindowRect(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f));
848
849 pt.x = rect.left;
850 pt.y = rect.top;
851 }
852
853 ClientToScreen (FRAME_W32_WINDOW(f), &pt);
854
855 *xptr = pt.x;
856 *yptr = pt.y;
857 }
858
859 /* Insert a description of internally-recorded parameters of frame X
860 into the parameter alist *ALISTPTR that is to be given to the user.
861 Only parameters that are specific to W32
862 and whose values are not correctly recorded in the frame's
863 param_alist need to be considered here. */
864
865 x_report_frame_params (f, alistptr)
866 struct frame *f;
867 Lisp_Object *alistptr;
868 {
869 char buf[16];
870 Lisp_Object tem;
871
872 /* Represent negative positions (off the top or left screen edge)
873 in a way that Fmodify_frame_parameters will understand correctly. */
874 XSETINT (tem, f->output_data.w32->left_pos);
875 if (f->output_data.w32->left_pos >= 0)
876 store_in_alist (alistptr, Qleft, tem);
877 else
878 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
879
880 XSETINT (tem, f->output_data.w32->top_pos);
881 if (f->output_data.w32->top_pos >= 0)
882 store_in_alist (alistptr, Qtop, tem);
883 else
884 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
885
886 store_in_alist (alistptr, Qborder_width,
887 make_number (f->output_data.w32->border_width));
888 store_in_alist (alistptr, Qinternal_border_width,
889 make_number (f->output_data.w32->internal_border_width));
890 sprintf (buf, "%ld", (long) FRAME_W32_WINDOW (f));
891 store_in_alist (alistptr, Qwindow_id,
892 build_string (buf));
893 store_in_alist (alistptr, Qicon_name, f->icon_name);
894 FRAME_SAMPLE_VISIBILITY (f);
895 store_in_alist (alistptr, Qvisibility,
896 (FRAME_VISIBLE_P (f) ? Qt
897 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
898 store_in_alist (alistptr, Qdisplay,
899 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->car);
900 }
901 \f
902
903 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color, Sw32_define_rgb_color, 4, 4, 0,
904 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
905 This adds or updates a named color to w32-color-map, making it available for use.\n\
906 The original entry's RGB ref is returned, or nil if the entry is new.")
907 (red, green, blue, name)
908 Lisp_Object red, green, blue, name;
909 {
910 Lisp_Object rgb;
911 Lisp_Object oldrgb = Qnil;
912 Lisp_Object entry;
913
914 CHECK_NUMBER (red, 0);
915 CHECK_NUMBER (green, 0);
916 CHECK_NUMBER (blue, 0);
917 CHECK_STRING (name, 0);
918
919 XSET (rgb, Lisp_Int, RGB(XUINT (red), XUINT (green), XUINT (blue)));
920
921 BLOCK_INPUT;
922
923 /* replace existing entry in w32-color-map or add new entry. */
924 entry = Fassoc (name, Vw32_color_map);
925 if (NILP (entry))
926 {
927 entry = Fcons (name, rgb);
928 Vw32_color_map = Fcons (entry, Vw32_color_map);
929 }
930 else
931 {
932 oldrgb = Fcdr (entry);
933 Fsetcdr (entry, rgb);
934 }
935
936 UNBLOCK_INPUT;
937
938 return (oldrgb);
939 }
940
941 DEFUN ("w32-load-color-file", Fw32_load_color_file, Sw32_load_color_file, 1, 1, 0,
942 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
943 Assign this value to w32-color-map to replace the existing color map.\n\
944 \
945 The file should define one named RGB color per line like so:\
946 R G B name\n\
947 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
948 (filename)
949 Lisp_Object filename;
950 {
951 FILE *fp;
952 Lisp_Object cmap = Qnil;
953 Lisp_Object abspath;
954
955 CHECK_STRING (filename, 0);
956 abspath = Fexpand_file_name (filename, Qnil);
957
958 fp = fopen (XSTRING (filename)->data, "rt");
959 if (fp)
960 {
961 char buf[512];
962 int red, green, blue;
963 int num;
964
965 BLOCK_INPUT;
966
967 while (fgets (buf, sizeof (buf), fp) != NULL) {
968 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
969 {
970 char *name = buf + num;
971 num = strlen (name) - 1;
972 if (name[num] == '\n')
973 name[num] = 0;
974 cmap = Fcons (Fcons (build_string (name),
975 make_number (RGB (red, green, blue))),
976 cmap);
977 }
978 }
979 fclose (fp);
980
981 UNBLOCK_INPUT;
982 }
983
984 return cmap;
985 }
986
987 /* The default colors for the w32 color map */
988 typedef struct colormap_t
989 {
990 char *name;
991 COLORREF colorref;
992 } colormap_t;
993
994 colormap_t w32_color_map[] =
995 {
996 {"snow" , PALETTERGB (255,250,250)},
997 {"ghost white" , PALETTERGB (248,248,255)},
998 {"GhostWhite" , PALETTERGB (248,248,255)},
999 {"white smoke" , PALETTERGB (245,245,245)},
1000 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1001 {"gainsboro" , PALETTERGB (220,220,220)},
1002 {"floral white" , PALETTERGB (255,250,240)},
1003 {"FloralWhite" , PALETTERGB (255,250,240)},
1004 {"old lace" , PALETTERGB (253,245,230)},
1005 {"OldLace" , PALETTERGB (253,245,230)},
1006 {"linen" , PALETTERGB (250,240,230)},
1007 {"antique white" , PALETTERGB (250,235,215)},
1008 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1009 {"papaya whip" , PALETTERGB (255,239,213)},
1010 {"PapayaWhip" , PALETTERGB (255,239,213)},
1011 {"blanched almond" , PALETTERGB (255,235,205)},
1012 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1013 {"bisque" , PALETTERGB (255,228,196)},
1014 {"peach puff" , PALETTERGB (255,218,185)},
1015 {"PeachPuff" , PALETTERGB (255,218,185)},
1016 {"navajo white" , PALETTERGB (255,222,173)},
1017 {"NavajoWhite" , PALETTERGB (255,222,173)},
1018 {"moccasin" , PALETTERGB (255,228,181)},
1019 {"cornsilk" , PALETTERGB (255,248,220)},
1020 {"ivory" , PALETTERGB (255,255,240)},
1021 {"lemon chiffon" , PALETTERGB (255,250,205)},
1022 {"LemonChiffon" , PALETTERGB (255,250,205)},
1023 {"seashell" , PALETTERGB (255,245,238)},
1024 {"honeydew" , PALETTERGB (240,255,240)},
1025 {"mint cream" , PALETTERGB (245,255,250)},
1026 {"MintCream" , PALETTERGB (245,255,250)},
1027 {"azure" , PALETTERGB (240,255,255)},
1028 {"alice blue" , PALETTERGB (240,248,255)},
1029 {"AliceBlue" , PALETTERGB (240,248,255)},
1030 {"lavender" , PALETTERGB (230,230,250)},
1031 {"lavender blush" , PALETTERGB (255,240,245)},
1032 {"LavenderBlush" , PALETTERGB (255,240,245)},
1033 {"misty rose" , PALETTERGB (255,228,225)},
1034 {"MistyRose" , PALETTERGB (255,228,225)},
1035 {"white" , PALETTERGB (255,255,255)},
1036 {"black" , PALETTERGB ( 0, 0, 0)},
1037 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1038 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1039 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1040 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1041 {"dim gray" , PALETTERGB (105,105,105)},
1042 {"DimGray" , PALETTERGB (105,105,105)},
1043 {"dim grey" , PALETTERGB (105,105,105)},
1044 {"DimGrey" , PALETTERGB (105,105,105)},
1045 {"slate gray" , PALETTERGB (112,128,144)},
1046 {"SlateGray" , PALETTERGB (112,128,144)},
1047 {"slate grey" , PALETTERGB (112,128,144)},
1048 {"SlateGrey" , PALETTERGB (112,128,144)},
1049 {"light slate gray" , PALETTERGB (119,136,153)},
1050 {"LightSlateGray" , PALETTERGB (119,136,153)},
1051 {"light slate grey" , PALETTERGB (119,136,153)},
1052 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1053 {"gray" , PALETTERGB (190,190,190)},
1054 {"grey" , PALETTERGB (190,190,190)},
1055 {"light grey" , PALETTERGB (211,211,211)},
1056 {"LightGrey" , PALETTERGB (211,211,211)},
1057 {"light gray" , PALETTERGB (211,211,211)},
1058 {"LightGray" , PALETTERGB (211,211,211)},
1059 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1060 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1061 {"navy" , PALETTERGB ( 0, 0,128)},
1062 {"navy blue" , PALETTERGB ( 0, 0,128)},
1063 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1064 {"cornflower blue" , PALETTERGB (100,149,237)},
1065 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1066 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1067 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1068 {"slate blue" , PALETTERGB (106, 90,205)},
1069 {"SlateBlue" , PALETTERGB (106, 90,205)},
1070 {"medium slate blue" , PALETTERGB (123,104,238)},
1071 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1072 {"light slate blue" , PALETTERGB (132,112,255)},
1073 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1074 {"medium blue" , PALETTERGB ( 0, 0,205)},
1075 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1076 {"royal blue" , PALETTERGB ( 65,105,225)},
1077 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1078 {"blue" , PALETTERGB ( 0, 0,255)},
1079 {"dodger blue" , PALETTERGB ( 30,144,255)},
1080 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1081 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1082 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1083 {"sky blue" , PALETTERGB (135,206,235)},
1084 {"SkyBlue" , PALETTERGB (135,206,235)},
1085 {"light sky blue" , PALETTERGB (135,206,250)},
1086 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1087 {"steel blue" , PALETTERGB ( 70,130,180)},
1088 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1089 {"light steel blue" , PALETTERGB (176,196,222)},
1090 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1091 {"light blue" , PALETTERGB (173,216,230)},
1092 {"LightBlue" , PALETTERGB (173,216,230)},
1093 {"powder blue" , PALETTERGB (176,224,230)},
1094 {"PowderBlue" , PALETTERGB (176,224,230)},
1095 {"pale turquoise" , PALETTERGB (175,238,238)},
1096 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1097 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1098 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1099 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1100 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1101 {"turquoise" , PALETTERGB ( 64,224,208)},
1102 {"cyan" , PALETTERGB ( 0,255,255)},
1103 {"light cyan" , PALETTERGB (224,255,255)},
1104 {"LightCyan" , PALETTERGB (224,255,255)},
1105 {"cadet blue" , PALETTERGB ( 95,158,160)},
1106 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1107 {"medium aquamarine" , PALETTERGB (102,205,170)},
1108 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1109 {"aquamarine" , PALETTERGB (127,255,212)},
1110 {"dark green" , PALETTERGB ( 0,100, 0)},
1111 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1112 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1113 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1114 {"dark sea green" , PALETTERGB (143,188,143)},
1115 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1116 {"sea green" , PALETTERGB ( 46,139, 87)},
1117 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1118 {"medium sea green" , PALETTERGB ( 60,179,113)},
1119 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1120 {"light sea green" , PALETTERGB ( 32,178,170)},
1121 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1122 {"pale green" , PALETTERGB (152,251,152)},
1123 {"PaleGreen" , PALETTERGB (152,251,152)},
1124 {"spring green" , PALETTERGB ( 0,255,127)},
1125 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1126 {"lawn green" , PALETTERGB (124,252, 0)},
1127 {"LawnGreen" , PALETTERGB (124,252, 0)},
1128 {"green" , PALETTERGB ( 0,255, 0)},
1129 {"chartreuse" , PALETTERGB (127,255, 0)},
1130 {"medium spring green" , PALETTERGB ( 0,250,154)},
1131 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1132 {"green yellow" , PALETTERGB (173,255, 47)},
1133 {"GreenYellow" , PALETTERGB (173,255, 47)},
1134 {"lime green" , PALETTERGB ( 50,205, 50)},
1135 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1136 {"yellow green" , PALETTERGB (154,205, 50)},
1137 {"YellowGreen" , PALETTERGB (154,205, 50)},
1138 {"forest green" , PALETTERGB ( 34,139, 34)},
1139 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1140 {"olive drab" , PALETTERGB (107,142, 35)},
1141 {"OliveDrab" , PALETTERGB (107,142, 35)},
1142 {"dark khaki" , PALETTERGB (189,183,107)},
1143 {"DarkKhaki" , PALETTERGB (189,183,107)},
1144 {"khaki" , PALETTERGB (240,230,140)},
1145 {"pale goldenrod" , PALETTERGB (238,232,170)},
1146 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1147 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1148 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1149 {"light yellow" , PALETTERGB (255,255,224)},
1150 {"LightYellow" , PALETTERGB (255,255,224)},
1151 {"yellow" , PALETTERGB (255,255, 0)},
1152 {"gold" , PALETTERGB (255,215, 0)},
1153 {"light goldenrod" , PALETTERGB (238,221,130)},
1154 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1155 {"goldenrod" , PALETTERGB (218,165, 32)},
1156 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1157 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1158 {"rosy brown" , PALETTERGB (188,143,143)},
1159 {"RosyBrown" , PALETTERGB (188,143,143)},
1160 {"indian red" , PALETTERGB (205, 92, 92)},
1161 {"IndianRed" , PALETTERGB (205, 92, 92)},
1162 {"saddle brown" , PALETTERGB (139, 69, 19)},
1163 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1164 {"sienna" , PALETTERGB (160, 82, 45)},
1165 {"peru" , PALETTERGB (205,133, 63)},
1166 {"burlywood" , PALETTERGB (222,184,135)},
1167 {"beige" , PALETTERGB (245,245,220)},
1168 {"wheat" , PALETTERGB (245,222,179)},
1169 {"sandy brown" , PALETTERGB (244,164, 96)},
1170 {"SandyBrown" , PALETTERGB (244,164, 96)},
1171 {"tan" , PALETTERGB (210,180,140)},
1172 {"chocolate" , PALETTERGB (210,105, 30)},
1173 {"firebrick" , PALETTERGB (178,34, 34)},
1174 {"brown" , PALETTERGB (165,42, 42)},
1175 {"dark salmon" , PALETTERGB (233,150,122)},
1176 {"DarkSalmon" , PALETTERGB (233,150,122)},
1177 {"salmon" , PALETTERGB (250,128,114)},
1178 {"light salmon" , PALETTERGB (255,160,122)},
1179 {"LightSalmon" , PALETTERGB (255,160,122)},
1180 {"orange" , PALETTERGB (255,165, 0)},
1181 {"dark orange" , PALETTERGB (255,140, 0)},
1182 {"DarkOrange" , PALETTERGB (255,140, 0)},
1183 {"coral" , PALETTERGB (255,127, 80)},
1184 {"light coral" , PALETTERGB (240,128,128)},
1185 {"LightCoral" , PALETTERGB (240,128,128)},
1186 {"tomato" , PALETTERGB (255, 99, 71)},
1187 {"orange red" , PALETTERGB (255, 69, 0)},
1188 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1189 {"red" , PALETTERGB (255, 0, 0)},
1190 {"hot pink" , PALETTERGB (255,105,180)},
1191 {"HotPink" , PALETTERGB (255,105,180)},
1192 {"deep pink" , PALETTERGB (255, 20,147)},
1193 {"DeepPink" , PALETTERGB (255, 20,147)},
1194 {"pink" , PALETTERGB (255,192,203)},
1195 {"light pink" , PALETTERGB (255,182,193)},
1196 {"LightPink" , PALETTERGB (255,182,193)},
1197 {"pale violet red" , PALETTERGB (219,112,147)},
1198 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1199 {"maroon" , PALETTERGB (176, 48, 96)},
1200 {"medium violet red" , PALETTERGB (199, 21,133)},
1201 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1202 {"violet red" , PALETTERGB (208, 32,144)},
1203 {"VioletRed" , PALETTERGB (208, 32,144)},
1204 {"magenta" , PALETTERGB (255, 0,255)},
1205 {"violet" , PALETTERGB (238,130,238)},
1206 {"plum" , PALETTERGB (221,160,221)},
1207 {"orchid" , PALETTERGB (218,112,214)},
1208 {"medium orchid" , PALETTERGB (186, 85,211)},
1209 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1210 {"dark orchid" , PALETTERGB (153, 50,204)},
1211 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1212 {"dark violet" , PALETTERGB (148, 0,211)},
1213 {"DarkViolet" , PALETTERGB (148, 0,211)},
1214 {"blue violet" , PALETTERGB (138, 43,226)},
1215 {"BlueViolet" , PALETTERGB (138, 43,226)},
1216 {"purple" , PALETTERGB (160, 32,240)},
1217 {"medium purple" , PALETTERGB (147,112,219)},
1218 {"MediumPurple" , PALETTERGB (147,112,219)},
1219 {"thistle" , PALETTERGB (216,191,216)},
1220 {"gray0" , PALETTERGB ( 0, 0, 0)},
1221 {"grey0" , PALETTERGB ( 0, 0, 0)},
1222 {"dark grey" , PALETTERGB (169,169,169)},
1223 {"DarkGrey" , PALETTERGB (169,169,169)},
1224 {"dark gray" , PALETTERGB (169,169,169)},
1225 {"DarkGray" , PALETTERGB (169,169,169)},
1226 {"dark blue" , PALETTERGB ( 0, 0,139)},
1227 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1228 {"dark cyan" , PALETTERGB ( 0,139,139)},
1229 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1230 {"dark magenta" , PALETTERGB (139, 0,139)},
1231 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1232 {"dark red" , PALETTERGB (139, 0, 0)},
1233 {"DarkRed" , PALETTERGB (139, 0, 0)},
1234 {"light green" , PALETTERGB (144,238,144)},
1235 {"LightGreen" , PALETTERGB (144,238,144)},
1236 };
1237
1238 DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
1239 0, 0, 0, "Return the default color map.")
1240 ()
1241 {
1242 int i;
1243 colormap_t *pc = w32_color_map;
1244 Lisp_Object cmap;
1245
1246 BLOCK_INPUT;
1247
1248 cmap = Qnil;
1249
1250 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
1251 pc++, i++)
1252 cmap = Fcons (Fcons (build_string (pc->name),
1253 make_number (pc->colorref)),
1254 cmap);
1255
1256 UNBLOCK_INPUT;
1257
1258 return (cmap);
1259 }
1260
1261 Lisp_Object
1262 w32_to_x_color (rgb)
1263 Lisp_Object rgb;
1264 {
1265 Lisp_Object color;
1266
1267 CHECK_NUMBER (rgb, 0);
1268
1269 BLOCK_INPUT;
1270
1271 color = Frassq (rgb, Vw32_color_map);
1272
1273 UNBLOCK_INPUT;
1274
1275 if (!NILP (color))
1276 return (Fcar (color));
1277 else
1278 return Qnil;
1279 }
1280
1281 COLORREF
1282 w32_color_map_lookup (colorname)
1283 char *colorname;
1284 {
1285 Lisp_Object tail, ret = Qnil;
1286
1287 BLOCK_INPUT;
1288
1289 for (tail = Vw32_color_map; !NILP (tail); tail = Fcdr (tail))
1290 {
1291 register Lisp_Object elt, tem;
1292
1293 elt = Fcar (tail);
1294 if (!CONSP (elt)) continue;
1295
1296 tem = Fcar (elt);
1297
1298 if (lstrcmpi (XSTRING (tem)->data, colorname) == 0)
1299 {
1300 ret = XUINT (Fcdr (elt));
1301 break;
1302 }
1303
1304 QUIT;
1305 }
1306
1307
1308 UNBLOCK_INPUT;
1309
1310 return ret;
1311 }
1312
1313 COLORREF
1314 x_to_w32_color (colorname)
1315 char * colorname;
1316 {
1317 register Lisp_Object tail, ret = Qnil;
1318
1319 BLOCK_INPUT;
1320
1321 if (colorname[0] == '#')
1322 {
1323 /* Could be an old-style RGB Device specification. */
1324 char *color;
1325 int size;
1326 color = colorname + 1;
1327
1328 size = strlen(color);
1329 if (size == 3 || size == 6 || size == 9 || size == 12)
1330 {
1331 UINT colorval;
1332 int i, pos;
1333 pos = 0;
1334 size /= 3;
1335 colorval = 0;
1336
1337 for (i = 0; i < 3; i++)
1338 {
1339 char *end;
1340 char t;
1341 unsigned long value;
1342
1343 /* The check for 'x' in the following conditional takes into
1344 account the fact that strtol allows a "0x" in front of
1345 our numbers, and we don't. */
1346 if (!isxdigit(color[0]) || color[1] == 'x')
1347 break;
1348 t = color[size];
1349 color[size] = '\0';
1350 value = strtoul(color, &end, 16);
1351 color[size] = t;
1352 if (errno == ERANGE || end - color != size)
1353 break;
1354 switch (size)
1355 {
1356 case 1:
1357 value = value * 0x10;
1358 break;
1359 case 2:
1360 break;
1361 case 3:
1362 value /= 0x10;
1363 break;
1364 case 4:
1365 value /= 0x100;
1366 break;
1367 }
1368 colorval |= (value << pos);
1369 pos += 0x8;
1370 if (i == 2)
1371 {
1372 UNBLOCK_INPUT;
1373 return (colorval);
1374 }
1375 color = end;
1376 }
1377 }
1378 }
1379 else if (strnicmp(colorname, "rgb:", 4) == 0)
1380 {
1381 char *color;
1382 UINT colorval;
1383 int i, pos;
1384 pos = 0;
1385
1386 colorval = 0;
1387 color = colorname + 4;
1388 for (i = 0; i < 3; i++)
1389 {
1390 char *end;
1391 unsigned long value;
1392
1393 /* The check for 'x' in the following conditional takes into
1394 account the fact that strtol allows a "0x" in front of
1395 our numbers, and we don't. */
1396 if (!isxdigit(color[0]) || color[1] == 'x')
1397 break;
1398 value = strtoul(color, &end, 16);
1399 if (errno == ERANGE)
1400 break;
1401 switch (end - color)
1402 {
1403 case 1:
1404 value = value * 0x10 + value;
1405 break;
1406 case 2:
1407 break;
1408 case 3:
1409 value /= 0x10;
1410 break;
1411 case 4:
1412 value /= 0x100;
1413 break;
1414 default:
1415 value = ULONG_MAX;
1416 }
1417 if (value == ULONG_MAX)
1418 break;
1419 colorval |= (value << pos);
1420 pos += 0x8;
1421 if (i == 2)
1422 {
1423 if (*end != '\0')
1424 break;
1425 UNBLOCK_INPUT;
1426 return (colorval);
1427 }
1428 if (*end != '/')
1429 break;
1430 color = end + 1;
1431 }
1432 }
1433 else if (strnicmp(colorname, "rgbi:", 5) == 0)
1434 {
1435 /* This is an RGB Intensity specification. */
1436 char *color;
1437 UINT colorval;
1438 int i, pos;
1439 pos = 0;
1440
1441 colorval = 0;
1442 color = colorname + 5;
1443 for (i = 0; i < 3; i++)
1444 {
1445 char *end;
1446 double value;
1447 UINT val;
1448
1449 value = strtod(color, &end);
1450 if (errno == ERANGE)
1451 break;
1452 if (value < 0.0 || value > 1.0)
1453 break;
1454 val = (UINT)(0x100 * value);
1455 /* We used 0x100 instead of 0xFF to give an continuous
1456 range between 0.0 and 1.0 inclusive. The next statement
1457 fixes the 1.0 case. */
1458 if (val == 0x100)
1459 val = 0xFF;
1460 colorval |= (val << pos);
1461 pos += 0x8;
1462 if (i == 2)
1463 {
1464 if (*end != '\0')
1465 break;
1466 UNBLOCK_INPUT;
1467 return (colorval);
1468 }
1469 if (*end != '/')
1470 break;
1471 color = end + 1;
1472 }
1473 }
1474 /* I am not going to attempt to handle any of the CIE color schemes
1475 or TekHVC, since I don't know the algorithms for conversion to
1476 RGB. */
1477
1478 /* If we fail to lookup the color name in w32_color_map, then check the
1479 colorname to see if it can be crudely approximated: If the X color
1480 ends in a number (e.g., "darkseagreen2"), strip the number and
1481 return the result of looking up the base color name. */
1482 ret = w32_color_map_lookup (colorname);
1483 if (NILP (ret))
1484 {
1485 int len = strlen (colorname);
1486
1487 if (isdigit (colorname[len - 1]))
1488 {
1489 char *ptr, *approx = alloca (len);
1490
1491 strcpy (approx, colorname);
1492 ptr = &approx[len - 1];
1493 while (ptr > approx && isdigit (*ptr))
1494 *ptr-- = '\0';
1495
1496 ret = w32_color_map_lookup (approx);
1497 }
1498 }
1499
1500 UNBLOCK_INPUT;
1501 return ret;
1502 }
1503
1504
1505 void
1506 w32_regenerate_palette (FRAME_PTR f)
1507 {
1508 struct w32_palette_entry * list;
1509 LOGPALETTE * log_palette;
1510 HPALETTE new_palette;
1511 int i;
1512
1513 /* don't bother trying to create palette if not supported */
1514 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
1515 return;
1516
1517 log_palette = (LOGPALETTE *)
1518 alloca (sizeof (LOGPALETTE) +
1519 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
1520 log_palette->palVersion = 0x300;
1521 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
1522
1523 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1524 for (i = 0;
1525 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
1526 i++, list = list->next)
1527 log_palette->palPalEntry[i] = list->entry;
1528
1529 new_palette = CreatePalette (log_palette);
1530
1531 enter_crit ();
1532
1533 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1534 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1535 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
1536
1537 /* Realize display palette and garbage all frames. */
1538 release_frame_dc (f, get_frame_dc (f));
1539
1540 leave_crit ();
1541 }
1542
1543 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1544 #define SET_W32_COLOR(pe, color) \
1545 do \
1546 { \
1547 pe.peRed = GetRValue (color); \
1548 pe.peGreen = GetGValue (color); \
1549 pe.peBlue = GetBValue (color); \
1550 pe.peFlags = 0; \
1551 } while (0)
1552
1553 #if 0
1554 /* Keep these around in case we ever want to track color usage. */
1555 void
1556 w32_map_color (FRAME_PTR f, COLORREF color)
1557 {
1558 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1559
1560 if (NILP (Vw32_enable_palette))
1561 return;
1562
1563 /* check if color is already mapped */
1564 while (list)
1565 {
1566 if (W32_COLOR (list->entry) == color)
1567 {
1568 ++list->refcount;
1569 return;
1570 }
1571 list = list->next;
1572 }
1573
1574 /* not already mapped, so add to list and recreate Windows palette */
1575 list = (struct w32_palette_entry *)
1576 xmalloc (sizeof (struct w32_palette_entry));
1577 SET_W32_COLOR (list->entry, color);
1578 list->refcount = 1;
1579 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1580 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1581 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
1582
1583 /* set flag that palette must be regenerated */
1584 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1585 }
1586
1587 void
1588 w32_unmap_color (FRAME_PTR f, COLORREF color)
1589 {
1590 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1591 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
1592
1593 if (NILP (Vw32_enable_palette))
1594 return;
1595
1596 /* check if color is already mapped */
1597 while (list)
1598 {
1599 if (W32_COLOR (list->entry) == color)
1600 {
1601 if (--list->refcount == 0)
1602 {
1603 *prev = list->next;
1604 xfree (list);
1605 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
1606 break;
1607 }
1608 else
1609 return;
1610 }
1611 prev = &list->next;
1612 list = list->next;
1613 }
1614
1615 /* set flag that palette must be regenerated */
1616 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1617 }
1618 #endif
1619
1620 /* Decide if color named COLOR is valid for the display associated with
1621 the selected frame; if so, return the rgb values in COLOR_DEF.
1622 If ALLOC is nonzero, allocate a new colormap cell. */
1623
1624 int
1625 defined_color (f, color, color_def, alloc)
1626 FRAME_PTR f;
1627 char *color;
1628 COLORREF *color_def;
1629 int alloc;
1630 {
1631 register Lisp_Object tem;
1632
1633 tem = x_to_w32_color (color);
1634
1635 if (!NILP (tem))
1636 {
1637 if (!NILP (Vw32_enable_palette))
1638 {
1639 struct w32_palette_entry * entry =
1640 FRAME_W32_DISPLAY_INFO (f)->color_list;
1641 struct w32_palette_entry ** prev =
1642 &FRAME_W32_DISPLAY_INFO (f)->color_list;
1643
1644 /* check if color is already mapped */
1645 while (entry)
1646 {
1647 if (W32_COLOR (entry->entry) == XUINT (tem))
1648 break;
1649 prev = &entry->next;
1650 entry = entry->next;
1651 }
1652
1653 if (entry == NULL && alloc)
1654 {
1655 /* not already mapped, so add to list */
1656 entry = (struct w32_palette_entry *)
1657 xmalloc (sizeof (struct w32_palette_entry));
1658 SET_W32_COLOR (entry->entry, XUINT (tem));
1659 entry->next = NULL;
1660 *prev = entry;
1661 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
1662
1663 /* set flag that palette must be regenerated */
1664 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1665 }
1666 }
1667 /* Ensure COLORREF value is snapped to nearest color in (default)
1668 palette by simulating the PALETTERGB macro. This works whether
1669 or not the display device has a palette. */
1670 *color_def = XUINT (tem) | 0x2000000;
1671 return 1;
1672 }
1673 else
1674 {
1675 return 0;
1676 }
1677 }
1678
1679 /* Given a string ARG naming a color, compute a pixel value from it
1680 suitable for screen F.
1681 If F is not a color screen, return DEF (default) regardless of what
1682 ARG says. */
1683
1684 int
1685 x_decode_color (f, arg, def)
1686 FRAME_PTR f;
1687 Lisp_Object arg;
1688 int def;
1689 {
1690 COLORREF cdef;
1691
1692 CHECK_STRING (arg, 0);
1693
1694 if (strcmp (XSTRING (arg)->data, "black") == 0)
1695 return BLACK_PIX_DEFAULT (f);
1696 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1697 return WHITE_PIX_DEFAULT (f);
1698
1699 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
1700 return def;
1701
1702 /* defined_color is responsible for coping with failures
1703 by looking for a near-miss. */
1704 if (defined_color (f, XSTRING (arg)->data, &cdef, 1))
1705 return cdef;
1706
1707 /* defined_color failed; return an ultimate default. */
1708 return def;
1709 }
1710 \f
1711 /* Functions called only from `x_set_frame_param'
1712 to set individual parameters.
1713
1714 If FRAME_W32_WINDOW (f) is 0,
1715 the frame is being created and its window does not exist yet.
1716 In that case, just record the parameter's new value
1717 in the standard place; do not attempt to change the window. */
1718
1719 void
1720 x_set_foreground_color (f, arg, oldval)
1721 struct frame *f;
1722 Lisp_Object arg, oldval;
1723 {
1724 f->output_data.w32->foreground_pixel
1725 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1726
1727 if (FRAME_W32_WINDOW (f) != 0)
1728 {
1729 recompute_basic_faces (f);
1730 if (FRAME_VISIBLE_P (f))
1731 redraw_frame (f);
1732 }
1733 }
1734
1735 void
1736 x_set_background_color (f, arg, oldval)
1737 struct frame *f;
1738 Lisp_Object arg, oldval;
1739 {
1740 Pixmap temp;
1741 int mask;
1742
1743 f->output_data.w32->background_pixel
1744 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1745
1746 if (FRAME_W32_WINDOW (f) != 0)
1747 {
1748 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX, f->output_data.w32->background_pixel);
1749
1750 recompute_basic_faces (f);
1751
1752 if (FRAME_VISIBLE_P (f))
1753 redraw_frame (f);
1754 }
1755 }
1756
1757 void
1758 x_set_mouse_color (f, arg, oldval)
1759 struct frame *f;
1760 Lisp_Object arg, oldval;
1761 {
1762 #if 0
1763 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1764 #endif
1765 int count;
1766 int mask_color;
1767
1768 if (!EQ (Qnil, arg))
1769 f->output_data.w32->mouse_pixel
1770 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1771 mask_color = f->output_data.w32->background_pixel;
1772 /* No invisible pointers. */
1773 if (mask_color == f->output_data.w32->mouse_pixel
1774 && mask_color == f->output_data.w32->background_pixel)
1775 f->output_data.w32->mouse_pixel = f->output_data.w32->foreground_pixel;
1776
1777 #if 0
1778 BLOCK_INPUT;
1779
1780 /* It's not okay to crash if the user selects a screwy cursor. */
1781 count = x_catch_errors (FRAME_W32_DISPLAY (f));
1782
1783 if (!EQ (Qnil, Vx_pointer_shape))
1784 {
1785 CHECK_NUMBER (Vx_pointer_shape, 0);
1786 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
1787 }
1788 else
1789 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1790 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
1791
1792 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1793 {
1794 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1795 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1796 XINT (Vx_nontext_pointer_shape));
1797 }
1798 else
1799 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1800 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1801
1802 if (!EQ (Qnil, Vx_mode_pointer_shape))
1803 {
1804 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1805 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1806 XINT (Vx_mode_pointer_shape));
1807 }
1808 else
1809 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1810 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
1811
1812 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1813 {
1814 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1815 cross_cursor
1816 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1817 XINT (Vx_sensitive_text_pointer_shape));
1818 }
1819 else
1820 cross_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
1821
1822 /* Check and report errors with the above calls. */
1823 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
1824 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
1825
1826 {
1827 XColor fore_color, back_color;
1828
1829 fore_color.pixel = f->output_data.w32->mouse_pixel;
1830 back_color.pixel = mask_color;
1831 XQueryColor (FRAME_W32_DISPLAY (f),
1832 DefaultColormap (FRAME_W32_DISPLAY (f),
1833 DefaultScreen (FRAME_W32_DISPLAY (f))),
1834 &fore_color);
1835 XQueryColor (FRAME_W32_DISPLAY (f),
1836 DefaultColormap (FRAME_W32_DISPLAY (f),
1837 DefaultScreen (FRAME_W32_DISPLAY (f))),
1838 &back_color);
1839 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
1840 &fore_color, &back_color);
1841 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
1842 &fore_color, &back_color);
1843 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
1844 &fore_color, &back_color);
1845 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
1846 &fore_color, &back_color);
1847 }
1848
1849 if (FRAME_W32_WINDOW (f) != 0)
1850 {
1851 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1852 }
1853
1854 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1855 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1856 f->output_data.w32->text_cursor = cursor;
1857
1858 if (nontext_cursor != f->output_data.w32->nontext_cursor
1859 && f->output_data.w32->nontext_cursor != 0)
1860 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1861 f->output_data.w32->nontext_cursor = nontext_cursor;
1862
1863 if (mode_cursor != f->output_data.w32->modeline_cursor
1864 && f->output_data.w32->modeline_cursor != 0)
1865 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1866 f->output_data.w32->modeline_cursor = mode_cursor;
1867 if (cross_cursor != f->output_data.w32->cross_cursor
1868 && f->output_data.w32->cross_cursor != 0)
1869 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor);
1870 f->output_data.w32->cross_cursor = cross_cursor;
1871
1872 XFlush (FRAME_W32_DISPLAY (f));
1873 UNBLOCK_INPUT;
1874 #endif
1875 }
1876
1877 void
1878 x_set_cursor_color (f, arg, oldval)
1879 struct frame *f;
1880 Lisp_Object arg, oldval;
1881 {
1882 unsigned long fore_pixel;
1883
1884 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1885 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1886 WHITE_PIX_DEFAULT (f));
1887 else
1888 fore_pixel = f->output_data.w32->background_pixel;
1889 f->output_data.w32->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1890
1891 /* Make sure that the cursor color differs from the background color. */
1892 if (f->output_data.w32->cursor_pixel == f->output_data.w32->background_pixel)
1893 {
1894 f->output_data.w32->cursor_pixel = f->output_data.w32->mouse_pixel;
1895 if (f->output_data.w32->cursor_pixel == fore_pixel)
1896 fore_pixel = f->output_data.w32->background_pixel;
1897 }
1898 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
1899
1900 if (FRAME_W32_WINDOW (f) != 0)
1901 {
1902 if (FRAME_VISIBLE_P (f))
1903 {
1904 x_display_cursor (f, 0);
1905 x_display_cursor (f, 1);
1906 }
1907 }
1908 }
1909
1910 /* Set the border-color of frame F to value described by ARG.
1911 ARG can be a string naming a color.
1912 The border-color is used for the border that is drawn by the server.
1913 Note that this does not fully take effect if done before
1914 F has a window; it must be redone when the window is created. */
1915
1916 void
1917 x_set_border_color (f, arg, oldval)
1918 struct frame *f;
1919 Lisp_Object arg, oldval;
1920 {
1921 unsigned char *str;
1922 int pix;
1923
1924 CHECK_STRING (arg, 0);
1925 str = XSTRING (arg)->data;
1926
1927 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1928
1929 x_set_border_pixel (f, pix);
1930 }
1931
1932 /* Set the border-color of frame F to pixel value PIX.
1933 Note that this does not fully take effect if done before
1934 F has an window. */
1935
1936 x_set_border_pixel (f, pix)
1937 struct frame *f;
1938 int pix;
1939 {
1940 f->output_data.w32->border_pixel = pix;
1941
1942 if (FRAME_W32_WINDOW (f) != 0 && f->output_data.w32->border_width > 0)
1943 {
1944 if (FRAME_VISIBLE_P (f))
1945 redraw_frame (f);
1946 }
1947 }
1948
1949 void
1950 x_set_cursor_type (f, arg, oldval)
1951 FRAME_PTR f;
1952 Lisp_Object arg, oldval;
1953 {
1954 if (EQ (arg, Qbar))
1955 {
1956 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1957 f->output_data.w32->cursor_width = 2;
1958 }
1959 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1960 && INTEGERP (XCONS (arg)->cdr))
1961 {
1962 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1963 f->output_data.w32->cursor_width = XINT (XCONS (arg)->cdr);
1964 }
1965 else
1966 /* Treat anything unknown as "box cursor".
1967 It was bad to signal an error; people have trouble fixing
1968 .Xdefaults with Emacs, when it has something bad in it. */
1969 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
1970
1971 /* Make sure the cursor gets redrawn. This is overkill, but how
1972 often do people change cursor types? */
1973 update_mode_lines++;
1974 }
1975
1976 void
1977 x_set_icon_type (f, arg, oldval)
1978 struct frame *f;
1979 Lisp_Object arg, oldval;
1980 {
1981 #if 0
1982 Lisp_Object tem;
1983 int result;
1984
1985 if (STRINGP (arg))
1986 {
1987 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1988 return;
1989 }
1990 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1991 return;
1992
1993 BLOCK_INPUT;
1994 if (NILP (arg))
1995 result = x_text_icon (f,
1996 (char *) XSTRING ((!NILP (f->icon_name)
1997 ? f->icon_name
1998 : f->name))->data);
1999 else
2000 result = x_bitmap_icon (f, arg);
2001
2002 if (result)
2003 {
2004 UNBLOCK_INPUT;
2005 error ("No icon window available");
2006 }
2007
2008 /* If the window was unmapped (and its icon was mapped),
2009 the new icon is not mapped, so map the window in its stead. */
2010 if (FRAME_VISIBLE_P (f))
2011 {
2012 #ifdef USE_X_TOOLKIT
2013 XtPopup (f->output_data.w32->widget, XtGrabNone);
2014 #endif
2015 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
2016 }
2017
2018 XFlush (FRAME_W32_DISPLAY (f));
2019 UNBLOCK_INPUT;
2020 #endif
2021 }
2022
2023 /* Return non-nil if frame F wants a bitmap icon. */
2024
2025 Lisp_Object
2026 x_icon_type (f)
2027 FRAME_PTR f;
2028 {
2029 Lisp_Object tem;
2030
2031 tem = assq_no_quit (Qicon_type, f->param_alist);
2032 if (CONSP (tem))
2033 return XCONS (tem)->cdr;
2034 else
2035 return Qnil;
2036 }
2037
2038 void
2039 x_set_icon_name (f, arg, oldval)
2040 struct frame *f;
2041 Lisp_Object arg, oldval;
2042 {
2043 Lisp_Object tem;
2044 int result;
2045
2046 if (STRINGP (arg))
2047 {
2048 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
2049 return;
2050 }
2051 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
2052 return;
2053
2054 f->icon_name = arg;
2055
2056 #if 0
2057 if (f->output_data.w32->icon_bitmap != 0)
2058 return;
2059
2060 BLOCK_INPUT;
2061
2062 result = x_text_icon (f,
2063 (char *) XSTRING ((!NILP (f->icon_name)
2064 ? f->icon_name
2065 : !NILP (f->title)
2066 ? f->title
2067 : f->name))->data);
2068
2069 if (result)
2070 {
2071 UNBLOCK_INPUT;
2072 error ("No icon window available");
2073 }
2074
2075 /* If the window was unmapped (and its icon was mapped),
2076 the new icon is not mapped, so map the window in its stead. */
2077 if (FRAME_VISIBLE_P (f))
2078 {
2079 #ifdef USE_X_TOOLKIT
2080 XtPopup (f->output_data.w32->widget, XtGrabNone);
2081 #endif
2082 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
2083 }
2084
2085 XFlush (FRAME_W32_DISPLAY (f));
2086 UNBLOCK_INPUT;
2087 #endif
2088 }
2089
2090 extern Lisp_Object x_new_font ();
2091 extern Lisp_Object x_new_fontset();
2092
2093 void
2094 x_set_font (f, arg, oldval)
2095 struct frame *f;
2096 Lisp_Object arg, oldval;
2097 {
2098 Lisp_Object result;
2099 Lisp_Object fontset_name;
2100 Lisp_Object frame;
2101
2102 CHECK_STRING (arg, 1);
2103
2104 fontset_name = Fquery_fontset (arg, Qnil);
2105
2106 BLOCK_INPUT;
2107 result = (STRINGP (fontset_name)
2108 ? x_new_fontset (f, XSTRING (fontset_name)->data)
2109 : x_new_font (f, XSTRING (arg)->data));
2110 UNBLOCK_INPUT;
2111
2112 if (EQ (result, Qnil))
2113 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
2114 else if (EQ (result, Qt))
2115 error ("the characters of the given font have varying widths");
2116 else if (STRINGP (result))
2117 {
2118 recompute_basic_faces (f);
2119 store_frame_param (f, Qfont, result);
2120 }
2121 else
2122 abort ();
2123
2124 XSETFRAME (frame, f);
2125 call1 (Qface_set_after_frame_default, frame);
2126 }
2127
2128 void
2129 x_set_border_width (f, arg, oldval)
2130 struct frame *f;
2131 Lisp_Object arg, oldval;
2132 {
2133 CHECK_NUMBER (arg, 0);
2134
2135 if (XINT (arg) == f->output_data.w32->border_width)
2136 return;
2137
2138 if (FRAME_W32_WINDOW (f) != 0)
2139 error ("Cannot change the border width of a window");
2140
2141 f->output_data.w32->border_width = XINT (arg);
2142 }
2143
2144 void
2145 x_set_internal_border_width (f, arg, oldval)
2146 struct frame *f;
2147 Lisp_Object arg, oldval;
2148 {
2149 int mask;
2150 int old = f->output_data.w32->internal_border_width;
2151
2152 CHECK_NUMBER (arg, 0);
2153 f->output_data.w32->internal_border_width = XINT (arg);
2154 if (f->output_data.w32->internal_border_width < 0)
2155 f->output_data.w32->internal_border_width = 0;
2156
2157 if (f->output_data.w32->internal_border_width == old)
2158 return;
2159
2160 if (FRAME_W32_WINDOW (f) != 0)
2161 {
2162 BLOCK_INPUT;
2163 x_set_window_size (f, 0, f->width, f->height);
2164 UNBLOCK_INPUT;
2165 SET_FRAME_GARBAGED (f);
2166 }
2167 }
2168
2169 void
2170 x_set_visibility (f, value, oldval)
2171 struct frame *f;
2172 Lisp_Object value, oldval;
2173 {
2174 Lisp_Object frame;
2175 XSETFRAME (frame, f);
2176
2177 if (NILP (value))
2178 Fmake_frame_invisible (frame, Qt);
2179 else if (EQ (value, Qicon))
2180 Ficonify_frame (frame);
2181 else
2182 Fmake_frame_visible (frame);
2183 }
2184
2185 void
2186 x_set_menu_bar_lines (f, value, oldval)
2187 struct frame *f;
2188 Lisp_Object value, oldval;
2189 {
2190 int nlines;
2191 int olines = FRAME_MENU_BAR_LINES (f);
2192
2193 /* Right now, menu bars don't work properly in minibuf-only frames;
2194 most of the commands try to apply themselves to the minibuffer
2195 frame itslef, and get an error because you can't switch buffers
2196 in or split the minibuffer window. */
2197 if (FRAME_MINIBUF_ONLY_P (f))
2198 return;
2199
2200 if (INTEGERP (value))
2201 nlines = XINT (value);
2202 else
2203 nlines = 0;
2204
2205 FRAME_MENU_BAR_LINES (f) = 0;
2206 if (nlines)
2207 FRAME_EXTERNAL_MENU_BAR (f) = 1;
2208 else
2209 {
2210 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2211 free_frame_menubar (f);
2212 FRAME_EXTERNAL_MENU_BAR (f) = 0;
2213
2214 /* Adjust the frame size so that the client (text) dimensions
2215 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2216 set correctly. */
2217 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2218 }
2219 }
2220
2221 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2222 w32_id_name.
2223
2224 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2225 name; if NAME is a string, set F's name to NAME and set
2226 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2227
2228 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2229 suggesting a new name, which lisp code should override; if
2230 F->explicit_name is set, ignore the new name; otherwise, set it. */
2231
2232 void
2233 x_set_name (f, name, explicit)
2234 struct frame *f;
2235 Lisp_Object name;
2236 int explicit;
2237 {
2238 /* Make sure that requests from lisp code override requests from
2239 Emacs redisplay code. */
2240 if (explicit)
2241 {
2242 /* If we're switching from explicit to implicit, we had better
2243 update the mode lines and thereby update the title. */
2244 if (f->explicit_name && NILP (name))
2245 update_mode_lines = 1;
2246
2247 f->explicit_name = ! NILP (name);
2248 }
2249 else if (f->explicit_name)
2250 return;
2251
2252 /* If NAME is nil, set the name to the w32_id_name. */
2253 if (NILP (name))
2254 {
2255 /* Check for no change needed in this very common case
2256 before we do any consing. */
2257 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
2258 XSTRING (f->name)->data))
2259 return;
2260 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
2261 }
2262 else
2263 CHECK_STRING (name, 0);
2264
2265 /* Don't change the name if it's already NAME. */
2266 if (! NILP (Fstring_equal (name, f->name)))
2267 return;
2268
2269 f->name = name;
2270
2271 /* For setting the frame title, the title parameter should override
2272 the name parameter. */
2273 if (! NILP (f->title))
2274 name = f->title;
2275
2276 if (FRAME_W32_WINDOW (f))
2277 {
2278 BLOCK_INPUT;
2279 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
2280 UNBLOCK_INPUT;
2281 }
2282 }
2283
2284 /* This function should be called when the user's lisp code has
2285 specified a name for the frame; the name will override any set by the
2286 redisplay code. */
2287 void
2288 x_explicitly_set_name (f, arg, oldval)
2289 FRAME_PTR f;
2290 Lisp_Object arg, oldval;
2291 {
2292 x_set_name (f, arg, 1);
2293 }
2294
2295 /* This function should be called by Emacs redisplay code to set the
2296 name; names set this way will never override names set by the user's
2297 lisp code. */
2298 void
2299 x_implicitly_set_name (f, arg, oldval)
2300 FRAME_PTR f;
2301 Lisp_Object arg, oldval;
2302 {
2303 x_set_name (f, arg, 0);
2304 }
2305 \f
2306 /* Change the title of frame F to NAME.
2307 If NAME is nil, use the frame name as the title.
2308
2309 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2310 name; if NAME is a string, set F's name to NAME and set
2311 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2312
2313 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2314 suggesting a new name, which lisp code should override; if
2315 F->explicit_name is set, ignore the new name; otherwise, set it. */
2316
2317 void
2318 x_set_title (f, name)
2319 struct frame *f;
2320 Lisp_Object name;
2321 {
2322 /* Don't change the title if it's already NAME. */
2323 if (EQ (name, f->title))
2324 return;
2325
2326 update_mode_lines = 1;
2327
2328 f->title = name;
2329
2330 if (NILP (name))
2331 name = f->name;
2332
2333 if (FRAME_W32_WINDOW (f))
2334 {
2335 BLOCK_INPUT;
2336 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
2337 UNBLOCK_INPUT;
2338 }
2339 }
2340 \f
2341 void
2342 x_set_autoraise (f, arg, oldval)
2343 struct frame *f;
2344 Lisp_Object arg, oldval;
2345 {
2346 f->auto_raise = !EQ (Qnil, arg);
2347 }
2348
2349 void
2350 x_set_autolower (f, arg, oldval)
2351 struct frame *f;
2352 Lisp_Object arg, oldval;
2353 {
2354 f->auto_lower = !EQ (Qnil, arg);
2355 }
2356
2357 void
2358 x_set_unsplittable (f, arg, oldval)
2359 struct frame *f;
2360 Lisp_Object arg, oldval;
2361 {
2362 f->no_split = !NILP (arg);
2363 }
2364
2365 void
2366 x_set_vertical_scroll_bars (f, arg, oldval)
2367 struct frame *f;
2368 Lisp_Object arg, oldval;
2369 {
2370 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2371 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2372 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2373 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
2374 {
2375 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = NILP (arg) ?
2376 vertical_scroll_bar_none :
2377 /* Put scroll bars on the right by default, as is conventional
2378 on MS-Windows. */
2379 EQ (Qleft, arg)
2380 ? vertical_scroll_bar_left
2381 : vertical_scroll_bar_right;
2382
2383 /* We set this parameter before creating the window for the
2384 frame, so we can get the geometry right from the start.
2385 However, if the window hasn't been created yet, we shouldn't
2386 call x_set_window_size. */
2387 if (FRAME_W32_WINDOW (f))
2388 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2389 }
2390 }
2391
2392 void
2393 x_set_scroll_bar_width (f, arg, oldval)
2394 struct frame *f;
2395 Lisp_Object arg, oldval;
2396 {
2397 if (NILP (arg))
2398 {
2399 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
2400 FRAME_SCROLL_BAR_COLS (f) = 2;
2401 }
2402 else if (INTEGERP (arg) && XINT (arg) > 0
2403 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2404 {
2405 int wid = FONT_WIDTH (f->output_data.w32->font);
2406 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2407 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
2408 if (FRAME_W32_WINDOW (f))
2409 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2410 }
2411 }
2412 \f
2413 /* Subroutines of creating an frame. */
2414
2415 /* Make sure that Vx_resource_name is set to a reasonable value.
2416 Fix it up, or set it to `emacs' if it is too hopeless. */
2417
2418 static void
2419 validate_x_resource_name ()
2420 {
2421 int len;
2422 /* Number of valid characters in the resource name. */
2423 int good_count = 0;
2424 /* Number of invalid characters in the resource name. */
2425 int bad_count = 0;
2426 Lisp_Object new;
2427 int i;
2428
2429 if (STRINGP (Vx_resource_name))
2430 {
2431 unsigned char *p = XSTRING (Vx_resource_name)->data;
2432 int i;
2433
2434 len = XSTRING (Vx_resource_name)->size;
2435
2436 /* Only letters, digits, - and _ are valid in resource names.
2437 Count the valid characters and count the invalid ones. */
2438 for (i = 0; i < len; i++)
2439 {
2440 int c = p[i];
2441 if (! ((c >= 'a' && c <= 'z')
2442 || (c >= 'A' && c <= 'Z')
2443 || (c >= '0' && c <= '9')
2444 || c == '-' || c == '_'))
2445 bad_count++;
2446 else
2447 good_count++;
2448 }
2449 }
2450 else
2451 /* Not a string => completely invalid. */
2452 bad_count = 5, good_count = 0;
2453
2454 /* If name is valid already, return. */
2455 if (bad_count == 0)
2456 return;
2457
2458 /* If name is entirely invalid, or nearly so, use `emacs'. */
2459 if (good_count == 0
2460 || (good_count == 1 && bad_count > 0))
2461 {
2462 Vx_resource_name = build_string ("emacs");
2463 return;
2464 }
2465
2466 /* Name is partly valid. Copy it and replace the invalid characters
2467 with underscores. */
2468
2469 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2470
2471 for (i = 0; i < len; i++)
2472 {
2473 int c = XSTRING (new)->data[i];
2474 if (! ((c >= 'a' && c <= 'z')
2475 || (c >= 'A' && c <= 'Z')
2476 || (c >= '0' && c <= '9')
2477 || c == '-' || c == '_'))
2478 XSTRING (new)->data[i] = '_';
2479 }
2480 }
2481
2482
2483 extern char *x_get_string_resource ();
2484
2485 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2486 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2487 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2488 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2489 the name specified by the `-name' or `-rn' command-line arguments.\n\
2490 \n\
2491 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2492 class, respectively. You must specify both of them or neither.\n\
2493 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2494 and the class is `Emacs.CLASS.SUBCLASS'.")
2495 (attribute, class, component, subclass)
2496 Lisp_Object attribute, class, component, subclass;
2497 {
2498 register char *value;
2499 char *name_key;
2500 char *class_key;
2501
2502 CHECK_STRING (attribute, 0);
2503 CHECK_STRING (class, 0);
2504
2505 if (!NILP (component))
2506 CHECK_STRING (component, 1);
2507 if (!NILP (subclass))
2508 CHECK_STRING (subclass, 2);
2509 if (NILP (component) != NILP (subclass))
2510 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2511
2512 validate_x_resource_name ();
2513
2514 /* Allocate space for the components, the dots which separate them,
2515 and the final '\0'. Make them big enough for the worst case. */
2516 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2517 + (STRINGP (component)
2518 ? XSTRING (component)->size : 0)
2519 + XSTRING (attribute)->size
2520 + 3);
2521
2522 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2523 + XSTRING (class)->size
2524 + (STRINGP (subclass)
2525 ? XSTRING (subclass)->size : 0)
2526 + 3);
2527
2528 /* Start with emacs.FRAMENAME for the name (the specific one)
2529 and with `Emacs' for the class key (the general one). */
2530 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2531 strcpy (class_key, EMACS_CLASS);
2532
2533 strcat (class_key, ".");
2534 strcat (class_key, XSTRING (class)->data);
2535
2536 if (!NILP (component))
2537 {
2538 strcat (class_key, ".");
2539 strcat (class_key, XSTRING (subclass)->data);
2540
2541 strcat (name_key, ".");
2542 strcat (name_key, XSTRING (component)->data);
2543 }
2544
2545 strcat (name_key, ".");
2546 strcat (name_key, XSTRING (attribute)->data);
2547
2548 value = x_get_string_resource (Qnil,
2549 name_key, class_key);
2550
2551 if (value != (char *) 0)
2552 return build_string (value);
2553 else
2554 return Qnil;
2555 }
2556
2557 /* Used when C code wants a resource value. */
2558
2559 char *
2560 x_get_resource_string (attribute, class)
2561 char *attribute, *class;
2562 {
2563 register char *value;
2564 char *name_key;
2565 char *class_key;
2566
2567 /* Allocate space for the components, the dots which separate them,
2568 and the final '\0'. */
2569 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
2570 + strlen (attribute) + 2);
2571 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2572 + strlen (class) + 2);
2573
2574 sprintf (name_key, "%s.%s",
2575 XSTRING (Vinvocation_name)->data,
2576 attribute);
2577 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2578
2579 return x_get_string_resource (selected_frame,
2580 name_key, class_key);
2581 }
2582
2583 /* Types we might convert a resource string into. */
2584 enum resource_types
2585 {
2586 number, boolean, string, symbol
2587 };
2588
2589 /* Return the value of parameter PARAM.
2590
2591 First search ALIST, then Vdefault_frame_alist, then the X defaults
2592 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2593
2594 Convert the resource to the type specified by desired_type.
2595
2596 If no default is specified, return Qunbound. If you call
2597 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2598 and don't let it get stored in any Lisp-visible variables! */
2599
2600 static Lisp_Object
2601 x_get_arg (alist, param, attribute, class, type)
2602 Lisp_Object alist, param;
2603 char *attribute;
2604 char *class;
2605 enum resource_types type;
2606 {
2607 register Lisp_Object tem;
2608
2609 tem = Fassq (param, alist);
2610 if (EQ (tem, Qnil))
2611 tem = Fassq (param, Vdefault_frame_alist);
2612 if (EQ (tem, Qnil))
2613 {
2614
2615 if (attribute)
2616 {
2617 tem = Fx_get_resource (build_string (attribute),
2618 build_string (class),
2619 Qnil, Qnil);
2620
2621 if (NILP (tem))
2622 return Qunbound;
2623
2624 switch (type)
2625 {
2626 case number:
2627 return make_number (atoi (XSTRING (tem)->data));
2628
2629 case boolean:
2630 tem = Fdowncase (tem);
2631 if (!strcmp (XSTRING (tem)->data, "on")
2632 || !strcmp (XSTRING (tem)->data, "true"))
2633 return Qt;
2634 else
2635 return Qnil;
2636
2637 case string:
2638 return tem;
2639
2640 case symbol:
2641 /* As a special case, we map the values `true' and `on'
2642 to Qt, and `false' and `off' to Qnil. */
2643 {
2644 Lisp_Object lower;
2645 lower = Fdowncase (tem);
2646 if (!strcmp (XSTRING (lower)->data, "on")
2647 || !strcmp (XSTRING (lower)->data, "true"))
2648 return Qt;
2649 else if (!strcmp (XSTRING (lower)->data, "off")
2650 || !strcmp (XSTRING (lower)->data, "false"))
2651 return Qnil;
2652 else
2653 return Fintern (tem, Qnil);
2654 }
2655
2656 default:
2657 abort ();
2658 }
2659 }
2660 else
2661 return Qunbound;
2662 }
2663 return Fcdr (tem);
2664 }
2665
2666 /* Record in frame F the specified or default value according to ALIST
2667 of the parameter named PARAM (a Lisp symbol).
2668 If no value is specified for PARAM, look for an X default for XPROP
2669 on the frame named NAME.
2670 If that is not found either, use the value DEFLT. */
2671
2672 static Lisp_Object
2673 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2674 struct frame *f;
2675 Lisp_Object alist;
2676 Lisp_Object prop;
2677 Lisp_Object deflt;
2678 char *xprop;
2679 char *xclass;
2680 enum resource_types type;
2681 {
2682 Lisp_Object tem;
2683
2684 tem = x_get_arg (alist, prop, xprop, xclass, type);
2685 if (EQ (tem, Qunbound))
2686 tem = deflt;
2687 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2688 return tem;
2689 }
2690 \f
2691 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2692 "Parse an X-style geometry string STRING.\n\
2693 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2694 The properties returned may include `top', `left', `height', and `width'.\n\
2695 The value of `left' or `top' may be an integer,\n\
2696 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2697 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2698 (string)
2699 Lisp_Object string;
2700 {
2701 int geometry, x, y;
2702 unsigned int width, height;
2703 Lisp_Object result;
2704
2705 CHECK_STRING (string, 0);
2706
2707 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2708 &x, &y, &width, &height);
2709
2710 result = Qnil;
2711 if (geometry & XValue)
2712 {
2713 Lisp_Object element;
2714
2715 if (x >= 0 && (geometry & XNegative))
2716 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2717 else if (x < 0 && ! (geometry & XNegative))
2718 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2719 else
2720 element = Fcons (Qleft, make_number (x));
2721 result = Fcons (element, result);
2722 }
2723
2724 if (geometry & YValue)
2725 {
2726 Lisp_Object element;
2727
2728 if (y >= 0 && (geometry & YNegative))
2729 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2730 else if (y < 0 && ! (geometry & YNegative))
2731 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2732 else
2733 element = Fcons (Qtop, make_number (y));
2734 result = Fcons (element, result);
2735 }
2736
2737 if (geometry & WidthValue)
2738 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2739 if (geometry & HeightValue)
2740 result = Fcons (Fcons (Qheight, make_number (height)), result);
2741
2742 return result;
2743 }
2744
2745 /* Calculate the desired size and position of this window,
2746 and return the flags saying which aspects were specified.
2747
2748 This function does not make the coordinates positive. */
2749
2750 #define DEFAULT_ROWS 40
2751 #define DEFAULT_COLS 80
2752
2753 static int
2754 x_figure_window_size (f, parms)
2755 struct frame *f;
2756 Lisp_Object parms;
2757 {
2758 register Lisp_Object tem0, tem1, tem2;
2759 int height, width, left, top;
2760 register int geometry;
2761 long window_prompting = 0;
2762
2763 /* Default values if we fall through.
2764 Actually, if that happens we should get
2765 window manager prompting. */
2766 SET_FRAME_WIDTH (f, DEFAULT_COLS);
2767 f->height = DEFAULT_ROWS;
2768 /* Window managers expect that if program-specified
2769 positions are not (0,0), they're intentional, not defaults. */
2770 f->output_data.w32->top_pos = 0;
2771 f->output_data.w32->left_pos = 0;
2772
2773 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
2774 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
2775 tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
2776 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2777 {
2778 if (!EQ (tem0, Qunbound))
2779 {
2780 CHECK_NUMBER (tem0, 0);
2781 f->height = XINT (tem0);
2782 }
2783 if (!EQ (tem1, Qunbound))
2784 {
2785 CHECK_NUMBER (tem1, 0);
2786 SET_FRAME_WIDTH (f, XINT (tem1));
2787 }
2788 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2789 window_prompting |= USSize;
2790 else
2791 window_prompting |= PSize;
2792 }
2793
2794 f->output_data.w32->vertical_scroll_bar_extra
2795 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2796 ? 0
2797 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2798 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2799 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font)));
2800 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2801 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2802
2803 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
2804 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
2805 tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
2806 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2807 {
2808 if (EQ (tem0, Qminus))
2809 {
2810 f->output_data.w32->top_pos = 0;
2811 window_prompting |= YNegative;
2812 }
2813 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2814 && CONSP (XCONS (tem0)->cdr)
2815 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2816 {
2817 f->output_data.w32->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2818 window_prompting |= YNegative;
2819 }
2820 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2821 && CONSP (XCONS (tem0)->cdr)
2822 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2823 {
2824 f->output_data.w32->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2825 }
2826 else if (EQ (tem0, Qunbound))
2827 f->output_data.w32->top_pos = 0;
2828 else
2829 {
2830 CHECK_NUMBER (tem0, 0);
2831 f->output_data.w32->top_pos = XINT (tem0);
2832 if (f->output_data.w32->top_pos < 0)
2833 window_prompting |= YNegative;
2834 }
2835
2836 if (EQ (tem1, Qminus))
2837 {
2838 f->output_data.w32->left_pos = 0;
2839 window_prompting |= XNegative;
2840 }
2841 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2842 && CONSP (XCONS (tem1)->cdr)
2843 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2844 {
2845 f->output_data.w32->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2846 window_prompting |= XNegative;
2847 }
2848 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2849 && CONSP (XCONS (tem1)->cdr)
2850 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2851 {
2852 f->output_data.w32->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2853 }
2854 else if (EQ (tem1, Qunbound))
2855 f->output_data.w32->left_pos = 0;
2856 else
2857 {
2858 CHECK_NUMBER (tem1, 0);
2859 f->output_data.w32->left_pos = XINT (tem1);
2860 if (f->output_data.w32->left_pos < 0)
2861 window_prompting |= XNegative;
2862 }
2863
2864 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2865 window_prompting |= USPosition;
2866 else
2867 window_prompting |= PPosition;
2868 }
2869
2870 return window_prompting;
2871 }
2872
2873 \f
2874
2875 extern LRESULT CALLBACK w32_wnd_proc ();
2876
2877 BOOL
2878 w32_init_class (hinst)
2879 HINSTANCE hinst;
2880 {
2881 WNDCLASS wc;
2882
2883 wc.style = CS_HREDRAW | CS_VREDRAW;
2884 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
2885 wc.cbClsExtra = 0;
2886 wc.cbWndExtra = WND_EXTRA_BYTES;
2887 wc.hInstance = hinst;
2888 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
2889 wc.hCursor = LoadCursor (NULL, IDC_ARROW);
2890 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
2891 wc.lpszMenuName = NULL;
2892 wc.lpszClassName = EMACS_CLASS;
2893
2894 return (RegisterClass (&wc));
2895 }
2896
2897 HWND
2898 w32_createscrollbar (f, bar)
2899 struct frame *f;
2900 struct scroll_bar * bar;
2901 {
2902 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
2903 /* Position and size of scroll bar. */
2904 XINT(bar->left), XINT(bar->top),
2905 XINT(bar->width), XINT(bar->height),
2906 FRAME_W32_WINDOW (f),
2907 NULL,
2908 hinst,
2909 NULL));
2910 }
2911
2912 void
2913 w32_createwindow (f)
2914 struct frame *f;
2915 {
2916 HWND hwnd;
2917 RECT rect;
2918
2919 rect.left = rect.top = 0;
2920 rect.right = PIXEL_WIDTH (f);
2921 rect.bottom = PIXEL_HEIGHT (f);
2922
2923 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2924 FRAME_EXTERNAL_MENU_BAR (f));
2925
2926 /* Do first time app init */
2927
2928 if (!hprevinst)
2929 {
2930 w32_init_class (hinst);
2931 }
2932
2933 FRAME_W32_WINDOW (f) = hwnd
2934 = CreateWindow (EMACS_CLASS,
2935 f->namebuf,
2936 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2937 f->output_data.w32->left_pos,
2938 f->output_data.w32->top_pos,
2939 rect.right - rect.left,
2940 rect.bottom - rect.top,
2941 NULL,
2942 NULL,
2943 hinst,
2944 NULL);
2945
2946 if (hwnd)
2947 {
2948 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FONT_WIDTH (f->output_data.w32->font));
2949 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
2950 SetWindowLong (hwnd, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
2951 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra);
2952 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, f->output_data.w32->background_pixel);
2953
2954 /* Enable drag-n-drop. */
2955 DragAcceptFiles (hwnd, TRUE);
2956
2957 /* Do this to discard the default setting specified by our parent. */
2958 ShowWindow (hwnd, SW_HIDE);
2959 }
2960 }
2961
2962 /* Convert between the modifier bits W32 uses and the modifier bits
2963 Emacs uses. */
2964 unsigned int
2965 w32_get_modifiers ()
2966 {
2967 return (((GetKeyState (VK_SHIFT)&0x8000) ? shift_modifier : 0) |
2968 ((GetKeyState (VK_CONTROL)&0x8000) ? ctrl_modifier : 0) |
2969 ((GetKeyState (VK_MENU)&0x8000) ?
2970 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2971 }
2972
2973 void
2974 my_post_msg (wmsg, hwnd, msg, wParam, lParam)
2975 W32Msg * wmsg;
2976 HWND hwnd;
2977 UINT msg;
2978 WPARAM wParam;
2979 LPARAM lParam;
2980 {
2981 wmsg->msg.hwnd = hwnd;
2982 wmsg->msg.message = msg;
2983 wmsg->msg.wParam = wParam;
2984 wmsg->msg.lParam = lParam;
2985 wmsg->msg.time = GetMessageTime ();
2986
2987 post_msg (wmsg);
2988 }
2989
2990 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2991 between left and right keys as advertised. We test for this
2992 support dynamically, and set a flag when the support is absent. If
2993 absent, we keep track of the left and right control and alt keys
2994 ourselves. This is particularly necessary on keyboards that rely
2995 upon the AltGr key, which is represented as having the left control
2996 and right alt keys pressed. For these keyboards, we need to know
2997 when the left alt key has been pressed in addition to the AltGr key
2998 so that we can properly support M-AltGr-key sequences (such as M-@
2999 on Swedish keyboards). */
3000
3001 #define EMACS_LCONTROL 0
3002 #define EMACS_RCONTROL 1
3003 #define EMACS_LMENU 2
3004 #define EMACS_RMENU 3
3005
3006 static int modifiers[4];
3007 static int modifiers_recorded;
3008 static int modifier_key_support_tested;
3009
3010 static void
3011 test_modifier_support (unsigned int wparam)
3012 {
3013 unsigned int l, r;
3014
3015 if (wparam != VK_CONTROL && wparam != VK_MENU)
3016 return;
3017 if (wparam == VK_CONTROL)
3018 {
3019 l = VK_LCONTROL;
3020 r = VK_RCONTROL;
3021 }
3022 else
3023 {
3024 l = VK_LMENU;
3025 r = VK_RMENU;
3026 }
3027 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
3028 modifiers_recorded = 1;
3029 else
3030 modifiers_recorded = 0;
3031 modifier_key_support_tested = 1;
3032 }
3033
3034 static void
3035 record_keydown (unsigned int wparam, unsigned int lparam)
3036 {
3037 int i;
3038
3039 if (!modifier_key_support_tested)
3040 test_modifier_support (wparam);
3041
3042 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3043 return;
3044
3045 if (wparam == VK_CONTROL)
3046 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3047 else
3048 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3049
3050 modifiers[i] = 1;
3051 }
3052
3053 static void
3054 record_keyup (unsigned int wparam, unsigned int lparam)
3055 {
3056 int i;
3057
3058 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3059 return;
3060
3061 if (wparam == VK_CONTROL)
3062 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3063 else
3064 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3065
3066 modifiers[i] = 0;
3067 }
3068
3069 /* Emacs can lose focus while a modifier key has been pressed. When
3070 it regains focus, be conservative and clear all modifiers since
3071 we cannot reconstruct the left and right modifier state. */
3072 static void
3073 reset_modifiers ()
3074 {
3075 SHORT ctrl, alt;
3076
3077 if (!modifiers_recorded)
3078 return;
3079
3080 ctrl = GetAsyncKeyState (VK_CONTROL);
3081 alt = GetAsyncKeyState (VK_MENU);
3082
3083 if (ctrl == 0 || alt == 0)
3084 /* Emacs doesn't have keyboard focus. Do nothing. */
3085 return;
3086
3087 if (!(ctrl & 0x08000))
3088 /* Clear any recorded control modifier state. */
3089 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3090
3091 if (!(alt & 0x08000))
3092 /* Clear any recorded alt modifier state. */
3093 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3094
3095 /* Otherwise, leave the modifier state as it was when Emacs lost
3096 keyboard focus. */
3097 }
3098
3099 /* Synchronize modifier state with what is reported with the current
3100 keystroke. Even if we cannot distinguish between left and right
3101 modifier keys, we know that, if no modifiers are set, then neither
3102 the left or right modifier should be set. */
3103 static void
3104 sync_modifiers ()
3105 {
3106 if (!modifiers_recorded)
3107 return;
3108
3109 if (!(GetKeyState (VK_CONTROL) & 0x8000))
3110 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3111
3112 if (!(GetKeyState (VK_MENU) & 0x8000))
3113 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3114 }
3115
3116 static int
3117 modifier_set (int vkey)
3118 {
3119 if (vkey == VK_CAPITAL)
3120 return (GetKeyState (vkey) & 0x1);
3121 if (!modifiers_recorded)
3122 return (GetKeyState (vkey) & 0x8000);
3123
3124 switch (vkey)
3125 {
3126 case VK_LCONTROL:
3127 return modifiers[EMACS_LCONTROL];
3128 case VK_RCONTROL:
3129 return modifiers[EMACS_RCONTROL];
3130 case VK_LMENU:
3131 return modifiers[EMACS_LMENU];
3132 case VK_RMENU:
3133 return modifiers[EMACS_RMENU];
3134 default:
3135 break;
3136 }
3137 return (GetKeyState (vkey) & 0x8000);
3138 }
3139
3140 /* We map the VK_* modifiers into console modifier constants
3141 so that we can use the same routines to handle both console
3142 and window input. */
3143
3144 static int
3145 construct_modifiers (unsigned int wparam, unsigned int lparam)
3146 {
3147 int mods;
3148
3149 if (wparam != VK_CONTROL && wparam != VK_MENU)
3150 mods = GetLastError ();
3151
3152 mods = 0;
3153 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
3154 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
3155 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
3156 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
3157 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
3158 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
3159
3160 return mods;
3161 }
3162
3163 static unsigned int
3164 map_keypad_keys (unsigned int wparam, unsigned int lparam)
3165 {
3166 unsigned int extended = (lparam & 0x1000000L);
3167
3168 if (wparam < VK_CLEAR || wparam > VK_DELETE)
3169 return wparam;
3170
3171 if (wparam == VK_RETURN)
3172 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
3173
3174 if (wparam >= VK_PRIOR && wparam <= VK_DOWN)
3175 return (!extended ? (VK_NUMPAD_PRIOR + (wparam - VK_PRIOR)) : wparam);
3176
3177 if (wparam == VK_INSERT || wparam == VK_DELETE)
3178 return (!extended ? (VK_NUMPAD_INSERT + (wparam - VK_INSERT)) : wparam);
3179
3180 if (wparam == VK_CLEAR)
3181 return (!extended ? VK_NUMPAD_CLEAR : wparam);
3182
3183 return wparam;
3184 }
3185
3186 /* Main message dispatch loop. */
3187
3188 static void
3189 w32_msg_pump (deferred_msg * msg_buf)
3190 {
3191 MSG msg;
3192
3193 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
3194
3195 while (GetMessage (&msg, NULL, 0, 0))
3196 {
3197 if (msg.hwnd == NULL)
3198 {
3199 switch (msg.message)
3200 {
3201 case WM_EMACS_CREATEWINDOW:
3202 w32_createwindow ((struct frame *) msg.wParam);
3203 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3204 abort ();
3205 break;
3206 case WM_EMACS_SETLOCALE:
3207 SetThreadLocale (msg.wParam);
3208 /* Reply is not expected. */
3209 break;
3210 default:
3211 /* No need to be so draconian! */
3212 /* abort (); */
3213 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
3214 }
3215 }
3216 else
3217 {
3218 DispatchMessage (&msg);
3219 }
3220
3221 /* Exit nested loop when our deferred message has completed. */
3222 if (msg_buf->completed)
3223 break;
3224 }
3225 }
3226
3227 deferred_msg * deferred_msg_head;
3228
3229 static deferred_msg *
3230 find_deferred_msg (HWND hwnd, UINT msg)
3231 {
3232 deferred_msg * item;
3233
3234 /* Don't actually need synchronization for read access, since
3235 modification of single pointer is always atomic. */
3236 /* enter_crit (); */
3237
3238 for (item = deferred_msg_head; item != NULL; item = item->next)
3239 if (item->w32msg.msg.hwnd == hwnd
3240 && item->w32msg.msg.message == msg)
3241 break;
3242
3243 /* leave_crit (); */
3244
3245 return item;
3246 }
3247
3248 static LRESULT
3249 send_deferred_msg (deferred_msg * msg_buf,
3250 HWND hwnd,
3251 UINT msg,
3252 WPARAM wParam,
3253 LPARAM lParam)
3254 {
3255 /* Only input thread can send deferred messages. */
3256 if (GetCurrentThreadId () != dwWindowsThreadId)
3257 abort ();
3258
3259 /* It is an error to send a message that is already deferred. */
3260 if (find_deferred_msg (hwnd, msg) != NULL)
3261 abort ();
3262
3263 /* Enforced synchronization is not needed because this is the only
3264 function that alters deferred_msg_head, and the following critical
3265 section is guaranteed to only be serially reentered (since only the
3266 input thread can call us). */
3267
3268 /* enter_crit (); */
3269
3270 msg_buf->completed = 0;
3271 msg_buf->next = deferred_msg_head;
3272 deferred_msg_head = msg_buf;
3273 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
3274
3275 /* leave_crit (); */
3276
3277 /* Start a new nested message loop to process other messages until
3278 this one is completed. */
3279 w32_msg_pump (msg_buf);
3280
3281 deferred_msg_head = msg_buf->next;
3282
3283 return msg_buf->result;
3284 }
3285
3286 void
3287 complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
3288 {
3289 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
3290
3291 if (msg_buf == NULL)
3292 abort ();
3293
3294 msg_buf->result = result;
3295 msg_buf->completed = 1;
3296
3297 /* Ensure input thread is woken so it notices the completion. */
3298 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3299 }
3300
3301
3302 DWORD
3303 w32_msg_worker (dw)
3304 DWORD dw;
3305 {
3306 MSG msg;
3307 deferred_msg dummy_buf;
3308
3309 /* Ensure our message queue is created */
3310
3311 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
3312
3313 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3314 abort ();
3315
3316 memset (&dummy_buf, 0, sizeof (dummy_buf));
3317 dummy_buf.w32msg.msg.hwnd = NULL;
3318 dummy_buf.w32msg.msg.message = WM_NULL;
3319
3320 /* This is the inital message loop which should only exit when the
3321 application quits. */
3322 w32_msg_pump (&dummy_buf);
3323
3324 return 0;
3325 }
3326
3327 /* Main window procedure */
3328
3329 extern char *lispy_function_keys[];
3330
3331 LRESULT CALLBACK
3332 w32_wnd_proc (hwnd, msg, wParam, lParam)
3333 HWND hwnd;
3334 UINT msg;
3335 WPARAM wParam;
3336 LPARAM lParam;
3337 {
3338 struct frame *f;
3339 struct w32_display_info *dpyinfo = &one_w32_display_info;
3340 W32Msg wmsg;
3341 int windows_translate;
3342
3343 /* Note that it is okay to call x_window_to_frame, even though we are
3344 not running in the main lisp thread, because frame deletion
3345 requires the lisp thread to synchronize with this thread. Thus, if
3346 a frame struct is returned, it can be used without concern that the
3347 lisp thread might make it disappear while we are using it.
3348
3349 NB. Walking the frame list in this thread is safe (as long as
3350 writes of Lisp_Object slots are atomic, which they are on Windows).
3351 Although delete-frame can destructively modify the frame list while
3352 we are walking it, a garbage collection cannot occur until after
3353 delete-frame has synchronized with this thread.
3354
3355 It is also safe to use functions that make GDI calls, such as
3356 w32_clear_rect, because these functions must obtain a DC handle
3357 from the frame struct using get_frame_dc which is thread-aware. */
3358
3359 switch (msg)
3360 {
3361 case WM_ERASEBKGND:
3362 f = x_window_to_frame (dpyinfo, hwnd);
3363 if (f)
3364 {
3365 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
3366 w32_clear_rect (f, NULL, &wmsg.rect);
3367 }
3368 return 1;
3369 case WM_PALETTECHANGED:
3370 /* ignore our own changes */
3371 if ((HWND)wParam != hwnd)
3372 {
3373 f = x_window_to_frame (dpyinfo, hwnd);
3374 if (f)
3375 /* get_frame_dc will realize our palette and force all
3376 frames to be redrawn if needed. */
3377 release_frame_dc (f, get_frame_dc (f));
3378 }
3379 return 0;
3380 case WM_PAINT:
3381 {
3382 PAINTSTRUCT paintStruct;
3383
3384 enter_crit ();
3385 BeginPaint (hwnd, &paintStruct);
3386 wmsg.rect = paintStruct.rcPaint;
3387 EndPaint (hwnd, &paintStruct);
3388 leave_crit ();
3389
3390 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3391
3392 return (0);
3393 }
3394
3395 case WM_KEYUP:
3396 case WM_SYSKEYUP:
3397 record_keyup (wParam, lParam);
3398 goto dflt;
3399
3400 case WM_KEYDOWN:
3401 case WM_SYSKEYDOWN:
3402 /* Synchronize modifiers with current keystroke. */
3403 sync_modifiers ();
3404
3405 record_keydown (wParam, lParam);
3406
3407 wParam = map_keypad_keys (wParam, lParam);
3408
3409 windows_translate = 0;
3410 switch (wParam) {
3411 case VK_LWIN:
3412 case VK_RWIN:
3413 case VK_APPS:
3414 /* More support for these keys will likely be necessary. */
3415 if (!NILP (Vw32_pass_optional_keys_to_system))
3416 windows_translate = 1;
3417 break;
3418 case VK_MENU:
3419 if (NILP (Vw32_pass_alt_to_system))
3420 return 0;
3421 windows_translate = 1;
3422 break;
3423 case VK_CONTROL:
3424 case VK_CAPITAL:
3425 case VK_SHIFT:
3426 case VK_NUMLOCK:
3427 case VK_SCROLL:
3428 windows_translate = 1;
3429 break;
3430 default:
3431 /* If not defined as a function key, change it to a WM_CHAR message. */
3432 if (lispy_function_keys[wParam] == 0)
3433 msg = WM_CHAR;
3434 break;
3435 }
3436
3437 if (windows_translate)
3438 {
3439 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3440
3441 windows_msg.time = GetMessageTime ();
3442 TranslateMessage (&windows_msg);
3443 goto dflt;
3444 }
3445
3446 /* Fall through */
3447
3448 case WM_SYSCHAR:
3449 case WM_CHAR:
3450 wmsg.dwModifiers = construct_modifiers (wParam, lParam);
3451
3452 #if 1
3453 /* Detect quit_char and set quit-flag directly. Note that we
3454 still need to post a message to ensure the main thread will be
3455 woken up if blocked in sys_select(), but we do NOT want to post
3456 the quit_char message itself (because it will usually be as if
3457 the user had typed quit_char twice). Instead, we post a dummy
3458 message that has no particular effect. */
3459 {
3460 int c = wParam;
3461 if (isalpha (c) && (wmsg.dwModifiers == LEFT_CTRL_PRESSED
3462 || wmsg.dwModifiers == RIGHT_CTRL_PRESSED))
3463 c = make_ctrl_char (c) & 0377;
3464 if (c == quit_char)
3465 {
3466 Vquit_flag = Qt;
3467
3468 /* The choice of message is somewhat arbitrary, as long as
3469 the main thread handler just ignores it. */
3470 msg = WM_NULL;
3471
3472 /* Interrupt any blocking system calls. */
3473 signal_quit ();
3474 }
3475 }
3476 #endif
3477
3478 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3479
3480 break;
3481
3482 /* Simulate middle mouse button events when left and right buttons
3483 are used together, but only if user has two button mouse. */
3484 case WM_LBUTTONDOWN:
3485 case WM_RBUTTONDOWN:
3486 if (XINT (Vw32_num_mouse_buttons) == 3)
3487 goto handle_plain_button;
3488
3489 {
3490 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3491 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3492
3493 if (button_state & this)
3494 return 0;
3495
3496 if (button_state == 0)
3497 SetCapture (hwnd);
3498
3499 button_state |= this;
3500
3501 if (button_state & other)
3502 {
3503 if (mouse_button_timer)
3504 {
3505 KillTimer (hwnd, mouse_button_timer);
3506 mouse_button_timer = 0;
3507
3508 /* Generate middle mouse event instead. */
3509 msg = WM_MBUTTONDOWN;
3510 button_state |= MMOUSE;
3511 }
3512 else if (button_state & MMOUSE)
3513 {
3514 /* Ignore button event if we've already generated a
3515 middle mouse down event. This happens if the
3516 user releases and press one of the two buttons
3517 after we've faked a middle mouse event. */
3518 return 0;
3519 }
3520 else
3521 {
3522 /* Flush out saved message. */
3523 post_msg (&saved_mouse_button_msg);
3524 }
3525 wmsg.dwModifiers = w32_get_modifiers ();
3526 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3527
3528 /* Clear message buffer. */
3529 saved_mouse_button_msg.msg.hwnd = 0;
3530 }
3531 else
3532 {
3533 /* Hold onto message for now. */
3534 mouse_button_timer =
3535 SetTimer (hwnd, MOUSE_BUTTON_ID, XINT (Vw32_mouse_button_tolerance), NULL);
3536 saved_mouse_button_msg.msg.hwnd = hwnd;
3537 saved_mouse_button_msg.msg.message = msg;
3538 saved_mouse_button_msg.msg.wParam = wParam;
3539 saved_mouse_button_msg.msg.lParam = lParam;
3540 saved_mouse_button_msg.msg.time = GetMessageTime ();
3541 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
3542 }
3543 }
3544 return 0;
3545
3546 case WM_LBUTTONUP:
3547 case WM_RBUTTONUP:
3548 if (XINT (Vw32_num_mouse_buttons) == 3)
3549 goto handle_plain_button;
3550
3551 {
3552 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3553 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3554
3555 if ((button_state & this) == 0)
3556 return 0;
3557
3558 button_state &= ~this;
3559
3560 if (button_state & MMOUSE)
3561 {
3562 /* Only generate event when second button is released. */
3563 if ((button_state & other) == 0)
3564 {
3565 msg = WM_MBUTTONUP;
3566 button_state &= ~MMOUSE;
3567
3568 if (button_state) abort ();
3569 }
3570 else
3571 return 0;
3572 }
3573 else
3574 {
3575 /* Flush out saved message if necessary. */
3576 if (saved_mouse_button_msg.msg.hwnd)
3577 {
3578 post_msg (&saved_mouse_button_msg);
3579 }
3580 }
3581 wmsg.dwModifiers = w32_get_modifiers ();
3582 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3583
3584 /* Always clear message buffer and cancel timer. */
3585 saved_mouse_button_msg.msg.hwnd = 0;
3586 KillTimer (hwnd, mouse_button_timer);
3587 mouse_button_timer = 0;
3588
3589 if (button_state == 0)
3590 ReleaseCapture ();
3591 }
3592 return 0;
3593
3594 case WM_MBUTTONDOWN:
3595 case WM_MBUTTONUP:
3596 handle_plain_button:
3597 {
3598 BOOL up;
3599 int button;
3600
3601 if (parse_button (msg, &button, &up))
3602 {
3603 if (up) ReleaseCapture ();
3604 else SetCapture (hwnd);
3605 button = (button == 0) ? LMOUSE :
3606 ((button == 1) ? MMOUSE : RMOUSE);
3607 if (up)
3608 button_state &= ~button;
3609 else
3610 button_state |= button;
3611 }
3612 }
3613
3614 wmsg.dwModifiers = w32_get_modifiers ();
3615 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3616 return 0;
3617
3618 case WM_VSCROLL:
3619 case WM_MOUSEMOVE:
3620 if (XINT (Vw32_mouse_move_interval) <= 0
3621 || (msg == WM_MOUSEMOVE && button_state == 0))
3622 {
3623 wmsg.dwModifiers = w32_get_modifiers ();
3624 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3625 return 0;
3626 }
3627
3628 /* Hang onto mouse move and scroll messages for a bit, to avoid
3629 sending such events to Emacs faster than it can process them.
3630 If we get more events before the timer from the first message
3631 expires, we just replace the first message. */
3632
3633 if (saved_mouse_move_msg.msg.hwnd == 0)
3634 mouse_move_timer =
3635 SetTimer (hwnd, MOUSE_MOVE_ID, XINT (Vw32_mouse_move_interval), NULL);
3636
3637 /* Hold onto message for now. */
3638 saved_mouse_move_msg.msg.hwnd = hwnd;
3639 saved_mouse_move_msg.msg.message = msg;
3640 saved_mouse_move_msg.msg.wParam = wParam;
3641 saved_mouse_move_msg.msg.lParam = lParam;
3642 saved_mouse_move_msg.msg.time = GetMessageTime ();
3643 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
3644
3645 return 0;
3646
3647 case WM_MOUSEWHEEL:
3648 wmsg.dwModifiers = w32_get_modifiers ();
3649 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3650 return 0;
3651
3652 case WM_DROPFILES:
3653 wmsg.dwModifiers = w32_get_modifiers ();
3654 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3655 return 0;
3656
3657 case WM_TIMER:
3658 /* Flush out saved messages if necessary. */
3659 if (wParam == mouse_button_timer)
3660 {
3661 if (saved_mouse_button_msg.msg.hwnd)
3662 {
3663 post_msg (&saved_mouse_button_msg);
3664 saved_mouse_button_msg.msg.hwnd = 0;
3665 }
3666 KillTimer (hwnd, mouse_button_timer);
3667 mouse_button_timer = 0;
3668 }
3669 else if (wParam == mouse_move_timer)
3670 {
3671 if (saved_mouse_move_msg.msg.hwnd)
3672 {
3673 post_msg (&saved_mouse_move_msg);
3674 saved_mouse_move_msg.msg.hwnd = 0;
3675 }
3676 KillTimer (hwnd, mouse_move_timer);
3677 mouse_move_timer = 0;
3678 }
3679 return 0;
3680
3681 case WM_NCACTIVATE:
3682 /* Windows doesn't send us focus messages when putting up and
3683 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3684 The only indication we get that something happened is receiving
3685 this message afterwards. So this is a good time to reset our
3686 keyboard modifiers' state. */
3687 reset_modifiers ();
3688 goto dflt;
3689
3690 case WM_INITMENU:
3691 /* We must ensure menu bar is fully constructed and up to date
3692 before allowing user interaction with it. To achieve this
3693 we send this message to the lisp thread and wait for a
3694 reply (whose value is not actually needed) to indicate that
3695 the menu bar is now ready for use, so we can now return.
3696
3697 To remain responsive in the meantime, we enter a nested message
3698 loop that can process all other messages.
3699
3700 However, we skip all this if the message results from calling
3701 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3702 thread a message because it is blocked on us at this point. We
3703 set menubar_active before calling TrackPopupMenu to indicate
3704 this (there is no possibility of confusion with real menubar
3705 being active). */
3706
3707 f = x_window_to_frame (dpyinfo, hwnd);
3708 if (f
3709 && (f->output_data.w32->menubar_active
3710 /* We can receive this message even in the absence of a
3711 menubar (ie. when the system menu is activated) - in this
3712 case we do NOT want to forward the message, otherwise it
3713 will cause the menubar to suddenly appear when the user
3714 had requested it to be turned off! */
3715 || f->output_data.w32->menubar_widget == NULL))
3716 return 0;
3717
3718 {
3719 deferred_msg msg_buf;
3720
3721 /* Detect if message has already been deferred; in this case
3722 we cannot return any sensible value to ignore this. */
3723 if (find_deferred_msg (hwnd, msg) != NULL)
3724 abort ();
3725
3726 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
3727 }
3728
3729 case WM_EXITMENULOOP:
3730 f = x_window_to_frame (dpyinfo, hwnd);
3731
3732 /* Indicate that menubar can be modified again. */
3733 if (f)
3734 f->output_data.w32->menubar_active = 0;
3735 goto dflt;
3736
3737 case WM_MEASUREITEM:
3738 f = x_window_to_frame (dpyinfo, hwnd);
3739 if (f)
3740 {
3741 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
3742
3743 if (pMis->CtlType == ODT_MENU)
3744 {
3745 /* Work out dimensions for popup menu titles. */
3746 char * title = (char *) pMis->itemData;
3747 HDC hdc = GetDC (hwnd);
3748 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3749 LOGFONT menu_logfont;
3750 HFONT old_font;
3751 SIZE size;
3752
3753 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3754 menu_logfont.lfWeight = FW_BOLD;
3755 menu_font = CreateFontIndirect (&menu_logfont);
3756 old_font = SelectObject (hdc, menu_font);
3757
3758 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
3759 pMis->itemWidth = size.cx;
3760 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
3761 if (pMis->itemHeight < size.cy)
3762 pMis->itemHeight = size.cy;
3763
3764 SelectObject (hdc, old_font);
3765 DeleteObject (menu_font);
3766 ReleaseDC (hwnd, hdc);
3767 return TRUE;
3768 }
3769 }
3770 return 0;
3771
3772 case WM_DRAWITEM:
3773 f = x_window_to_frame (dpyinfo, hwnd);
3774 if (f)
3775 {
3776 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
3777
3778 if (pDis->CtlType == ODT_MENU)
3779 {
3780 /* Draw popup menu title. */
3781 char * title = (char *) pDis->itemData;
3782 HDC hdc = pDis->hDC;
3783 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3784 LOGFONT menu_logfont;
3785 HFONT old_font;
3786
3787 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3788 menu_logfont.lfWeight = FW_BOLD;
3789 menu_font = CreateFontIndirect (&menu_logfont);
3790 old_font = SelectObject (hdc, menu_font);
3791
3792 /* Always draw title as if not selected. */
3793 ExtTextOut (hdc,
3794 pDis->rcItem.left + GetSystemMetrics (SM_CXMENUCHECK),
3795 pDis->rcItem.top,
3796 ETO_OPAQUE, &pDis->rcItem,
3797 title, strlen (title), NULL);
3798
3799 SelectObject (hdc, old_font);
3800 DeleteObject (menu_font);
3801 return TRUE;
3802 }
3803 }
3804 return 0;
3805
3806 #if 0
3807 /* Still not right - can't distinguish between clicks in the
3808 client area of the frame from clicks forwarded from the scroll
3809 bars - may have to hook WM_NCHITTEST to remember the mouse
3810 position and then check if it is in the client area ourselves. */
3811 case WM_MOUSEACTIVATE:
3812 /* Discard the mouse click that activates a frame, allowing the
3813 user to click anywhere without changing point (or worse!).
3814 Don't eat mouse clicks on scrollbars though!! */
3815 if (LOWORD (lParam) == HTCLIENT )
3816 return MA_ACTIVATEANDEAT;
3817 goto dflt;
3818 #endif
3819
3820 case WM_ACTIVATE:
3821 case WM_ACTIVATEAPP:
3822 case WM_WINDOWPOSCHANGED:
3823 case WM_SHOWWINDOW:
3824 /* Inform lisp thread that a frame might have just been obscured
3825 or exposed, so should recheck visibility of all frames. */
3826 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3827 goto dflt;
3828
3829 case WM_SETFOCUS:
3830 reset_modifiers ();
3831 case WM_KILLFOCUS:
3832 case WM_MOVE:
3833 case WM_SIZE:
3834 case WM_COMMAND:
3835 wmsg.dwModifiers = w32_get_modifiers ();
3836 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3837 goto dflt;
3838
3839 case WM_CLOSE:
3840 wmsg.dwModifiers = w32_get_modifiers ();
3841 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3842 return 0;
3843
3844 case WM_WINDOWPOSCHANGING:
3845 {
3846 WINDOWPLACEMENT wp;
3847 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
3848
3849 wp.length = sizeof (WINDOWPLACEMENT);
3850 GetWindowPlacement (hwnd, &wp);
3851
3852 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
3853 {
3854 RECT rect;
3855 int wdiff;
3856 int hdiff;
3857 DWORD font_width;
3858 DWORD line_height;
3859 DWORD internal_border;
3860 DWORD scrollbar_extra;
3861 RECT wr;
3862
3863 wp.length = sizeof(wp);
3864 GetWindowRect (hwnd, &wr);
3865
3866 enter_crit ();
3867
3868 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
3869 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
3870 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
3871 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
3872
3873 leave_crit ();
3874
3875 memset (&rect, 0, sizeof (rect));
3876 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
3877 GetMenu (hwnd) != NULL);
3878
3879 /* Force width and height of client area to be exact
3880 multiples of the character cell dimensions. */
3881 wdiff = (lppos->cx - (rect.right - rect.left)
3882 - 2 * internal_border - scrollbar_extra)
3883 % font_width;
3884 hdiff = (lppos->cy - (rect.bottom - rect.top)
3885 - 2 * internal_border)
3886 % line_height;
3887
3888 if (wdiff || hdiff)
3889 {
3890 /* For right/bottom sizing we can just fix the sizes.
3891 However for top/left sizing we will need to fix the X
3892 and Y positions as well. */
3893
3894 lppos->cx -= wdiff;
3895 lppos->cy -= hdiff;
3896
3897 if (wp.showCmd != SW_SHOWMAXIMIZED
3898 && (lppos->flags & SWP_NOMOVE) == 0)
3899 {
3900 if (lppos->x != wr.left || lppos->y != wr.top)
3901 {
3902 lppos->x += wdiff;
3903 lppos->y += hdiff;
3904 }
3905 else
3906 {
3907 lppos->flags |= SWP_NOMOVE;
3908 }
3909 }
3910
3911 return 0;
3912 }
3913 }
3914 }
3915
3916 goto dflt;
3917
3918 case WM_EMACS_CREATESCROLLBAR:
3919 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
3920 (struct scroll_bar *) lParam);
3921
3922 case WM_EMACS_SHOWWINDOW:
3923 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
3924
3925 case WM_EMACS_SETFOREGROUND:
3926 return SetForegroundWindow ((HWND) wParam);
3927
3928 case WM_EMACS_SETWINDOWPOS:
3929 {
3930 WINDOWPOS * pos = (WINDOWPOS *) wParam;
3931 return SetWindowPos (hwnd, pos->hwndInsertAfter,
3932 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3933 }
3934
3935 case WM_EMACS_DESTROYWINDOW:
3936 DragAcceptFiles ((HWND) wParam, FALSE);
3937 return DestroyWindow ((HWND) wParam);
3938
3939 case WM_EMACS_TRACKPOPUPMENU:
3940 {
3941 UINT flags;
3942 POINT *pos;
3943 int retval;
3944 pos = (POINT *)lParam;
3945 flags = TPM_CENTERALIGN;
3946 if (button_state & LMOUSE)
3947 flags |= TPM_LEFTBUTTON;
3948 else if (button_state & RMOUSE)
3949 flags |= TPM_RIGHTBUTTON;
3950
3951 /* Remember we did a SetCapture on the initial mouse down event,
3952 so for safety, we make sure the capture is cancelled now. */
3953 ReleaseCapture ();
3954 button_state = 0;
3955
3956 /* Use menubar_active to indicate that WM_INITMENU is from
3957 TrackPopupMenu below, and should be ignored. */
3958 f = x_window_to_frame (dpyinfo, hwnd);
3959 if (f)
3960 f->output_data.w32->menubar_active = 1;
3961
3962 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
3963 0, hwnd, NULL))
3964 {
3965 MSG amsg;
3966 /* Eat any mouse messages during popupmenu */
3967 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
3968 PM_REMOVE));
3969 /* Get the menu selection, if any */
3970 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
3971 {
3972 retval = LOWORD (amsg.wParam);
3973 }
3974 else
3975 {
3976 retval = 0;
3977 }
3978 }
3979 else
3980 {
3981 retval = -1;
3982 }
3983
3984 return retval;
3985 }
3986
3987 default:
3988 /* Check for messages registered at runtime. */
3989 if (msg == msh_mousewheel)
3990 {
3991 wmsg.dwModifiers = w32_get_modifiers ();
3992 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3993 return 0;
3994 }
3995
3996 dflt:
3997 return DefWindowProc (hwnd, msg, wParam, lParam);
3998 }
3999
4000
4001 /* The most common default return code for handled messages is 0. */
4002 return 0;
4003 }
4004
4005 void
4006 my_create_window (f)
4007 struct frame * f;
4008 {
4009 MSG msg;
4010
4011 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
4012 abort ();
4013 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4014 }
4015
4016 /* Create and set up the w32 window for frame F. */
4017
4018 static void
4019 w32_window (f, window_prompting, minibuffer_only)
4020 struct frame *f;
4021 long window_prompting;
4022 int minibuffer_only;
4023 {
4024 BLOCK_INPUT;
4025
4026 /* Use the resource name as the top-level window name
4027 for looking up resources. Make a non-Lisp copy
4028 for the window manager, so GC relocation won't bother it.
4029
4030 Elsewhere we specify the window name for the window manager. */
4031
4032 {
4033 char *str = (char *) XSTRING (Vx_resource_name)->data;
4034 f->namebuf = (char *) xmalloc (strlen (str) + 1);
4035 strcpy (f->namebuf, str);
4036 }
4037
4038 my_create_window (f);
4039
4040 validate_x_resource_name ();
4041
4042 /* x_set_name normally ignores requests to set the name if the
4043 requested name is the same as the current name. This is the one
4044 place where that assumption isn't correct; f->name is set, but
4045 the server hasn't been told. */
4046 {
4047 Lisp_Object name;
4048 int explicit = f->explicit_name;
4049
4050 f->explicit_name = 0;
4051 name = f->name;
4052 f->name = Qnil;
4053 x_set_name (f, name, explicit);
4054 }
4055
4056 UNBLOCK_INPUT;
4057
4058 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4059 initialize_frame_menubar (f);
4060
4061 if (FRAME_W32_WINDOW (f) == 0)
4062 error ("Unable to create window");
4063 }
4064
4065 /* Handle the icon stuff for this window. Perhaps later we might
4066 want an x_set_icon_position which can be called interactively as
4067 well. */
4068
4069 static void
4070 x_icon (f, parms)
4071 struct frame *f;
4072 Lisp_Object parms;
4073 {
4074 Lisp_Object icon_x, icon_y;
4075
4076 /* Set the position of the icon. Note that Windows 95 groups all
4077 icons in the tray. */
4078 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
4079 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
4080 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4081 {
4082 CHECK_NUMBER (icon_x, 0);
4083 CHECK_NUMBER (icon_y, 0);
4084 }
4085 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4086 error ("Both left and top icon corners of icon must be specified");
4087
4088 BLOCK_INPUT;
4089
4090 if (! EQ (icon_x, Qunbound))
4091 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4092
4093 #if 0 /* TODO */
4094 /* Start up iconic or window? */
4095 x_wm_set_window_state
4096 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
4097 ? IconicState
4098 : NormalState));
4099
4100 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
4101 ? f->icon_name
4102 : f->name))->data);
4103 #endif
4104
4105 UNBLOCK_INPUT;
4106 }
4107
4108 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4109 1, 1, 0,
4110 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
4111 Returns an Emacs frame object.\n\
4112 ALIST is an alist of frame parameters.\n\
4113 If the parameters specify that the frame should not have a minibuffer,\n\
4114 and do not specify a specific minibuffer window to use,\n\
4115 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4116 be shared by the new frame.\n\
4117 \n\
4118 This function is an internal primitive--use `make-frame' instead.")
4119 (parms)
4120 Lisp_Object parms;
4121 {
4122 struct frame *f;
4123 Lisp_Object frame, tem;
4124 Lisp_Object name;
4125 int minibuffer_only = 0;
4126 long window_prompting = 0;
4127 int width, height;
4128 int count = specpdl_ptr - specpdl;
4129 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4130 Lisp_Object display;
4131 struct w32_display_info *dpyinfo;
4132 Lisp_Object parent;
4133 struct kboard *kb;
4134
4135 check_w32 ();
4136
4137 /* Use this general default value to start with
4138 until we know if this frame has a specified name. */
4139 Vx_resource_name = Vinvocation_name;
4140
4141 display = x_get_arg (parms, Qdisplay, 0, 0, string);
4142 if (EQ (display, Qunbound))
4143 display = Qnil;
4144 dpyinfo = check_x_display_info (display);
4145 #ifdef MULTI_KBOARD
4146 kb = dpyinfo->kboard;
4147 #else
4148 kb = &the_only_kboard;
4149 #endif
4150
4151 name = x_get_arg (parms, Qname, "name", "Name", string);
4152 if (!STRINGP (name)
4153 && ! EQ (name, Qunbound)
4154 && ! NILP (name))
4155 error ("Invalid frame name--not a string or nil");
4156
4157 if (STRINGP (name))
4158 Vx_resource_name = name;
4159
4160 /* See if parent window is specified. */
4161 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
4162 if (EQ (parent, Qunbound))
4163 parent = Qnil;
4164 if (! NILP (parent))
4165 CHECK_NUMBER (parent, 0);
4166
4167 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4168 /* No need to protect DISPLAY because that's not used after passing
4169 it to make_frame_without_minibuffer. */
4170 frame = Qnil;
4171 GCPRO4 (parms, parent, name, frame);
4172 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
4173 if (EQ (tem, Qnone) || NILP (tem))
4174 f = make_frame_without_minibuffer (Qnil, kb, display);
4175 else if (EQ (tem, Qonly))
4176 {
4177 f = make_minibuffer_frame ();
4178 minibuffer_only = 1;
4179 }
4180 else if (WINDOWP (tem))
4181 f = make_frame_without_minibuffer (tem, kb, display);
4182 else
4183 f = make_frame (1);
4184
4185 XSETFRAME (frame, f);
4186
4187 /* Note that Windows does support scroll bars. */
4188 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
4189 /* By default, make scrollbars the system standard width. */
4190 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
4191
4192 f->output_method = output_w32;
4193 f->output_data.w32 = (struct w32_output *) xmalloc (sizeof (struct w32_output));
4194 bzero (f->output_data.w32, sizeof (struct w32_output));
4195
4196 FRAME_FONTSET (f) = -1;
4197
4198 f->icon_name
4199 = x_get_arg (parms, Qicon_name, "iconName", "Title", string);
4200 if (! STRINGP (f->icon_name))
4201 f->icon_name = Qnil;
4202
4203 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4204 #ifdef MULTI_KBOARD
4205 FRAME_KBOARD (f) = kb;
4206 #endif
4207
4208 /* Specify the parent under which to make this window. */
4209
4210 if (!NILP (parent))
4211 {
4212 f->output_data.w32->parent_desc = (Window) parent;
4213 f->output_data.w32->explicit_parent = 1;
4214 }
4215 else
4216 {
4217 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4218 f->output_data.w32->explicit_parent = 0;
4219 }
4220
4221 /* Note that the frame has no physical cursor right now. */
4222 f->phys_cursor_x = -1;
4223
4224 /* Set the name; the functions to which we pass f expect the name to
4225 be set. */
4226 if (EQ (name, Qunbound) || NILP (name))
4227 {
4228 f->name = build_string (dpyinfo->w32_id_name);
4229 f->explicit_name = 0;
4230 }
4231 else
4232 {
4233 f->name = name;
4234 f->explicit_name = 1;
4235 /* use the frame's title when getting resources for this frame. */
4236 specbind (Qx_resource_name, name);
4237 }
4238
4239 /* Create fontsets from `global_fontset_alist' before handling fonts. */
4240 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
4241 fs_register_fontset (f, XCONS (tem)->car);
4242
4243 /* Extract the window parameters from the supplied values
4244 that are needed to determine window geometry. */
4245 {
4246 Lisp_Object font;
4247
4248 font = x_get_arg (parms, Qfont, "font", "Font", string);
4249 BLOCK_INPUT;
4250 /* First, try whatever font the caller has specified. */
4251 if (STRINGP (font))
4252 {
4253 tem = Fquery_fontset (font, Qnil);
4254 if (STRINGP (tem))
4255 font = x_new_fontset (f, XSTRING (tem)->data);
4256 else
4257 font = x_new_font (f, XSTRING (font)->data);
4258 }
4259 /* Try out a font which we hope has bold and italic variations. */
4260 if (!STRINGP (font))
4261 font = x_new_font (f, "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4262 if (! STRINGP (font))
4263 font = x_new_font (f, "-*-Courier-normal-r-*-*-*-97-*-*-c-*-iso8859-1");
4264 /* If those didn't work, look for something which will at least work. */
4265 if (! STRINGP (font))
4266 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-*-*-90-*-c-*-iso8859-1");
4267 UNBLOCK_INPUT;
4268 if (! STRINGP (font))
4269 font = build_string ("Fixedsys");
4270
4271 x_default_parameter (f, parms, Qfont, font,
4272 "font", "Font", string);
4273 }
4274
4275 x_default_parameter (f, parms, Qborder_width, make_number (2),
4276 "borderwidth", "BorderWidth", number);
4277 /* This defaults to 2 in order to match xterm. We recognize either
4278 internalBorderWidth or internalBorder (which is what xterm calls
4279 it). */
4280 if (NILP (Fassq (Qinternal_border_width, parms)))
4281 {
4282 Lisp_Object value;
4283
4284 value = x_get_arg (parms, Qinternal_border_width,
4285 "internalBorder", "BorderWidth", number);
4286 if (! EQ (value, Qunbound))
4287 parms = Fcons (Fcons (Qinternal_border_width, value),
4288 parms);
4289 }
4290 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4291 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
4292 "internalBorderWidth", "BorderWidth", number);
4293 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
4294 "verticalScrollBars", "ScrollBars", boolean);
4295
4296 /* Also do the stuff which must be set before the window exists. */
4297 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
4298 "foreground", "Foreground", string);
4299 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
4300 "background", "Background", string);
4301 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
4302 "pointerColor", "Foreground", string);
4303 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
4304 "cursorColor", "Foreground", string);
4305 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
4306 "borderColor", "BorderColor", string);
4307
4308 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
4309 "menuBar", "MenuBar", number);
4310 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
4311 "scrollBarWidth", "ScrollBarWidth", number);
4312 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
4313 "bufferPredicate", "BufferPredicate", symbol);
4314 x_default_parameter (f, parms, Qtitle, Qnil,
4315 "title", "Title", string);
4316
4317 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4318 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4319 window_prompting = x_figure_window_size (f, parms);
4320
4321 if (window_prompting & XNegative)
4322 {
4323 if (window_prompting & YNegative)
4324 f->output_data.w32->win_gravity = SouthEastGravity;
4325 else
4326 f->output_data.w32->win_gravity = NorthEastGravity;
4327 }
4328 else
4329 {
4330 if (window_prompting & YNegative)
4331 f->output_data.w32->win_gravity = SouthWestGravity;
4332 else
4333 f->output_data.w32->win_gravity = NorthWestGravity;
4334 }
4335
4336 f->output_data.w32->size_hint_flags = window_prompting;
4337
4338 w32_window (f, window_prompting, minibuffer_only);
4339 x_icon (f, parms);
4340 init_frame_faces (f);
4341
4342 /* We need to do this after creating the window, so that the
4343 icon-creation functions can say whose icon they're describing. */
4344 x_default_parameter (f, parms, Qicon_type, Qnil,
4345 "bitmapIcon", "BitmapIcon", symbol);
4346
4347 x_default_parameter (f, parms, Qauto_raise, Qnil,
4348 "autoRaise", "AutoRaiseLower", boolean);
4349 x_default_parameter (f, parms, Qauto_lower, Qnil,
4350 "autoLower", "AutoRaiseLower", boolean);
4351 x_default_parameter (f, parms, Qcursor_type, Qbox,
4352 "cursorType", "CursorType", symbol);
4353
4354 /* Dimensions, especially f->height, must be done via change_frame_size.
4355 Change will not be effected unless different from the current
4356 f->height. */
4357 width = f->width;
4358 height = f->height;
4359 f->height = 0;
4360 SET_FRAME_WIDTH (f, 0);
4361 change_frame_size (f, height, width, 1, 0);
4362
4363 /* Tell the server what size and position, etc, we want,
4364 and how badly we want them. */
4365 BLOCK_INPUT;
4366 x_wm_set_size_hint (f, window_prompting, 0);
4367 UNBLOCK_INPUT;
4368
4369 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
4370 f->no_split = minibuffer_only || EQ (tem, Qt);
4371
4372 UNGCPRO;
4373
4374 /* It is now ok to make the frame official
4375 even if we get an error below.
4376 And the frame needs to be on Vframe_list
4377 or making it visible won't work. */
4378 Vframe_list = Fcons (frame, Vframe_list);
4379
4380 /* Now that the frame is official, it counts as a reference to
4381 its display. */
4382 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
4383
4384 /* Make the window appear on the frame and enable display,
4385 unless the caller says not to. However, with explicit parent,
4386 Emacs cannot control visibility, so don't try. */
4387 if (! f->output_data.w32->explicit_parent)
4388 {
4389 Lisp_Object visibility;
4390
4391 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
4392 if (EQ (visibility, Qunbound))
4393 visibility = Qt;
4394
4395 if (EQ (visibility, Qicon))
4396 x_iconify_frame (f);
4397 else if (! NILP (visibility))
4398 x_make_frame_visible (f);
4399 else
4400 /* Must have been Qnil. */
4401 ;
4402 }
4403
4404 return unbind_to (count, frame);
4405 }
4406
4407 /* FRAME is used only to get a handle on the X display. We don't pass the
4408 display info directly because we're called from frame.c, which doesn't
4409 know about that structure. */
4410 Lisp_Object
4411 x_get_focus_frame (frame)
4412 struct frame *frame;
4413 {
4414 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
4415 Lisp_Object xfocus;
4416 if (! dpyinfo->w32_focus_frame)
4417 return Qnil;
4418
4419 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
4420 return xfocus;
4421 }
4422
4423 DEFUN ("w32-focus-frame", Fw32_focus_frame, Sw32_focus_frame, 1, 1, 0,
4424 "Give FRAME input focus, raising to foreground if necessary.")
4425 (frame)
4426 Lisp_Object frame;
4427 {
4428 x_focus_on_frame (check_x_frame (frame));
4429 return Qnil;
4430 }
4431
4432 \f
4433 /* Load font named FONTNAME of size SIZE for frame F, and return a
4434 pointer to the structure font_info while allocating it dynamically.
4435 If loading fails, return NULL. */
4436 struct font_info *
4437 w32_load_font (f,fontname,size)
4438 struct frame *f;
4439 char * fontname;
4440 int size;
4441 {
4442 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4443 Lisp_Object font_names;
4444
4445 #if 0 /* x_load_font attempts to get a list of fonts - presumably to
4446 allow a fuzzier fontname to be specified. w32_list_fonts
4447 appears to be a bit too fuzzy for this purpose. */
4448
4449 /* Get a list of all the fonts that match this name. Once we
4450 have a list of matching fonts, we compare them against the fonts
4451 we already have loaded by comparing names. */
4452 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
4453
4454 if (!NILP (font_names))
4455 {
4456 Lisp_Object tail;
4457 int i;
4458
4459 #if 0 /* This code has nasty side effects that cause Emacs to crash. */
4460
4461 /* First check if any are already loaded, as that is cheaper
4462 than loading another one. */
4463 for (i = 0; i < dpyinfo->n_fonts; i++)
4464 for (tail = font_names; CONSP (tail); tail = XCONS (tail)->cdr)
4465 if (!strcmp (dpyinfo->font_table[i].name,
4466 XSTRING (XCONS (tail)->car)->data)
4467 || !strcmp (dpyinfo->font_table[i].full_name,
4468 XSTRING (XCONS (tail)->car)->data))
4469 return (dpyinfo->font_table + i);
4470 #endif
4471
4472 fontname = (char *) XSTRING (XCONS (font_names)->car)->data;
4473 }
4474 else
4475 return NULL;
4476 #endif
4477
4478 /* Load the font and add it to the table. */
4479 {
4480 char *full_name;
4481 XFontStruct *font;
4482 struct font_info *fontp;
4483 LOGFONT lf;
4484 BOOL ok;
4485
4486 if (!fontname || !x_to_w32_font (fontname, &lf))
4487 return (NULL);
4488
4489 if (!*lf.lfFaceName)
4490 /* If no name was specified for the font, we get a random font
4491 from CreateFontIndirect - this is not particularly
4492 desirable, especially since CreateFontIndirect does not
4493 fill out the missing name in lf, so we never know what we
4494 ended up with. */
4495 return NULL;
4496
4497 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
4498
4499 if (!font) return (NULL);
4500
4501 BLOCK_INPUT;
4502
4503 font->hfont = CreateFontIndirect (&lf);
4504
4505 if (font->hfont == NULL)
4506 {
4507 ok = FALSE;
4508 }
4509 else
4510 {
4511 HDC hdc;
4512 HANDLE oldobj;
4513
4514 hdc = GetDC (dpyinfo->root_window);
4515 oldobj = SelectObject (hdc, font->hfont);
4516 ok = GetTextMetrics (hdc, &font->tm);
4517 SelectObject (hdc, oldobj);
4518 ReleaseDC (dpyinfo->root_window, hdc);
4519 }
4520
4521 UNBLOCK_INPUT;
4522
4523 if (!ok)
4524 {
4525 w32_unload_font (dpyinfo, font);
4526 return (NULL);
4527 }
4528
4529 /* Do we need to create the table? */
4530 if (dpyinfo->font_table_size == 0)
4531 {
4532 dpyinfo->font_table_size = 16;
4533 dpyinfo->font_table
4534 = (struct font_info *) xmalloc (dpyinfo->font_table_size
4535 * sizeof (struct font_info));
4536 }
4537 /* Do we need to grow the table? */
4538 else if (dpyinfo->n_fonts
4539 >= dpyinfo->font_table_size)
4540 {
4541 dpyinfo->font_table_size *= 2;
4542 dpyinfo->font_table
4543 = (struct font_info *) xrealloc (dpyinfo->font_table,
4544 (dpyinfo->font_table_size
4545 * sizeof (struct font_info)));
4546 }
4547
4548 fontp = dpyinfo->font_table + dpyinfo->n_fonts;
4549
4550 /* Now fill in the slots of *FONTP. */
4551 BLOCK_INPUT;
4552 fontp->font = font;
4553 fontp->font_idx = dpyinfo->n_fonts;
4554 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
4555 bcopy (fontname, fontp->name, strlen (fontname) + 1);
4556
4557 /* Work out the font's full name. */
4558 full_name = (char *)xmalloc (100);
4559 if (full_name && w32_to_x_font (&lf, full_name, 100))
4560 fontp->full_name = full_name;
4561 else
4562 {
4563 /* If all else fails - just use the name we used to load it. */
4564 xfree (full_name);
4565 fontp->full_name = fontp->name;
4566 }
4567
4568 fontp->size = FONT_WIDTH (font);
4569 fontp->height = FONT_HEIGHT (font);
4570
4571 /* The slot `encoding' specifies how to map a character
4572 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
4573 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF, 0:0x2020..0x7F7F,
4574 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF,
4575 0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
4576 2:0xA020..0xFF7F). For the moment, we don't know which charset
4577 uses this font. So, we set informatoin in fontp->encoding[1]
4578 which is never used by any charset. If mapping can't be
4579 decided, set FONT_ENCODING_NOT_DECIDED. */
4580 fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
4581
4582 /* The following three values are set to 0 under W32, which is
4583 what they get set to if XGetFontProperty fails under X. */
4584 fontp->baseline_offset = 0;
4585 fontp->relative_compose = 0;
4586 fontp->default_ascent = FONT_BASE (font);
4587
4588 UNBLOCK_INPUT;
4589 dpyinfo->n_fonts++;
4590
4591 return fontp;
4592 }
4593 }
4594
4595 void
4596 w32_unload_font (dpyinfo, font)
4597 struct w32_display_info *dpyinfo;
4598 XFontStruct * font;
4599 {
4600 if (font)
4601 {
4602 if (font->hfont) DeleteObject(font->hfont);
4603 xfree (font);
4604 }
4605 }
4606
4607 /* The font conversion stuff between x and w32 */
4608
4609 /* X font string is as follows (from faces.el)
4610 * (let ((- "[-?]")
4611 * (foundry "[^-]+")
4612 * (family "[^-]+")
4613 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4614 * (weight\? "\\([^-]*\\)") ; 1
4615 * (slant "\\([ior]\\)") ; 2
4616 * (slant\? "\\([^-]?\\)") ; 2
4617 * (swidth "\\([^-]*\\)") ; 3
4618 * (adstyle "[^-]*") ; 4
4619 * (pixelsize "[0-9]+")
4620 * (pointsize "[0-9][0-9]+")
4621 * (resx "[0-9][0-9]+")
4622 * (resy "[0-9][0-9]+")
4623 * (spacing "[cmp?*]")
4624 * (avgwidth "[0-9]+")
4625 * (registry "[^-]+")
4626 * (encoding "[^-]+")
4627 * )
4628 * (setq x-font-regexp
4629 * (concat "\\`\\*?[-?*]"
4630 * foundry - family - weight\? - slant\? - swidth - adstyle -
4631 * pixelsize - pointsize - resx - resy - spacing - registry -
4632 * encoding "[-?*]\\*?\\'"
4633 * ))
4634 * (setq x-font-regexp-head
4635 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
4636 * "\\([-*?]\\|\\'\\)"))
4637 * (setq x-font-regexp-slant (concat - slant -))
4638 * (setq x-font-regexp-weight (concat - weight -))
4639 * nil)
4640 */
4641
4642 #define FONT_START "[-?]"
4643 #define FONT_FOUNDRY "[^-]+"
4644 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
4645 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
4646 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
4647 #define FONT_SLANT "\\([ior]\\)" /* 3 */
4648 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
4649 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
4650 #define FONT_ADSTYLE "[^-]*"
4651 #define FONT_PIXELSIZE "[^-]*"
4652 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
4653 #define FONT_RESX "[0-9][0-9]+"
4654 #define FONT_RESY "[0-9][0-9]+"
4655 #define FONT_SPACING "[cmp?*]"
4656 #define FONT_AVGWIDTH "[0-9]+"
4657 #define FONT_REGISTRY "[^-]+"
4658 #define FONT_ENCODING "[^-]+"
4659
4660 #define FONT_REGEXP ("\\`\\*?[-?*]" \
4661 FONT_FOUNDRY "-" \
4662 FONT_FAMILY "-" \
4663 FONT_WEIGHT_Q "-" \
4664 FONT_SLANT_Q "-" \
4665 FONT_SWIDTH "-" \
4666 FONT_ADSTYLE "-" \
4667 FONT_PIXELSIZE "-" \
4668 FONT_POINTSIZE "-" \
4669 "[-?*]\\|\\'")
4670
4671 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
4672 FONT_FOUNDRY "-" \
4673 FONT_FAMILY "-" \
4674 FONT_WEIGHT_Q "-" \
4675 FONT_SLANT_Q \
4676 "\\([-*?]\\|\\'\\)")
4677
4678 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
4679 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
4680
4681 LONG
4682 x_to_w32_weight (lpw)
4683 char * lpw;
4684 {
4685 if (!lpw) return (FW_DONTCARE);
4686
4687 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
4688 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
4689 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
4690 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
4691 else if (stricmp (lpw,"semibold") == 0) return FW_SEMIBOLD;
4692 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
4693 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
4694 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
4695 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
4696 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
4697 else
4698 return FW_DONTCARE;
4699 }
4700
4701
4702 char *
4703 w32_to_x_weight (fnweight)
4704 int fnweight;
4705 {
4706 if (fnweight >= FW_HEAVY) return "heavy";
4707 if (fnweight >= FW_EXTRABOLD) return "extrabold";
4708 if (fnweight >= FW_BOLD) return "bold";
4709 if (fnweight >= FW_SEMIBOLD) return "semibold";
4710 if (fnweight >= FW_MEDIUM) return "medium";
4711 if (fnweight >= FW_NORMAL) return "normal";
4712 if (fnweight >= FW_LIGHT) return "light";
4713 if (fnweight >= FW_EXTRALIGHT) return "extralight";
4714 if (fnweight >= FW_THIN) return "thin";
4715 else
4716 return "*";
4717 }
4718
4719 LONG
4720 x_to_w32_charset (lpcs)
4721 char * lpcs;
4722 {
4723 if (!lpcs) return (0);
4724
4725 if (stricmp (lpcs,"ansi") == 0) return ANSI_CHARSET;
4726 else if (stricmp (lpcs,"iso8859-1") == 0) return ANSI_CHARSET;
4727 else if (stricmp (lpcs, "symbol") == 0) return SYMBOL_CHARSET;
4728 else if (stricmp (lpcs, "jis") == 0) return SHIFTJIS_CHARSET;
4729 else if (stricmp (lpcs, "ksc5601") == 0) return HANGEUL_CHARSET;
4730 else if (stricmp (lpcs, "gb2312") == 0) return GB2312_CHARSET;
4731 else if (stricmp (lpcs, "big5") == 0) return CHINESEBIG5_CHARSET;
4732 else if (stricmp (lpcs, "oem") == 0) return OEM_CHARSET;
4733
4734 #ifdef EASTEUROPE_CHARSET
4735 else if (stricmp (lpcs, "iso8859-2") == 0) return EASTEUROPE_CHARSET;
4736 else if (stricmp (lpcs, "iso8859-3") == 0) return TURKISH_CHARSET;
4737 else if (stricmp (lpcs, "iso8859-4") == 0) return BALTIC_CHARSET;
4738 else if (stricmp (lpcs, "iso8859-5") == 0) return RUSSIAN_CHARSET;
4739 else if (stricmp (lpcs, "koi8") == 0) return RUSSIAN_CHARSET;
4740 else if (stricmp (lpcs, "iso8859-6") == 0) return ARABIC_CHARSET;
4741 else if (stricmp (lpcs, "iso8859-7") == 0) return GREEK_CHARSET;
4742 else if (stricmp (lpcs, "iso8859-8") == 0) return HEBREW_CHARSET;
4743 else if (stricmp (lpcs, "viscii") == 0) return VIETNAMESE_CHARSET;
4744 else if (stricmp (lpcs, "vscii") == 0) return VIETNAMESE_CHARSET;
4745 else if (stricmp (lpcs, "tis620") == 0) return THAI_CHARSET;
4746 else if (stricmp (lpcs, "mac") == 0) return MAC_CHARSET;
4747 #endif
4748
4749 #ifdef UNICODE_CHARSET
4750 else if (stricmp (lpcs,"iso10646") == 0) return UNICODE_CHARSET;
4751 else if (stricmp (lpcs, "unicode") == 0) return UNICODE_CHARSET;
4752 #endif
4753 else if (lpcs[0] == '#') return atoi (lpcs + 1);
4754 else
4755 return DEFAULT_CHARSET;
4756 }
4757
4758 char *
4759 w32_to_x_charset (fncharset)
4760 int fncharset;
4761 {
4762 static char buf[16];
4763
4764 switch (fncharset)
4765 {
4766 /* ansi is considered iso8859-1, as most modern ansi fonts are. */
4767 case ANSI_CHARSET: return "iso8859-1";
4768 case DEFAULT_CHARSET: return "ascii-*";
4769 case SYMBOL_CHARSET: return "*-symbol";
4770 case SHIFTJIS_CHARSET: return "jisx0212-sjis";
4771 case HANGEUL_CHARSET: return "ksc5601-*";
4772 case GB2312_CHARSET: return "gb2312-*";
4773 case CHINESEBIG5_CHARSET: return "big5-*";
4774 case OEM_CHARSET: return "*-oem";
4775
4776 /* More recent versions of Windows (95 and NT4.0) define more
4777 character sets. */
4778 #ifdef EASTEUROPE_CHARSET
4779 case EASTEUROPE_CHARSET: return "iso8859-2";
4780 case TURKISH_CHARSET: return "iso8859-3";
4781 case BALTIC_CHARSET: return "iso8859-4";
4782 case RUSSIAN_CHARSET: return "iso8859-5";
4783 case ARABIC_CHARSET: return "iso8859-6";
4784 case GREEK_CHARSET: return "iso8859-7";
4785 case HEBREW_CHARSET: return "iso8859-8";
4786 case VIETNAMESE_CHARSET: return "viscii1.1-*";
4787 case THAI_CHARSET: return "tis620-*";
4788 case MAC_CHARSET: return "*-mac";
4789 case JOHAB_CHARSET: break; /* What is this? Latin-9? */
4790 #endif
4791
4792 #ifdef UNICODE_CHARSET
4793 case UNICODE_CHARSET: return "iso10646-unicode";
4794 #endif
4795 }
4796 /* Encode numerical value of unknown charset. */
4797 sprintf (buf, "*-#%u", fncharset);
4798 return buf;
4799 }
4800
4801 BOOL
4802 w32_to_x_font (lplogfont, lpxstr, len)
4803 LOGFONT * lplogfont;
4804 char * lpxstr;
4805 int len;
4806 {
4807 char fontname[50];
4808 char height_pixels[8];
4809 char height_dpi[8];
4810 char width_pixels[8];
4811 char *fontname_dash;
4812
4813 if (!lpxstr) abort ();
4814
4815 if (!lplogfont)
4816 return FALSE;
4817
4818 strncpy (fontname, lplogfont->lfFaceName, 50);
4819 fontname[49] = '\0'; /* Just in case */
4820
4821 /* Replace dashes with underscores so the dashes are not
4822 misinterpreted */
4823 fontname_dash = fontname;
4824 while (fontname_dash = strchr (fontname_dash, '-'))
4825 *fontname_dash = '_';
4826
4827 if (lplogfont->lfHeight)
4828 {
4829 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
4830 sprintf (height_dpi, "%u",
4831 (abs (lplogfont->lfHeight) * 720) / one_w32_display_info.height_in);
4832 }
4833 else
4834 {
4835 strcpy (height_pixels, "*");
4836 strcpy (height_dpi, "*");
4837 }
4838 if (lplogfont->lfWidth)
4839 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
4840 else
4841 strcpy (width_pixels, "*");
4842
4843 _snprintf (lpxstr, len - 1,
4844 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-%s",
4845 /* foundry */
4846 fontname, /* family */
4847 w32_to_x_weight (lplogfont->lfWeight), /* weight */
4848 lplogfont->lfItalic?'i':'r', /* slant */
4849 /* setwidth name */
4850 /* add style name */
4851 height_pixels, /* pixel size */
4852 height_dpi, /* point size */
4853 /* resx */
4854 /* resy */
4855 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
4856 ? 'p' : 'c', /* spacing */
4857 width_pixels, /* avg width */
4858 w32_to_x_charset (lplogfont->lfCharSet) /* charset registry
4859 and encoding*/
4860 );
4861
4862 lpxstr[len - 1] = 0; /* just to be sure */
4863 return (TRUE);
4864 }
4865
4866 BOOL
4867 x_to_w32_font (lpxstr, lplogfont)
4868 char * lpxstr;
4869 LOGFONT * lplogfont;
4870 {
4871 if (!lplogfont) return (FALSE);
4872
4873 memset (lplogfont, 0, sizeof (*lplogfont));
4874
4875 /* Set default value for each field. */
4876 #if 1
4877 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
4878 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
4879 lplogfont->lfQuality = DEFAULT_QUALITY;
4880 #else
4881 /* go for maximum quality */
4882 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
4883 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
4884 lplogfont->lfQuality = PROOF_QUALITY;
4885 #endif
4886
4887 lplogfont->lfCharSet = DEFAULT_CHARSET;
4888 lplogfont->lfWeight = FW_DONTCARE;
4889 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
4890
4891 if (!lpxstr)
4892 return FALSE;
4893
4894 /* Provide a simple escape mechanism for specifying Windows font names
4895 * directly -- if font spec does not beginning with '-', assume this
4896 * format:
4897 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
4898 */
4899
4900 if (*lpxstr == '-')
4901 {
4902 int fields;
4903 char name[50], weight[20], slant, pitch, pixels[10], height[10], width[10], remainder[20];
4904 char * encoding;
4905
4906 fields = sscanf (lpxstr,
4907 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
4908 name, weight, &slant, pixels, height, &pitch, width, remainder);
4909
4910 if (fields == EOF) return (FALSE);
4911
4912 if (fields > 0 && name[0] != '*')
4913 {
4914 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
4915 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
4916 }
4917 else
4918 {
4919 lplogfont->lfFaceName[0] = 0;
4920 }
4921
4922 fields--;
4923
4924 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
4925
4926 fields--;
4927
4928 if (!NILP (Vw32_enable_italics))
4929 lplogfont->lfItalic = (fields > 0 && slant == 'i');
4930
4931 fields--;
4932
4933 if (fields > 0 && pixels[0] != '*')
4934 lplogfont->lfHeight = atoi (pixels);
4935
4936 fields--;
4937
4938 if (fields > 0 && lplogfont->lfHeight == 0 && height[0] != '*')
4939 lplogfont->lfHeight = (atoi (height)
4940 * one_w32_display_info.height_in) / 720;
4941
4942 fields--;
4943
4944 lplogfont->lfPitchAndFamily =
4945 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
4946
4947 fields--;
4948
4949 if (fields > 0 && width[0] != '*')
4950 lplogfont->lfWidth = atoi (width) / 10;
4951
4952 fields--;
4953
4954 /* Strip the trailing '-' if present. (it shouldn't be, as it
4955 fails the test against xlfn-tight-regexp in fontset.el). */
4956 {
4957 int len = strlen (remainder);
4958 if (len > 0 && remainder[len-1] == '-')
4959 remainder[len-1] = 0;
4960 }
4961 encoding = remainder;
4962 if (strncmp (encoding, "*-", 2) == 0)
4963 encoding += 2;
4964 lplogfont->lfCharSet = x_to_w32_charset (fields > 0 ? encoding : "");
4965 }
4966 else
4967 {
4968 int fields;
4969 char name[100], height[10], width[10], weight[20];
4970
4971 fields = sscanf (lpxstr,
4972 "%99[^:]:%9[^:]:%9[^:]:%19s",
4973 name, height, width, weight);
4974
4975 if (fields == EOF) return (FALSE);
4976
4977 if (fields > 0)
4978 {
4979 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
4980 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
4981 }
4982 else
4983 {
4984 lplogfont->lfFaceName[0] = 0;
4985 }
4986
4987 fields--;
4988
4989 if (fields > 0)
4990 lplogfont->lfHeight = atoi (height);
4991
4992 fields--;
4993
4994 if (fields > 0)
4995 lplogfont->lfWidth = atoi (width);
4996
4997 fields--;
4998
4999 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5000 }
5001
5002 /* This makes TrueType fonts work better. */
5003 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
5004
5005 return (TRUE);
5006 }
5007
5008 BOOL
5009 w32_font_match (lpszfont1, lpszfont2)
5010 char * lpszfont1;
5011 char * lpszfont2;
5012 {
5013 char * s1 = lpszfont1, *e1;
5014 char * s2 = lpszfont2, *e2;
5015
5016 if (s1 == NULL || s2 == NULL) return (FALSE);
5017
5018 if (*s1 == '-') s1++;
5019 if (*s2 == '-') s2++;
5020
5021 while (1)
5022 {
5023 int len1, len2;
5024
5025 e1 = strchr (s1, '-');
5026 e2 = strchr (s2, '-');
5027
5028 if (e1 == NULL || e2 == NULL) return (TRUE);
5029
5030 len1 = e1 - s1;
5031 len2 = e2 - s2;
5032
5033 if (*s1 != '*' && *s2 != '*'
5034 && (len1 != len2 || strnicmp (s1, s2, len1) != 0))
5035 return (FALSE);
5036
5037 s1 = e1 + 1;
5038 s2 = e2 + 1;
5039 }
5040 }
5041
5042 typedef struct enumfont_t
5043 {
5044 HDC hdc;
5045 int numFonts;
5046 LOGFONT logfont;
5047 XFontStruct *size_ref;
5048 Lisp_Object *pattern;
5049 Lisp_Object *head;
5050 Lisp_Object *tail;
5051 } enumfont_t;
5052
5053 int CALLBACK
5054 enum_font_cb2 (lplf, lptm, FontType, lpef)
5055 ENUMLOGFONT * lplf;
5056 NEWTEXTMETRIC * lptm;
5057 int FontType;
5058 enumfont_t * lpef;
5059 {
5060 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
5061 return (1);
5062
5063 /* Check that the character set matches if it was specified */
5064 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
5065 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
5066 return (1);
5067
5068 /* We want all fonts cached, so don't compare sizes just yet */
5069 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
5070 {
5071 char buf[100];
5072 Lisp_Object width = Qnil;
5073
5074 if (!NILP (*(lpef->pattern)) && FontType != RASTER_FONTTYPE)
5075 {
5076 /* Scalable fonts are as big as you want them to be. */
5077 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
5078 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
5079 }
5080
5081 /* The MaxCharWidth is not valid at this stage for scalable fonts. */
5082 if (FontType == RASTER_FONTTYPE)
5083 width = make_number (lptm->tmMaxCharWidth);
5084
5085 if (!w32_to_x_font (lplf, buf, 100)) return (0);
5086
5087 if (NILP (*(lpef->pattern)) || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
5088 {
5089 *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
5090 lpef->tail = &(XCONS (*lpef->tail)->cdr);
5091 lpef->numFonts++;
5092 }
5093 }
5094
5095 return (1);
5096 }
5097
5098 int CALLBACK
5099 enum_font_cb1 (lplf, lptm, FontType, lpef)
5100 ENUMLOGFONT * lplf;
5101 NEWTEXTMETRIC * lptm;
5102 int FontType;
5103 enumfont_t * lpef;
5104 {
5105 return EnumFontFamilies (lpef->hdc,
5106 lplf->elfLogFont.lfFaceName,
5107 (FONTENUMPROC) enum_font_cb2,
5108 (LPARAM) lpef);
5109 }
5110
5111
5112 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
5113 and xterm.c in Emacs 20.3) */
5114
5115 /* Return a list of names of available fonts matching PATTERN on frame
5116 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
5117 to be listed. Frame F NULL means we have not yet created any
5118 frame, which means we can't get proper size info, as we don't have
5119 a device context to use for GetTextMetrics.
5120 MAXNAMES sets a limit on how many fonts to match. */
5121
5122 Lisp_Object
5123 w32_list_fonts (FRAME_PTR f, Lisp_Object pattern, int size, int maxnames )
5124 {
5125 Lisp_Object patterns, key, tem;
5126 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
5127
5128 /* If we don't have a frame, we can't use the Windows API to list
5129 fonts, as it requires a device context for the Window. This will
5130 only happen during startup if the user specifies a font on the
5131 command line. Print a message on stderr and return nil. */
5132 if (!f)
5133 {
5134 char buffer[256];
5135
5136 sprintf (buffer,
5137 "Emacs cannot get a list of fonts before the initial frame "
5138 "is created.\nThe font specified on the command line may not "
5139 "be found.\n");
5140 MessageBox (NULL, buffer, "Emacs Warning Dialog",
5141 MB_OK | MB_ICONEXCLAMATION | MB_TASKMODAL);
5142 return Qnil;
5143 }
5144
5145
5146 patterns = Fassoc (pattern, Valternate_fontname_alist);
5147 if (NILP (patterns))
5148 patterns = Fcons (pattern, Qnil);
5149
5150 for (; CONSP (patterns); patterns = XCONS (patterns)->cdr)
5151 {
5152 enumfont_t ef;
5153
5154 pattern = XCONS (patterns)->car;
5155
5156 /* See if we cached the result for this particular query.
5157 The cache is an alist of the form:
5158 ((PATTERN (FONTNAME . WIDTH) ...) ...)
5159 */
5160 if ( f &&
5161 (tem = XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr,
5162 !NILP (list = Fassoc (pattern, tem))))
5163 {
5164 list = Fcdr_safe (list);
5165 /* We have a cached list. Don't have to get the list again. */
5166 goto label_cached;
5167 }
5168
5169 BLOCK_INPUT;
5170 /* At first, put PATTERN in the cache. */
5171 list = Qnil;
5172 ef.pattern = &pattern;
5173 ef.tail = ef.head = &list;
5174 ef.numFonts = 0;
5175 x_to_w32_font (STRINGP (pattern) ? XSTRING (pattern)->data :
5176 NULL, &ef.logfont);
5177 {
5178 ef.hdc = GetDC (FRAME_W32_WINDOW (f));
5179
5180 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
5181 (LPARAM)&ef);
5182
5183 ReleaseDC (FRAME_W32_WINDOW (f), ef.hdc);
5184 }
5185
5186 UNBLOCK_INPUT;
5187
5188 /* Make a list of the fonts we got back.
5189 Store that in the font cache for the display. */
5190 if (f != NULL)
5191 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr
5192 = Fcons (Fcons (pattern, list),
5193 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
5194
5195 label_cached:
5196 if (NILP (list)) continue; /* Try the remaining alternatives. */
5197
5198 newlist = second_best = Qnil;
5199
5200 /* Make a list of the fonts that have the right width. */
5201 for (; CONSP (list); list = XCONS (list)->cdr)
5202 {
5203 int found_size;
5204 tem = XCONS (list)->car;
5205
5206 if (!CONSP (tem))
5207 continue;
5208 if (NILP (XCONS (tem)->car))
5209 continue;
5210 if (!size)
5211 {
5212 newlist = Fcons (XCONS (tem)->car, newlist);
5213 continue;
5214 }
5215 if (!INTEGERP (XCONS (tem)->cdr))
5216 {
5217 /* Since we don't yet know the size of the font, we must
5218 load it and try GetTextMetrics. */
5219 struct w32_display_info *dpyinfo
5220 = FRAME_W32_DISPLAY_INFO (f);
5221 W32FontStruct thisinfo;
5222 LOGFONT lf;
5223 HDC hdc;
5224 HANDLE oldobj;
5225
5226 if (!x_to_w32_font (XSTRING (XCONS (tem)->car)->data, &lf))
5227 continue;
5228
5229 BLOCK_INPUT;
5230 thisinfo.hfont = CreateFontIndirect (&lf);
5231 if (thisinfo.hfont == NULL)
5232 continue;
5233
5234 hdc = GetDC (dpyinfo->root_window);
5235 oldobj = SelectObject (hdc, thisinfo.hfont);
5236 if (GetTextMetrics (hdc, &thisinfo.tm))
5237 XCONS (tem)->cdr = make_number (FONT_WIDTH (&thisinfo));
5238 else
5239 XCONS (tem)->cdr = make_number (0);
5240 SelectObject (hdc, oldobj);
5241 ReleaseDC (dpyinfo->root_window, hdc);
5242 DeleteObject(thisinfo.hfont);
5243 UNBLOCK_INPUT;
5244 }
5245 found_size = XINT (XCONS (tem)->cdr);
5246 if (found_size == size)
5247 newlist = Fcons (XCONS (tem)->car, newlist);
5248
5249 /* keep track of the closest matching size in case
5250 no exact match is found. */
5251 else if (found_size > 0)
5252 {
5253 if (NILP (second_best))
5254 second_best = tem;
5255 else if (found_size < size)
5256 {
5257 if (XINT (XCONS (second_best)->cdr) > size
5258 || XINT (XCONS (second_best)->cdr) < found_size)
5259 second_best = tem;
5260 }
5261 else
5262 {
5263 if (XINT (XCONS (second_best)->cdr) > size
5264 && XINT (XCONS (second_best)->cdr) >
5265 found_size)
5266 second_best = tem;
5267 }
5268 }
5269 }
5270
5271 if (!NILP (newlist))
5272 break;
5273 else if (!NILP (second_best))
5274 {
5275 newlist = Fcons (XCONS (second_best)->car, Qnil);
5276 break;
5277 }
5278 }
5279
5280 return newlist;
5281 }
5282
5283 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
5284 struct font_info *
5285 w32_get_font_info (f, font_idx)
5286 FRAME_PTR f;
5287 int font_idx;
5288 {
5289 return (FRAME_W32_FONT_TABLE (f) + font_idx);
5290 }
5291
5292
5293 struct font_info*
5294 w32_query_font (struct frame *f, char *fontname)
5295 {
5296 int i;
5297 struct font_info *pfi;
5298
5299 pfi = FRAME_W32_FONT_TABLE (f);
5300
5301 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
5302 {
5303 if (strcmp(pfi->name, fontname) == 0) return pfi;
5304 }
5305
5306 return NULL;
5307 }
5308
5309 /* Find a CCL program for a font specified by FONTP, and set the member
5310 `encoder' of the structure. */
5311
5312 void
5313 w32_find_ccl_program (fontp)
5314 struct font_info *fontp;
5315 {
5316 extern Lisp_Object Vfont_ccl_encoder_alist, Vccl_program_table;
5317 extern Lisp_Object Qccl_program_idx;
5318 extern Lisp_Object resolve_symbol_ccl_program ();
5319 Lisp_Object list, elt, ccl_prog, ccl_id;
5320
5321 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCONS (list)->cdr)
5322 {
5323 elt = XCONS (list)->car;
5324 if (CONSP (elt)
5325 && STRINGP (XCONS (elt)->car)
5326 && (fast_c_string_match_ignore_case (XCONS (elt)->car, fontp->name)
5327 >= 0))
5328 {
5329 if (SYMBOLP (XCONS (elt)->cdr) &&
5330 (!NILP (ccl_id = Fget (XCONS (elt)->cdr, Qccl_program_idx))))
5331 {
5332 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
5333 if (!CONSP (ccl_prog)) continue;
5334 ccl_prog = XCONS (ccl_prog)->cdr;
5335 }
5336 else
5337 {
5338 ccl_prog = XCONS (elt)->cdr;
5339 if (!VECTORP (ccl_prog)) continue;
5340 }
5341
5342 fontp->font_encoder
5343 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
5344 setup_ccl_program (fontp->font_encoder,
5345 resolve_symbol_ccl_program (ccl_prog));
5346 break;
5347 }
5348 }
5349 }
5350
5351 \f
5352 #if 1
5353 #include "x-list-font.c"
5354 #else
5355 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 4, 0,
5356 "Return a list of the names of available fonts matching PATTERN.\n\
5357 If optional arguments FACE and FRAME are specified, return only fonts\n\
5358 the same size as FACE on FRAME.\n\
5359 \n\
5360 PATTERN is a string, perhaps with wildcard characters;\n\
5361 the * character matches any substring, and\n\
5362 the ? character matches any single character.\n\
5363 PATTERN is case-insensitive.\n\
5364 FACE is a face name--a symbol.\n\
5365 \n\
5366 The return value is a list of strings, suitable as arguments to\n\
5367 set-face-font.\n\
5368 \n\
5369 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
5370 even if they match PATTERN and FACE.\n\
5371 \n\
5372 The optional fourth argument MAXIMUM sets a limit on how many\n\
5373 fonts to match. The first MAXIMUM fonts are reported.")
5374 (pattern, face, frame, maximum)
5375 Lisp_Object pattern, face, frame, maximum;
5376 {
5377 int num_fonts;
5378 char **names;
5379 XFontStruct *info;
5380 XFontStruct *size_ref;
5381 Lisp_Object namelist;
5382 Lisp_Object list;
5383 FRAME_PTR f;
5384 enumfont_t ef;
5385
5386 CHECK_STRING (pattern, 0);
5387 if (!NILP (face))
5388 CHECK_SYMBOL (face, 1);
5389
5390 f = check_x_frame (frame);
5391
5392 /* Determine the width standard for comparison with the fonts we find. */
5393
5394 if (NILP (face))
5395 size_ref = 0;
5396 else
5397 {
5398 int face_id;
5399
5400 /* Don't die if we get called with a terminal frame. */
5401 if (! FRAME_W32_P (f))
5402 error ("non-w32 frame used in `x-list-fonts'");
5403
5404 face_id = face_name_id_number (f, face);
5405
5406 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
5407 || FRAME_PARAM_FACES (f) [face_id] == 0)
5408 size_ref = f->output_data.w32->font;
5409 else
5410 {
5411 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
5412 if (size_ref == (XFontStruct *) (~0))
5413 size_ref = f->output_data.w32->font;
5414 }
5415 }
5416
5417 /* See if we cached the result for this particular query. */
5418 list = Fassoc (pattern,
5419 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
5420
5421 /* We have info in the cache for this PATTERN. */
5422 if (!NILP (list))
5423 {
5424 Lisp_Object tem, newlist;
5425
5426 /* We have info about this pattern. */
5427 list = XCONS (list)->cdr;
5428
5429 if (size_ref == 0)
5430 return list;
5431
5432 BLOCK_INPUT;
5433
5434 /* Filter the cached info and return just the fonts that match FACE. */
5435 newlist = Qnil;
5436 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
5437 {
5438 struct font_info *fontinf;
5439 XFontStruct *thisinfo = NULL;
5440
5441 fontinf = w32_load_font (f, XSTRING (XCONS (tem)->car)->data, 0);
5442 if (fontinf)
5443 thisinfo = (XFontStruct *)fontinf->font;
5444 if (thisinfo && same_size_fonts (thisinfo, size_ref))
5445 newlist = Fcons (XCONS (tem)->car, newlist);
5446
5447 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
5448 }
5449
5450 UNBLOCK_INPUT;
5451
5452 return newlist;
5453 }
5454
5455 BLOCK_INPUT;
5456
5457 namelist = Qnil;
5458 ef.pattern = &pattern;
5459 ef.tail = ef.head = &namelist;
5460 ef.numFonts = 0;
5461 x_to_w32_font (STRINGP (pattern) ? XSTRING (pattern)->data : NULL, &ef.logfont);
5462
5463 {
5464 ef.hdc = GetDC (FRAME_W32_WINDOW (f));
5465
5466 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1, (LPARAM)&ef);
5467
5468 ReleaseDC (FRAME_W32_WINDOW (f), ef.hdc);
5469 }
5470
5471 UNBLOCK_INPUT;
5472
5473 if (ef.numFonts)
5474 {
5475 int i;
5476 Lisp_Object cur;
5477
5478 /* Make a list of all the fonts we got back.
5479 Store that in the font cache for the display. */
5480 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr
5481 = Fcons (Fcons (pattern, namelist),
5482 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
5483
5484 /* Make a list of the fonts that have the right width. */
5485 list = Qnil;
5486 cur=namelist;
5487 for (i = 0; i < ef.numFonts; i++)
5488 {
5489 int keeper;
5490
5491 if (!size_ref)
5492 keeper = 1;
5493 else
5494 {
5495 struct font_info *fontinf;
5496 XFontStruct *thisinfo = NULL;
5497
5498 BLOCK_INPUT;
5499 fontinf = w32_load_font (f, XSTRING (Fcar (cur))->data, 0);
5500 if (fontinf)
5501 thisinfo = (XFontStruct *)fontinf->font;
5502
5503 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
5504
5505 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
5506
5507 UNBLOCK_INPUT;
5508 }
5509 if (keeper)
5510 list = Fcons (build_string (XSTRING (Fcar (cur))->data), list);
5511
5512 cur = Fcdr (cur);
5513 }
5514 list = Fnreverse (list);
5515 }
5516
5517 return list;
5518 }
5519 #endif
5520 \f
5521 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
5522 "Return non-nil if color COLOR is supported on frame FRAME.\n\
5523 If FRAME is omitted or nil, use the selected frame.")
5524 (color, frame)
5525 Lisp_Object color, frame;
5526 {
5527 COLORREF foo;
5528 FRAME_PTR f = check_x_frame (frame);
5529
5530 CHECK_STRING (color, 1);
5531
5532 if (defined_color (f, XSTRING (color)->data, &foo, 0))
5533 return Qt;
5534 else
5535 return Qnil;
5536 }
5537
5538 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
5539 "Return a description of the color named COLOR on frame FRAME.\n\
5540 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
5541 These values appear to range from 0 to 65280 or 65535, depending\n\
5542 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
5543 If FRAME is omitted or nil, use the selected frame.")
5544 (color, frame)
5545 Lisp_Object color, frame;
5546 {
5547 COLORREF foo;
5548 FRAME_PTR f = check_x_frame (frame);
5549
5550 CHECK_STRING (color, 1);
5551
5552 if (defined_color (f, XSTRING (color)->data, &foo, 0))
5553 {
5554 Lisp_Object rgb[3];
5555
5556 rgb[0] = make_number ((GetRValue (foo) << 8) | GetRValue (foo));
5557 rgb[1] = make_number ((GetGValue (foo) << 8) | GetGValue (foo));
5558 rgb[2] = make_number ((GetBValue (foo) << 8) | GetBValue (foo));
5559 return Flist (3, rgb);
5560 }
5561 else
5562 return Qnil;
5563 }
5564
5565 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
5566 "Return t if the X display supports color.\n\
5567 The optional argument DISPLAY specifies which display to ask about.\n\
5568 DISPLAY should be either a frame or a display name (a string).\n\
5569 If omitted or nil, that stands for the selected frame's display.")
5570 (display)
5571 Lisp_Object display;
5572 {
5573 struct w32_display_info *dpyinfo = check_x_display_info (display);
5574
5575 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
5576 return Qnil;
5577
5578 return Qt;
5579 }
5580
5581 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
5582 0, 1, 0,
5583 "Return t if the X display supports shades of gray.\n\
5584 Note that color displays do support shades of gray.\n\
5585 The optional argument DISPLAY specifies which display to ask about.\n\
5586 DISPLAY should be either a frame or a display name (a string).\n\
5587 If omitted or nil, that stands for the selected frame's display.")
5588 (display)
5589 Lisp_Object display;
5590 {
5591 struct w32_display_info *dpyinfo = check_x_display_info (display);
5592
5593 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
5594 return Qnil;
5595
5596 return Qt;
5597 }
5598
5599 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
5600 0, 1, 0,
5601 "Returns the width in pixels of the X display DISPLAY.\n\
5602 The optional argument DISPLAY specifies which display to ask about.\n\
5603 DISPLAY should be either a frame or a display name (a string).\n\
5604 If omitted or nil, that stands for the selected frame's display.")
5605 (display)
5606 Lisp_Object display;
5607 {
5608 struct w32_display_info *dpyinfo = check_x_display_info (display);
5609
5610 return make_number (dpyinfo->width);
5611 }
5612
5613 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
5614 Sx_display_pixel_height, 0, 1, 0,
5615 "Returns the height in pixels of the X display DISPLAY.\n\
5616 The optional argument DISPLAY specifies which display to ask about.\n\
5617 DISPLAY should be either a frame or a display name (a string).\n\
5618 If omitted or nil, that stands for the selected frame's display.")
5619 (display)
5620 Lisp_Object display;
5621 {
5622 struct w32_display_info *dpyinfo = check_x_display_info (display);
5623
5624 return make_number (dpyinfo->height);
5625 }
5626
5627 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
5628 0, 1, 0,
5629 "Returns the number of bitplanes of the display DISPLAY.\n\
5630 The optional argument DISPLAY specifies which display to ask about.\n\
5631 DISPLAY should be either a frame or a display name (a string).\n\
5632 If omitted or nil, that stands for the selected frame's display.")
5633 (display)
5634 Lisp_Object display;
5635 {
5636 struct w32_display_info *dpyinfo = check_x_display_info (display);
5637
5638 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
5639 }
5640
5641 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
5642 0, 1, 0,
5643 "Returns the number of color cells of the display DISPLAY.\n\
5644 The optional argument DISPLAY specifies which display to ask about.\n\
5645 DISPLAY should be either a frame or a display name (a string).\n\
5646 If omitted or nil, that stands for the selected frame's display.")
5647 (display)
5648 Lisp_Object display;
5649 {
5650 struct w32_display_info *dpyinfo = check_x_display_info (display);
5651 HDC hdc;
5652 int cap;
5653
5654 hdc = GetDC (dpyinfo->root_window);
5655 if (dpyinfo->has_palette)
5656 cap = GetDeviceCaps (hdc,SIZEPALETTE);
5657 else
5658 cap = GetDeviceCaps (hdc,NUMCOLORS);
5659
5660 ReleaseDC (dpyinfo->root_window, hdc);
5661
5662 return make_number (cap);
5663 }
5664
5665 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
5666 Sx_server_max_request_size,
5667 0, 1, 0,
5668 "Returns the maximum request size of the server of display DISPLAY.\n\
5669 The optional argument DISPLAY specifies which display to ask about.\n\
5670 DISPLAY should be either a frame or a display name (a string).\n\
5671 If omitted or nil, that stands for the selected frame's display.")
5672 (display)
5673 Lisp_Object display;
5674 {
5675 struct w32_display_info *dpyinfo = check_x_display_info (display);
5676
5677 return make_number (1);
5678 }
5679
5680 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
5681 "Returns the vendor ID string of the W32 system (Microsoft).\n\
5682 The optional argument DISPLAY specifies which display to ask about.\n\
5683 DISPLAY should be either a frame or a display name (a string).\n\
5684 If omitted or nil, that stands for the selected frame's display.")
5685 (display)
5686 Lisp_Object display;
5687 {
5688 struct w32_display_info *dpyinfo = check_x_display_info (display);
5689 char *vendor = "Microsoft Corp.";
5690
5691 if (! vendor) vendor = "";
5692 return build_string (vendor);
5693 }
5694
5695 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
5696 "Returns the version numbers of the server of display DISPLAY.\n\
5697 The value is a list of three integers: the major and minor\n\
5698 version numbers, and the vendor-specific release\n\
5699 number. See also the function `x-server-vendor'.\n\n\
5700 The optional argument DISPLAY specifies which display to ask about.\n\
5701 DISPLAY should be either a frame or a display name (a string).\n\
5702 If omitted or nil, that stands for the selected frame's display.")
5703 (display)
5704 Lisp_Object display;
5705 {
5706 struct w32_display_info *dpyinfo = check_x_display_info (display);
5707
5708 return Fcons (make_number (w32_major_version),
5709 Fcons (make_number (w32_minor_version), Qnil));
5710 }
5711
5712 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
5713 "Returns the number of screens on the server of display DISPLAY.\n\
5714 The optional argument DISPLAY specifies which display to ask about.\n\
5715 DISPLAY should be either a frame or a display name (a string).\n\
5716 If omitted or nil, that stands for the selected frame's display.")
5717 (display)
5718 Lisp_Object display;
5719 {
5720 struct w32_display_info *dpyinfo = check_x_display_info (display);
5721
5722 return make_number (1);
5723 }
5724
5725 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
5726 "Returns the height in millimeters of the X display DISPLAY.\n\
5727 The optional argument DISPLAY specifies which display to ask about.\n\
5728 DISPLAY should be either a frame or a display name (a string).\n\
5729 If omitted or nil, that stands for the selected frame's display.")
5730 (display)
5731 Lisp_Object display;
5732 {
5733 struct w32_display_info *dpyinfo = check_x_display_info (display);
5734 HDC hdc;
5735 int cap;
5736
5737 hdc = GetDC (dpyinfo->root_window);
5738
5739 cap = GetDeviceCaps (hdc, VERTSIZE);
5740
5741 ReleaseDC (dpyinfo->root_window, hdc);
5742
5743 return make_number (cap);
5744 }
5745
5746 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
5747 "Returns the width in millimeters of the X display DISPLAY.\n\
5748 The optional argument DISPLAY specifies which display to ask about.\n\
5749 DISPLAY should be either a frame or a display name (a string).\n\
5750 If omitted or nil, that stands for the selected frame's display.")
5751 (display)
5752 Lisp_Object display;
5753 {
5754 struct w32_display_info *dpyinfo = check_x_display_info (display);
5755
5756 HDC hdc;
5757 int cap;
5758
5759 hdc = GetDC (dpyinfo->root_window);
5760
5761 cap = GetDeviceCaps (hdc, HORZSIZE);
5762
5763 ReleaseDC (dpyinfo->root_window, hdc);
5764
5765 return make_number (cap);
5766 }
5767
5768 DEFUN ("x-display-backing-store", Fx_display_backing_store,
5769 Sx_display_backing_store, 0, 1, 0,
5770 "Returns an indication of whether display DISPLAY does backing store.\n\
5771 The value may be `always', `when-mapped', or `not-useful'.\n\
5772 The optional argument DISPLAY specifies which display to ask about.\n\
5773 DISPLAY should be either a frame or a display name (a string).\n\
5774 If omitted or nil, that stands for the selected frame's display.")
5775 (display)
5776 Lisp_Object display;
5777 {
5778 return intern ("not-useful");
5779 }
5780
5781 DEFUN ("x-display-visual-class", Fx_display_visual_class,
5782 Sx_display_visual_class, 0, 1, 0,
5783 "Returns the visual class of the display DISPLAY.\n\
5784 The value is one of the symbols `static-gray', `gray-scale',\n\
5785 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
5786 The optional argument DISPLAY specifies which display to ask about.\n\
5787 DISPLAY should be either a frame or a display name (a string).\n\
5788 If omitted or nil, that stands for the selected frame's display.")
5789 (display)
5790 Lisp_Object display;
5791 {
5792 struct w32_display_info *dpyinfo = check_x_display_info (display);
5793
5794 #if 0
5795 switch (dpyinfo->visual->class)
5796 {
5797 case StaticGray: return (intern ("static-gray"));
5798 case GrayScale: return (intern ("gray-scale"));
5799 case StaticColor: return (intern ("static-color"));
5800 case PseudoColor: return (intern ("pseudo-color"));
5801 case TrueColor: return (intern ("true-color"));
5802 case DirectColor: return (intern ("direct-color"));
5803 default:
5804 error ("Display has an unknown visual class");
5805 }
5806 #endif
5807
5808 error ("Display has an unknown visual class");
5809 }
5810
5811 DEFUN ("x-display-save-under", Fx_display_save_under,
5812 Sx_display_save_under, 0, 1, 0,
5813 "Returns t if the display DISPLAY supports the save-under feature.\n\
5814 The optional argument DISPLAY specifies which display to ask about.\n\
5815 DISPLAY should be either a frame or a display name (a string).\n\
5816 If omitted or nil, that stands for the selected frame's display.")
5817 (display)
5818 Lisp_Object display;
5819 {
5820 struct w32_display_info *dpyinfo = check_x_display_info (display);
5821
5822 return Qnil;
5823 }
5824 \f
5825 int
5826 x_pixel_width (f)
5827 register struct frame *f;
5828 {
5829 return PIXEL_WIDTH (f);
5830 }
5831
5832 int
5833 x_pixel_height (f)
5834 register struct frame *f;
5835 {
5836 return PIXEL_HEIGHT (f);
5837 }
5838
5839 int
5840 x_char_width (f)
5841 register struct frame *f;
5842 {
5843 return FONT_WIDTH (f->output_data.w32->font);
5844 }
5845
5846 int
5847 x_char_height (f)
5848 register struct frame *f;
5849 {
5850 return f->output_data.w32->line_height;
5851 }
5852
5853 int
5854 x_screen_planes (frame)
5855 Lisp_Object frame;
5856 {
5857 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes *
5858 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits);
5859 }
5860 \f
5861 /* Return the display structure for the display named NAME.
5862 Open a new connection if necessary. */
5863
5864 struct w32_display_info *
5865 x_display_info_for_name (name)
5866 Lisp_Object name;
5867 {
5868 Lisp_Object names;
5869 struct w32_display_info *dpyinfo;
5870
5871 CHECK_STRING (name, 0);
5872
5873 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
5874 dpyinfo;
5875 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
5876 {
5877 Lisp_Object tem;
5878 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
5879 if (!NILP (tem))
5880 return dpyinfo;
5881 }
5882
5883 /* Use this general default value to start with. */
5884 Vx_resource_name = Vinvocation_name;
5885
5886 validate_x_resource_name ();
5887
5888 dpyinfo = w32_term_init (name, (unsigned char *)0,
5889 (char *) XSTRING (Vx_resource_name)->data);
5890
5891 if (dpyinfo == 0)
5892 error ("Cannot connect to server %s", XSTRING (name)->data);
5893
5894 w32_in_use = 1;
5895 XSETFASTINT (Vwindow_system_version, 3);
5896
5897 return dpyinfo;
5898 }
5899
5900 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5901 1, 3, 0, "Open a connection to a server.\n\
5902 DISPLAY is the name of the display to connect to.\n\
5903 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5904 If the optional third arg MUST-SUCCEED is non-nil,\n\
5905 terminate Emacs if we can't open the connection.")
5906 (display, xrm_string, must_succeed)
5907 Lisp_Object display, xrm_string, must_succeed;
5908 {
5909 unsigned int n_planes;
5910 unsigned char *xrm_option;
5911 struct w32_display_info *dpyinfo;
5912
5913 CHECK_STRING (display, 0);
5914 if (! NILP (xrm_string))
5915 CHECK_STRING (xrm_string, 1);
5916
5917 if (! EQ (Vwindow_system, intern ("w32")))
5918 error ("Not using Microsoft Windows");
5919
5920 /* Allow color mapping to be defined externally; first look in user's
5921 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
5922 {
5923 Lisp_Object color_file;
5924 struct gcpro gcpro1;
5925
5926 color_file = build_string("~/rgb.txt");
5927
5928 GCPRO1 (color_file);
5929
5930 if (NILP (Ffile_readable_p (color_file)))
5931 color_file =
5932 Fexpand_file_name (build_string ("rgb.txt"),
5933 Fsymbol_value (intern ("data-directory")));
5934
5935 Vw32_color_map = Fw32_load_color_file (color_file);
5936
5937 UNGCPRO;
5938 }
5939 if (NILP (Vw32_color_map))
5940 Vw32_color_map = Fw32_default_color_map ();
5941
5942 if (! NILP (xrm_string))
5943 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
5944 else
5945 xrm_option = (unsigned char *) 0;
5946
5947 /* Use this general default value to start with. */
5948 /* First remove .exe suffix from invocation-name - it looks ugly. */
5949 {
5950 char basename[ MAX_PATH ], *str;
5951
5952 strcpy (basename, XSTRING (Vinvocation_name)->data);
5953 str = strrchr (basename, '.');
5954 if (str) *str = 0;
5955 Vinvocation_name = build_string (basename);
5956 }
5957 Vx_resource_name = Vinvocation_name;
5958
5959 validate_x_resource_name ();
5960
5961 /* This is what opens the connection and sets x_current_display.
5962 This also initializes many symbols, such as those used for input. */
5963 dpyinfo = w32_term_init (display, xrm_option,
5964 (char *) XSTRING (Vx_resource_name)->data);
5965
5966 if (dpyinfo == 0)
5967 {
5968 if (!NILP (must_succeed))
5969 fatal ("Cannot connect to server %s.\n",
5970 XSTRING (display)->data);
5971 else
5972 error ("Cannot connect to server %s", XSTRING (display)->data);
5973 }
5974
5975 w32_in_use = 1;
5976
5977 XSETFASTINT (Vwindow_system_version, 3);
5978 return Qnil;
5979 }
5980
5981 DEFUN ("x-close-connection", Fx_close_connection,
5982 Sx_close_connection, 1, 1, 0,
5983 "Close the connection to DISPLAY's server.\n\
5984 For DISPLAY, specify either a frame or a display name (a string).\n\
5985 If DISPLAY is nil, that stands for the selected frame's display.")
5986 (display)
5987 Lisp_Object display;
5988 {
5989 struct w32_display_info *dpyinfo = check_x_display_info (display);
5990 struct w32_display_info *tail;
5991 int i;
5992
5993 if (dpyinfo->reference_count > 0)
5994 error ("Display still has frames on it");
5995
5996 BLOCK_INPUT;
5997 /* Free the fonts in the font table. */
5998 for (i = 0; i < dpyinfo->n_fonts; i++)
5999 {
6000 if (dpyinfo->font_table[i].name)
6001 free (dpyinfo->font_table[i].name);
6002 /* Don't free the full_name string;
6003 it is always shared with something else. */
6004 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
6005 }
6006 x_destroy_all_bitmaps (dpyinfo);
6007
6008 x_delete_display (dpyinfo);
6009 UNBLOCK_INPUT;
6010
6011 return Qnil;
6012 }
6013
6014 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
6015 "Return the list of display names that Emacs has connections to.")
6016 ()
6017 {
6018 Lisp_Object tail, result;
6019
6020 result = Qnil;
6021 for (tail = w32_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
6022 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
6023
6024 return result;
6025 }
6026
6027 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
6028 "If ON is non-nil, report errors as soon as the erring request is made.\n\
6029 If ON is nil, allow buffering of requests.\n\
6030 This is a noop on W32 systems.\n\
6031 The optional second argument DISPLAY specifies which display to act on.\n\
6032 DISPLAY should be either a frame or a display name (a string).\n\
6033 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
6034 (on, display)
6035 Lisp_Object display, on;
6036 {
6037 struct w32_display_info *dpyinfo = check_x_display_info (display);
6038
6039 return Qnil;
6040 }
6041
6042 \f
6043 /* These are the w32 specialized functions */
6044
6045 DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
6046 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
6047 (frame)
6048 Lisp_Object frame;
6049 {
6050 FRAME_PTR f = check_x_frame (frame);
6051 CHOOSEFONT cf;
6052 LOGFONT lf;
6053 char buf[100];
6054
6055 bzero (&cf, sizeof (cf));
6056
6057 cf.lStructSize = sizeof (cf);
6058 cf.hwndOwner = FRAME_W32_WINDOW (f);
6059 cf.Flags = CF_FIXEDPITCHONLY | CF_FORCEFONTEXIST | CF_SCREENFONTS;
6060 cf.lpLogFont = &lf;
6061
6062 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100))
6063 return Qnil;
6064
6065 return build_string (buf);
6066 }
6067
6068 DEFUN ("w32-send-sys-command", Fw32_send_sys_command, Sw32_send_sys_command, 1, 2, 0,
6069 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
6070 Some useful values for command are 0xf030 to maximise frame (0xf020\n\
6071 to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
6072 to activate the menubar for keyboard access. 0xf140 activates the\n\
6073 screen saver if defined.\n\
6074 \n\
6075 If optional parameter FRAME is not specified, use selected frame.")
6076 (command, frame)
6077 Lisp_Object command, frame;
6078 {
6079 WPARAM code;
6080 FRAME_PTR f = check_x_frame (frame);
6081
6082 CHECK_NUMBER (command, 0);
6083
6084 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
6085
6086 return Qnil;
6087 }
6088
6089 \f
6090 syms_of_w32fns ()
6091 {
6092 /* This is zero if not using MS-Windows. */
6093 w32_in_use = 0;
6094
6095 /* The section below is built by the lisp expression at the top of the file,
6096 just above where these variables are declared. */
6097 /*&&& init symbols here &&&*/
6098 Qauto_raise = intern ("auto-raise");
6099 staticpro (&Qauto_raise);
6100 Qauto_lower = intern ("auto-lower");
6101 staticpro (&Qauto_lower);
6102 Qbackground_color = intern ("background-color");
6103 staticpro (&Qbackground_color);
6104 Qbar = intern ("bar");
6105 staticpro (&Qbar);
6106 Qborder_color = intern ("border-color");
6107 staticpro (&Qborder_color);
6108 Qborder_width = intern ("border-width");
6109 staticpro (&Qborder_width);
6110 Qbox = intern ("box");
6111 staticpro (&Qbox);
6112 Qcursor_color = intern ("cursor-color");
6113 staticpro (&Qcursor_color);
6114 Qcursor_type = intern ("cursor-type");
6115 staticpro (&Qcursor_type);
6116 Qforeground_color = intern ("foreground-color");
6117 staticpro (&Qforeground_color);
6118 Qgeometry = intern ("geometry");
6119 staticpro (&Qgeometry);
6120 Qicon_left = intern ("icon-left");
6121 staticpro (&Qicon_left);
6122 Qicon_top = intern ("icon-top");
6123 staticpro (&Qicon_top);
6124 Qicon_type = intern ("icon-type");
6125 staticpro (&Qicon_type);
6126 Qicon_name = intern ("icon-name");
6127 staticpro (&Qicon_name);
6128 Qinternal_border_width = intern ("internal-border-width");
6129 staticpro (&Qinternal_border_width);
6130 Qleft = intern ("left");
6131 staticpro (&Qleft);
6132 Qright = intern ("right");
6133 staticpro (&Qright);
6134 Qmouse_color = intern ("mouse-color");
6135 staticpro (&Qmouse_color);
6136 Qnone = intern ("none");
6137 staticpro (&Qnone);
6138 Qparent_id = intern ("parent-id");
6139 staticpro (&Qparent_id);
6140 Qscroll_bar_width = intern ("scroll-bar-width");
6141 staticpro (&Qscroll_bar_width);
6142 Qsuppress_icon = intern ("suppress-icon");
6143 staticpro (&Qsuppress_icon);
6144 Qtop = intern ("top");
6145 staticpro (&Qtop);
6146 Qundefined_color = intern ("undefined-color");
6147 staticpro (&Qundefined_color);
6148 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
6149 staticpro (&Qvertical_scroll_bars);
6150 Qvisibility = intern ("visibility");
6151 staticpro (&Qvisibility);
6152 Qwindow_id = intern ("window-id");
6153 staticpro (&Qwindow_id);
6154 Qx_frame_parameter = intern ("x-frame-parameter");
6155 staticpro (&Qx_frame_parameter);
6156 Qx_resource_name = intern ("x-resource-name");
6157 staticpro (&Qx_resource_name);
6158 Quser_position = intern ("user-position");
6159 staticpro (&Quser_position);
6160 Quser_size = intern ("user-size");
6161 staticpro (&Quser_size);
6162 Qdisplay = intern ("display");
6163 staticpro (&Qdisplay);
6164 /* This is the end of symbol initialization. */
6165
6166 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
6167 staticpro (&Qface_set_after_frame_default);
6168
6169 Fput (Qundefined_color, Qerror_conditions,
6170 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
6171 Fput (Qundefined_color, Qerror_message,
6172 build_string ("Undefined color"));
6173
6174 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
6175 "A array of color name mappings for windows.");
6176 Vw32_color_map = Qnil;
6177
6178 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
6179 "Non-nil if alt key presses are passed on to Windows.\n\
6180 When non-nil, for example, alt pressed and released and then space will\n\
6181 open the System menu. When nil, Emacs silently swallows alt key events.");
6182 Vw32_pass_alt_to_system = Qnil;
6183
6184 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
6185 "Non-nil if the alt key is to be considered the same as the meta key.\n\
6186 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
6187 Vw32_alt_is_meta = Qt;
6188
6189 DEFVAR_LISP ("w32-pass-optional-keys-to-system",
6190 &Vw32_pass_optional_keys_to_system,
6191 "Non-nil if the 'optional' keys (left window, right window,\n\
6192 and application keys) are passed on to Windows.");
6193 Vw32_pass_optional_keys_to_system = Qnil;
6194
6195 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics,
6196 "Non-nil enables selection of artificially italicized fonts.");
6197 Vw32_enable_italics = Qnil;
6198
6199 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
6200 "Non-nil enables Windows palette management to map colors exactly.");
6201 Vw32_enable_palette = Qt;
6202
6203 DEFVAR_INT ("w32-mouse-button-tolerance",
6204 &Vw32_mouse_button_tolerance,
6205 "Analogue of double click interval for faking middle mouse events.\n\
6206 The value is the minimum time in milliseconds that must elapse between\n\
6207 left/right button down events before they are considered distinct events.\n\
6208 If both mouse buttons are depressed within this interval, a middle mouse\n\
6209 button down event is generated instead.");
6210 XSETINT (Vw32_mouse_button_tolerance, GetDoubleClickTime () / 2);
6211
6212 DEFVAR_INT ("w32-mouse-move-interval",
6213 &Vw32_mouse_move_interval,
6214 "Minimum interval between mouse move events.\n\
6215 The value is the minimum time in milliseconds that must elapse between\n\
6216 successive mouse move (or scroll bar drag) events before they are\n\
6217 reported as lisp events.");
6218 XSETINT (Vw32_mouse_move_interval, 50);
6219
6220 init_x_parm_symbols ();
6221
6222 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
6223 "List of directories to search for bitmap files for w32.");
6224 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
6225
6226 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
6227 "The shape of the pointer when over text.\n\
6228 Changing the value does not affect existing frames\n\
6229 unless you set the mouse color.");
6230 Vx_pointer_shape = Qnil;
6231
6232 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
6233 "The name Emacs uses to look up resources; for internal use only.\n\
6234 `x-get-resource' uses this as the first component of the instance name\n\
6235 when requesting resource values.\n\
6236 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
6237 was invoked, or to the value specified with the `-name' or `-rn'\n\
6238 switches, if present.");
6239 Vx_resource_name = Qnil;
6240
6241 Vx_nontext_pointer_shape = Qnil;
6242
6243 Vx_mode_pointer_shape = Qnil;
6244
6245 DEFVAR_INT ("x-sensitive-text-pointer-shape",
6246 &Vx_sensitive_text_pointer_shape,
6247 "The shape of the pointer when over mouse-sensitive text.\n\
6248 This variable takes effect when you create a new frame\n\
6249 or when you set the mouse color.");
6250 Vx_sensitive_text_pointer_shape = Qnil;
6251
6252 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
6253 "A string indicating the foreground color of the cursor box.");
6254 Vx_cursor_fore_pixel = Qnil;
6255
6256 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
6257 "Non-nil if no window manager is in use.\n\
6258 Emacs doesn't try to figure this out; this is always nil\n\
6259 unless you set it to something else.");
6260 /* We don't have any way to find this out, so set it to nil
6261 and maybe the user would like to set it to t. */
6262 Vx_no_window_manager = Qnil;
6263
6264 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
6265 &Vx_pixel_size_width_font_regexp,
6266 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
6267 \n\
6268 Since Emacs gets width of a font matching with this regexp from\n\
6269 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
6270 such a font. This is especially effective for such large fonts as\n\
6271 Chinese, Japanese, and Korean.");
6272 Vx_pixel_size_width_font_regexp = Qnil;
6273
6274 DEFVAR_BOOL ("unibyte-display-via-language-environment",
6275 &unibyte_display_via_language_environment,
6276 "*Non-nil means display unibyte text according to language environment.\n\
6277 Specifically this means that unibyte non-ASCII characters\n\
6278 are displayed by converting them to the equivalent multibyte characters\n\
6279 according to the current language environment. As a result, they are\n\
6280 displayed according to the current fontset.");
6281 unibyte_display_via_language_environment = 0;
6282
6283 defsubr (&Sx_get_resource);
6284 defsubr (&Sx_list_fonts);
6285 defsubr (&Sx_display_color_p);
6286 defsubr (&Sx_display_grayscale_p);
6287 defsubr (&Sx_color_defined_p);
6288 defsubr (&Sx_color_values);
6289 defsubr (&Sx_server_max_request_size);
6290 defsubr (&Sx_server_vendor);
6291 defsubr (&Sx_server_version);
6292 defsubr (&Sx_display_pixel_width);
6293 defsubr (&Sx_display_pixel_height);
6294 defsubr (&Sx_display_mm_width);
6295 defsubr (&Sx_display_mm_height);
6296 defsubr (&Sx_display_screens);
6297 defsubr (&Sx_display_planes);
6298 defsubr (&Sx_display_color_cells);
6299 defsubr (&Sx_display_visual_class);
6300 defsubr (&Sx_display_backing_store);
6301 defsubr (&Sx_display_save_under);
6302 defsubr (&Sx_parse_geometry);
6303 defsubr (&Sx_create_frame);
6304 defsubr (&Sx_open_connection);
6305 defsubr (&Sx_close_connection);
6306 defsubr (&Sx_display_list);
6307 defsubr (&Sx_synchronize);
6308
6309 /* W32 specific functions */
6310
6311 defsubr (&Sw32_focus_frame);
6312 defsubr (&Sw32_select_font);
6313 defsubr (&Sw32_define_rgb_color);
6314 defsubr (&Sw32_default_color_map);
6315 defsubr (&Sw32_load_color_file);
6316 defsubr (&Sw32_send_sys_command);
6317
6318 /* Setting callback functions for fontset handler. */
6319 get_font_info_func = w32_get_font_info;
6320 list_fonts_func = w32_list_fonts;
6321 load_font_func = w32_load_font;
6322 find_ccl_program_func = w32_find_ccl_program;
6323 query_font_func = w32_query_font;
6324 set_frame_fontset_func = x_set_font;
6325 check_window_system_func = check_w32;
6326 }
6327
6328 #undef abort
6329
6330 void
6331 w32_abort()
6332 {
6333 int button;
6334 button = MessageBox (NULL,
6335 "A fatal error has occurred!\n\n"
6336 "Select Abort to exit, Retry to debug, Ignore to continue",
6337 "Emacs Abort Dialog",
6338 MB_ICONEXCLAMATION | MB_TASKMODAL
6339 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
6340 switch (button)
6341 {
6342 case IDRETRY:
6343 DebugBreak ();
6344 break;
6345 case IDIGNORE:
6346 break;
6347 case IDABORT:
6348 default:
6349 abort ();
6350 break;
6351 }
6352 }
6353
Unnamed repository; edit this file 'description' to name the repository.