1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 92, 93, 94, 95, 1996, 1997, 1998, 1999, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Added by Kevin Gallo */
33 #include "dispextern.h"
40 #include "intervals.h"
41 #include "blockinput.h"
44 #include "termhooks.h"
49 #include "bitmaps/gray.xbm"
55 #define max(a, b) ((a) > (b) ? (a) : (b))
57 extern void free_frame_menubar ();
58 extern double atof ();
59 extern int w32_console_toggle_lock_key (int vk_code
, Lisp_Object new_state
);
62 /* A definition of XColor for non-X frames. */
63 #ifndef HAVE_X_WINDOWS
66 unsigned short red
, green
, blue
;
72 extern char *lispy_function_keys
[];
74 /* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
75 it, and including `bitmaps/gray' more than once is a problem when
76 config.h defines `static' as an empty replacement string. */
78 int gray_bitmap_width
= gray_width
;
79 int gray_bitmap_height
= gray_height
;
80 unsigned char *gray_bitmap_bits
= gray_bits
;
82 /* The colormap for converting color names to RGB values */
83 Lisp_Object Vw32_color_map
;
85 /* Non nil if alt key presses are passed on to Windows. */
86 Lisp_Object Vw32_pass_alt_to_system
;
88 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
90 Lisp_Object Vw32_alt_is_meta
;
92 /* If non-zero, the windows virtual key code for an alternative quit key. */
93 Lisp_Object Vw32_quit_key
;
95 /* Non nil if left window key events are passed on to Windows (this only
96 affects whether "tapping" the key opens the Start menu). */
97 Lisp_Object Vw32_pass_lwindow_to_system
;
99 /* Non nil if right window key events are passed on to Windows (this
100 only affects whether "tapping" the key opens the Start menu). */
101 Lisp_Object Vw32_pass_rwindow_to_system
;
103 /* Virtual key code used to generate "phantom" key presses in order
104 to stop system from acting on Windows key events. */
105 Lisp_Object Vw32_phantom_key_code
;
107 /* Modifier associated with the left "Windows" key, or nil to act as a
109 Lisp_Object Vw32_lwindow_modifier
;
111 /* Modifier associated with the right "Windows" key, or nil to act as a
113 Lisp_Object Vw32_rwindow_modifier
;
115 /* Modifier associated with the "Apps" key, or nil to act as a normal
117 Lisp_Object Vw32_apps_modifier
;
119 /* Value is nil if Num Lock acts as a function key. */
120 Lisp_Object Vw32_enable_num_lock
;
122 /* Value is nil if Caps Lock acts as a function key. */
123 Lisp_Object Vw32_enable_caps_lock
;
125 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
126 Lisp_Object Vw32_scroll_lock_modifier
;
128 /* Switch to control whether we inhibit requests for synthesized bold
129 and italic versions of fonts. */
130 Lisp_Object Vw32_enable_synthesized_fonts
;
132 /* Enable palette management. */
133 Lisp_Object Vw32_enable_palette
;
135 /* Control how close left/right button down events must be to
136 be converted to a middle button down event. */
137 Lisp_Object Vw32_mouse_button_tolerance
;
139 /* Minimum interval between mouse movement (and scroll bar drag)
140 events that are passed on to the event loop. */
141 Lisp_Object Vw32_mouse_move_interval
;
143 /* The name we're using in resource queries. */
144 Lisp_Object Vx_resource_name
;
146 /* Non nil if no window manager is in use. */
147 Lisp_Object Vx_no_window_manager
;
149 /* Non-zero means we're allowed to display a hourglass pointer. */
151 int display_hourglass_p
;
153 /* The background and shape of the mouse pointer, and shape when not
154 over text or in the modeline. */
156 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
157 Lisp_Object Vx_hourglass_pointer_shape
, Vx_window_horizontal_drag_shape
;
159 /* The shape when over mouse-sensitive text. */
161 Lisp_Object Vx_sensitive_text_pointer_shape
;
163 /* Color of chars displayed in cursor box. */
165 Lisp_Object Vx_cursor_fore_pixel
;
167 /* Nonzero if using Windows. */
169 static int w32_in_use
;
171 /* Search path for bitmap files. */
173 Lisp_Object Vx_bitmap_file_path
;
175 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
177 Lisp_Object Vx_pixel_size_width_font_regexp
;
179 /* Alist of bdf fonts and the files that define them. */
180 Lisp_Object Vw32_bdf_filename_alist
;
182 Lisp_Object Vw32_system_coding_system
;
184 /* A flag to control whether fonts are matched strictly or not. */
185 int w32_strict_fontnames
;
187 /* A flag to control whether we should only repaint if GetUpdateRect
188 indicates there is an update region. */
189 int w32_strict_painting
;
191 /* Associative list linking character set strings to Windows codepages. */
192 Lisp_Object Vw32_charset_info_alist
;
194 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
195 #ifndef VIETNAMESE_CHARSET
196 #define VIETNAMESE_CHARSET 163
199 Lisp_Object Qauto_raise
;
200 Lisp_Object Qauto_lower
;
202 Lisp_Object Qborder_color
;
203 Lisp_Object Qborder_width
;
205 Lisp_Object Qcursor_color
;
206 Lisp_Object Qcursor_type
;
207 Lisp_Object Qgeometry
;
208 Lisp_Object Qicon_left
;
209 Lisp_Object Qicon_top
;
210 Lisp_Object Qicon_type
;
211 Lisp_Object Qicon_name
;
212 Lisp_Object Qinternal_border_width
;
215 Lisp_Object Qmouse_color
;
217 Lisp_Object Qparent_id
;
218 Lisp_Object Qscroll_bar_width
;
219 Lisp_Object Qsuppress_icon
;
220 Lisp_Object Qundefined_color
;
221 Lisp_Object Qvertical_scroll_bars
;
222 Lisp_Object Qvisibility
;
223 Lisp_Object Qwindow_id
;
224 Lisp_Object Qx_frame_parameter
;
225 Lisp_Object Qx_resource_name
;
226 Lisp_Object Quser_position
;
227 Lisp_Object Quser_size
;
228 Lisp_Object Qscreen_gamma
;
229 Lisp_Object Qline_spacing
;
231 Lisp_Object Qcancel_timer
;
237 Lisp_Object Qcontrol
;
240 Lisp_Object Qw32_charset_ansi
;
241 Lisp_Object Qw32_charset_default
;
242 Lisp_Object Qw32_charset_symbol
;
243 Lisp_Object Qw32_charset_shiftjis
;
244 Lisp_Object Qw32_charset_hangeul
;
245 Lisp_Object Qw32_charset_gb2312
;
246 Lisp_Object Qw32_charset_chinesebig5
;
247 Lisp_Object Qw32_charset_oem
;
249 #ifndef JOHAB_CHARSET
250 #define JOHAB_CHARSET 130
253 Lisp_Object Qw32_charset_easteurope
;
254 Lisp_Object Qw32_charset_turkish
;
255 Lisp_Object Qw32_charset_baltic
;
256 Lisp_Object Qw32_charset_russian
;
257 Lisp_Object Qw32_charset_arabic
;
258 Lisp_Object Qw32_charset_greek
;
259 Lisp_Object Qw32_charset_hebrew
;
260 Lisp_Object Qw32_charset_vietnamese
;
261 Lisp_Object Qw32_charset_thai
;
262 Lisp_Object Qw32_charset_johab
;
263 Lisp_Object Qw32_charset_mac
;
266 #ifdef UNICODE_CHARSET
267 Lisp_Object Qw32_charset_unicode
;
270 extern Lisp_Object Qtop
;
271 extern Lisp_Object Qdisplay
;
272 extern Lisp_Object Qtool_bar_lines
;
274 /* State variables for emulating a three button mouse. */
279 static int button_state
= 0;
280 static W32Msg saved_mouse_button_msg
;
281 static unsigned mouse_button_timer
; /* non-zero when timer is active */
282 static W32Msg saved_mouse_move_msg
;
283 static unsigned mouse_move_timer
;
285 /* W95 mousewheel handler */
286 unsigned int msh_mousewheel
= 0;
288 #define MOUSE_BUTTON_ID 1
289 #define MOUSE_MOVE_ID 2
291 /* The below are defined in frame.c. */
293 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
294 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
295 extern Lisp_Object Qtool_bar_lines
;
297 extern Lisp_Object Vwindow_system_version
;
299 Lisp_Object Qface_set_after_frame_default
;
302 int image_cache_refcount
, dpyinfo_refcount
;
306 /* From w32term.c. */
307 extern Lisp_Object Vw32_num_mouse_buttons
;
308 extern Lisp_Object Vw32_recognize_altgr
;
310 extern HWND w32_system_caret_hwnd
;
311 extern int w32_system_caret_width
;
312 extern int w32_system_caret_height
;
313 extern int w32_system_caret_x
;
314 extern int w32_system_caret_y
;
317 /* Error if we are not connected to MS-Windows. */
322 error ("MS-Windows not in use or not initialized");
325 /* Nonzero if we can use mouse menus.
326 You should not call this unless HAVE_MENUS is defined. */
334 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
335 and checking validity for W32. */
338 check_x_frame (frame
)
344 frame
= selected_frame
;
345 CHECK_LIVE_FRAME (frame
);
347 if (! FRAME_W32_P (f
))
348 error ("non-w32 frame used");
352 /* Let the user specify an display with a frame.
353 nil stands for the selected frame--or, if that is not a w32 frame,
354 the first display on the list. */
356 static struct w32_display_info
*
357 check_x_display_info (frame
)
362 struct frame
*sf
= XFRAME (selected_frame
);
364 if (FRAME_W32_P (sf
) && FRAME_LIVE_P (sf
))
365 return FRAME_W32_DISPLAY_INFO (sf
);
367 return &one_w32_display_info
;
369 else if (STRINGP (frame
))
370 return x_display_info_for_name (frame
);
375 CHECK_LIVE_FRAME (frame
);
377 if (! FRAME_W32_P (f
))
378 error ("non-w32 frame used");
379 return FRAME_W32_DISPLAY_INFO (f
);
383 /* Return the Emacs frame-object corresponding to an w32 window.
384 It could be the frame's main window or an icon window. */
386 /* This function can be called during GC, so use GC_xxx type test macros. */
389 x_window_to_frame (dpyinfo
, wdesc
)
390 struct w32_display_info
*dpyinfo
;
393 Lisp_Object tail
, frame
;
396 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
399 if (!GC_FRAMEP (frame
))
402 if (!FRAME_W32_P (f
) || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
404 if (f
->output_data
.w32
->hourglass_window
== wdesc
)
407 /* TODO: Check tooltips when supported. */
408 if (FRAME_W32_WINDOW (f
) == wdesc
)
416 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
417 id, which is just an int that this section returns. Bitmaps are
418 reference counted so they can be shared among frames.
420 Bitmap indices are guaranteed to be > 0, so a negative number can
421 be used to indicate no bitmap.
423 If you use x_create_bitmap_from_data, then you must keep track of
424 the bitmaps yourself. That is, creating a bitmap from the same
425 data more than once will not be caught. */
428 /* Functions to access the contents of a bitmap, given an id. */
431 x_bitmap_height (f
, id
)
435 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
439 x_bitmap_width (f
, id
)
443 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
447 x_bitmap_pixmap (f
, id
)
451 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
455 /* Allocate a new bitmap record. Returns index of new record. */
458 x_allocate_bitmap_record (f
)
461 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
464 if (dpyinfo
->bitmaps
== NULL
)
466 dpyinfo
->bitmaps_size
= 10;
468 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
469 dpyinfo
->bitmaps_last
= 1;
473 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
474 return ++dpyinfo
->bitmaps_last
;
476 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
477 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
480 dpyinfo
->bitmaps_size
*= 2;
482 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
483 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
484 return ++dpyinfo
->bitmaps_last
;
487 /* Add one reference to the reference count of the bitmap with id ID. */
490 x_reference_bitmap (f
, id
)
494 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
497 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
500 x_create_bitmap_from_data (f
, bits
, width
, height
)
503 unsigned int width
, height
;
505 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
509 bitmap
= CreateBitmap (width
, height
,
510 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
511 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
517 id
= x_allocate_bitmap_record (f
);
518 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
519 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
520 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
521 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
522 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
523 dpyinfo
->bitmaps
[id
- 1].height
= height
;
524 dpyinfo
->bitmaps
[id
- 1].width
= width
;
529 /* Create bitmap from file FILE for frame F. */
532 x_create_bitmap_from_file (f
, file
)
537 #if 0 /* TODO : bitmap support */
538 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
539 unsigned int width
, height
;
541 int xhot
, yhot
, result
, id
;
547 /* Look for an existing bitmap with the same name. */
548 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
550 if (dpyinfo
->bitmaps
[id
].refcount
551 && dpyinfo
->bitmaps
[id
].file
552 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
554 ++dpyinfo
->bitmaps
[id
].refcount
;
559 /* Search bitmap-file-path for the file, if appropriate. */
560 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, 0);
565 filename
= (char *) XSTRING (found
)->data
;
567 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
573 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
574 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
575 if (result
!= BitmapSuccess
)
578 id
= x_allocate_bitmap_record (f
);
579 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
580 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
581 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
582 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
583 dpyinfo
->bitmaps
[id
- 1].height
= height
;
584 dpyinfo
->bitmaps
[id
- 1].width
= width
;
585 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
591 /* Remove reference to bitmap with id number ID. */
594 x_destroy_bitmap (f
, id
)
598 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
602 --dpyinfo
->bitmaps
[id
- 1].refcount
;
603 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
606 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
607 if (dpyinfo
->bitmaps
[id
- 1].file
)
609 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
610 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
617 /* Free all the bitmaps for the display specified by DPYINFO. */
620 x_destroy_all_bitmaps (dpyinfo
)
621 struct w32_display_info
*dpyinfo
;
624 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
625 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
627 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
628 if (dpyinfo
->bitmaps
[i
].file
)
629 xfree (dpyinfo
->bitmaps
[i
].file
);
631 dpyinfo
->bitmaps_last
= 0;
634 /* Connect the frame-parameter names for W32 frames
635 to the ways of passing the parameter values to the window system.
637 The name of a parameter, as a Lisp symbol,
638 has an `x-frame-parameter' property which is an integer in Lisp
639 but can be interpreted as an `enum x_frame_parm' in C. */
643 X_PARM_FOREGROUND_COLOR
,
644 X_PARM_BACKGROUND_COLOR
,
651 X_PARM_INTERNAL_BORDER_WIDTH
,
655 X_PARM_VERT_SCROLL_BAR
,
657 X_PARM_MENU_BAR_LINES
661 struct x_frame_parm_table
664 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
667 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
668 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
669 static void x_change_window_heights
P_ ((Lisp_Object
, int));
670 /* TODO: Native Input Method support; see x_create_im. */
671 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
672 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
673 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
674 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
675 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
676 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
677 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
678 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
679 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
680 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
681 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
682 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
684 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
685 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
686 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
687 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
689 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
690 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
691 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
692 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
693 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
694 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
695 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
696 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
699 static struct x_frame_parm_table x_frame_parms
[] =
701 "auto-raise", x_set_autoraise
,
702 "auto-lower", x_set_autolower
,
703 "background-color", x_set_background_color
,
704 "border-color", x_set_border_color
,
705 "border-width", x_set_border_width
,
706 "cursor-color", x_set_cursor_color
,
707 "cursor-type", x_set_cursor_type
,
709 "foreground-color", x_set_foreground_color
,
710 "icon-name", x_set_icon_name
,
711 "icon-type", x_set_icon_type
,
712 "internal-border-width", x_set_internal_border_width
,
713 "menu-bar-lines", x_set_menu_bar_lines
,
714 "mouse-color", x_set_mouse_color
,
715 "name", x_explicitly_set_name
,
716 "scroll-bar-width", x_set_scroll_bar_width
,
717 "title", x_set_title
,
718 "unsplittable", x_set_unsplittable
,
719 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
720 "visibility", x_set_visibility
,
721 "tool-bar-lines", x_set_tool_bar_lines
,
722 "screen-gamma", x_set_screen_gamma
,
723 "line-spacing", x_set_line_spacing
726 /* Attach the `x-frame-parameter' properties to
727 the Lisp symbol names of parameters relevant to W32. */
730 init_x_parm_symbols ()
734 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
735 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
739 /* Change the parameters of frame F as specified by ALIST.
740 If a parameter is not specially recognized, do nothing;
741 otherwise call the `x_set_...' function for that parameter. */
744 x_set_frame_parameters (f
, alist
)
750 /* If both of these parameters are present, it's more efficient to
751 set them both at once. So we wait until we've looked at the
752 entire list before we set them. */
756 Lisp_Object left
, top
;
758 /* Same with these. */
759 Lisp_Object icon_left
, icon_top
;
761 /* Record in these vectors all the parms specified. */
765 int left_no_change
= 0, top_no_change
= 0;
766 int icon_left_no_change
= 0, icon_top_no_change
= 0;
768 struct gcpro gcpro1
, gcpro2
;
771 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
774 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
775 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
777 /* Extract parm names and values into those vectors. */
780 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
785 parms
[i
] = Fcar (elt
);
786 values
[i
] = Fcdr (elt
);
789 /* TAIL and ALIST are not used again below here. */
792 GCPRO2 (*parms
, *values
);
796 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
797 because their values appear in VALUES and strings are not valid. */
798 top
= left
= Qunbound
;
799 icon_left
= icon_top
= Qunbound
;
801 /* Provide default values for HEIGHT and WIDTH. */
802 if (FRAME_NEW_WIDTH (f
))
803 width
= FRAME_NEW_WIDTH (f
);
805 width
= FRAME_WIDTH (f
);
807 if (FRAME_NEW_HEIGHT (f
))
808 height
= FRAME_NEW_HEIGHT (f
);
810 height
= FRAME_HEIGHT (f
);
812 /* Process foreground_color and background_color before anything else.
813 They are independent of other properties, but other properties (e.g.,
814 cursor_color) are dependent upon them. */
815 for (p
= 0; p
< i
; p
++)
817 Lisp_Object prop
, val
;
821 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
823 register Lisp_Object param_index
, old_value
;
825 param_index
= Fget (prop
, Qx_frame_parameter
);
826 old_value
= get_frame_param (f
, prop
);
827 store_frame_param (f
, prop
, val
);
828 if (NATNUMP (param_index
)
829 && (XFASTINT (param_index
)
830 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
831 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
835 /* Now process them in reverse of specified order. */
836 for (i
--; i
>= 0; i
--)
838 Lisp_Object prop
, val
;
843 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
844 width
= XFASTINT (val
);
845 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
846 height
= XFASTINT (val
);
847 else if (EQ (prop
, Qtop
))
849 else if (EQ (prop
, Qleft
))
851 else if (EQ (prop
, Qicon_top
))
853 else if (EQ (prop
, Qicon_left
))
855 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
856 /* Processed above. */
860 register Lisp_Object param_index
, old_value
;
862 param_index
= Fget (prop
, Qx_frame_parameter
);
863 old_value
= get_frame_param (f
, prop
);
864 store_frame_param (f
, prop
, val
);
865 if (NATNUMP (param_index
)
866 && (XFASTINT (param_index
)
867 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
868 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
872 /* Don't die if just one of these was set. */
873 if (EQ (left
, Qunbound
))
876 if (f
->output_data
.w32
->left_pos
< 0)
877 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
879 XSETINT (left
, f
->output_data
.w32
->left_pos
);
881 if (EQ (top
, Qunbound
))
884 if (f
->output_data
.w32
->top_pos
< 0)
885 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
887 XSETINT (top
, f
->output_data
.w32
->top_pos
);
890 /* If one of the icon positions was not set, preserve or default it. */
891 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
893 icon_left_no_change
= 1;
894 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
895 if (NILP (icon_left
))
896 XSETINT (icon_left
, 0);
898 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
900 icon_top_no_change
= 1;
901 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
903 XSETINT (icon_top
, 0);
906 /* Don't set these parameters unless they've been explicitly
907 specified. The window might be mapped or resized while we're in
908 this function, and we don't want to override that unless the lisp
909 code has asked for it.
911 Don't set these parameters unless they actually differ from the
912 window's current parameters; the window may not actually exist
917 check_frame_size (f
, &height
, &width
);
919 XSETFRAME (frame
, f
);
921 if (width
!= FRAME_WIDTH (f
)
922 || height
!= FRAME_HEIGHT (f
)
923 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
924 Fset_frame_size (frame
, make_number (width
), make_number (height
));
926 if ((!NILP (left
) || !NILP (top
))
927 && ! (left_no_change
&& top_no_change
)
928 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
929 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
934 /* Record the signs. */
935 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
936 if (EQ (left
, Qminus
))
937 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
938 else if (INTEGERP (left
))
940 leftpos
= XINT (left
);
942 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
944 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
945 && CONSP (XCDR (left
))
946 && INTEGERP (XCAR (XCDR (left
))))
948 leftpos
= - XINT (XCAR (XCDR (left
)));
949 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
951 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
952 && CONSP (XCDR (left
))
953 && INTEGERP (XCAR (XCDR (left
))))
955 leftpos
= XINT (XCAR (XCDR (left
)));
958 if (EQ (top
, Qminus
))
959 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
960 else if (INTEGERP (top
))
964 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
966 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
967 && CONSP (XCDR (top
))
968 && INTEGERP (XCAR (XCDR (top
))))
970 toppos
= - XINT (XCAR (XCDR (top
)));
971 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
973 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
974 && CONSP (XCDR (top
))
975 && INTEGERP (XCAR (XCDR (top
))))
977 toppos
= XINT (XCAR (XCDR (top
)));
981 /* Store the numeric value of the position. */
982 f
->output_data
.w32
->top_pos
= toppos
;
983 f
->output_data
.w32
->left_pos
= leftpos
;
985 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
987 /* Actually set that position, and convert to absolute. */
988 x_set_offset (f
, leftpos
, toppos
, -1);
991 if ((!NILP (icon_left
) || !NILP (icon_top
))
992 && ! (icon_left_no_change
&& icon_top_no_change
))
993 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
999 /* Store the screen positions of frame F into XPTR and YPTR.
1000 These are the positions of the containing window manager window,
1001 not Emacs's own window. */
1004 x_real_positions (f
, xptr
, yptr
)
1013 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
1014 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
1020 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
1026 /* Insert a description of internally-recorded parameters of frame X
1027 into the parameter alist *ALISTPTR that is to be given to the user.
1028 Only parameters that are specific to W32
1029 and whose values are not correctly recorded in the frame's
1030 param_alist need to be considered here. */
1033 x_report_frame_params (f
, alistptr
)
1035 Lisp_Object
*alistptr
;
1040 /* Represent negative positions (off the top or left screen edge)
1041 in a way that Fmodify_frame_parameters will understand correctly. */
1042 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
1043 if (f
->output_data
.w32
->left_pos
>= 0)
1044 store_in_alist (alistptr
, Qleft
, tem
);
1046 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1048 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
1049 if (f
->output_data
.w32
->top_pos
>= 0)
1050 store_in_alist (alistptr
, Qtop
, tem
);
1052 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1054 store_in_alist (alistptr
, Qborder_width
,
1055 make_number (f
->output_data
.w32
->border_width
));
1056 store_in_alist (alistptr
, Qinternal_border_width
,
1057 make_number (f
->output_data
.w32
->internal_border_width
));
1058 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
1059 store_in_alist (alistptr
, Qwindow_id
,
1060 build_string (buf
));
1061 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1062 FRAME_SAMPLE_VISIBILITY (f
);
1063 store_in_alist (alistptr
, Qvisibility
,
1064 (FRAME_VISIBLE_P (f
) ? Qt
1065 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1066 store_in_alist (alistptr
, Qdisplay
,
1067 XCAR (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
));
1071 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
, Sw32_define_rgb_color
, 4, 4, 0,
1072 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
1073 This adds or updates a named color to w32-color-map, making it available for use.\n\
1074 The original entry's RGB ref is returned, or nil if the entry is new.")
1075 (red
, green
, blue
, name
)
1076 Lisp_Object red
, green
, blue
, name
;
1079 Lisp_Object oldrgb
= Qnil
;
1083 CHECK_NUMBER (green
);
1084 CHECK_NUMBER (blue
);
1085 CHECK_STRING (name
);
1087 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
1091 /* replace existing entry in w32-color-map or add new entry. */
1092 entry
= Fassoc (name
, Vw32_color_map
);
1095 entry
= Fcons (name
, rgb
);
1096 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
1100 oldrgb
= Fcdr (entry
);
1101 Fsetcdr (entry
, rgb
);
1109 DEFUN ("w32-load-color-file", Fw32_load_color_file
, Sw32_load_color_file
, 1, 1, 0,
1110 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
1111 Assign this value to w32-color-map to replace the existing color map.\n\
1113 The file should define one named RGB color per line like so:\
1115 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
1117 Lisp_Object filename
;
1120 Lisp_Object cmap
= Qnil
;
1121 Lisp_Object abspath
;
1123 CHECK_STRING (filename
);
1124 abspath
= Fexpand_file_name (filename
, Qnil
);
1126 fp
= fopen (XSTRING (filename
)->data
, "rt");
1130 int red
, green
, blue
;
1135 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
1136 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
1138 char *name
= buf
+ num
;
1139 num
= strlen (name
) - 1;
1140 if (name
[num
] == '\n')
1142 cmap
= Fcons (Fcons (build_string (name
),
1143 make_number (RGB (red
, green
, blue
))),
1155 /* The default colors for the w32 color map */
1156 typedef struct colormap_t
1162 colormap_t w32_color_map
[] =
1164 {"snow" , PALETTERGB (255,250,250)},
1165 {"ghost white" , PALETTERGB (248,248,255)},
1166 {"GhostWhite" , PALETTERGB (248,248,255)},
1167 {"white smoke" , PALETTERGB (245,245,245)},
1168 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1169 {"gainsboro" , PALETTERGB (220,220,220)},
1170 {"floral white" , PALETTERGB (255,250,240)},
1171 {"FloralWhite" , PALETTERGB (255,250,240)},
1172 {"old lace" , PALETTERGB (253,245,230)},
1173 {"OldLace" , PALETTERGB (253,245,230)},
1174 {"linen" , PALETTERGB (250,240,230)},
1175 {"antique white" , PALETTERGB (250,235,215)},
1176 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1177 {"papaya whip" , PALETTERGB (255,239,213)},
1178 {"PapayaWhip" , PALETTERGB (255,239,213)},
1179 {"blanched almond" , PALETTERGB (255,235,205)},
1180 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1181 {"bisque" , PALETTERGB (255,228,196)},
1182 {"peach puff" , PALETTERGB (255,218,185)},
1183 {"PeachPuff" , PALETTERGB (255,218,185)},
1184 {"navajo white" , PALETTERGB (255,222,173)},
1185 {"NavajoWhite" , PALETTERGB (255,222,173)},
1186 {"moccasin" , PALETTERGB (255,228,181)},
1187 {"cornsilk" , PALETTERGB (255,248,220)},
1188 {"ivory" , PALETTERGB (255,255,240)},
1189 {"lemon chiffon" , PALETTERGB (255,250,205)},
1190 {"LemonChiffon" , PALETTERGB (255,250,205)},
1191 {"seashell" , PALETTERGB (255,245,238)},
1192 {"honeydew" , PALETTERGB (240,255,240)},
1193 {"mint cream" , PALETTERGB (245,255,250)},
1194 {"MintCream" , PALETTERGB (245,255,250)},
1195 {"azure" , PALETTERGB (240,255,255)},
1196 {"alice blue" , PALETTERGB (240,248,255)},
1197 {"AliceBlue" , PALETTERGB (240,248,255)},
1198 {"lavender" , PALETTERGB (230,230,250)},
1199 {"lavender blush" , PALETTERGB (255,240,245)},
1200 {"LavenderBlush" , PALETTERGB (255,240,245)},
1201 {"misty rose" , PALETTERGB (255,228,225)},
1202 {"MistyRose" , PALETTERGB (255,228,225)},
1203 {"white" , PALETTERGB (255,255,255)},
1204 {"black" , PALETTERGB ( 0, 0, 0)},
1205 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1206 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1207 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1208 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1209 {"dim gray" , PALETTERGB (105,105,105)},
1210 {"DimGray" , PALETTERGB (105,105,105)},
1211 {"dim grey" , PALETTERGB (105,105,105)},
1212 {"DimGrey" , PALETTERGB (105,105,105)},
1213 {"slate gray" , PALETTERGB (112,128,144)},
1214 {"SlateGray" , PALETTERGB (112,128,144)},
1215 {"slate grey" , PALETTERGB (112,128,144)},
1216 {"SlateGrey" , PALETTERGB (112,128,144)},
1217 {"light slate gray" , PALETTERGB (119,136,153)},
1218 {"LightSlateGray" , PALETTERGB (119,136,153)},
1219 {"light slate grey" , PALETTERGB (119,136,153)},
1220 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1221 {"gray" , PALETTERGB (190,190,190)},
1222 {"grey" , PALETTERGB (190,190,190)},
1223 {"light grey" , PALETTERGB (211,211,211)},
1224 {"LightGrey" , PALETTERGB (211,211,211)},
1225 {"light gray" , PALETTERGB (211,211,211)},
1226 {"LightGray" , PALETTERGB (211,211,211)},
1227 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1228 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1229 {"navy" , PALETTERGB ( 0, 0,128)},
1230 {"navy blue" , PALETTERGB ( 0, 0,128)},
1231 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1232 {"cornflower blue" , PALETTERGB (100,149,237)},
1233 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1234 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1235 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1236 {"slate blue" , PALETTERGB (106, 90,205)},
1237 {"SlateBlue" , PALETTERGB (106, 90,205)},
1238 {"medium slate blue" , PALETTERGB (123,104,238)},
1239 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1240 {"light slate blue" , PALETTERGB (132,112,255)},
1241 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1242 {"medium blue" , PALETTERGB ( 0, 0,205)},
1243 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1244 {"royal blue" , PALETTERGB ( 65,105,225)},
1245 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1246 {"blue" , PALETTERGB ( 0, 0,255)},
1247 {"dodger blue" , PALETTERGB ( 30,144,255)},
1248 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1249 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1250 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1251 {"sky blue" , PALETTERGB (135,206,235)},
1252 {"SkyBlue" , PALETTERGB (135,206,235)},
1253 {"light sky blue" , PALETTERGB (135,206,250)},
1254 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1255 {"steel blue" , PALETTERGB ( 70,130,180)},
1256 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1257 {"light steel blue" , PALETTERGB (176,196,222)},
1258 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1259 {"light blue" , PALETTERGB (173,216,230)},
1260 {"LightBlue" , PALETTERGB (173,216,230)},
1261 {"powder blue" , PALETTERGB (176,224,230)},
1262 {"PowderBlue" , PALETTERGB (176,224,230)},
1263 {"pale turquoise" , PALETTERGB (175,238,238)},
1264 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1265 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1266 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1267 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1268 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1269 {"turquoise" , PALETTERGB ( 64,224,208)},
1270 {"cyan" , PALETTERGB ( 0,255,255)},
1271 {"light cyan" , PALETTERGB (224,255,255)},
1272 {"LightCyan" , PALETTERGB (224,255,255)},
1273 {"cadet blue" , PALETTERGB ( 95,158,160)},
1274 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1275 {"medium aquamarine" , PALETTERGB (102,205,170)},
1276 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1277 {"aquamarine" , PALETTERGB (127,255,212)},
1278 {"dark green" , PALETTERGB ( 0,100, 0)},
1279 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1280 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1281 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1282 {"dark sea green" , PALETTERGB (143,188,143)},
1283 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1284 {"sea green" , PALETTERGB ( 46,139, 87)},
1285 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1286 {"medium sea green" , PALETTERGB ( 60,179,113)},
1287 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1288 {"light sea green" , PALETTERGB ( 32,178,170)},
1289 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1290 {"pale green" , PALETTERGB (152,251,152)},
1291 {"PaleGreen" , PALETTERGB (152,251,152)},
1292 {"spring green" , PALETTERGB ( 0,255,127)},
1293 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1294 {"lawn green" , PALETTERGB (124,252, 0)},
1295 {"LawnGreen" , PALETTERGB (124,252, 0)},
1296 {"green" , PALETTERGB ( 0,255, 0)},
1297 {"chartreuse" , PALETTERGB (127,255, 0)},
1298 {"medium spring green" , PALETTERGB ( 0,250,154)},
1299 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1300 {"green yellow" , PALETTERGB (173,255, 47)},
1301 {"GreenYellow" , PALETTERGB (173,255, 47)},
1302 {"lime green" , PALETTERGB ( 50,205, 50)},
1303 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1304 {"yellow green" , PALETTERGB (154,205, 50)},
1305 {"YellowGreen" , PALETTERGB (154,205, 50)},
1306 {"forest green" , PALETTERGB ( 34,139, 34)},
1307 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1308 {"olive drab" , PALETTERGB (107,142, 35)},
1309 {"OliveDrab" , PALETTERGB (107,142, 35)},
1310 {"dark khaki" , PALETTERGB (189,183,107)},
1311 {"DarkKhaki" , PALETTERGB (189,183,107)},
1312 {"khaki" , PALETTERGB (240,230,140)},
1313 {"pale goldenrod" , PALETTERGB (238,232,170)},
1314 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1315 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1316 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1317 {"light yellow" , PALETTERGB (255,255,224)},
1318 {"LightYellow" , PALETTERGB (255,255,224)},
1319 {"yellow" , PALETTERGB (255,255, 0)},
1320 {"gold" , PALETTERGB (255,215, 0)},
1321 {"light goldenrod" , PALETTERGB (238,221,130)},
1322 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1323 {"goldenrod" , PALETTERGB (218,165, 32)},
1324 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1325 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1326 {"rosy brown" , PALETTERGB (188,143,143)},
1327 {"RosyBrown" , PALETTERGB (188,143,143)},
1328 {"indian red" , PALETTERGB (205, 92, 92)},
1329 {"IndianRed" , PALETTERGB (205, 92, 92)},
1330 {"saddle brown" , PALETTERGB (139, 69, 19)},
1331 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1332 {"sienna" , PALETTERGB (160, 82, 45)},
1333 {"peru" , PALETTERGB (205,133, 63)},
1334 {"burlywood" , PALETTERGB (222,184,135)},
1335 {"beige" , PALETTERGB (245,245,220)},
1336 {"wheat" , PALETTERGB (245,222,179)},
1337 {"sandy brown" , PALETTERGB (244,164, 96)},
1338 {"SandyBrown" , PALETTERGB (244,164, 96)},
1339 {"tan" , PALETTERGB (210,180,140)},
1340 {"chocolate" , PALETTERGB (210,105, 30)},
1341 {"firebrick" , PALETTERGB (178,34, 34)},
1342 {"brown" , PALETTERGB (165,42, 42)},
1343 {"dark salmon" , PALETTERGB (233,150,122)},
1344 {"DarkSalmon" , PALETTERGB (233,150,122)},
1345 {"salmon" , PALETTERGB (250,128,114)},
1346 {"light salmon" , PALETTERGB (255,160,122)},
1347 {"LightSalmon" , PALETTERGB (255,160,122)},
1348 {"orange" , PALETTERGB (255,165, 0)},
1349 {"dark orange" , PALETTERGB (255,140, 0)},
1350 {"DarkOrange" , PALETTERGB (255,140, 0)},
1351 {"coral" , PALETTERGB (255,127, 80)},
1352 {"light coral" , PALETTERGB (240,128,128)},
1353 {"LightCoral" , PALETTERGB (240,128,128)},
1354 {"tomato" , PALETTERGB (255, 99, 71)},
1355 {"orange red" , PALETTERGB (255, 69, 0)},
1356 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1357 {"red" , PALETTERGB (255, 0, 0)},
1358 {"hot pink" , PALETTERGB (255,105,180)},
1359 {"HotPink" , PALETTERGB (255,105,180)},
1360 {"deep pink" , PALETTERGB (255, 20,147)},
1361 {"DeepPink" , PALETTERGB (255, 20,147)},
1362 {"pink" , PALETTERGB (255,192,203)},
1363 {"light pink" , PALETTERGB (255,182,193)},
1364 {"LightPink" , PALETTERGB (255,182,193)},
1365 {"pale violet red" , PALETTERGB (219,112,147)},
1366 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1367 {"maroon" , PALETTERGB (176, 48, 96)},
1368 {"medium violet red" , PALETTERGB (199, 21,133)},
1369 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1370 {"violet red" , PALETTERGB (208, 32,144)},
1371 {"VioletRed" , PALETTERGB (208, 32,144)},
1372 {"magenta" , PALETTERGB (255, 0,255)},
1373 {"violet" , PALETTERGB (238,130,238)},
1374 {"plum" , PALETTERGB (221,160,221)},
1375 {"orchid" , PALETTERGB (218,112,214)},
1376 {"medium orchid" , PALETTERGB (186, 85,211)},
1377 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1378 {"dark orchid" , PALETTERGB (153, 50,204)},
1379 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1380 {"dark violet" , PALETTERGB (148, 0,211)},
1381 {"DarkViolet" , PALETTERGB (148, 0,211)},
1382 {"blue violet" , PALETTERGB (138, 43,226)},
1383 {"BlueViolet" , PALETTERGB (138, 43,226)},
1384 {"purple" , PALETTERGB (160, 32,240)},
1385 {"medium purple" , PALETTERGB (147,112,219)},
1386 {"MediumPurple" , PALETTERGB (147,112,219)},
1387 {"thistle" , PALETTERGB (216,191,216)},
1388 {"gray0" , PALETTERGB ( 0, 0, 0)},
1389 {"grey0" , PALETTERGB ( 0, 0, 0)},
1390 {"dark grey" , PALETTERGB (169,169,169)},
1391 {"DarkGrey" , PALETTERGB (169,169,169)},
1392 {"dark gray" , PALETTERGB (169,169,169)},
1393 {"DarkGray" , PALETTERGB (169,169,169)},
1394 {"dark blue" , PALETTERGB ( 0, 0,139)},
1395 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1396 {"dark cyan" , PALETTERGB ( 0,139,139)},
1397 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1398 {"dark magenta" , PALETTERGB (139, 0,139)},
1399 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1400 {"dark red" , PALETTERGB (139, 0, 0)},
1401 {"DarkRed" , PALETTERGB (139, 0, 0)},
1402 {"light green" , PALETTERGB (144,238,144)},
1403 {"LightGreen" , PALETTERGB (144,238,144)},
1406 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1407 0, 0, 0, "Return the default color map.")
1411 colormap_t
*pc
= w32_color_map
;
1418 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1420 cmap
= Fcons (Fcons (build_string (pc
->name
),
1421 make_number (pc
->colorref
)),
1430 w32_to_x_color (rgb
)
1439 color
= Frassq (rgb
, Vw32_color_map
);
1444 return (Fcar (color
));
1450 w32_color_map_lookup (colorname
)
1453 Lisp_Object tail
, ret
= Qnil
;
1457 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1459 register Lisp_Object elt
, tem
;
1462 if (!CONSP (elt
)) continue;
1466 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1468 ret
= XUINT (Fcdr (elt
));
1482 x_to_w32_color (colorname
)
1485 register Lisp_Object ret
= Qnil
;
1489 if (colorname
[0] == '#')
1491 /* Could be an old-style RGB Device specification. */
1494 color
= colorname
+ 1;
1496 size
= strlen(color
);
1497 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1505 for (i
= 0; i
< 3; i
++)
1509 unsigned long value
;
1511 /* The check for 'x' in the following conditional takes into
1512 account the fact that strtol allows a "0x" in front of
1513 our numbers, and we don't. */
1514 if (!isxdigit(color
[0]) || color
[1] == 'x')
1518 value
= strtoul(color
, &end
, 16);
1520 if (errno
== ERANGE
|| end
- color
!= size
)
1525 value
= value
* 0x10;
1536 colorval
|= (value
<< pos
);
1547 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1555 color
= colorname
+ 4;
1556 for (i
= 0; i
< 3; i
++)
1559 unsigned long value
;
1561 /* The check for 'x' in the following conditional takes into
1562 account the fact that strtol allows a "0x" in front of
1563 our numbers, and we don't. */
1564 if (!isxdigit(color
[0]) || color
[1] == 'x')
1566 value
= strtoul(color
, &end
, 16);
1567 if (errno
== ERANGE
)
1569 switch (end
- color
)
1572 value
= value
* 0x10 + value
;
1585 if (value
== ULONG_MAX
)
1587 colorval
|= (value
<< pos
);
1601 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1603 /* This is an RGB Intensity specification. */
1610 color
= colorname
+ 5;
1611 for (i
= 0; i
< 3; i
++)
1617 value
= strtod(color
, &end
);
1618 if (errno
== ERANGE
)
1620 if (value
< 0.0 || value
> 1.0)
1622 val
= (UINT
)(0x100 * value
);
1623 /* We used 0x100 instead of 0xFF to give an continuous
1624 range between 0.0 and 1.0 inclusive. The next statement
1625 fixes the 1.0 case. */
1628 colorval
|= (val
<< pos
);
1642 /* I am not going to attempt to handle any of the CIE color schemes
1643 or TekHVC, since I don't know the algorithms for conversion to
1646 /* If we fail to lookup the color name in w32_color_map, then check the
1647 colorname to see if it can be crudely approximated: If the X color
1648 ends in a number (e.g., "darkseagreen2"), strip the number and
1649 return the result of looking up the base color name. */
1650 ret
= w32_color_map_lookup (colorname
);
1653 int len
= strlen (colorname
);
1655 if (isdigit (colorname
[len
- 1]))
1657 char *ptr
, *approx
= alloca (len
+ 1);
1659 strcpy (approx
, colorname
);
1660 ptr
= &approx
[len
- 1];
1661 while (ptr
> approx
&& isdigit (*ptr
))
1664 ret
= w32_color_map_lookup (approx
);
1674 w32_regenerate_palette (FRAME_PTR f
)
1676 struct w32_palette_entry
* list
;
1677 LOGPALETTE
* log_palette
;
1678 HPALETTE new_palette
;
1681 /* don't bother trying to create palette if not supported */
1682 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1685 log_palette
= (LOGPALETTE
*)
1686 alloca (sizeof (LOGPALETTE
) +
1687 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1688 log_palette
->palVersion
= 0x300;
1689 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1691 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1693 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1694 i
++, list
= list
->next
)
1695 log_palette
->palPalEntry
[i
] = list
->entry
;
1697 new_palette
= CreatePalette (log_palette
);
1701 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1702 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1703 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1705 /* Realize display palette and garbage all frames. */
1706 release_frame_dc (f
, get_frame_dc (f
));
1711 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1712 #define SET_W32_COLOR(pe, color) \
1715 pe.peRed = GetRValue (color); \
1716 pe.peGreen = GetGValue (color); \
1717 pe.peBlue = GetBValue (color); \
1722 /* Keep these around in case we ever want to track color usage. */
1724 w32_map_color (FRAME_PTR f
, COLORREF color
)
1726 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1728 if (NILP (Vw32_enable_palette
))
1731 /* check if color is already mapped */
1734 if (W32_COLOR (list
->entry
) == color
)
1742 /* not already mapped, so add to list and recreate Windows palette */
1743 list
= (struct w32_palette_entry
*)
1744 xmalloc (sizeof (struct w32_palette_entry
));
1745 SET_W32_COLOR (list
->entry
, color
);
1747 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1748 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1749 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1751 /* set flag that palette must be regenerated */
1752 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1756 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1758 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1759 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1761 if (NILP (Vw32_enable_palette
))
1764 /* check if color is already mapped */
1767 if (W32_COLOR (list
->entry
) == color
)
1769 if (--list
->refcount
== 0)
1773 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1783 /* set flag that palette must be regenerated */
1784 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1789 /* Gamma-correct COLOR on frame F. */
1792 gamma_correct (f
, color
)
1798 *color
= PALETTERGB (
1799 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1800 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1801 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1806 /* Decide if color named COLOR is valid for the display associated with
1807 the selected frame; if so, return the rgb values in COLOR_DEF.
1808 If ALLOC is nonzero, allocate a new colormap cell. */
1811 w32_defined_color (f
, color
, color_def
, alloc
)
1817 register Lisp_Object tem
;
1818 COLORREF w32_color_ref
;
1820 tem
= x_to_w32_color (color
);
1826 /* Apply gamma correction. */
1827 w32_color_ref
= XUINT (tem
);
1828 gamma_correct (f
, &w32_color_ref
);
1829 XSETINT (tem
, w32_color_ref
);
1832 /* Map this color to the palette if it is enabled. */
1833 if (!NILP (Vw32_enable_palette
))
1835 struct w32_palette_entry
* entry
=
1836 one_w32_display_info
.color_list
;
1837 struct w32_palette_entry
** prev
=
1838 &one_w32_display_info
.color_list
;
1840 /* check if color is already mapped */
1843 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1845 prev
= &entry
->next
;
1846 entry
= entry
->next
;
1849 if (entry
== NULL
&& alloc
)
1851 /* not already mapped, so add to list */
1852 entry
= (struct w32_palette_entry
*)
1853 xmalloc (sizeof (struct w32_palette_entry
));
1854 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1857 one_w32_display_info
.num_colors
++;
1859 /* set flag that palette must be regenerated */
1860 one_w32_display_info
.regen_palette
= TRUE
;
1863 /* Ensure COLORREF value is snapped to nearest color in (default)
1864 palette by simulating the PALETTERGB macro. This works whether
1865 or not the display device has a palette. */
1866 w32_color_ref
= XUINT (tem
) | 0x2000000;
1868 color_def
->pixel
= w32_color_ref
;
1869 color_def
->red
= GetRValue (w32_color_ref
);
1870 color_def
->green
= GetGValue (w32_color_ref
);
1871 color_def
->blue
= GetBValue (w32_color_ref
);
1881 /* Given a string ARG naming a color, compute a pixel value from it
1882 suitable for screen F.
1883 If F is not a color screen, return DEF (default) regardless of what
1887 x_decode_color (f
, arg
, def
)
1896 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1897 return BLACK_PIX_DEFAULT (f
);
1898 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1899 return WHITE_PIX_DEFAULT (f
);
1901 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1904 /* w32_defined_color is responsible for coping with failures
1905 by looking for a near-miss. */
1906 if (w32_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1909 /* defined_color failed; return an ultimate default. */
1913 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1914 the previous value of that parameter, NEW_VALUE is the new value. */
1917 x_set_line_spacing (f
, new_value
, old_value
)
1919 Lisp_Object new_value
, old_value
;
1921 if (NILP (new_value
))
1922 f
->extra_line_spacing
= 0;
1923 else if (NATNUMP (new_value
))
1924 f
->extra_line_spacing
= XFASTINT (new_value
);
1926 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1927 Fcons (new_value
, Qnil
)));
1928 if (FRAME_VISIBLE_P (f
))
1933 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1934 the previous value of that parameter, NEW_VALUE is the new value. */
1937 x_set_screen_gamma (f
, new_value
, old_value
)
1939 Lisp_Object new_value
, old_value
;
1941 if (NILP (new_value
))
1943 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1944 /* The value 0.4545 is the normal viewing gamma. */
1945 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1947 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1948 Fcons (new_value
, Qnil
)));
1950 clear_face_cache (0);
1954 /* Functions called only from `x_set_frame_param'
1955 to set individual parameters.
1957 If FRAME_W32_WINDOW (f) is 0,
1958 the frame is being created and its window does not exist yet.
1959 In that case, just record the parameter's new value
1960 in the standard place; do not attempt to change the window. */
1963 x_set_foreground_color (f
, arg
, oldval
)
1965 Lisp_Object arg
, oldval
;
1967 struct w32_output
*x
= f
->output_data
.w32
;
1968 PIX_TYPE fg
, old_fg
;
1970 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1971 old_fg
= FRAME_FOREGROUND_PIXEL (f
);
1972 FRAME_FOREGROUND_PIXEL (f
) = fg
;
1974 if (FRAME_W32_WINDOW (f
) != 0)
1976 if (x
->cursor_pixel
== old_fg
)
1977 x
->cursor_pixel
= fg
;
1979 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1980 if (FRAME_VISIBLE_P (f
))
1986 x_set_background_color (f
, arg
, oldval
)
1988 Lisp_Object arg
, oldval
;
1990 FRAME_BACKGROUND_PIXEL (f
)
1991 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1993 if (FRAME_W32_WINDOW (f
) != 0)
1995 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
1996 FRAME_BACKGROUND_PIXEL (f
));
1998 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
2000 if (FRAME_VISIBLE_P (f
))
2006 x_set_mouse_color (f
, arg
, oldval
)
2008 Lisp_Object arg
, oldval
;
2010 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
2014 if (!EQ (Qnil
, arg
))
2015 f
->output_data
.w32
->mouse_pixel
2016 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2017 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
2019 /* Don't let pointers be invisible. */
2020 if (mask_color
== f
->output_data
.w32
->mouse_pixel
2021 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
2022 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
2024 #if 0 /* TODO : cursor changes */
2027 /* It's not okay to crash if the user selects a screwy cursor. */
2028 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
2030 if (!EQ (Qnil
, Vx_pointer_shape
))
2032 CHECK_NUMBER (Vx_pointer_shape
);
2033 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
2036 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2037 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
2039 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
2041 CHECK_NUMBER (Vx_nontext_pointer_shape
);
2042 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2043 XINT (Vx_nontext_pointer_shape
));
2046 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
2047 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2049 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
2051 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
2052 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2053 XINT (Vx_hourglass_pointer_shape
));
2056 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
2057 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
2059 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2060 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
2062 CHECK_NUMBER (Vx_mode_pointer_shape
);
2063 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2064 XINT (Vx_mode_pointer_shape
));
2067 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2068 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
2070 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
2072 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
2074 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2075 XINT (Vx_sensitive_text_pointer_shape
));
2078 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
2080 if (!NILP (Vx_window_horizontal_drag_shape
))
2082 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
2083 horizontal_drag_cursor
2084 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
2085 XINT (Vx_window_horizontal_drag_shape
));
2088 horizontal_drag_cursor
2089 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
2091 /* Check and report errors with the above calls. */
2092 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
2093 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
2096 XColor fore_color
, back_color
;
2098 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
2099 back_color
.pixel
= mask_color
;
2100 XQueryColor (FRAME_W32_DISPLAY (f
),
2101 DefaultColormap (FRAME_W32_DISPLAY (f
),
2102 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2104 XQueryColor (FRAME_W32_DISPLAY (f
),
2105 DefaultColormap (FRAME_W32_DISPLAY (f
),
2106 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2108 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
2109 &fore_color
, &back_color
);
2110 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
2111 &fore_color
, &back_color
);
2112 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
2113 &fore_color
, &back_color
);
2114 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
2115 &fore_color
, &back_color
);
2116 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
2117 &fore_color
, &back_color
);
2120 if (FRAME_W32_WINDOW (f
) != 0)
2121 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
2123 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
2124 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
2125 f
->output_data
.w32
->text_cursor
= cursor
;
2127 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
2128 && f
->output_data
.w32
->nontext_cursor
!= 0)
2129 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
2130 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
2132 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
2133 && f
->output_data
.w32
->hourglass_cursor
!= 0)
2134 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
2135 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
2137 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
2138 && f
->output_data
.w32
->modeline_cursor
!= 0)
2139 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
2140 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
2142 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
2143 && f
->output_data
.w32
->cross_cursor
!= 0)
2144 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
2145 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
2147 XFlush (FRAME_W32_DISPLAY (f
));
2150 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
2154 /* Defined in w32term.c. */
2155 void x_update_cursor (struct frame
*f
, int on_p
);
2158 x_set_cursor_color (f
, arg
, oldval
)
2160 Lisp_Object arg
, oldval
;
2162 unsigned long fore_pixel
, pixel
;
2164 if (!NILP (Vx_cursor_fore_pixel
))
2165 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
2166 WHITE_PIX_DEFAULT (f
));
2168 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2170 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2172 /* Make sure that the cursor color differs from the background color. */
2173 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
2175 pixel
= f
->output_data
.w32
->mouse_pixel
;
2176 if (pixel
== fore_pixel
)
2177 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2180 FRAME_FOREGROUND_PIXEL (f
) = fore_pixel
;
2181 f
->output_data
.w32
->cursor_pixel
= pixel
;
2183 if (FRAME_W32_WINDOW (f
) != 0)
2185 if (FRAME_VISIBLE_P (f
))
2187 x_update_cursor (f
, 0);
2188 x_update_cursor (f
, 1);
2192 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
2195 /* Set the border-color of frame F to pixel value PIX.
2196 Note that this does not fully take effect if done before
2199 x_set_border_pixel (f
, pix
)
2203 f
->output_data
.w32
->border_pixel
= pix
;
2205 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
2207 if (FRAME_VISIBLE_P (f
))
2212 /* Set the border-color of frame F to value described by ARG.
2213 ARG can be a string naming a color.
2214 The border-color is used for the border that is drawn by the server.
2215 Note that this does not fully take effect if done before
2216 F has a window; it must be redone when the window is created. */
2219 x_set_border_color (f
, arg
, oldval
)
2221 Lisp_Object arg
, oldval
;
2226 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2227 x_set_border_pixel (f
, pix
);
2228 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
2231 /* Value is the internal representation of the specified cursor type
2232 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
2233 of the bar cursor. */
2235 enum text_cursor_kinds
2236 x_specified_cursor_type (arg
, width
)
2240 enum text_cursor_kinds type
;
2247 else if (CONSP (arg
)
2248 && EQ (XCAR (arg
), Qbar
)
2249 && INTEGERP (XCDR (arg
))
2250 && XINT (XCDR (arg
)) >= 0)
2253 *width
= XINT (XCDR (arg
));
2255 else if (NILP (arg
))
2258 /* Treat anything unknown as "box cursor".
2259 It was bad to signal an error; people have trouble fixing
2260 .Xdefaults with Emacs, when it has something bad in it. */
2261 type
= FILLED_BOX_CURSOR
;
2267 x_set_cursor_type (f
, arg
, oldval
)
2269 Lisp_Object arg
, oldval
;
2273 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
2274 f
->output_data
.w32
->cursor_width
= width
;
2276 /* Make sure the cursor gets redrawn. This is overkill, but how
2277 often do people change cursor types? */
2278 update_mode_lines
++;
2282 x_set_icon_type (f
, arg
, oldval
)
2284 Lisp_Object arg
, oldval
;
2288 if (NILP (arg
) && NILP (oldval
))
2291 if (STRINGP (arg
) && STRINGP (oldval
)
2292 && EQ (Fstring_equal (oldval
, arg
), Qt
))
2295 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
2300 result
= x_bitmap_icon (f
, arg
);
2304 error ("No icon window available");
2310 /* Return non-nil if frame F wants a bitmap icon. */
2318 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
2326 x_set_icon_name (f
, arg
, oldval
)
2328 Lisp_Object arg
, oldval
;
2332 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2335 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2341 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2346 result
= x_text_icon (f
,
2347 (char *) XSTRING ((!NILP (f
->icon_name
)
2356 error ("No icon window available");
2359 /* If the window was unmapped (and its icon was mapped),
2360 the new icon is not mapped, so map the window in its stead. */
2361 if (FRAME_VISIBLE_P (f
))
2363 #ifdef USE_X_TOOLKIT
2364 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2366 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2369 XFlush (FRAME_W32_DISPLAY (f
));
2374 extern Lisp_Object
x_new_font ();
2375 extern Lisp_Object
x_new_fontset();
2378 x_set_font (f
, arg
, oldval
)
2380 Lisp_Object arg
, oldval
;
2383 Lisp_Object fontset_name
;
2385 int old_fontset
= FRAME_FONTSET(f
);
2389 fontset_name
= Fquery_fontset (arg
, Qnil
);
2392 result
= (STRINGP (fontset_name
)
2393 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
2394 : x_new_font (f
, XSTRING (arg
)->data
));
2397 if (EQ (result
, Qnil
))
2398 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
2399 else if (EQ (result
, Qt
))
2400 error ("The characters of the given font have varying widths");
2401 else if (STRINGP (result
))
2403 if (STRINGP (fontset_name
))
2405 /* Fontset names are built from ASCII font names, so the
2406 names may be equal despite there was a change. */
2407 if (old_fontset
== FRAME_FONTSET (f
))
2410 else if (!NILP (Fequal (result
, oldval
)))
2413 store_frame_param (f
, Qfont
, result
);
2414 recompute_basic_faces (f
);
2419 do_pending_window_change (0);
2421 /* Don't call `face-set-after-frame-default' when faces haven't been
2422 initialized yet. This is the case when called from
2423 Fx_create_frame. In that case, the X widget or window doesn't
2424 exist either, and we can end up in x_report_frame_params with a
2425 null widget which gives a segfault. */
2426 if (FRAME_FACE_CACHE (f
))
2428 XSETFRAME (frame
, f
);
2429 call1 (Qface_set_after_frame_default
, frame
);
2434 x_set_border_width (f
, arg
, oldval
)
2436 Lisp_Object arg
, oldval
;
2440 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2443 if (FRAME_W32_WINDOW (f
) != 0)
2444 error ("Cannot change the border width of a window");
2446 f
->output_data
.w32
->border_width
= XINT (arg
);
2450 x_set_internal_border_width (f
, arg
, oldval
)
2452 Lisp_Object arg
, oldval
;
2454 int old
= f
->output_data
.w32
->internal_border_width
;
2457 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2458 if (f
->output_data
.w32
->internal_border_width
< 0)
2459 f
->output_data
.w32
->internal_border_width
= 0;
2461 if (f
->output_data
.w32
->internal_border_width
== old
)
2464 if (FRAME_W32_WINDOW (f
) != 0)
2466 x_set_window_size (f
, 0, f
->width
, f
->height
);
2467 SET_FRAME_GARBAGED (f
);
2468 do_pending_window_change (0);
2473 x_set_visibility (f
, value
, oldval
)
2475 Lisp_Object value
, oldval
;
2478 XSETFRAME (frame
, f
);
2481 Fmake_frame_invisible (frame
, Qt
);
2482 else if (EQ (value
, Qicon
))
2483 Ficonify_frame (frame
);
2485 Fmake_frame_visible (frame
);
2489 /* Change window heights in windows rooted in WINDOW by N lines. */
2492 x_change_window_heights (window
, n
)
2496 struct window
*w
= XWINDOW (window
);
2498 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2499 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2501 if (INTEGERP (w
->orig_top
))
2502 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2503 if (INTEGERP (w
->orig_height
))
2504 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2506 /* Handle just the top child in a vertical split. */
2507 if (!NILP (w
->vchild
))
2508 x_change_window_heights (w
->vchild
, n
);
2510 /* Adjust all children in a horizontal split. */
2511 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2513 w
= XWINDOW (window
);
2514 x_change_window_heights (window
, n
);
2519 x_set_menu_bar_lines (f
, value
, oldval
)
2521 Lisp_Object value
, oldval
;
2524 int olines
= FRAME_MENU_BAR_LINES (f
);
2526 /* Right now, menu bars don't work properly in minibuf-only frames;
2527 most of the commands try to apply themselves to the minibuffer
2528 frame itself, and get an error because you can't switch buffers
2529 in or split the minibuffer window. */
2530 if (FRAME_MINIBUF_ONLY_P (f
))
2533 if (INTEGERP (value
))
2534 nlines
= XINT (value
);
2538 FRAME_MENU_BAR_LINES (f
) = 0;
2540 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2543 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2544 free_frame_menubar (f
);
2545 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2547 /* Adjust the frame size so that the client (text) dimensions
2548 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2550 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2551 do_pending_window_change (0);
2557 /* Set the number of lines used for the tool bar of frame F to VALUE.
2558 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2559 is the old number of tool bar lines. This function changes the
2560 height of all windows on frame F to match the new tool bar height.
2561 The frame's height doesn't change. */
2564 x_set_tool_bar_lines (f
, value
, oldval
)
2566 Lisp_Object value
, oldval
;
2568 int delta
, nlines
, root_height
;
2569 Lisp_Object root_window
;
2571 /* Treat tool bars like menu bars. */
2572 if (FRAME_MINIBUF_ONLY_P (f
))
2575 /* Use VALUE only if an integer >= 0. */
2576 if (INTEGERP (value
) && XINT (value
) >= 0)
2577 nlines
= XFASTINT (value
);
2581 /* Make sure we redisplay all windows in this frame. */
2582 ++windows_or_buffers_changed
;
2584 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2586 /* Don't resize the tool-bar to more than we have room for. */
2587 root_window
= FRAME_ROOT_WINDOW (f
);
2588 root_height
= XINT (XWINDOW (root_window
)->height
);
2589 if (root_height
- delta
< 1)
2591 delta
= root_height
- 1;
2592 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2595 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2596 x_change_window_heights (root_window
, delta
);
2599 /* We also have to make sure that the internal border at the top of
2600 the frame, below the menu bar or tool bar, is redrawn when the
2601 tool bar disappears. This is so because the internal border is
2602 below the tool bar if one is displayed, but is below the menu bar
2603 if there isn't a tool bar. The tool bar draws into the area
2604 below the menu bar. */
2605 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2609 clear_current_matrices (f
);
2610 updating_frame
= NULL
;
2613 /* If the tool bar gets smaller, the internal border below it
2614 has to be cleared. It was formerly part of the display
2615 of the larger tool bar, and updating windows won't clear it. */
2618 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2619 int width
= PIXEL_WIDTH (f
);
2620 int y
= nlines
* CANON_Y_UNIT (f
);
2624 HDC hdc
= get_frame_dc (f
);
2625 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
2626 release_frame_dc (f
, hdc
);
2630 if (WINDOWP (f
->tool_bar_window
))
2631 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2636 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2639 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2640 name; if NAME is a string, set F's name to NAME and set
2641 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2643 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2644 suggesting a new name, which lisp code should override; if
2645 F->explicit_name is set, ignore the new name; otherwise, set it. */
2648 x_set_name (f
, name
, explicit)
2653 /* Make sure that requests from lisp code override requests from
2654 Emacs redisplay code. */
2657 /* If we're switching from explicit to implicit, we had better
2658 update the mode lines and thereby update the title. */
2659 if (f
->explicit_name
&& NILP (name
))
2660 update_mode_lines
= 1;
2662 f
->explicit_name
= ! NILP (name
);
2664 else if (f
->explicit_name
)
2667 /* If NAME is nil, set the name to the w32_id_name. */
2670 /* Check for no change needed in this very common case
2671 before we do any consing. */
2672 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2673 XSTRING (f
->name
)->data
))
2675 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2678 CHECK_STRING (name
);
2680 /* Don't change the name if it's already NAME. */
2681 if (! NILP (Fstring_equal (name
, f
->name
)))
2686 /* For setting the frame title, the title parameter should override
2687 the name parameter. */
2688 if (! NILP (f
->title
))
2691 if (FRAME_W32_WINDOW (f
))
2693 if (STRING_MULTIBYTE (name
))
2694 name
= ENCODE_SYSTEM (name
);
2697 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2702 /* This function should be called when the user's lisp code has
2703 specified a name for the frame; the name will override any set by the
2706 x_explicitly_set_name (f
, arg
, oldval
)
2708 Lisp_Object arg
, oldval
;
2710 x_set_name (f
, arg
, 1);
2713 /* This function should be called by Emacs redisplay code to set the
2714 name; names set this way will never override names set by the user's
2717 x_implicitly_set_name (f
, arg
, oldval
)
2719 Lisp_Object arg
, oldval
;
2721 x_set_name (f
, arg
, 0);
2724 /* Change the title of frame F to NAME.
2725 If NAME is nil, use the frame name as the title.
2727 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2728 name; if NAME is a string, set F's name to NAME and set
2729 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2731 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2732 suggesting a new name, which lisp code should override; if
2733 F->explicit_name is set, ignore the new name; otherwise, set it. */
2736 x_set_title (f
, name
, old_name
)
2738 Lisp_Object name
, old_name
;
2740 /* Don't change the title if it's already NAME. */
2741 if (EQ (name
, f
->title
))
2744 update_mode_lines
= 1;
2751 if (FRAME_W32_WINDOW (f
))
2753 if (STRING_MULTIBYTE (name
))
2754 name
= ENCODE_SYSTEM (name
);
2757 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2763 x_set_autoraise (f
, arg
, oldval
)
2765 Lisp_Object arg
, oldval
;
2767 f
->auto_raise
= !EQ (Qnil
, arg
);
2771 x_set_autolower (f
, arg
, oldval
)
2773 Lisp_Object arg
, oldval
;
2775 f
->auto_lower
= !EQ (Qnil
, arg
);
2779 x_set_unsplittable (f
, arg
, oldval
)
2781 Lisp_Object arg
, oldval
;
2783 f
->no_split
= !NILP (arg
);
2787 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2789 Lisp_Object arg
, oldval
;
2791 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2792 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2793 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2794 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2796 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2797 vertical_scroll_bar_none
:
2798 /* Put scroll bars on the right by default, as is conventional
2801 ? vertical_scroll_bar_left
2802 : vertical_scroll_bar_right
;
2804 /* We set this parameter before creating the window for the
2805 frame, so we can get the geometry right from the start.
2806 However, if the window hasn't been created yet, we shouldn't
2807 call x_set_window_size. */
2808 if (FRAME_W32_WINDOW (f
))
2809 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2810 do_pending_window_change (0);
2815 x_set_scroll_bar_width (f
, arg
, oldval
)
2817 Lisp_Object arg
, oldval
;
2819 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2823 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
2824 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) +
2826 if (FRAME_W32_WINDOW (f
))
2827 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2828 do_pending_window_change (0);
2830 else if (INTEGERP (arg
) && XINT (arg
) > 0
2831 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2833 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2834 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2836 if (FRAME_W32_WINDOW (f
))
2837 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2838 do_pending_window_change (0);
2840 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2841 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2842 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2845 /* Subroutines of creating an frame. */
2847 /* Make sure that Vx_resource_name is set to a reasonable value.
2848 Fix it up, or set it to `emacs' if it is too hopeless. */
2851 validate_x_resource_name ()
2854 /* Number of valid characters in the resource name. */
2856 /* Number of invalid characters in the resource name. */
2861 if (STRINGP (Vx_resource_name
))
2863 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2866 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2868 /* Only letters, digits, - and _ are valid in resource names.
2869 Count the valid characters and count the invalid ones. */
2870 for (i
= 0; i
< len
; i
++)
2873 if (! ((c
>= 'a' && c
<= 'z')
2874 || (c
>= 'A' && c
<= 'Z')
2875 || (c
>= '0' && c
<= '9')
2876 || c
== '-' || c
== '_'))
2883 /* Not a string => completely invalid. */
2884 bad_count
= 5, good_count
= 0;
2886 /* If name is valid already, return. */
2890 /* If name is entirely invalid, or nearly so, use `emacs'. */
2892 || (good_count
== 1 && bad_count
> 0))
2894 Vx_resource_name
= build_string ("emacs");
2898 /* Name is partly valid. Copy it and replace the invalid characters
2899 with underscores. */
2901 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2903 for (i
= 0; i
< len
; i
++)
2905 int c
= XSTRING (new)->data
[i
];
2906 if (! ((c
>= 'a' && c
<= 'z')
2907 || (c
>= 'A' && c
<= 'Z')
2908 || (c
>= '0' && c
<= '9')
2909 || c
== '-' || c
== '_'))
2910 XSTRING (new)->data
[i
] = '_';
2915 extern char *x_get_string_resource ();
2917 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2918 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2919 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2920 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2921 the name specified by the `-name' or `-rn' command-line arguments.\n\
2923 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2924 class, respectively. You must specify both of them or neither.\n\
2925 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2926 and the class is `Emacs.CLASS.SUBCLASS'.")
2927 (attribute
, class, component
, subclass
)
2928 Lisp_Object attribute
, class, component
, subclass
;
2930 register char *value
;
2934 CHECK_STRING (attribute
);
2935 CHECK_STRING (class);
2937 if (!NILP (component
))
2938 CHECK_STRING (component
);
2939 if (!NILP (subclass
))
2940 CHECK_STRING (subclass
);
2941 if (NILP (component
) != NILP (subclass
))
2942 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2944 validate_x_resource_name ();
2946 /* Allocate space for the components, the dots which separate them,
2947 and the final '\0'. Make them big enough for the worst case. */
2948 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2949 + (STRINGP (component
)
2950 ? STRING_BYTES (XSTRING (component
)) : 0)
2951 + STRING_BYTES (XSTRING (attribute
))
2954 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2955 + STRING_BYTES (XSTRING (class))
2956 + (STRINGP (subclass
)
2957 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2960 /* Start with emacs.FRAMENAME for the name (the specific one)
2961 and with `Emacs' for the class key (the general one). */
2962 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2963 strcpy (class_key
, EMACS_CLASS
);
2965 strcat (class_key
, ".");
2966 strcat (class_key
, XSTRING (class)->data
);
2968 if (!NILP (component
))
2970 strcat (class_key
, ".");
2971 strcat (class_key
, XSTRING (subclass
)->data
);
2973 strcat (name_key
, ".");
2974 strcat (name_key
, XSTRING (component
)->data
);
2977 strcat (name_key
, ".");
2978 strcat (name_key
, XSTRING (attribute
)->data
);
2980 value
= x_get_string_resource (Qnil
,
2981 name_key
, class_key
);
2983 if (value
!= (char *) 0)
2984 return build_string (value
);
2989 /* Used when C code wants a resource value. */
2992 x_get_resource_string (attribute
, class)
2993 char *attribute
, *class;
2997 struct frame
*sf
= SELECTED_FRAME ();
2999 /* Allocate space for the components, the dots which separate them,
3000 and the final '\0'. */
3001 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
3002 + strlen (attribute
) + 2);
3003 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3004 + strlen (class) + 2);
3006 sprintf (name_key
, "%s.%s",
3007 XSTRING (Vinvocation_name
)->data
,
3009 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3011 return x_get_string_resource (sf
, name_key
, class_key
);
3014 /* Types we might convert a resource string into. */
3024 /* Return the value of parameter PARAM.
3026 First search ALIST, then Vdefault_frame_alist, then the X defaults
3027 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3029 Convert the resource to the type specified by desired_type.
3031 If no default is specified, return Qunbound. If you call
3032 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
3033 and don't let it get stored in any Lisp-visible variables! */
3036 w32_get_arg (alist
, param
, attribute
, class, type
)
3037 Lisp_Object alist
, param
;
3040 enum resource_types type
;
3042 register Lisp_Object tem
;
3044 tem
= Fassq (param
, alist
);
3046 tem
= Fassq (param
, Vdefault_frame_alist
);
3052 tem
= Fx_get_resource (build_string (attribute
),
3053 build_string (class),
3061 case RES_TYPE_NUMBER
:
3062 return make_number (atoi (XSTRING (tem
)->data
));
3064 case RES_TYPE_FLOAT
:
3065 return make_float (atof (XSTRING (tem
)->data
));
3067 case RES_TYPE_BOOLEAN
:
3068 tem
= Fdowncase (tem
);
3069 if (!strcmp (XSTRING (tem
)->data
, "on")
3070 || !strcmp (XSTRING (tem
)->data
, "true"))
3075 case RES_TYPE_STRING
:
3078 case RES_TYPE_SYMBOL
:
3079 /* As a special case, we map the values `true' and `on'
3080 to Qt, and `false' and `off' to Qnil. */
3083 lower
= Fdowncase (tem
);
3084 if (!strcmp (XSTRING (lower
)->data
, "on")
3085 || !strcmp (XSTRING (lower
)->data
, "true"))
3087 else if (!strcmp (XSTRING (lower
)->data
, "off")
3088 || !strcmp (XSTRING (lower
)->data
, "false"))
3091 return Fintern (tem
, Qnil
);
3104 /* Record in frame F the specified or default value according to ALIST
3105 of the parameter named PROP (a Lisp symbol).
3106 If no value is specified for PROP, look for an X default for XPROP
3107 on the frame named NAME.
3108 If that is not found either, use the value DEFLT. */
3111 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3118 enum resource_types type
;
3122 tem
= w32_get_arg (alist
, prop
, xprop
, xclass
, type
);
3123 if (EQ (tem
, Qunbound
))
3125 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3129 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3130 "Parse an X-style geometry string STRING.\n\
3131 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
3132 The properties returned may include `top', `left', `height', and `width'.\n\
3133 The value of `left' or `top' may be an integer,\n\
3134 or a list (+ N) meaning N pixels relative to top/left corner,\n\
3135 or a list (- N) meaning -N pixels relative to bottom/right corner.")
3140 unsigned int width
, height
;
3143 CHECK_STRING (string
);
3145 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3146 &x
, &y
, &width
, &height
);
3149 if (geometry
& XValue
)
3151 Lisp_Object element
;
3153 if (x
>= 0 && (geometry
& XNegative
))
3154 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3155 else if (x
< 0 && ! (geometry
& XNegative
))
3156 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3158 element
= Fcons (Qleft
, make_number (x
));
3159 result
= Fcons (element
, result
);
3162 if (geometry
& YValue
)
3164 Lisp_Object element
;
3166 if (y
>= 0 && (geometry
& YNegative
))
3167 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3168 else if (y
< 0 && ! (geometry
& YNegative
))
3169 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3171 element
= Fcons (Qtop
, make_number (y
));
3172 result
= Fcons (element
, result
);
3175 if (geometry
& WidthValue
)
3176 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3177 if (geometry
& HeightValue
)
3178 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3183 /* Calculate the desired size and position of this window,
3184 and return the flags saying which aspects were specified.
3186 This function does not make the coordinates positive. */
3188 #define DEFAULT_ROWS 40
3189 #define DEFAULT_COLS 80
3192 x_figure_window_size (f
, parms
)
3196 register Lisp_Object tem0
, tem1
, tem2
;
3197 long window_prompting
= 0;
3199 /* Default values if we fall through.
3200 Actually, if that happens we should get
3201 window manager prompting. */
3202 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3203 f
->height
= DEFAULT_ROWS
;
3204 /* Window managers expect that if program-specified
3205 positions are not (0,0), they're intentional, not defaults. */
3206 f
->output_data
.w32
->top_pos
= 0;
3207 f
->output_data
.w32
->left_pos
= 0;
3209 /* Ensure that old new_width and new_height will not override the
3211 FRAME_NEW_WIDTH (f
) = 0;
3212 FRAME_NEW_HEIGHT (f
) = 0;
3214 tem0
= w32_get_arg (parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3215 tem1
= w32_get_arg (parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3216 tem2
= w32_get_arg (parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3217 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3219 if (!EQ (tem0
, Qunbound
))
3221 CHECK_NUMBER (tem0
);
3222 f
->height
= XINT (tem0
);
3224 if (!EQ (tem1
, Qunbound
))
3226 CHECK_NUMBER (tem1
);
3227 SET_FRAME_WIDTH (f
, XINT (tem1
));
3229 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3230 window_prompting
|= USSize
;
3232 window_prompting
|= PSize
;
3235 f
->output_data
.w32
->vertical_scroll_bar_extra
3236 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3238 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
3239 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
3240 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
3241 f
->output_data
.w32
->flags_areas_extra
3242 = FRAME_FLAGS_AREA_WIDTH (f
);
3243 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3244 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3246 tem0
= w32_get_arg (parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3247 tem1
= w32_get_arg (parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3248 tem2
= w32_get_arg (parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3249 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3251 if (EQ (tem0
, Qminus
))
3253 f
->output_data
.w32
->top_pos
= 0;
3254 window_prompting
|= YNegative
;
3256 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3257 && CONSP (XCDR (tem0
))
3258 && INTEGERP (XCAR (XCDR (tem0
))))
3260 f
->output_data
.w32
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3261 window_prompting
|= YNegative
;
3263 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3264 && CONSP (XCDR (tem0
))
3265 && INTEGERP (XCAR (XCDR (tem0
))))
3267 f
->output_data
.w32
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3269 else if (EQ (tem0
, Qunbound
))
3270 f
->output_data
.w32
->top_pos
= 0;
3273 CHECK_NUMBER (tem0
);
3274 f
->output_data
.w32
->top_pos
= XINT (tem0
);
3275 if (f
->output_data
.w32
->top_pos
< 0)
3276 window_prompting
|= YNegative
;
3279 if (EQ (tem1
, Qminus
))
3281 f
->output_data
.w32
->left_pos
= 0;
3282 window_prompting
|= XNegative
;
3284 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3285 && CONSP (XCDR (tem1
))
3286 && INTEGERP (XCAR (XCDR (tem1
))))
3288 f
->output_data
.w32
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3289 window_prompting
|= XNegative
;
3291 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3292 && CONSP (XCDR (tem1
))
3293 && INTEGERP (XCAR (XCDR (tem1
))))
3295 f
->output_data
.w32
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3297 else if (EQ (tem1
, Qunbound
))
3298 f
->output_data
.w32
->left_pos
= 0;
3301 CHECK_NUMBER (tem1
);
3302 f
->output_data
.w32
->left_pos
= XINT (tem1
);
3303 if (f
->output_data
.w32
->left_pos
< 0)
3304 window_prompting
|= XNegative
;
3307 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3308 window_prompting
|= USPosition
;
3310 window_prompting
|= PPosition
;
3313 return window_prompting
;
3318 extern LRESULT CALLBACK
w32_wnd_proc ();
3321 w32_init_class (hinst
)
3326 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
3327 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
3329 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
3330 wc
.hInstance
= hinst
;
3331 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
3332 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
3333 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
3334 wc
.lpszMenuName
= NULL
;
3335 wc
.lpszClassName
= EMACS_CLASS
;
3337 return (RegisterClass (&wc
));
3341 w32_createscrollbar (f
, bar
)
3343 struct scroll_bar
* bar
;
3345 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
3346 /* Position and size of scroll bar. */
3347 XINT(bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
3349 XINT(bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
3351 FRAME_W32_WINDOW (f
),
3358 w32_createwindow (f
)
3364 rect
.left
= rect
.top
= 0;
3365 rect
.right
= PIXEL_WIDTH (f
);
3366 rect
.bottom
= PIXEL_HEIGHT (f
);
3368 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
3369 FRAME_EXTERNAL_MENU_BAR (f
));
3371 /* Do first time app init */
3375 w32_init_class (hinst
);
3378 FRAME_W32_WINDOW (f
) = hwnd
3379 = CreateWindow (EMACS_CLASS
,
3381 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
3382 f
->output_data
.w32
->left_pos
,
3383 f
->output_data
.w32
->top_pos
,
3384 rect
.right
- rect
.left
,
3385 rect
.bottom
- rect
.top
,
3393 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
3394 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
3395 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
3396 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
3397 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
3399 /* Enable drag-n-drop. */
3400 DragAcceptFiles (hwnd
, TRUE
);
3402 /* Do this to discard the default setting specified by our parent. */
3403 ShowWindow (hwnd
, SW_HIDE
);
3408 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
3415 wmsg
->msg
.hwnd
= hwnd
;
3416 wmsg
->msg
.message
= msg
;
3417 wmsg
->msg
.wParam
= wParam
;
3418 wmsg
->msg
.lParam
= lParam
;
3419 wmsg
->msg
.time
= GetMessageTime ();
3424 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
3425 between left and right keys as advertised. We test for this
3426 support dynamically, and set a flag when the support is absent. If
3427 absent, we keep track of the left and right control and alt keys
3428 ourselves. This is particularly necessary on keyboards that rely
3429 upon the AltGr key, which is represented as having the left control
3430 and right alt keys pressed. For these keyboards, we need to know
3431 when the left alt key has been pressed in addition to the AltGr key
3432 so that we can properly support M-AltGr-key sequences (such as M-@
3433 on Swedish keyboards). */
3435 #define EMACS_LCONTROL 0
3436 #define EMACS_RCONTROL 1
3437 #define EMACS_LMENU 2
3438 #define EMACS_RMENU 3
3440 static int modifiers
[4];
3441 static int modifiers_recorded
;
3442 static int modifier_key_support_tested
;
3445 test_modifier_support (unsigned int wparam
)
3449 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3451 if (wparam
== VK_CONTROL
)
3461 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
3462 modifiers_recorded
= 1;
3464 modifiers_recorded
= 0;
3465 modifier_key_support_tested
= 1;
3469 record_keydown (unsigned int wparam
, unsigned int lparam
)
3473 if (!modifier_key_support_tested
)
3474 test_modifier_support (wparam
);
3476 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3479 if (wparam
== VK_CONTROL
)
3480 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3482 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3488 record_keyup (unsigned int wparam
, unsigned int lparam
)
3492 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3495 if (wparam
== VK_CONTROL
)
3496 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3498 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3503 /* Emacs can lose focus while a modifier key has been pressed. When
3504 it regains focus, be conservative and clear all modifiers since
3505 we cannot reconstruct the left and right modifier state. */
3511 if (GetFocus () == NULL
)
3512 /* Emacs doesn't have keyboard focus. Do nothing. */
3515 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3516 alt
= GetAsyncKeyState (VK_MENU
);
3518 if (!(ctrl
& 0x08000))
3519 /* Clear any recorded control modifier state. */
3520 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3522 if (!(alt
& 0x08000))
3523 /* Clear any recorded alt modifier state. */
3524 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3526 /* Update the state of all modifier keys, because modifiers used in
3527 hot-key combinations can get stuck on if Emacs loses focus as a
3528 result of a hot-key being pressed. */
3532 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3534 GetKeyboardState (keystate
);
3535 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
3536 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
3537 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
3538 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
3539 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
3540 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
3541 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
3542 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
3543 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
3544 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
3545 SetKeyboardState (keystate
);
3549 /* Synchronize modifier state with what is reported with the current
3550 keystroke. Even if we cannot distinguish between left and right
3551 modifier keys, we know that, if no modifiers are set, then neither
3552 the left or right modifier should be set. */
3556 if (!modifiers_recorded
)
3559 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3560 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3562 if (!(GetKeyState (VK_MENU
) & 0x8000))
3563 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3567 modifier_set (int vkey
)
3569 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
3570 return (GetKeyState (vkey
) & 0x1);
3571 if (!modifiers_recorded
)
3572 return (GetKeyState (vkey
) & 0x8000);
3577 return modifiers
[EMACS_LCONTROL
];
3579 return modifiers
[EMACS_RCONTROL
];
3581 return modifiers
[EMACS_LMENU
];
3583 return modifiers
[EMACS_RMENU
];
3585 return (GetKeyState (vkey
) & 0x8000);
3588 /* Convert between the modifier bits W32 uses and the modifier bits
3592 w32_key_to_modifier (int key
)
3594 Lisp_Object key_mapping
;
3599 key_mapping
= Vw32_lwindow_modifier
;
3602 key_mapping
= Vw32_rwindow_modifier
;
3605 key_mapping
= Vw32_apps_modifier
;
3608 key_mapping
= Vw32_scroll_lock_modifier
;
3614 /* NB. This code runs in the input thread, asychronously to the lisp
3615 thread, so we must be careful to ensure access to lisp data is
3616 thread-safe. The following code is safe because the modifier
3617 variable values are updated atomically from lisp and symbols are
3618 not relocated by GC. Also, we don't have to worry about seeing GC
3620 if (EQ (key_mapping
, Qhyper
))
3621 return hyper_modifier
;
3622 if (EQ (key_mapping
, Qsuper
))
3623 return super_modifier
;
3624 if (EQ (key_mapping
, Qmeta
))
3625 return meta_modifier
;
3626 if (EQ (key_mapping
, Qalt
))
3627 return alt_modifier
;
3628 if (EQ (key_mapping
, Qctrl
))
3629 return ctrl_modifier
;
3630 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
3631 return ctrl_modifier
;
3632 if (EQ (key_mapping
, Qshift
))
3633 return shift_modifier
;
3635 /* Don't generate any modifier if not explicitly requested. */
3640 w32_get_modifiers ()
3642 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
3643 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
3644 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
3645 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
3646 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
3647 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
3648 (modifier_set (VK_MENU
) ?
3649 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
3652 /* We map the VK_* modifiers into console modifier constants
3653 so that we can use the same routines to handle both console
3654 and window input. */
3657 construct_console_modifiers ()
3662 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3663 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3664 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
3665 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
3666 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3667 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3668 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3669 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3670 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
3671 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
3672 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
3678 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
3682 /* Convert to emacs modifiers. */
3683 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
3689 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
3691 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
3694 if (virt_key
== VK_RETURN
)
3695 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3697 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
3698 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
3700 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
3701 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
3703 if (virt_key
== VK_CLEAR
)
3704 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
3709 /* List of special key combinations which w32 would normally capture,
3710 but emacs should grab instead. Not directly visible to lisp, to
3711 simplify synchronization. Each item is an integer encoding a virtual
3712 key code and modifier combination to capture. */
3713 Lisp_Object w32_grabbed_keys
;
3715 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3716 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3717 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3718 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3720 /* Register hot-keys for reserved key combinations when Emacs has
3721 keyboard focus, since this is the only way Emacs can receive key
3722 combinations like Alt-Tab which are used by the system. */
3725 register_hot_keys (hwnd
)
3728 Lisp_Object keylist
;
3730 /* Use GC_CONSP, since we are called asynchronously. */
3731 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3733 Lisp_Object key
= XCAR (keylist
);
3735 /* Deleted entries get set to nil. */
3736 if (!INTEGERP (key
))
3739 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
3740 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
3745 unregister_hot_keys (hwnd
)
3748 Lisp_Object keylist
;
3750 /* Use GC_CONSP, since we are called asynchronously. */
3751 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3753 Lisp_Object key
= XCAR (keylist
);
3755 if (!INTEGERP (key
))
3758 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
3762 /* Main message dispatch loop. */
3765 w32_msg_pump (deferred_msg
* msg_buf
)
3771 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3773 while (GetMessage (&msg
, NULL
, 0, 0))
3775 if (msg
.hwnd
== NULL
)
3777 switch (msg
.message
)
3780 /* Produced by complete_deferred_msg; just ignore. */
3782 case WM_EMACS_CREATEWINDOW
:
3783 w32_createwindow ((struct frame
*) msg
.wParam
);
3784 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3787 case WM_EMACS_SETLOCALE
:
3788 SetThreadLocale (msg
.wParam
);
3789 /* Reply is not expected. */
3791 case WM_EMACS_SETKEYBOARDLAYOUT
:
3792 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
3793 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3797 case WM_EMACS_REGISTER_HOT_KEY
:
3798 focus_window
= GetFocus ();
3799 if (focus_window
!= NULL
)
3800 RegisterHotKey (focus_window
,
3801 HOTKEY_ID (msg
.wParam
),
3802 HOTKEY_MODIFIERS (msg
.wParam
),
3803 HOTKEY_VK_CODE (msg
.wParam
));
3804 /* Reply is not expected. */
3806 case WM_EMACS_UNREGISTER_HOT_KEY
:
3807 focus_window
= GetFocus ();
3808 if (focus_window
!= NULL
)
3809 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
3810 /* Mark item as erased. NB: this code must be
3811 thread-safe. The next line is okay because the cons
3812 cell is never made into garbage and is not relocated by
3814 XSETCAR ((Lisp_Object
) msg
.lParam
, Qnil
);
3815 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3818 case WM_EMACS_TOGGLE_LOCK_KEY
:
3820 int vk_code
= (int) msg
.wParam
;
3821 int cur_state
= (GetKeyState (vk_code
) & 1);
3822 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
3824 /* NB: This code must be thread-safe. It is safe to
3825 call NILP because symbols are not relocated by GC,
3826 and pointer here is not touched by GC (so the markbit
3827 can't be set). Numbers are safe because they are
3828 immediate values. */
3829 if (NILP (new_state
)
3830 || (NUMBERP (new_state
)
3831 && ((XUINT (new_state
)) & 1) != cur_state
))
3833 one_w32_display_info
.faked_key
= vk_code
;
3835 keybd_event ((BYTE
) vk_code
,
3836 (BYTE
) MapVirtualKey (vk_code
, 0),
3837 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3838 keybd_event ((BYTE
) vk_code
,
3839 (BYTE
) MapVirtualKey (vk_code
, 0),
3840 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3841 keybd_event ((BYTE
) vk_code
,
3842 (BYTE
) MapVirtualKey (vk_code
, 0),
3843 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3844 cur_state
= !cur_state
;
3846 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3852 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3857 DispatchMessage (&msg
);
3860 /* Exit nested loop when our deferred message has completed. */
3861 if (msg_buf
->completed
)
3866 deferred_msg
* deferred_msg_head
;
3868 static deferred_msg
*
3869 find_deferred_msg (HWND hwnd
, UINT msg
)
3871 deferred_msg
* item
;
3873 /* Don't actually need synchronization for read access, since
3874 modification of single pointer is always atomic. */
3875 /* enter_crit (); */
3877 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3878 if (item
->w32msg
.msg
.hwnd
== hwnd
3879 && item
->w32msg
.msg
.message
== msg
)
3882 /* leave_crit (); */
3888 send_deferred_msg (deferred_msg
* msg_buf
,
3894 /* Only input thread can send deferred messages. */
3895 if (GetCurrentThreadId () != dwWindowsThreadId
)
3898 /* It is an error to send a message that is already deferred. */
3899 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3902 /* Enforced synchronization is not needed because this is the only
3903 function that alters deferred_msg_head, and the following critical
3904 section is guaranteed to only be serially reentered (since only the
3905 input thread can call us). */
3907 /* enter_crit (); */
3909 msg_buf
->completed
= 0;
3910 msg_buf
->next
= deferred_msg_head
;
3911 deferred_msg_head
= msg_buf
;
3912 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
3914 /* leave_crit (); */
3916 /* Start a new nested message loop to process other messages until
3917 this one is completed. */
3918 w32_msg_pump (msg_buf
);
3920 deferred_msg_head
= msg_buf
->next
;
3922 return msg_buf
->result
;
3926 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
3928 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
3930 if (msg_buf
== NULL
)
3931 /* Message may have been cancelled, so don't abort(). */
3934 msg_buf
->result
= result
;
3935 msg_buf
->completed
= 1;
3937 /* Ensure input thread is woken so it notices the completion. */
3938 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3942 cancel_all_deferred_msgs ()
3944 deferred_msg
* item
;
3946 /* Don't actually need synchronization for read access, since
3947 modification of single pointer is always atomic. */
3948 /* enter_crit (); */
3950 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3953 item
->completed
= 1;
3956 /* leave_crit (); */
3958 /* Ensure input thread is woken so it notices the completion. */
3959 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3967 deferred_msg dummy_buf
;
3969 /* Ensure our message queue is created */
3971 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
3973 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3976 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
3977 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
3978 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
3980 /* This is the inital message loop which should only exit when the
3981 application quits. */
3982 w32_msg_pump (&dummy_buf
);
3988 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
3998 wmsg
.dwModifiers
= modifiers
;
4000 /* Detect quit_char and set quit-flag directly. Note that we
4001 still need to post a message to ensure the main thread will be
4002 woken up if blocked in sys_select(), but we do NOT want to post
4003 the quit_char message itself (because it will usually be as if
4004 the user had typed quit_char twice). Instead, we post a dummy
4005 message that has no particular effect. */
4008 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
4009 c
= make_ctrl_char (c
) & 0377;
4011 || (wmsg
.dwModifiers
== 0 &&
4012 XFASTINT (Vw32_quit_key
) && wParam
== XFASTINT (Vw32_quit_key
)))
4016 /* The choice of message is somewhat arbitrary, as long as
4017 the main thread handler just ignores it. */
4020 /* Interrupt any blocking system calls. */
4023 /* As a safety precaution, forcibly complete any deferred
4024 messages. This is a kludge, but I don't see any particularly
4025 clean way to handle the situation where a deferred message is
4026 "dropped" in the lisp thread, and will thus never be
4027 completed, eg. by the user trying to activate the menubar
4028 when the lisp thread is busy, and then typing C-g when the
4029 menubar doesn't open promptly (with the result that the
4030 menubar never responds at all because the deferred
4031 WM_INITMENU message is never completed). Another problem
4032 situation is when the lisp thread calls SendMessage (to send
4033 a window manager command) when a message has been deferred;
4034 the lisp thread gets blocked indefinitely waiting for the
4035 deferred message to be completed, which itself is waiting for
4036 the lisp thread to respond.
4038 Note that we don't want to block the input thread waiting for
4039 a reponse from the lisp thread (although that would at least
4040 solve the deadlock problem above), because we want to be able
4041 to receive C-g to interrupt the lisp thread. */
4042 cancel_all_deferred_msgs ();
4046 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4049 /* Main window procedure */
4052 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
4059 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
4061 int windows_translate
;
4064 /* Note that it is okay to call x_window_to_frame, even though we are
4065 not running in the main lisp thread, because frame deletion
4066 requires the lisp thread to synchronize with this thread. Thus, if
4067 a frame struct is returned, it can be used without concern that the
4068 lisp thread might make it disappear while we are using it.
4070 NB. Walking the frame list in this thread is safe (as long as
4071 writes of Lisp_Object slots are atomic, which they are on Windows).
4072 Although delete-frame can destructively modify the frame list while
4073 we are walking it, a garbage collection cannot occur until after
4074 delete-frame has synchronized with this thread.
4076 It is also safe to use functions that make GDI calls, such as
4077 w32_clear_rect, because these functions must obtain a DC handle
4078 from the frame struct using get_frame_dc which is thread-aware. */
4083 f
= x_window_to_frame (dpyinfo
, hwnd
);
4086 HDC hdc
= get_frame_dc (f
);
4087 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
4088 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
4089 release_frame_dc (f
, hdc
);
4091 #if defined (W32_DEBUG_DISPLAY)
4092 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4094 wmsg
.rect
.left
, wmsg
.rect
.top
,
4095 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4096 #endif /* W32_DEBUG_DISPLAY */
4099 case WM_PALETTECHANGED
:
4100 /* ignore our own changes */
4101 if ((HWND
)wParam
!= hwnd
)
4103 f
= x_window_to_frame (dpyinfo
, hwnd
);
4105 /* get_frame_dc will realize our palette and force all
4106 frames to be redrawn if needed. */
4107 release_frame_dc (f
, get_frame_dc (f
));
4112 PAINTSTRUCT paintStruct
;
4115 f
= x_window_to_frame (dpyinfo
, hwnd
);
4118 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
4122 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4123 fails. Apparently this can happen under some
4125 if (!w32_strict_painting
|| GetUpdateRect (hwnd
, &update_rect
, FALSE
))
4128 BeginPaint (hwnd
, &paintStruct
);
4130 if (w32_strict_painting
)
4131 /* The rectangles returned by GetUpdateRect and BeginPaint
4132 do not always match. GetUpdateRect seems to be the
4133 more reliable of the two. */
4134 wmsg
.rect
= update_rect
;
4136 wmsg
.rect
= paintStruct
.rcPaint
;
4138 #if defined (W32_DEBUG_DISPLAY)
4139 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4141 wmsg
.rect
.left
, wmsg
.rect
.top
,
4142 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4143 DebPrint ((" [update region is %d,%d-%d,%d]\n",
4144 update_rect
.left
, update_rect
.top
,
4145 update_rect
.right
, update_rect
.bottom
));
4147 EndPaint (hwnd
, &paintStruct
);
4150 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4155 /* If GetUpdateRect returns 0 (meaning there is no update
4156 region), assume the whole window needs to be repainted. */
4157 GetClientRect(hwnd
, &wmsg
.rect
);
4158 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4162 case WM_INPUTLANGCHANGE
:
4163 /* Inform lisp thread of keyboard layout changes. */
4164 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4166 /* Clear dead keys in the keyboard state; for simplicity only
4167 preserve modifier key states. */
4172 GetKeyboardState (keystate
);
4173 for (i
= 0; i
< 256; i
++)
4190 SetKeyboardState (keystate
);
4195 /* Synchronize hot keys with normal input. */
4196 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
4201 record_keyup (wParam
, lParam
);
4206 /* Ignore keystrokes we fake ourself; see below. */
4207 if (dpyinfo
->faked_key
== wParam
)
4209 dpyinfo
->faked_key
= 0;
4210 /* Make sure TranslateMessage sees them though (as long as
4211 they don't produce WM_CHAR messages). This ensures that
4212 indicator lights are toggled promptly on Windows 9x, for
4214 if (lispy_function_keys
[wParam
] != 0)
4216 windows_translate
= 1;
4222 /* Synchronize modifiers with current keystroke. */
4224 record_keydown (wParam
, lParam
);
4225 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
4227 windows_translate
= 0;
4232 if (NILP (Vw32_pass_lwindow_to_system
))
4234 /* Prevent system from acting on keyup (which opens the
4235 Start menu if no other key was pressed) by simulating a
4236 press of Space which we will ignore. */
4237 if (GetAsyncKeyState (wParam
) & 1)
4239 if (NUMBERP (Vw32_phantom_key_code
))
4240 key
= XUINT (Vw32_phantom_key_code
) & 255;
4243 dpyinfo
->faked_key
= key
;
4244 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4247 if (!NILP (Vw32_lwindow_modifier
))
4251 if (NILP (Vw32_pass_rwindow_to_system
))
4253 if (GetAsyncKeyState (wParam
) & 1)
4255 if (NUMBERP (Vw32_phantom_key_code
))
4256 key
= XUINT (Vw32_phantom_key_code
) & 255;
4259 dpyinfo
->faked_key
= key
;
4260 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4263 if (!NILP (Vw32_rwindow_modifier
))
4267 if (!NILP (Vw32_apps_modifier
))
4271 if (NILP (Vw32_pass_alt_to_system
))
4272 /* Prevent DefWindowProc from activating the menu bar if an
4273 Alt key is pressed and released by itself. */
4275 windows_translate
= 1;
4278 /* Decide whether to treat as modifier or function key. */
4279 if (NILP (Vw32_enable_caps_lock
))
4280 goto disable_lock_key
;
4281 windows_translate
= 1;
4284 /* Decide whether to treat as modifier or function key. */
4285 if (NILP (Vw32_enable_num_lock
))
4286 goto disable_lock_key
;
4287 windows_translate
= 1;
4290 /* Decide whether to treat as modifier or function key. */
4291 if (NILP (Vw32_scroll_lock_modifier
))
4292 goto disable_lock_key
;
4293 windows_translate
= 1;
4296 /* Ensure the appropriate lock key state (and indicator light)
4297 remains in the same state. We do this by faking another
4298 press of the relevant key. Apparently, this really is the
4299 only way to toggle the state of the indicator lights. */
4300 dpyinfo
->faked_key
= wParam
;
4301 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4302 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4303 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4304 KEYEVENTF_EXTENDEDKEY
| 0, 0);
4305 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4306 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4307 /* Ensure indicator lights are updated promptly on Windows 9x
4308 (TranslateMessage apparently does this), after forwarding
4310 post_character_message (hwnd
, msg
, wParam
, lParam
,
4311 w32_get_key_modifiers (wParam
, lParam
));
4312 windows_translate
= 1;
4316 case VK_PROCESSKEY
: /* Generated by IME. */
4317 windows_translate
= 1;
4320 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4321 which is confusing for purposes of key binding; convert
4322 VK_CANCEL events into VK_PAUSE events. */
4326 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4327 for purposes of key binding; convert these back into
4328 VK_NUMLOCK events, at least when we want to see NumLock key
4329 presses. (Note that there is never any possibility that
4330 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4331 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
4332 wParam
= VK_NUMLOCK
;
4335 /* If not defined as a function key, change it to a WM_CHAR message. */
4336 if (lispy_function_keys
[wParam
] == 0)
4338 DWORD modifiers
= construct_console_modifiers ();
4340 if (!NILP (Vw32_recognize_altgr
)
4341 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
4343 /* Always let TranslateMessage handle AltGr key chords;
4344 for some reason, ToAscii doesn't always process AltGr
4345 chords correctly. */
4346 windows_translate
= 1;
4348 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
4350 /* Handle key chords including any modifiers other
4351 than shift directly, in order to preserve as much
4352 modifier information as possible. */
4353 if ('A' <= wParam
&& wParam
<= 'Z')
4355 /* Don't translate modified alphabetic keystrokes,
4356 so the user doesn't need to constantly switch
4357 layout to type control or meta keystrokes when
4358 the normal layout translates alphabetic
4359 characters to non-ascii characters. */
4360 if (!modifier_set (VK_SHIFT
))
4361 wParam
+= ('a' - 'A');
4366 /* Try to handle other keystrokes by determining the
4367 base character (ie. translating the base key plus
4371 KEY_EVENT_RECORD key
;
4373 key
.bKeyDown
= TRUE
;
4374 key
.wRepeatCount
= 1;
4375 key
.wVirtualKeyCode
= wParam
;
4376 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
4377 key
.uChar
.AsciiChar
= 0;
4378 key
.dwControlKeyState
= modifiers
;
4380 add
= w32_kbd_patch_key (&key
);
4381 /* 0 means an unrecognised keycode, negative means
4382 dead key. Ignore both. */
4385 /* Forward asciified character sequence. */
4386 post_character_message
4387 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
4388 w32_get_key_modifiers (wParam
, lParam
));
4389 w32_kbd_patch_key (&key
);
4396 /* Let TranslateMessage handle everything else. */
4397 windows_translate
= 1;
4403 if (windows_translate
)
4405 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
4407 windows_msg
.time
= GetMessageTime ();
4408 TranslateMessage (&windows_msg
);
4416 post_character_message (hwnd
, msg
, wParam
, lParam
,
4417 w32_get_key_modifiers (wParam
, lParam
));
4420 /* Simulate middle mouse button events when left and right buttons
4421 are used together, but only if user has two button mouse. */
4422 case WM_LBUTTONDOWN
:
4423 case WM_RBUTTONDOWN
:
4424 if (XINT (Vw32_num_mouse_buttons
) > 2)
4425 goto handle_plain_button
;
4428 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
4429 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
4431 if (button_state
& this)
4434 if (button_state
== 0)
4437 button_state
|= this;
4439 if (button_state
& other
)
4441 if (mouse_button_timer
)
4443 KillTimer (hwnd
, mouse_button_timer
);
4444 mouse_button_timer
= 0;
4446 /* Generate middle mouse event instead. */
4447 msg
= WM_MBUTTONDOWN
;
4448 button_state
|= MMOUSE
;
4450 else if (button_state
& MMOUSE
)
4452 /* Ignore button event if we've already generated a
4453 middle mouse down event. This happens if the
4454 user releases and press one of the two buttons
4455 after we've faked a middle mouse event. */
4460 /* Flush out saved message. */
4461 post_msg (&saved_mouse_button_msg
);
4463 wmsg
.dwModifiers
= w32_get_modifiers ();
4464 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4466 /* Clear message buffer. */
4467 saved_mouse_button_msg
.msg
.hwnd
= 0;
4471 /* Hold onto message for now. */
4472 mouse_button_timer
=
4473 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
4474 XINT (Vw32_mouse_button_tolerance
), NULL
);
4475 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
4476 saved_mouse_button_msg
.msg
.message
= msg
;
4477 saved_mouse_button_msg
.msg
.wParam
= wParam
;
4478 saved_mouse_button_msg
.msg
.lParam
= lParam
;
4479 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
4480 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
4487 if (XINT (Vw32_num_mouse_buttons
) > 2)
4488 goto handle_plain_button
;
4491 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
4492 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
4494 if ((button_state
& this) == 0)
4497 button_state
&= ~this;
4499 if (button_state
& MMOUSE
)
4501 /* Only generate event when second button is released. */
4502 if ((button_state
& other
) == 0)
4505 button_state
&= ~MMOUSE
;
4507 if (button_state
) abort ();
4514 /* Flush out saved message if necessary. */
4515 if (saved_mouse_button_msg
.msg
.hwnd
)
4517 post_msg (&saved_mouse_button_msg
);
4520 wmsg
.dwModifiers
= w32_get_modifiers ();
4521 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4523 /* Always clear message buffer and cancel timer. */
4524 saved_mouse_button_msg
.msg
.hwnd
= 0;
4525 KillTimer (hwnd
, mouse_button_timer
);
4526 mouse_button_timer
= 0;
4528 if (button_state
== 0)
4533 case WM_MBUTTONDOWN
:
4535 handle_plain_button
:
4540 if (parse_button (msg
, &button
, &up
))
4542 if (up
) ReleaseCapture ();
4543 else SetCapture (hwnd
);
4544 button
= (button
== 0) ? LMOUSE
:
4545 ((button
== 1) ? MMOUSE
: RMOUSE
);
4547 button_state
&= ~button
;
4549 button_state
|= button
;
4553 wmsg
.dwModifiers
= w32_get_modifiers ();
4554 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4559 if (XINT (Vw32_mouse_move_interval
) <= 0
4560 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
4562 wmsg
.dwModifiers
= w32_get_modifiers ();
4563 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4567 /* Hang onto mouse move and scroll messages for a bit, to avoid
4568 sending such events to Emacs faster than it can process them.
4569 If we get more events before the timer from the first message
4570 expires, we just replace the first message. */
4572 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
4574 SetTimer (hwnd
, MOUSE_MOVE_ID
,
4575 XINT (Vw32_mouse_move_interval
), NULL
);
4577 /* Hold onto message for now. */
4578 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
4579 saved_mouse_move_msg
.msg
.message
= msg
;
4580 saved_mouse_move_msg
.msg
.wParam
= wParam
;
4581 saved_mouse_move_msg
.msg
.lParam
= lParam
;
4582 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
4583 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
4588 wmsg
.dwModifiers
= w32_get_modifiers ();
4589 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4593 wmsg
.dwModifiers
= w32_get_modifiers ();
4594 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4598 /* Flush out saved messages if necessary. */
4599 if (wParam
== mouse_button_timer
)
4601 if (saved_mouse_button_msg
.msg
.hwnd
)
4603 post_msg (&saved_mouse_button_msg
);
4604 saved_mouse_button_msg
.msg
.hwnd
= 0;
4606 KillTimer (hwnd
, mouse_button_timer
);
4607 mouse_button_timer
= 0;
4609 else if (wParam
== mouse_move_timer
)
4611 if (saved_mouse_move_msg
.msg
.hwnd
)
4613 post_msg (&saved_mouse_move_msg
);
4614 saved_mouse_move_msg
.msg
.hwnd
= 0;
4616 KillTimer (hwnd
, mouse_move_timer
);
4617 mouse_move_timer
= 0;
4622 /* Windows doesn't send us focus messages when putting up and
4623 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4624 The only indication we get that something happened is receiving
4625 this message afterwards. So this is a good time to reset our
4626 keyboard modifiers' state. */
4633 /* We must ensure menu bar is fully constructed and up to date
4634 before allowing user interaction with it. To achieve this
4635 we send this message to the lisp thread and wait for a
4636 reply (whose value is not actually needed) to indicate that
4637 the menu bar is now ready for use, so we can now return.
4639 To remain responsive in the meantime, we enter a nested message
4640 loop that can process all other messages.
4642 However, we skip all this if the message results from calling
4643 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4644 thread a message because it is blocked on us at this point. We
4645 set menubar_active before calling TrackPopupMenu to indicate
4646 this (there is no possibility of confusion with real menubar
4649 f
= x_window_to_frame (dpyinfo
, hwnd
);
4651 && (f
->output_data
.w32
->menubar_active
4652 /* We can receive this message even in the absence of a
4653 menubar (ie. when the system menu is activated) - in this
4654 case we do NOT want to forward the message, otherwise it
4655 will cause the menubar to suddenly appear when the user
4656 had requested it to be turned off! */
4657 || f
->output_data
.w32
->menubar_widget
== NULL
))
4661 deferred_msg msg_buf
;
4663 /* Detect if message has already been deferred; in this case
4664 we cannot return any sensible value to ignore this. */
4665 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4668 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
4671 case WM_EXITMENULOOP
:
4672 f
= x_window_to_frame (dpyinfo
, hwnd
);
4674 /* Indicate that menubar can be modified again. */
4676 f
->output_data
.w32
->menubar_active
= 0;
4680 wmsg
.dwModifiers
= w32_get_modifiers ();
4681 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4684 case WM_MEASUREITEM
:
4685 f
= x_window_to_frame (dpyinfo
, hwnd
);
4688 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
4690 if (pMis
->CtlType
== ODT_MENU
)
4692 /* Work out dimensions for popup menu titles. */
4693 char * title
= (char *) pMis
->itemData
;
4694 HDC hdc
= GetDC (hwnd
);
4695 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4696 LOGFONT menu_logfont
;
4700 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4701 menu_logfont
.lfWeight
= FW_BOLD
;
4702 menu_font
= CreateFontIndirect (&menu_logfont
);
4703 old_font
= SelectObject (hdc
, menu_font
);
4705 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
4708 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
4709 pMis
->itemWidth
= size
.cx
;
4710 if (pMis
->itemHeight
< size
.cy
)
4711 pMis
->itemHeight
= size
.cy
;
4714 pMis
->itemWidth
= 0;
4716 SelectObject (hdc
, old_font
);
4717 DeleteObject (menu_font
);
4718 ReleaseDC (hwnd
, hdc
);
4725 f
= x_window_to_frame (dpyinfo
, hwnd
);
4728 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
4730 if (pDis
->CtlType
== ODT_MENU
)
4732 /* Draw popup menu title. */
4733 char * title
= (char *) pDis
->itemData
;
4736 HDC hdc
= pDis
->hDC
;
4737 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4738 LOGFONT menu_logfont
;
4741 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4742 menu_logfont
.lfWeight
= FW_BOLD
;
4743 menu_font
= CreateFontIndirect (&menu_logfont
);
4744 old_font
= SelectObject (hdc
, menu_font
);
4746 /* Always draw title as if not selected. */
4749 + GetSystemMetrics (SM_CXMENUCHECK
),
4751 ETO_OPAQUE
, &pDis
->rcItem
,
4752 title
, strlen (title
), NULL
);
4754 SelectObject (hdc
, old_font
);
4755 DeleteObject (menu_font
);
4763 /* Still not right - can't distinguish between clicks in the
4764 client area of the frame from clicks forwarded from the scroll
4765 bars - may have to hook WM_NCHITTEST to remember the mouse
4766 position and then check if it is in the client area ourselves. */
4767 case WM_MOUSEACTIVATE
:
4768 /* Discard the mouse click that activates a frame, allowing the
4769 user to click anywhere without changing point (or worse!).
4770 Don't eat mouse clicks on scrollbars though!! */
4771 if (LOWORD (lParam
) == HTCLIENT
)
4772 return MA_ACTIVATEANDEAT
;
4776 case WM_ACTIVATEAPP
:
4778 case WM_WINDOWPOSCHANGED
:
4780 /* Inform lisp thread that a frame might have just been obscured
4781 or exposed, so should recheck visibility of all frames. */
4782 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4786 dpyinfo
->faked_key
= 0;
4788 register_hot_keys (hwnd
);
4791 unregister_hot_keys (hwnd
);
4794 /* Relinquish the system caret. */
4795 if (w32_system_caret_hwnd
)
4798 w32_system_caret_hwnd
= NULL
;
4804 wmsg
.dwModifiers
= w32_get_modifiers ();
4805 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4809 wmsg
.dwModifiers
= w32_get_modifiers ();
4810 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4813 case WM_WINDOWPOSCHANGING
:
4816 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
4818 wp
.length
= sizeof (WINDOWPLACEMENT
);
4819 GetWindowPlacement (hwnd
, &wp
);
4821 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
4828 DWORD internal_border
;
4829 DWORD scrollbar_extra
;
4832 wp
.length
= sizeof(wp
);
4833 GetWindowRect (hwnd
, &wr
);
4837 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
4838 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
4839 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
4840 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
4844 memset (&rect
, 0, sizeof (rect
));
4845 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
4846 GetMenu (hwnd
) != NULL
);
4848 /* Force width and height of client area to be exact
4849 multiples of the character cell dimensions. */
4850 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
4851 - 2 * internal_border
- scrollbar_extra
)
4853 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
4854 - 2 * internal_border
)
4859 /* For right/bottom sizing we can just fix the sizes.
4860 However for top/left sizing we will need to fix the X
4861 and Y positions as well. */
4866 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
4867 && (lppos
->flags
& SWP_NOMOVE
) == 0)
4869 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
4876 lppos
->flags
|= SWP_NOMOVE
;
4887 case WM_GETMINMAXINFO
:
4888 /* Hack to correct bug that allows Emacs frames to be resized
4889 below the Minimum Tracking Size. */
4890 ((LPMINMAXINFO
) lParam
)->ptMinTrackSize
.y
++;
4891 /* Hack to allow resizing the Emacs frame above the screen size.
4892 Note that Windows 9x limits coordinates to 16-bits. */
4893 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
4894 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
4897 case WM_EMACS_CREATESCROLLBAR
:
4898 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
4899 (struct scroll_bar
*) lParam
);
4901 case WM_EMACS_SHOWWINDOW
:
4902 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
4904 case WM_EMACS_SETFOREGROUND
:
4906 HWND foreground_window
;
4907 DWORD foreground_thread
, retval
;
4909 /* On NT 5.0, and apparently Windows 98, it is necessary to
4910 attach to the thread that currently has focus in order to
4911 pull the focus away from it. */
4912 foreground_window
= GetForegroundWindow ();
4913 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
4914 if (!foreground_window
4915 || foreground_thread
== GetCurrentThreadId ()
4916 || !AttachThreadInput (GetCurrentThreadId (),
4917 foreground_thread
, TRUE
))
4918 foreground_thread
= 0;
4920 retval
= SetForegroundWindow ((HWND
) wParam
);
4922 /* Detach from the previous foreground thread. */
4923 if (foreground_thread
)
4924 AttachThreadInput (GetCurrentThreadId (),
4925 foreground_thread
, FALSE
);
4930 case WM_EMACS_SETWINDOWPOS
:
4932 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
4933 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
4934 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
4937 case WM_EMACS_DESTROYWINDOW
:
4938 DragAcceptFiles ((HWND
) wParam
, FALSE
);
4939 return DestroyWindow ((HWND
) wParam
);
4941 case WM_EMACS_DESTROY_CARET
:
4942 w32_system_caret_hwnd
= NULL
;
4943 return DestroyCaret ();
4945 case WM_EMACS_TRACK_CARET
:
4946 /* If there is currently no system caret, create one. */
4947 if (w32_system_caret_hwnd
== NULL
)
4949 w32_system_caret_hwnd
= hwnd
;
4950 CreateCaret (hwnd
, NULL
, w32_system_caret_width
,
4951 w32_system_caret_height
);
4953 return SetCaretPos (w32_system_caret_x
, w32_system_caret_y
);
4955 case WM_EMACS_TRACKPOPUPMENU
:
4960 pos
= (POINT
*)lParam
;
4961 flags
= TPM_CENTERALIGN
;
4962 if (button_state
& LMOUSE
)
4963 flags
|= TPM_LEFTBUTTON
;
4964 else if (button_state
& RMOUSE
)
4965 flags
|= TPM_RIGHTBUTTON
;
4967 /* Remember we did a SetCapture on the initial mouse down event,
4968 so for safety, we make sure the capture is cancelled now. */
4972 /* Use menubar_active to indicate that WM_INITMENU is from
4973 TrackPopupMenu below, and should be ignored. */
4974 f
= x_window_to_frame (dpyinfo
, hwnd
);
4976 f
->output_data
.w32
->menubar_active
= 1;
4978 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
4982 /* Eat any mouse messages during popupmenu */
4983 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
4985 /* Get the menu selection, if any */
4986 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
4988 retval
= LOWORD (amsg
.wParam
);
5004 /* Check for messages registered at runtime. */
5005 if (msg
== msh_mousewheel
)
5007 wmsg
.dwModifiers
= w32_get_modifiers ();
5008 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
5013 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
5017 /* The most common default return code for handled messages is 0. */
5022 my_create_window (f
)
5027 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
5029 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
5032 /* Create and set up the w32 window for frame F. */
5035 w32_window (f
, window_prompting
, minibuffer_only
)
5037 long window_prompting
;
5038 int minibuffer_only
;
5042 /* Use the resource name as the top-level window name
5043 for looking up resources. Make a non-Lisp copy
5044 for the window manager, so GC relocation won't bother it.
5046 Elsewhere we specify the window name for the window manager. */
5049 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
5050 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
5051 strcpy (f
->namebuf
, str
);
5054 my_create_window (f
);
5056 validate_x_resource_name ();
5058 /* x_set_name normally ignores requests to set the name if the
5059 requested name is the same as the current name. This is the one
5060 place where that assumption isn't correct; f->name is set, but
5061 the server hasn't been told. */
5064 int explicit = f
->explicit_name
;
5066 f
->explicit_name
= 0;
5069 x_set_name (f
, name
, explicit);
5074 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
5075 initialize_frame_menubar (f
);
5077 if (FRAME_W32_WINDOW (f
) == 0)
5078 error ("Unable to create window");
5081 /* Handle the icon stuff for this window. Perhaps later we might
5082 want an x_set_icon_position which can be called interactively as
5090 Lisp_Object icon_x
, icon_y
;
5092 /* Set the position of the icon. Note that Windows 95 groups all
5093 icons in the tray. */
5094 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
5095 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
5096 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
5098 CHECK_NUMBER (icon_x
);
5099 CHECK_NUMBER (icon_y
);
5101 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
5102 error ("Both left and top icon corners of icon must be specified");
5106 if (! EQ (icon_x
, Qunbound
))
5107 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
5110 /* Start up iconic or window? */
5111 x_wm_set_window_state
5112 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
5116 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
5129 XGCValues gc_values
;
5133 /* Create the GC's of this frame.
5134 Note that many default values are used. */
5137 gc_values
.font
= f
->output_data
.w32
->font
;
5139 /* Cursor has cursor-color background, background-color foreground. */
5140 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
5141 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
5142 f
->output_data
.w32
->cursor_gc
5143 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
5144 (GCFont
| GCForeground
| GCBackground
),
5148 f
->output_data
.w32
->white_relief
.gc
= 0;
5149 f
->output_data
.w32
->black_relief
.gc
= 0;
5155 /* Handler for signals raised during x_create_frame and
5156 x_create_top_frame. FRAME is the frame which is partially
5160 unwind_create_frame (frame
)
5163 struct frame
*f
= XFRAME (frame
);
5165 /* If frame is ``official'', nothing to do. */
5166 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
5169 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5172 x_free_frame_resources (f
);
5174 /* Check that reference counts are indeed correct. */
5175 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
5176 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
5185 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
5187 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
5188 Returns an Emacs frame object.\n\
5189 ALIST is an alist of frame parameters.\n\
5190 If the parameters specify that the frame should not have a minibuffer,\n\
5191 and do not specify a specific minibuffer window to use,\n\
5192 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
5193 be shared by the new frame.\n\
5195 This function is an internal primitive--use `make-frame' instead.")
5200 Lisp_Object frame
, tem
;
5202 int minibuffer_only
= 0;
5203 long window_prompting
= 0;
5205 int count
= BINDING_STACK_SIZE ();
5206 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
5207 Lisp_Object display
;
5208 struct w32_display_info
*dpyinfo
= NULL
;
5214 /* Use this general default value to start with
5215 until we know if this frame has a specified name. */
5216 Vx_resource_name
= Vinvocation_name
;
5218 display
= w32_get_arg (parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
5219 if (EQ (display
, Qunbound
))
5221 dpyinfo
= check_x_display_info (display
);
5223 kb
= dpyinfo
->kboard
;
5225 kb
= &the_only_kboard
;
5228 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
5230 && ! EQ (name
, Qunbound
)
5232 error ("Invalid frame name--not a string or nil");
5235 Vx_resource_name
= name
;
5237 /* See if parent window is specified. */
5238 parent
= w32_get_arg (parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
5239 if (EQ (parent
, Qunbound
))
5241 if (! NILP (parent
))
5242 CHECK_NUMBER (parent
);
5244 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5245 /* No need to protect DISPLAY because that's not used after passing
5246 it to make_frame_without_minibuffer. */
5248 GCPRO4 (parms
, parent
, name
, frame
);
5249 tem
= w32_get_arg (parms
, Qminibuffer
, "minibuffer", "Minibuffer",
5251 if (EQ (tem
, Qnone
) || NILP (tem
))
5252 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
5253 else if (EQ (tem
, Qonly
))
5255 f
= make_minibuffer_frame ();
5256 minibuffer_only
= 1;
5258 else if (WINDOWP (tem
))
5259 f
= make_frame_without_minibuffer (tem
, kb
, display
);
5263 XSETFRAME (frame
, f
);
5265 /* Note that Windows does support scroll bars. */
5266 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
5267 /* By default, make scrollbars the system standard width. */
5268 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
5270 f
->output_method
= output_w32
;
5271 f
->output_data
.w32
=
5272 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
5273 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
5274 FRAME_FONTSET (f
) = -1;
5275 record_unwind_protect (unwind_create_frame
, frame
);
5278 = w32_get_arg (parms
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
5279 if (! STRINGP (f
->icon_name
))
5280 f
->icon_name
= Qnil
;
5282 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
5284 FRAME_KBOARD (f
) = kb
;
5287 /* Specify the parent under which to make this window. */
5291 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
5292 f
->output_data
.w32
->explicit_parent
= 1;
5296 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5297 f
->output_data
.w32
->explicit_parent
= 0;
5300 /* Set the name; the functions to which we pass f expect the name to
5302 if (EQ (name
, Qunbound
) || NILP (name
))
5304 f
->name
= build_string (dpyinfo
->w32_id_name
);
5305 f
->explicit_name
= 0;
5310 f
->explicit_name
= 1;
5311 /* use the frame's title when getting resources for this frame. */
5312 specbind (Qx_resource_name
, name
);
5315 /* Extract the window parameters from the supplied values
5316 that are needed to determine window geometry. */
5320 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
5323 /* First, try whatever font the caller has specified. */
5326 tem
= Fquery_fontset (font
, Qnil
);
5328 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
5330 font
= x_new_font (f
, XSTRING (font
)->data
);
5332 /* Try out a font which we hope has bold and italic variations. */
5333 if (!STRINGP (font
))
5334 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
5335 if (! STRINGP (font
))
5336 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
5337 /* If those didn't work, look for something which will at least work. */
5338 if (! STRINGP (font
))
5339 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
5341 if (! STRINGP (font
))
5342 font
= build_string ("Fixedsys");
5344 x_default_parameter (f
, parms
, Qfont
, font
,
5345 "font", "Font", RES_TYPE_STRING
);
5348 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
5349 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
5350 /* This defaults to 2 in order to match xterm. We recognize either
5351 internalBorderWidth or internalBorder (which is what xterm calls
5353 if (NILP (Fassq (Qinternal_border_width
, parms
)))
5357 value
= w32_get_arg (parms
, Qinternal_border_width
,
5358 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
5359 if (! EQ (value
, Qunbound
))
5360 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
5363 /* Default internalBorderWidth to 0 on Windows to match other programs. */
5364 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
5365 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
5366 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qright
,
5367 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
5369 /* Also do the stuff which must be set before the window exists. */
5370 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
5371 "foreground", "Foreground", RES_TYPE_STRING
);
5372 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
5373 "background", "Background", RES_TYPE_STRING
);
5374 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
5375 "pointerColor", "Foreground", RES_TYPE_STRING
);
5376 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
5377 "cursorColor", "Foreground", RES_TYPE_STRING
);
5378 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
5379 "borderColor", "BorderColor", RES_TYPE_STRING
);
5380 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
5381 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
5382 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
5383 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
5386 /* Init faces before x_default_parameter is called for scroll-bar
5387 parameters because that function calls x_set_scroll_bar_width,
5388 which calls change_frame_size, which calls Fset_window_buffer,
5389 which runs hooks, which call Fvertical_motion. At the end, we
5390 end up in init_iterator with a null face cache, which should not
5392 init_frame_faces (f
);
5394 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
5395 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
5396 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
5397 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
5398 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
5399 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
5400 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
5401 "title", "Title", RES_TYPE_STRING
);
5403 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
5404 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5406 /* Add the tool-bar height to the initial frame height so that the
5407 user gets a text display area of the size he specified with -g or
5408 via .Xdefaults. Later changes of the tool-bar height don't
5409 change the frame size. This is done so that users can create
5410 tall Emacs frames without having to guess how tall the tool-bar
5412 if (FRAME_TOOL_BAR_LINES (f
))
5414 int margin
, relief
, bar_height
;
5416 relief
= (tool_bar_button_relief
> 0
5417 ? tool_bar_button_relief
5418 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
5420 if (INTEGERP (Vtool_bar_button_margin
)
5421 && XINT (Vtool_bar_button_margin
) > 0)
5422 margin
= XFASTINT (Vtool_bar_button_margin
);
5423 else if (CONSP (Vtool_bar_button_margin
)
5424 && INTEGERP (XCDR (Vtool_bar_button_margin
))
5425 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
5426 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
5430 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
5431 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
5434 window_prompting
= x_figure_window_size (f
, parms
);
5436 if (window_prompting
& XNegative
)
5438 if (window_prompting
& YNegative
)
5439 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
5441 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
5445 if (window_prompting
& YNegative
)
5446 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
5448 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
5451 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
5453 tem
= w32_get_arg (parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
5454 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
5456 w32_window (f
, window_prompting
, minibuffer_only
);
5461 /* Now consider the frame official. */
5462 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
5463 Vframe_list
= Fcons (frame
, Vframe_list
);
5465 /* We need to do this after creating the window, so that the
5466 icon-creation functions can say whose icon they're describing. */
5467 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
5468 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
5470 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
5471 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5472 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
5473 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5474 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
5475 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
5476 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
5477 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
5479 /* Dimensions, especially f->height, must be done via change_frame_size.
5480 Change will not be effected unless different from the current
5486 SET_FRAME_WIDTH (f
, 0);
5487 change_frame_size (f
, height
, width
, 1, 0, 0);
5489 /* Tell the server what size and position, etc, we want, and how
5490 badly we want them. This should be done after we have the menu
5491 bar so that its size can be taken into account. */
5493 x_wm_set_size_hint (f
, window_prompting
, 0);
5496 /* Set up faces after all frame parameters are known. This call
5497 also merges in face attributes specified for new frames. If we
5498 don't do this, the `menu' face for instance won't have the right
5499 colors, and the menu bar won't appear in the specified colors for
5501 call1 (Qface_set_after_frame_default
, frame
);
5503 /* Make the window appear on the frame and enable display, unless
5504 the caller says not to. However, with explicit parent, Emacs
5505 cannot control visibility, so don't try. */
5506 if (! f
->output_data
.w32
->explicit_parent
)
5508 Lisp_Object visibility
;
5510 visibility
= w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
5511 if (EQ (visibility
, Qunbound
))
5514 if (EQ (visibility
, Qicon
))
5515 x_iconify_frame (f
);
5516 else if (! NILP (visibility
))
5517 x_make_frame_visible (f
);
5519 /* Must have been Qnil. */
5524 /* Make sure windows on this frame appear in calls to next-window
5525 and similar functions. */
5526 Vwindow_list
= Qnil
;
5528 return unbind_to (count
, frame
);
5531 /* FRAME is used only to get a handle on the X display. We don't pass the
5532 display info directly because we're called from frame.c, which doesn't
5533 know about that structure. */
5535 x_get_focus_frame (frame
)
5536 struct frame
*frame
;
5538 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
5540 if (! dpyinfo
->w32_focus_frame
)
5543 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
5547 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
5548 "Give FRAME input focus, raising to foreground if necessary.")
5552 x_focus_on_frame (check_x_frame (frame
));
5557 /* Return the charset portion of a font name. */
5558 char * xlfd_charset_of_font (char * fontname
)
5560 char *charset
, *encoding
;
5562 encoding
= strrchr(fontname
, '-');
5563 if (!encoding
|| encoding
== fontname
)
5566 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
5567 if (*charset
== '-')
5570 if (charset
== fontname
|| strcmp(charset
, "-*-*") == 0)
5576 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
5577 int size
, char* filename
);
5578 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
5579 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
5581 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
5583 static struct font_info
*
5584 w32_load_system_font (f
,fontname
,size
)
5589 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5590 Lisp_Object font_names
;
5592 /* Get a list of all the fonts that match this name. Once we
5593 have a list of matching fonts, we compare them against the fonts
5594 we already have loaded by comparing names. */
5595 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
5597 if (!NILP (font_names
))
5602 /* First check if any are already loaded, as that is cheaper
5603 than loading another one. */
5604 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5605 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
5606 if (dpyinfo
->font_table
[i
].name
5607 && (!strcmp (dpyinfo
->font_table
[i
].name
,
5608 XSTRING (XCAR (tail
))->data
)
5609 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
5610 XSTRING (XCAR (tail
))->data
)))
5611 return (dpyinfo
->font_table
+ i
);
5613 fontname
= (char *) XSTRING (XCAR (font_names
))->data
;
5615 else if (w32_strict_fontnames
)
5617 /* If EnumFontFamiliesEx was available, we got a full list of
5618 fonts back so stop now to avoid the possibility of loading a
5619 random font. If we had to fall back to EnumFontFamilies, the
5620 list is incomplete, so continue whether the font we want was
5622 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5623 FARPROC enum_font_families_ex
5624 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
5625 if (enum_font_families_ex
)
5629 /* Load the font and add it to the table. */
5631 char *full_name
, *encoding
, *charset
;
5633 struct font_info
*fontp
;
5639 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
5642 if (!*lf
.lfFaceName
)
5643 /* If no name was specified for the font, we get a random font
5644 from CreateFontIndirect - this is not particularly
5645 desirable, especially since CreateFontIndirect does not
5646 fill out the missing name in lf, so we never know what we
5650 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
5651 bzero (font
, sizeof (*font
));
5653 /* Set bdf to NULL to indicate that this is a Windows font. */
5658 font
->hfont
= CreateFontIndirect (&lf
);
5660 if (font
->hfont
== NULL
)
5669 codepage
= w32_codepage_for_font (fontname
);
5671 hdc
= GetDC (dpyinfo
->root_window
);
5672 oldobj
= SelectObject (hdc
, font
->hfont
);
5674 ok
= GetTextMetrics (hdc
, &font
->tm
);
5675 if (codepage
== CP_UNICODE
)
5676 font
->double_byte_p
= 1;
5679 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5680 don't report themselves as double byte fonts, when
5681 patently they are. So instead of trusting
5682 GetFontLanguageInfo, we check the properties of the
5683 codepage directly, since that is ultimately what we are
5684 working from anyway. */
5685 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5687 GetCPInfo (codepage
, &cpi
);
5688 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
5691 SelectObject (hdc
, oldobj
);
5692 ReleaseDC (dpyinfo
->root_window
, hdc
);
5693 /* Fill out details in lf according to the font that was
5695 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
5696 lf
.lfWidth
= font
->tm
.tmAveCharWidth
;
5697 lf
.lfWeight
= font
->tm
.tmWeight
;
5698 lf
.lfItalic
= font
->tm
.tmItalic
;
5699 lf
.lfCharSet
= font
->tm
.tmCharSet
;
5700 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
5701 ? VARIABLE_PITCH
: FIXED_PITCH
);
5702 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
5703 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
5705 w32_cache_char_metrics (font
);
5712 w32_unload_font (dpyinfo
, font
);
5716 /* Find a free slot in the font table. */
5717 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
5718 if (dpyinfo
->font_table
[i
].name
== NULL
)
5721 /* If no free slot found, maybe enlarge the font table. */
5722 if (i
== dpyinfo
->n_fonts
5723 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
5726 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
5727 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
5729 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
5732 fontp
= dpyinfo
->font_table
+ i
;
5733 if (i
== dpyinfo
->n_fonts
)
5736 /* Now fill in the slots of *FONTP. */
5739 fontp
->font_idx
= i
;
5740 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
5741 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
5743 charset
= xlfd_charset_of_font (fontname
);
5745 /* Cache the W32 codepage for a font. This makes w32_encode_char
5746 (called for every glyph during redisplay) much faster. */
5747 fontp
->codepage
= codepage
;
5749 /* Work out the font's full name. */
5750 full_name
= (char *)xmalloc (100);
5751 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
5752 fontp
->full_name
= full_name
;
5755 /* If all else fails - just use the name we used to load it. */
5757 fontp
->full_name
= fontp
->name
;
5760 fontp
->size
= FONT_WIDTH (font
);
5761 fontp
->height
= FONT_HEIGHT (font
);
5763 /* The slot `encoding' specifies how to map a character
5764 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
5765 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
5766 (0:0x20..0x7F, 1:0xA0..0xFF,
5767 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
5768 2:0xA020..0xFF7F). For the moment, we don't know which charset
5769 uses this font. So, we set information in fontp->encoding[1]
5770 which is never used by any charset. If mapping can't be
5771 decided, set FONT_ENCODING_NOT_DECIDED. */
5773 /* SJIS fonts need to be set to type 4, all others seem to work as
5774 type FONT_ENCODING_NOT_DECIDED. */
5775 encoding
= strrchr (fontp
->name
, '-');
5776 if (encoding
&& stricmp (encoding
+1, "sjis") == 0)
5777 fontp
->encoding
[1] = 4;
5779 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
5781 /* The following three values are set to 0 under W32, which is
5782 what they get set to if XGetFontProperty fails under X. */
5783 fontp
->baseline_offset
= 0;
5784 fontp
->relative_compose
= 0;
5785 fontp
->default_ascent
= 0;
5787 /* Set global flag fonts_changed_p to non-zero if the font loaded
5788 has a character with a smaller width than any other character
5789 before, or if the font loaded has a smalle>r height than any
5790 other font loaded before. If this happens, it will make a
5791 glyph matrix reallocation necessary. */
5792 fonts_changed_p
= x_compute_min_glyph_bounds (f
);
5798 /* Load font named FONTNAME of size SIZE for frame F, and return a
5799 pointer to the structure font_info while allocating it dynamically.
5800 If loading fails, return NULL. */
5802 w32_load_font (f
,fontname
,size
)
5807 Lisp_Object bdf_fonts
;
5808 struct font_info
*retval
= NULL
;
5810 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
5812 while (!retval
&& CONSP (bdf_fonts
))
5814 char *bdf_name
, *bdf_file
;
5815 Lisp_Object bdf_pair
;
5817 bdf_name
= XSTRING (XCAR (bdf_fonts
))->data
;
5818 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
5819 bdf_file
= XSTRING (XCDR (bdf_pair
))->data
;
5821 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
5823 bdf_fonts
= XCDR (bdf_fonts
);
5829 return w32_load_system_font(f
, fontname
, size
);
5834 w32_unload_font (dpyinfo
, font
)
5835 struct w32_display_info
*dpyinfo
;
5840 if (font
->per_char
) xfree (font
->per_char
);
5841 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
5843 if (font
->hfont
) DeleteObject(font
->hfont
);
5848 /* The font conversion stuff between x and w32 */
5850 /* X font string is as follows (from faces.el)
5854 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5855 * (weight\? "\\([^-]*\\)") ; 1
5856 * (slant "\\([ior]\\)") ; 2
5857 * (slant\? "\\([^-]?\\)") ; 2
5858 * (swidth "\\([^-]*\\)") ; 3
5859 * (adstyle "[^-]*") ; 4
5860 * (pixelsize "[0-9]+")
5861 * (pointsize "[0-9][0-9]+")
5862 * (resx "[0-9][0-9]+")
5863 * (resy "[0-9][0-9]+")
5864 * (spacing "[cmp?*]")
5865 * (avgwidth "[0-9]+")
5866 * (registry "[^-]+")
5867 * (encoding "[^-]+")
5872 x_to_w32_weight (lpw
)
5875 if (!lpw
) return (FW_DONTCARE
);
5877 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
5878 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
5879 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
5880 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
5881 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
5882 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
5883 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
5884 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
5885 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
5886 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
5893 w32_to_x_weight (fnweight
)
5896 if (fnweight
>= FW_HEAVY
) return "heavy";
5897 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
5898 if (fnweight
>= FW_BOLD
) return "bold";
5899 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
5900 if (fnweight
>= FW_MEDIUM
) return "medium";
5901 if (fnweight
>= FW_NORMAL
) return "normal";
5902 if (fnweight
>= FW_LIGHT
) return "light";
5903 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
5904 if (fnweight
>= FW_THIN
) return "thin";
5910 x_to_w32_charset (lpcs
)
5913 Lisp_Object this_entry
, w32_charset
;
5915 int len
= strlen (lpcs
);
5917 /* Support "*-#nnn" format for unknown charsets. */
5918 if (strncmp (lpcs
, "*-#", 3) == 0)
5919 return atoi (lpcs
+ 3);
5921 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5922 charset
= alloca (len
+ 1);
5923 strcpy (charset
, lpcs
);
5924 lpcs
= strchr (charset
, '*');
5928 /* Look through w32-charset-info-alist for the character set.
5929 Format of each entry is
5930 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5932 this_entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
5934 if (NILP(this_entry
))
5936 /* At startup, we want iso8859-1 fonts to come up properly. */
5937 if (stricmp(charset
, "iso8859-1") == 0)
5938 return ANSI_CHARSET
;
5940 return DEFAULT_CHARSET
;
5943 w32_charset
= Fcar (Fcdr (this_entry
));
5945 // Translate Lisp symbol to number.
5946 if (w32_charset
== Qw32_charset_ansi
)
5947 return ANSI_CHARSET
;
5948 if (w32_charset
== Qw32_charset_symbol
)
5949 return SYMBOL_CHARSET
;
5950 if (w32_charset
== Qw32_charset_shiftjis
)
5951 return SHIFTJIS_CHARSET
;
5952 if (w32_charset
== Qw32_charset_hangeul
)
5953 return HANGEUL_CHARSET
;
5954 if (w32_charset
== Qw32_charset_chinesebig5
)
5955 return CHINESEBIG5_CHARSET
;
5956 if (w32_charset
== Qw32_charset_gb2312
)
5957 return GB2312_CHARSET
;
5958 if (w32_charset
== Qw32_charset_oem
)
5960 #ifdef JOHAB_CHARSET
5961 if (w32_charset
== Qw32_charset_johab
)
5962 return JOHAB_CHARSET
;
5963 if (w32_charset
== Qw32_charset_easteurope
)
5964 return EASTEUROPE_CHARSET
;
5965 if (w32_charset
== Qw32_charset_turkish
)
5966 return TURKISH_CHARSET
;
5967 if (w32_charset
== Qw32_charset_baltic
)
5968 return BALTIC_CHARSET
;
5969 if (w32_charset
== Qw32_charset_russian
)
5970 return RUSSIAN_CHARSET
;
5971 if (w32_charset
== Qw32_charset_arabic
)
5972 return ARABIC_CHARSET
;
5973 if (w32_charset
== Qw32_charset_greek
)
5974 return GREEK_CHARSET
;
5975 if (w32_charset
== Qw32_charset_hebrew
)
5976 return HEBREW_CHARSET
;
5977 if (w32_charset
== Qw32_charset_vietnamese
)
5978 return VIETNAMESE_CHARSET
;
5979 if (w32_charset
== Qw32_charset_thai
)
5980 return THAI_CHARSET
;
5981 if (w32_charset
== Qw32_charset_mac
)
5983 #endif /* JOHAB_CHARSET */
5984 #ifdef UNICODE_CHARSET
5985 if (w32_charset
== Qw32_charset_unicode
)
5986 return UNICODE_CHARSET
;
5989 return DEFAULT_CHARSET
;
5994 w32_to_x_charset (fncharset
)
5997 static char buf
[32];
5998 Lisp_Object charset_type
;
6003 /* Handle startup case of w32-charset-info-alist not
6004 being set up yet. */
6005 if (NILP(Vw32_charset_info_alist
))
6007 charset_type
= Qw32_charset_ansi
;
6009 case DEFAULT_CHARSET
:
6010 charset_type
= Qw32_charset_default
;
6012 case SYMBOL_CHARSET
:
6013 charset_type
= Qw32_charset_symbol
;
6015 case SHIFTJIS_CHARSET
:
6016 charset_type
= Qw32_charset_shiftjis
;
6018 case HANGEUL_CHARSET
:
6019 charset_type
= Qw32_charset_hangeul
;
6021 case GB2312_CHARSET
:
6022 charset_type
= Qw32_charset_gb2312
;
6024 case CHINESEBIG5_CHARSET
:
6025 charset_type
= Qw32_charset_chinesebig5
;
6028 charset_type
= Qw32_charset_oem
;
6031 /* More recent versions of Windows (95 and NT4.0) define more
6033 #ifdef EASTEUROPE_CHARSET
6034 case EASTEUROPE_CHARSET
:
6035 charset_type
= Qw32_charset_easteurope
;
6037 case TURKISH_CHARSET
:
6038 charset_type
= Qw32_charset_turkish
;
6040 case BALTIC_CHARSET
:
6041 charset_type
= Qw32_charset_baltic
;
6043 case RUSSIAN_CHARSET
:
6044 charset_type
= Qw32_charset_russian
;
6046 case ARABIC_CHARSET
:
6047 charset_type
= Qw32_charset_arabic
;
6050 charset_type
= Qw32_charset_greek
;
6052 case HEBREW_CHARSET
:
6053 charset_type
= Qw32_charset_hebrew
;
6055 case VIETNAMESE_CHARSET
:
6056 charset_type
= Qw32_charset_vietnamese
;
6059 charset_type
= Qw32_charset_thai
;
6062 charset_type
= Qw32_charset_mac
;
6065 charset_type
= Qw32_charset_johab
;
6069 #ifdef UNICODE_CHARSET
6070 case UNICODE_CHARSET
:
6071 charset_type
= Qw32_charset_unicode
;
6075 /* Encode numerical value of unknown charset. */
6076 sprintf (buf
, "*-#%u", fncharset
);
6082 char * best_match
= NULL
;
6084 /* Look through w32-charset-info-alist for the character set.
6085 Prefer ISO codepages, and prefer lower numbers in the ISO
6086 range. Only return charsets for codepages which are installed.
6088 Format of each entry is
6089 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6091 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
6094 Lisp_Object w32_charset
;
6095 Lisp_Object codepage
;
6097 Lisp_Object this_entry
= XCAR (rest
);
6099 /* Skip invalid entries in alist. */
6100 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
6101 || !CONSP (XCDR (this_entry
))
6102 || !SYMBOLP (XCAR (XCDR (this_entry
))))
6105 x_charset
= XSTRING (XCAR (this_entry
))->data
;
6106 w32_charset
= XCAR (XCDR (this_entry
));
6107 codepage
= XCDR (XCDR (this_entry
));
6109 /* Look for Same charset and a valid codepage (or non-int
6110 which means ignore). */
6111 if (w32_charset
== charset_type
6112 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
6113 || IsValidCodePage (XINT (codepage
))))
6115 /* If we don't have a match already, then this is the
6118 best_match
= x_charset
;
6119 /* If this is an ISO codepage, and the best so far isn't,
6120 then this is better. */
6121 else if (stricmp (best_match
, "iso") != 0
6122 && stricmp (x_charset
, "iso") == 0)
6123 best_match
= x_charset
;
6124 /* If both are ISO8859 codepages, choose the one with the
6125 lowest number in the encoding field. */
6126 else if (stricmp (best_match
, "iso8859-") == 0
6127 && stricmp (x_charset
, "iso8859-") == 0)
6129 int best_enc
= atoi (best_match
+ 8);
6130 int this_enc
= atoi (x_charset
+ 8);
6131 if (this_enc
> 0 && this_enc
< best_enc
)
6132 best_match
= x_charset
;
6137 /* If no match, encode the numeric value. */
6140 sprintf (buf
, "*-#%u", fncharset
);
6144 strncpy(buf
, best_match
, 31);
6151 /* Get the Windows codepage corresponding to the specified font. The
6152 charset info in the font name is used to look up
6153 w32-charset-to-codepage-alist. */
6155 w32_codepage_for_font (char *fontname
)
6157 Lisp_Object codepage
, entry
;
6158 char *charset_str
, *charset
, *end
;
6160 if (NILP (Vw32_charset_info_alist
))
6163 /* Extract charset part of font string. */
6164 charset
= xlfd_charset_of_font (fontname
);
6169 charset_str
= (char *) alloca (strlen (charset
) + 1);
6170 strcpy (charset_str
, charset
);
6173 /* Remove leading "*-". */
6174 if (strncmp ("*-", charset_str
, 2) == 0)
6175 charset
= charset_str
+ 2;
6178 charset
= charset_str
;
6180 /* Stop match at wildcard (including preceding '-'). */
6181 if (end
= strchr (charset
, '*'))
6183 if (end
> charset
&& *(end
-1) == '-')
6188 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6192 codepage
= Fcdr (Fcdr (entry
));
6194 if (NILP (codepage
))
6196 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
6198 else if (INTEGERP (codepage
))
6199 return XINT (codepage
);
6206 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
6207 LOGFONT
* lplogfont
;
6210 char * specific_charset
;
6214 char height_pixels
[8];
6216 char width_pixels
[8];
6217 char *fontname_dash
;
6218 int display_resy
= one_w32_display_info
.resy
;
6219 int display_resx
= one_w32_display_info
.resx
;
6221 struct coding_system coding
;
6223 if (!lpxstr
) abort ();
6228 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
6229 fonttype
= "raster";
6230 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
6231 fonttype
= "outline";
6233 fonttype
= "unknown";
6235 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system
),
6237 coding
.src_multibyte
= 0;
6238 coding
.dst_multibyte
= 1;
6239 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6240 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
6242 fontname
= alloca(sizeof(*fontname
) * bufsz
);
6243 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
6244 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
6245 *(fontname
+ coding
.produced
) = '\0';
6247 /* Replace dashes with underscores so the dashes are not
6249 fontname_dash
= fontname
;
6250 while (fontname_dash
= strchr (fontname_dash
, '-'))
6251 *fontname_dash
= '_';
6253 if (lplogfont
->lfHeight
)
6255 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
6256 sprintf (height_dpi
, "%u",
6257 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
6261 strcpy (height_pixels
, "*");
6262 strcpy (height_dpi
, "*");
6264 if (lplogfont
->lfWidth
)
6265 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
6267 strcpy (width_pixels
, "*");
6269 _snprintf (lpxstr
, len
- 1,
6270 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6271 fonttype
, /* foundry */
6272 fontname
, /* family */
6273 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
6274 lplogfont
->lfItalic
?'i':'r', /* slant */
6276 /* add style name */
6277 height_pixels
, /* pixel size */
6278 height_dpi
, /* point size */
6279 display_resx
, /* resx */
6280 display_resy
, /* resy */
6281 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
6282 ? 'p' : 'c', /* spacing */
6283 width_pixels
, /* avg width */
6284 specific_charset
? specific_charset
6285 : w32_to_x_charset (lplogfont
->lfCharSet
)
6286 /* charset registry and encoding */
6289 lpxstr
[len
- 1] = 0; /* just to be sure */
6294 x_to_w32_font (lpxstr
, lplogfont
)
6296 LOGFONT
* lplogfont
;
6298 struct coding_system coding
;
6300 if (!lplogfont
) return (FALSE
);
6302 memset (lplogfont
, 0, sizeof (*lplogfont
));
6304 /* Set default value for each field. */
6306 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
6307 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
6308 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
6310 /* go for maximum quality */
6311 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
6312 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
6313 lplogfont
->lfQuality
= PROOF_QUALITY
;
6316 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
6317 lplogfont
->lfWeight
= FW_DONTCARE
;
6318 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
6323 /* Provide a simple escape mechanism for specifying Windows font names
6324 * directly -- if font spec does not beginning with '-', assume this
6326 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6332 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
6333 width
[10], resy
[10], remainder
[50];
6335 int dpi
= one_w32_display_info
.resy
;
6337 fields
= sscanf (lpxstr
,
6338 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
6339 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
6343 /* In the general case when wildcards cover more than one field,
6344 we don't know which field is which, so don't fill any in.
6345 However, we need to cope with this particular form, which is
6346 generated by font_list_1 (invoked by try_font_list):
6347 "-raster-6x10-*-gb2312*-*"
6348 and make sure to correctly parse the charset field. */
6351 fields
= sscanf (lpxstr
,
6352 "-%*[^-]-%49[^-]-*-%49s",
6355 else if (fields
< 9)
6361 if (fields
> 0 && name
[0] != '*')
6367 (Fcheck_coding_system (Vw32_system_coding_system
), &coding
);
6368 coding
.src_multibyte
= 1;
6369 coding
.dst_multibyte
= 1;
6370 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
6371 buf
= (unsigned char *) alloca (bufsize
);
6372 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6373 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
6374 if (coding
.produced
>= LF_FACESIZE
)
6375 coding
.produced
= LF_FACESIZE
- 1;
6376 buf
[coding
.produced
] = 0;
6377 strcpy (lplogfont
->lfFaceName
, buf
);
6381 lplogfont
->lfFaceName
[0] = '\0';
6386 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6390 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
6394 if (fields
> 0 && pixels
[0] != '*')
6395 lplogfont
->lfHeight
= atoi (pixels
);
6399 if (fields
> 0 && resy
[0] != '*')
6402 if (tem
> 0) dpi
= tem
;
6405 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
6406 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
6409 lplogfont
->lfPitchAndFamily
=
6410 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
6414 if (fields
> 0 && width
[0] != '*')
6415 lplogfont
->lfWidth
= atoi (width
) / 10;
6419 /* Strip the trailing '-' if present. (it shouldn't be, as it
6420 fails the test against xlfd-tight-regexp in fontset.el). */
6422 int len
= strlen (remainder
);
6423 if (len
> 0 && remainder
[len
-1] == '-')
6424 remainder
[len
-1] = 0;
6426 encoding
= remainder
;
6428 if (strncmp (encoding
, "*-", 2) == 0)
6431 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
6436 char name
[100], height
[10], width
[10], weight
[20];
6438 fields
= sscanf (lpxstr
,
6439 "%99[^:]:%9[^:]:%9[^:]:%19s",
6440 name
, height
, width
, weight
);
6442 if (fields
== EOF
) return (FALSE
);
6446 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
6447 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
6451 lplogfont
->lfFaceName
[0] = 0;
6457 lplogfont
->lfHeight
= atoi (height
);
6462 lplogfont
->lfWidth
= atoi (width
);
6466 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6469 /* This makes TrueType fonts work better. */
6470 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
6475 /* Strip the pixel height and point height from the given xlfd, and
6476 return the pixel height. If no pixel height is specified, calculate
6477 one from the point height, or if that isn't defined either, return
6478 0 (which usually signifies a scalable font).
6481 xlfd_strip_height (char *fontname
)
6483 int pixel_height
, field_number
;
6484 char *read_from
, *write_to
;
6488 pixel_height
= field_number
= 0;
6491 /* Look for height fields. */
6492 for (read_from
= fontname
; *read_from
; read_from
++)
6494 if (*read_from
== '-')
6497 if (field_number
== 7) /* Pixel height. */
6500 write_to
= read_from
;
6502 /* Find end of field. */
6503 for (;*read_from
&& *read_from
!= '-'; read_from
++)
6506 /* Split the fontname at end of field. */
6512 pixel_height
= atoi (write_to
);
6513 /* Blank out field. */
6514 if (read_from
> write_to
)
6519 /* If the pixel height field is at the end (partial xlfd),
6522 return pixel_height
;
6524 /* If we got a pixel height, the point height can be
6525 ignored. Just blank it out and break now. */
6528 /* Find end of point size field. */
6529 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6535 /* Blank out the point size field. */
6536 if (read_from
> write_to
)
6542 return pixel_height
;
6546 /* If the point height is already blank, break now. */
6547 if (*read_from
== '-')
6553 else if (field_number
== 8)
6555 /* If we didn't get a pixel height, try to get the point
6556 height and convert that. */
6558 char *point_size_start
= read_from
++;
6560 /* Find end of field. */
6561 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6570 point_size
= atoi (point_size_start
);
6572 /* Convert to pixel height. */
6573 pixel_height
= point_size
6574 * one_w32_display_info
.height_in
/ 720;
6576 /* Blank out this field and break. */
6584 /* Shift the rest of the font spec into place. */
6585 if (write_to
&& read_from
> write_to
)
6587 for (; *read_from
; read_from
++, write_to
++)
6588 *write_to
= *read_from
;
6592 return pixel_height
;
6595 /* Assume parameter 1 is fully qualified, no wildcards. */
6597 w32_font_match (fontname
, pattern
)
6601 char *regex
= alloca (strlen (pattern
) * 2 + 3);
6602 char *font_name_copy
= alloca (strlen (fontname
) + 1);
6605 /* Copy fontname so we can modify it during comparison. */
6606 strcpy (font_name_copy
, fontname
);
6611 /* Turn pattern into a regexp and do a regexp match. */
6612 for (; *pattern
; pattern
++)
6614 if (*pattern
== '?')
6616 else if (*pattern
== '*')
6627 /* Strip out font heights and compare them seperately, since
6628 rounding error can cause mismatches. This also allows a
6629 comparison between a font that declares only a pixel height and a
6630 pattern that declares the point height.
6633 int font_height
, pattern_height
;
6635 font_height
= xlfd_strip_height (font_name_copy
);
6636 pattern_height
= xlfd_strip_height (regex
);
6638 /* Compare now, and don't bother doing expensive regexp matching
6639 if the heights differ. */
6640 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
6644 return (fast_c_string_match_ignore_case (build_string (regex
),
6645 font_name_copy
) >= 0);
6648 /* Callback functions, and a structure holding info they need, for
6649 listing system fonts on W32. We need one set of functions to do the
6650 job properly, but these don't work on NT 3.51 and earlier, so we
6651 have a second set which don't handle character sets properly to
6654 In both cases, there are two passes made. The first pass gets one
6655 font from each family, the second pass lists all the fonts from
6658 typedef struct enumfont_t
6663 XFontStruct
*size_ref
;
6664 Lisp_Object
*pattern
;
6669 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
6671 NEWTEXTMETRIC
* lptm
;
6675 /* Ignore struck out, underlined and vertical versions of fonts. */
6676 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
6677 || lplf
->elfLogFont
.lfEscapement
!= 0
6678 || lplf
->elfLogFont
.lfOrientation
!= 0)
6681 /* Check that the character set matches if it was specified */
6682 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
6683 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
6688 Lisp_Object width
= Qnil
;
6689 char *charset
= NULL
;
6691 /* Truetype fonts do not report their true metrics until loaded */
6692 if (FontType
!= RASTER_FONTTYPE
)
6694 if (!NILP (*(lpef
->pattern
)))
6696 /* Scalable fonts are as big as you want them to be. */
6697 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
6698 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
6699 width
= make_number (lpef
->logfont
.lfWidth
);
6703 lplf
->elfLogFont
.lfHeight
= 0;
6704 lplf
->elfLogFont
.lfWidth
= 0;
6708 /* Make sure the height used here is the same as everywhere
6709 else (ie character height, not cell height). */
6710 if (lplf
->elfLogFont
.lfHeight
> 0)
6712 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6713 if (FontType
== RASTER_FONTTYPE
)
6714 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
6716 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
6719 if (!NILP (*(lpef
->pattern
)))
6721 charset
= xlfd_charset_of_font (XSTRING(*(lpef
->pattern
))->data
);
6723 /* Ensure that charset is valid for this font. */
6725 && (x_to_w32_charset (charset
) != lplf
->elfLogFont
.lfCharSet
))
6729 /* TODO: List all relevant charsets if charset not specified. */
6730 if (!w32_to_x_font (&(lplf
->elfLogFont
), buf
, 100, charset
))
6733 if (NILP (*(lpef
->pattern
))
6734 || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
6736 *lpef
->tail
= Fcons (Fcons (build_string (buf
), width
), Qnil
);
6737 lpef
->tail
= &(XCDR (*lpef
->tail
));
6746 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
6748 NEWTEXTMETRIC
* lptm
;
6752 return EnumFontFamilies (lpef
->hdc
,
6753 lplf
->elfLogFont
.lfFaceName
,
6754 (FONTENUMPROC
) enum_font_cb2
,
6760 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
6761 ENUMLOGFONTEX
* lplf
;
6762 NEWTEXTMETRICEX
* lptm
;
6766 /* We are not interested in the extra info we get back from the 'Ex
6767 version - only the fact that we get character set variations
6768 enumerated seperately. */
6769 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
6774 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
6775 ENUMLOGFONTEX
* lplf
;
6776 NEWTEXTMETRICEX
* lptm
;
6780 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6781 FARPROC enum_font_families_ex
6782 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6783 /* We don't really expect EnumFontFamiliesEx to disappear once we
6784 get here, so don't bother handling it gracefully. */
6785 if (enum_font_families_ex
== NULL
)
6786 error ("gdi32.dll has disappeared!");
6787 return enum_font_families_ex (lpef
->hdc
,
6789 (FONTENUMPROC
) enum_fontex_cb2
,
6793 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6794 and xterm.c in Emacs 20.3) */
6796 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
6798 char *fontname
, *ptnstr
;
6799 Lisp_Object list
, tem
, newlist
= Qnil
;
6802 list
= Vw32_bdf_filename_alist
;
6803 ptnstr
= XSTRING (pattern
)->data
;
6805 for ( ; CONSP (list
); list
= XCDR (list
))
6809 fontname
= XSTRING (XCAR (tem
))->data
;
6810 else if (STRINGP (tem
))
6811 fontname
= XSTRING (tem
)->data
;
6815 if (w32_font_match (fontname
, ptnstr
))
6817 newlist
= Fcons (XCAR (tem
), newlist
);
6819 if (n_fonts
>= max_names
)
6827 static Lisp_Object
w32_list_synthesized_fonts (FRAME_PTR f
,
6828 Lisp_Object pattern
,
6829 int size
, int max_names
);
6831 /* Return a list of names of available fonts matching PATTERN on frame
6832 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6833 to be listed. Frame F NULL means we have not yet created any
6834 frame, which means we can't get proper size info, as we don't have
6835 a device context to use for GetTextMetrics.
6836 MAXNAMES sets a limit on how many fonts to match. */
6839 w32_list_fonts (f
, pattern
, size
, maxnames
)
6841 Lisp_Object pattern
;
6845 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
6846 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
6847 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
6850 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
6851 if (NILP (patterns
))
6852 patterns
= Fcons (pattern
, Qnil
);
6854 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
6859 tpat
= XCAR (patterns
);
6861 if (!STRINGP (tpat
))
6864 /* Avoid expensive EnumFontFamilies functions if we are not
6865 going to be able to output one of these anyway. */
6866 codepage
= w32_codepage_for_font (XSTRING (tpat
)->data
);
6867 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
6868 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
6869 && !IsValidCodePage(codepage
))
6872 /* See if we cached the result for this particular query.
6873 The cache is an alist of the form:
6874 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6876 if (tem
= XCDR (dpyinfo
->name_list_element
),
6877 !NILP (list
= Fassoc (tpat
, tem
)))
6879 list
= Fcdr_safe (list
);
6880 /* We have a cached list. Don't have to get the list again. */
6885 /* At first, put PATTERN in the cache. */
6891 /* Use EnumFontFamiliesEx where it is available, as it knows
6892 about character sets. Fall back to EnumFontFamilies for
6893 older versions of NT that don't support the 'Ex function. */
6894 x_to_w32_font (XSTRING (tpat
)->data
, &ef
.logfont
);
6896 LOGFONT font_match_pattern
;
6897 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6898 FARPROC enum_font_families_ex
6899 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6901 /* We do our own pattern matching so we can handle wildcards. */
6902 font_match_pattern
.lfFaceName
[0] = 0;
6903 font_match_pattern
.lfPitchAndFamily
= 0;
6904 /* We can use the charset, because if it is a wildcard it will
6905 be DEFAULT_CHARSET anyway. */
6906 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
6908 ef
.hdc
= GetDC (dpyinfo
->root_window
);
6910 if (enum_font_families_ex
)
6911 enum_font_families_ex (ef
.hdc
,
6912 &font_match_pattern
,
6913 (FONTENUMPROC
) enum_fontex_cb1
,
6916 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
6919 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
6924 /* Make a list of the fonts we got back.
6925 Store that in the font cache for the display. */
6926 XSETCDR (dpyinfo
->name_list_element
,
6927 Fcons (Fcons (tpat
, list
),
6928 XCDR (dpyinfo
->name_list_element
)));
6931 if (NILP (list
)) continue; /* Try the remaining alternatives. */
6933 newlist
= second_best
= Qnil
;
6935 /* Make a list of the fonts that have the right width. */
6936 for (; CONSP (list
); list
= XCDR (list
))
6943 if (NILP (XCAR (tem
)))
6947 newlist
= Fcons (XCAR (tem
), newlist
);
6949 if (n_fonts
>= maxnames
)
6954 if (!INTEGERP (XCDR (tem
)))
6956 /* Since we don't yet know the size of the font, we must
6957 load it and try GetTextMetrics. */
6958 W32FontStruct thisinfo
;
6963 if (!x_to_w32_font (XSTRING (XCAR (tem
))->data
, &lf
))
6967 thisinfo
.bdf
= NULL
;
6968 thisinfo
.hfont
= CreateFontIndirect (&lf
);
6969 if (thisinfo
.hfont
== NULL
)
6972 hdc
= GetDC (dpyinfo
->root_window
);
6973 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
6974 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
6975 XSETCDR (tem
, make_number (FONT_WIDTH (&thisinfo
)));
6977 XSETCDR (tem
, make_number (0));
6978 SelectObject (hdc
, oldobj
);
6979 ReleaseDC (dpyinfo
->root_window
, hdc
);
6980 DeleteObject(thisinfo
.hfont
);
6983 found_size
= XINT (XCDR (tem
));
6984 if (found_size
== size
)
6986 newlist
= Fcons (XCAR (tem
), newlist
);
6988 if (n_fonts
>= maxnames
)
6991 /* keep track of the closest matching size in case
6992 no exact match is found. */
6993 else if (found_size
> 0)
6995 if (NILP (second_best
))
6998 else if (found_size
< size
)
7000 if (XINT (XCDR (second_best
)) > size
7001 || XINT (XCDR (second_best
)) < found_size
)
7006 if (XINT (XCDR (second_best
)) > size
7007 && XINT (XCDR (second_best
)) >
7014 if (!NILP (newlist
))
7016 else if (!NILP (second_best
))
7018 newlist
= Fcons (XCAR (second_best
), Qnil
);
7023 /* Include any bdf fonts. */
7024 if (n_fonts
< maxnames
)
7026 Lisp_Object combined
[2];
7027 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
7028 combined
[1] = newlist
;
7029 newlist
= Fnconc(2, combined
);
7032 /* If we can't find a font that matches, check if Windows would be
7033 able to synthesize it from a different style. */
7034 if (NILP (newlist
) && !NILP (Vw32_enable_synthesized_fonts
))
7035 newlist
= w32_list_synthesized_fonts (f
, pattern
, size
, maxnames
);
7041 w32_list_synthesized_fonts (f
, pattern
, size
, max_names
)
7043 Lisp_Object pattern
;
7048 char *full_pattn
, *new_pattn
, foundary
[50], family
[50], *pattn_part2
;
7049 char style
[20], slant
;
7050 Lisp_Object matches
, tem
, synthed_matches
= Qnil
;
7052 full_pattn
= XSTRING (pattern
)->data
;
7054 pattn_part2
= alloca (XSTRING (pattern
)->size
+ 1);
7055 /* Allow some space for wildcard expansion. */
7056 new_pattn
= alloca (XSTRING (pattern
)->size
+ 100);
7058 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
7059 foundary
, family
, style
, &slant
, pattn_part2
);
7060 if (fields
== EOF
|| fields
< 5)
7063 /* If the style and slant are wildcards already there is no point
7064 checking again (and we don't want to keep recursing). */
7065 if (*style
== '*' && slant
== '*')
7068 sprintf (new_pattn
, "-%s-%s-*-*-%s", foundary
, family
, pattn_part2
);
7070 matches
= w32_list_fonts (f
, build_string (new_pattn
), size
, max_names
);
7072 for ( ; CONSP (matches
); matches
= XCDR (matches
))
7074 tem
= XCAR (matches
);
7078 full_pattn
= XSTRING (tem
)->data
;
7079 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
7080 foundary
, family
, pattn_part2
);
7081 if (fields
== EOF
|| fields
< 3)
7084 sprintf (new_pattn
, "-%s-%s-%s-%c-%s", foundary
, family
, style
,
7085 slant
, pattn_part2
);
7087 synthed_matches
= Fcons (build_string (new_pattn
),
7091 return synthed_matches
;
7095 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7097 w32_get_font_info (f
, font_idx
)
7101 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
7106 w32_query_font (struct frame
*f
, char *fontname
)
7109 struct font_info
*pfi
;
7111 pfi
= FRAME_W32_FONT_TABLE (f
);
7113 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
7115 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
7121 /* Find a CCL program for a font specified by FONTP, and set the member
7122 `encoder' of the structure. */
7125 w32_find_ccl_program (fontp
)
7126 struct font_info
*fontp
;
7128 Lisp_Object list
, elt
;
7130 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
7134 && STRINGP (XCAR (elt
))
7135 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
7141 struct ccl_program
*ccl
7142 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
7144 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
7147 fontp
->font_encoder
= ccl
;
7152 /* Find BDF files in a specified directory. (use GCPRO when calling,
7153 as this calls lisp to get a directory listing). */
7155 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
7157 Lisp_Object filelist
, list
= Qnil
;
7160 if (!STRINGP(directory
))
7163 filelist
= Fdirectory_files (directory
, Qt
,
7164 build_string (".*\\.[bB][dD][fF]"), Qt
);
7166 for ( ; CONSP(filelist
); filelist
= XCDR (filelist
))
7168 Lisp_Object filename
= XCAR (filelist
);
7169 if (w32_BDF_to_x_font (XSTRING (filename
)->data
, fontname
, 100))
7170 store_in_alist (&list
, build_string (fontname
), filename
);
7175 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
7177 "Return a list of BDF fonts in DIR, suitable for appending to\n\
7178 w32-bdf-filename-alist. Fonts which do not contain an xlfd description\n\
7179 will not be included in the list. DIR may be a list of directories.")
7181 Lisp_Object directory
;
7183 Lisp_Object list
= Qnil
;
7184 struct gcpro gcpro1
, gcpro2
;
7186 if (!CONSP (directory
))
7187 return w32_find_bdf_fonts_in_dir (directory
);
7189 for ( ; CONSP (directory
); directory
= XCDR (directory
))
7191 Lisp_Object pair
[2];
7194 GCPRO2 (directory
, list
);
7195 pair
[1] = w32_find_bdf_fonts_in_dir( XCAR (directory
) );
7196 list
= Fnconc( 2, pair
);
7203 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
7204 "Internal function called by `color-defined-p', which see.")
7206 Lisp_Object color
, frame
;
7209 FRAME_PTR f
= check_x_frame (frame
);
7211 CHECK_STRING (color
);
7213 if (w32_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
7219 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
7220 "Internal function called by `color-values', which see.")
7222 Lisp_Object color
, frame
;
7225 FRAME_PTR f
= check_x_frame (frame
);
7227 CHECK_STRING (color
);
7229 if (w32_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
7233 rgb
[0] = make_number ((GetRValue (foo
.pixel
) << 8)
7234 | GetRValue (foo
.pixel
));
7235 rgb
[1] = make_number ((GetGValue (foo
.pixel
) << 8)
7236 | GetGValue (foo
.pixel
));
7237 rgb
[2] = make_number ((GetBValue (foo
.pixel
) << 8)
7238 | GetBValue (foo
.pixel
));
7239 return Flist (3, rgb
);
7245 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
7246 "Internal function called by `display-color-p', which see.")
7248 Lisp_Object display
;
7250 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7252 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
7258 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
7260 "Return t if the X display supports shades of gray.\n\
7261 Note that color displays do support shades of gray.\n\
7262 The optional argument DISPLAY specifies which display to ask about.\n\
7263 DISPLAY should be either a frame or a display name (a string).\n\
7264 If omitted or nil, that stands for the selected frame's display.")
7266 Lisp_Object display
;
7268 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7270 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
7276 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
7278 "Returns the width in pixels of the X display DISPLAY.\n\
7279 The optional argument DISPLAY specifies which display to ask about.\n\
7280 DISPLAY should be either a frame or a display name (a string).\n\
7281 If omitted or nil, that stands for the selected frame's display.")
7283 Lisp_Object display
;
7285 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7287 return make_number (dpyinfo
->width
);
7290 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
7291 Sx_display_pixel_height
, 0, 1, 0,
7292 "Returns the height in pixels of the X display DISPLAY.\n\
7293 The optional argument DISPLAY specifies which display to ask about.\n\
7294 DISPLAY should be either a frame or a display name (a string).\n\
7295 If omitted or nil, that stands for the selected frame's display.")
7297 Lisp_Object display
;
7299 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7301 return make_number (dpyinfo
->height
);
7304 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
7306 "Returns the number of bitplanes of the display DISPLAY.\n\
7307 The optional argument DISPLAY specifies which display to ask about.\n\
7308 DISPLAY should be either a frame or a display name (a string).\n\
7309 If omitted or nil, that stands for the selected frame's display.")
7311 Lisp_Object display
;
7313 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7315 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7318 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
7320 "Returns the number of color cells of the display DISPLAY.\n\
7321 The optional argument DISPLAY specifies which display to ask about.\n\
7322 DISPLAY should be either a frame or a display name (a string).\n\
7323 If omitted or nil, that stands for the selected frame's display.")
7325 Lisp_Object display
;
7327 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7331 hdc
= GetDC (dpyinfo
->root_window
);
7332 if (dpyinfo
->has_palette
)
7333 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
7335 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
7338 cap
= 1 << (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7340 ReleaseDC (dpyinfo
->root_window
, hdc
);
7342 return make_number (cap
);
7345 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
7346 Sx_server_max_request_size
,
7348 "Returns the maximum request size of the server of display DISPLAY.\n\
7349 The optional argument DISPLAY specifies which display to ask about.\n\
7350 DISPLAY should be either a frame or a display name (a string).\n\
7351 If omitted or nil, that stands for the selected frame's display.")
7353 Lisp_Object display
;
7355 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7357 return make_number (1);
7360 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
7361 "Returns the vendor ID string of the W32 system (Microsoft).\n\
7362 The optional argument DISPLAY specifies which display to ask about.\n\
7363 DISPLAY should be either a frame or a display name (a string).\n\
7364 If omitted or nil, that stands for the selected frame's display.")
7366 Lisp_Object display
;
7368 return build_string ("Microsoft Corp.");
7371 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
7372 "Returns the version numbers of the server of display DISPLAY.\n\
7373 The value is a list of three integers: the major and minor\n\
7374 version numbers, and the vendor-specific release\n\
7375 number. See also the function `x-server-vendor'.\n\n\
7376 The optional argument DISPLAY specifies which display to ask about.\n\
7377 DISPLAY should be either a frame or a display name (a string).\n\
7378 If omitted or nil, that stands for the selected frame's display.")
7380 Lisp_Object display
;
7382 return Fcons (make_number (w32_major_version
),
7383 Fcons (make_number (w32_minor_version
),
7384 Fcons (make_number (w32_build_number
), Qnil
)));
7387 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
7388 "Returns the number of screens on the server of display DISPLAY.\n\
7389 The optional argument DISPLAY specifies which display to ask about.\n\
7390 DISPLAY should be either a frame or a display name (a string).\n\
7391 If omitted or nil, that stands for the selected frame's display.")
7393 Lisp_Object display
;
7395 return make_number (1);
7398 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
7399 "Returns the height in millimeters of the X display DISPLAY.\n\
7400 The optional argument DISPLAY specifies which display to ask about.\n\
7401 DISPLAY should be either a frame or a display name (a string).\n\
7402 If omitted or nil, that stands for the selected frame's display.")
7404 Lisp_Object display
;
7406 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7410 hdc
= GetDC (dpyinfo
->root_window
);
7412 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
7414 ReleaseDC (dpyinfo
->root_window
, hdc
);
7416 return make_number (cap
);
7419 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
7420 "Returns the width in millimeters of the X display DISPLAY.\n\
7421 The optional argument DISPLAY specifies which display to ask about.\n\
7422 DISPLAY should be either a frame or a display name (a string).\n\
7423 If omitted or nil, that stands for the selected frame's display.")
7425 Lisp_Object display
;
7427 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7432 hdc
= GetDC (dpyinfo
->root_window
);
7434 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
7436 ReleaseDC (dpyinfo
->root_window
, hdc
);
7438 return make_number (cap
);
7441 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
7442 Sx_display_backing_store
, 0, 1, 0,
7443 "Returns an indication of whether display DISPLAY does backing store.\n\
7444 The value may be `always', `when-mapped', or `not-useful'.\n\
7445 The optional argument DISPLAY specifies which display to ask about.\n\
7446 DISPLAY should be either a frame or a display name (a string).\n\
7447 If omitted or nil, that stands for the selected frame's display.")
7449 Lisp_Object display
;
7451 return intern ("not-useful");
7454 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
7455 Sx_display_visual_class
, 0, 1, 0,
7456 "Returns the visual class of the display DISPLAY.\n\
7457 The value is one of the symbols `static-gray', `gray-scale',\n\
7458 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
7459 The optional argument DISPLAY specifies which display to ask about.\n\
7460 DISPLAY should be either a frame or a display name (a string).\n\
7461 If omitted or nil, that stands for the selected frame's display.")
7463 Lisp_Object display
;
7465 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7466 Lisp_Object result
= Qnil
;
7468 if (dpyinfo
->has_palette
)
7469 result
= intern ("pseudo-color");
7470 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
7471 result
= intern ("static-grey");
7472 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
7473 result
= intern ("static-color");
7474 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
7475 result
= intern ("true-color");
7480 DEFUN ("x-display-save-under", Fx_display_save_under
,
7481 Sx_display_save_under
, 0, 1, 0,
7482 "Returns t if the display DISPLAY supports the save-under feature.\n\
7483 The optional argument DISPLAY specifies which display to ask about.\n\
7484 DISPLAY should be either a frame or a display name (a string).\n\
7485 If omitted or nil, that stands for the selected frame's display.")
7487 Lisp_Object display
;
7494 register struct frame
*f
;
7496 return PIXEL_WIDTH (f
);
7501 register struct frame
*f
;
7503 return PIXEL_HEIGHT (f
);
7508 register struct frame
*f
;
7510 return FONT_WIDTH (f
->output_data
.w32
->font
);
7515 register struct frame
*f
;
7517 return f
->output_data
.w32
->line_height
;
7522 register struct frame
*f
;
7524 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
7527 /* Return the display structure for the display named NAME.
7528 Open a new connection if necessary. */
7530 struct w32_display_info
*
7531 x_display_info_for_name (name
)
7535 struct w32_display_info
*dpyinfo
;
7537 CHECK_STRING (name
);
7539 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
7541 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
7544 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
7549 /* Use this general default value to start with. */
7550 Vx_resource_name
= Vinvocation_name
;
7552 validate_x_resource_name ();
7554 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
7555 (char *) XSTRING (Vx_resource_name
)->data
);
7558 error ("Cannot connect to server %s", XSTRING (name
)->data
);
7561 XSETFASTINT (Vwindow_system_version
, 3);
7566 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
7567 1, 3, 0, "Open a connection to a server.\n\
7568 DISPLAY is the name of the display to connect to.\n\
7569 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
7570 If the optional third arg MUST-SUCCEED is non-nil,\n\
7571 terminate Emacs if we can't open the connection.")
7572 (display
, xrm_string
, must_succeed
)
7573 Lisp_Object display
, xrm_string
, must_succeed
;
7575 unsigned char *xrm_option
;
7576 struct w32_display_info
*dpyinfo
;
7578 CHECK_STRING (display
);
7579 if (! NILP (xrm_string
))
7580 CHECK_STRING (xrm_string
);
7582 if (! EQ (Vwindow_system
, intern ("w32")))
7583 error ("Not using Microsoft Windows");
7585 /* Allow color mapping to be defined externally; first look in user's
7586 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
7588 Lisp_Object color_file
;
7589 struct gcpro gcpro1
;
7591 color_file
= build_string("~/rgb.txt");
7593 GCPRO1 (color_file
);
7595 if (NILP (Ffile_readable_p (color_file
)))
7597 Fexpand_file_name (build_string ("rgb.txt"),
7598 Fsymbol_value (intern ("data-directory")));
7600 Vw32_color_map
= Fw32_load_color_file (color_file
);
7604 if (NILP (Vw32_color_map
))
7605 Vw32_color_map
= Fw32_default_color_map ();
7607 if (! NILP (xrm_string
))
7608 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
7610 xrm_option
= (unsigned char *) 0;
7612 /* Use this general default value to start with. */
7613 /* First remove .exe suffix from invocation-name - it looks ugly. */
7615 char basename
[ MAX_PATH
], *str
;
7617 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
7618 str
= strrchr (basename
, '.');
7620 Vinvocation_name
= build_string (basename
);
7622 Vx_resource_name
= Vinvocation_name
;
7624 validate_x_resource_name ();
7626 /* This is what opens the connection and sets x_current_display.
7627 This also initializes many symbols, such as those used for input. */
7628 dpyinfo
= w32_term_init (display
, xrm_option
,
7629 (char *) XSTRING (Vx_resource_name
)->data
);
7633 if (!NILP (must_succeed
))
7634 fatal ("Cannot connect to server %s.\n",
7635 XSTRING (display
)->data
);
7637 error ("Cannot connect to server %s", XSTRING (display
)->data
);
7642 XSETFASTINT (Vwindow_system_version
, 3);
7646 DEFUN ("x-close-connection", Fx_close_connection
,
7647 Sx_close_connection
, 1, 1, 0,
7648 "Close the connection to DISPLAY's server.\n\
7649 For DISPLAY, specify either a frame or a display name (a string).\n\
7650 If DISPLAY is nil, that stands for the selected frame's display.")
7652 Lisp_Object display
;
7654 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7657 if (dpyinfo
->reference_count
> 0)
7658 error ("Display still has frames on it");
7661 /* Free the fonts in the font table. */
7662 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
7663 if (dpyinfo
->font_table
[i
].name
)
7665 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
7666 xfree (dpyinfo
->font_table
[i
].full_name
);
7667 xfree (dpyinfo
->font_table
[i
].name
);
7668 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
7670 x_destroy_all_bitmaps (dpyinfo
);
7672 x_delete_display (dpyinfo
);
7678 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
7679 "Return the list of display names that Emacs has connections to.")
7682 Lisp_Object tail
, result
;
7685 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
7686 result
= Fcons (XCAR (XCAR (tail
)), result
);
7691 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
7692 "If ON is non-nil, report errors as soon as the erring request is made.\n\
7693 If ON is nil, allow buffering of requests.\n\
7694 This is a noop on W32 systems.\n\
7695 The optional second argument DISPLAY specifies which display to act on.\n\
7696 DISPLAY should be either a frame or a display name (a string).\n\
7697 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
7699 Lisp_Object display
, on
;
7706 /***********************************************************************
7708 ***********************************************************************/
7710 /* Value is the number of elements of vector VECTOR. */
7712 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
7714 /* List of supported image types. Use define_image_type to add new
7715 types. Use lookup_image_type to find a type for a given symbol. */
7717 static struct image_type
*image_types
;
7719 /* The symbol `image' which is the car of the lists used to represent
7722 extern Lisp_Object Qimage
;
7724 /* The symbol `xbm' which is used as the type symbol for XBM images. */
7730 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
7731 extern Lisp_Object QCdata
;
7732 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
7733 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
7734 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
7736 /* Other symbols. */
7738 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
7740 /* Time in seconds after which images should be removed from the cache
7741 if not displayed. */
7743 Lisp_Object Vimage_cache_eviction_delay
;
7745 /* Function prototypes. */
7747 static void define_image_type
P_ ((struct image_type
*type
));
7748 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
7749 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
7750 static void x_laplace
P_ ((struct frame
*, struct image
*));
7751 static void x_emboss
P_ ((struct frame
*, struct image
*));
7752 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
7756 /* Define a new image type from TYPE. This adds a copy of TYPE to
7757 image_types and adds the symbol *TYPE->type to Vimage_types. */
7760 define_image_type (type
)
7761 struct image_type
*type
;
7763 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7764 The initialized data segment is read-only. */
7765 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
7766 bcopy (type
, p
, sizeof *p
);
7767 p
->next
= image_types
;
7769 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
7773 /* Look up image type SYMBOL, and return a pointer to its image_type
7774 structure. Value is null if SYMBOL is not a known image type. */
7776 static INLINE
struct image_type
*
7777 lookup_image_type (symbol
)
7780 struct image_type
*type
;
7782 for (type
= image_types
; type
; type
= type
->next
)
7783 if (EQ (symbol
, *type
->type
))
7790 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
7791 valid image specification is a list whose car is the symbol
7792 `image', and whose rest is a property list. The property list must
7793 contain a value for key `:type'. That value must be the name of a
7794 supported image type. The rest of the property list depends on the
7798 valid_image_p (object
)
7803 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
7807 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
7808 if (EQ (XCAR (tem
), QCtype
))
7811 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
7813 struct image_type
*type
;
7814 type
= lookup_image_type (XCAR (tem
));
7816 valid_p
= type
->valid_p (object
);
7827 /* Log error message with format string FORMAT and argument ARG.
7828 Signaling an error, e.g. when an image cannot be loaded, is not a
7829 good idea because this would interrupt redisplay, and the error
7830 message display would lead to another redisplay. This function
7831 therefore simply displays a message. */
7834 image_error (format
, arg1
, arg2
)
7836 Lisp_Object arg1
, arg2
;
7838 add_to_log (format
, arg1
, arg2
);
7843 /***********************************************************************
7844 Image specifications
7845 ***********************************************************************/
7847 enum image_value_type
7849 IMAGE_DONT_CHECK_VALUE_TYPE
,
7851 IMAGE_STRING_OR_NIL_VALUE
,
7853 IMAGE_POSITIVE_INTEGER_VALUE
,
7854 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
7855 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
7857 IMAGE_INTEGER_VALUE
,
7858 IMAGE_FUNCTION_VALUE
,
7863 /* Structure used when parsing image specifications. */
7865 struct image_keyword
7867 /* Name of keyword. */
7870 /* The type of value allowed. */
7871 enum image_value_type type
;
7873 /* Non-zero means key must be present. */
7876 /* Used to recognize duplicate keywords in a property list. */
7879 /* The value that was found. */
7884 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
7886 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
7889 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
7890 has the format (image KEYWORD VALUE ...). One of the keyword/
7891 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7892 image_keywords structures of size NKEYWORDS describing other
7893 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7896 parse_image_spec (spec
, keywords
, nkeywords
, type
)
7898 struct image_keyword
*keywords
;
7905 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
7908 plist
= XCDR (spec
);
7909 while (CONSP (plist
))
7911 Lisp_Object key
, value
;
7913 /* First element of a pair must be a symbol. */
7915 plist
= XCDR (plist
);
7919 /* There must follow a value. */
7922 value
= XCAR (plist
);
7923 plist
= XCDR (plist
);
7925 /* Find key in KEYWORDS. Error if not found. */
7926 for (i
= 0; i
< nkeywords
; ++i
)
7927 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
7933 /* Record that we recognized the keyword. If a keywords
7934 was found more than once, it's an error. */
7935 keywords
[i
].value
= value
;
7936 ++keywords
[i
].count
;
7938 if (keywords
[i
].count
> 1)
7941 /* Check type of value against allowed type. */
7942 switch (keywords
[i
].type
)
7944 case IMAGE_STRING_VALUE
:
7945 if (!STRINGP (value
))
7949 case IMAGE_STRING_OR_NIL_VALUE
:
7950 if (!STRINGP (value
) && !NILP (value
))
7954 case IMAGE_SYMBOL_VALUE
:
7955 if (!SYMBOLP (value
))
7959 case IMAGE_POSITIVE_INTEGER_VALUE
:
7960 if (!INTEGERP (value
) || XINT (value
) <= 0)
7964 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
7965 if (INTEGERP (value
) && XINT (value
) >= 0)
7968 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
7969 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
7973 case IMAGE_ASCENT_VALUE
:
7974 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
7976 else if (INTEGERP (value
)
7977 && XINT (value
) >= 0
7978 && XINT (value
) <= 100)
7982 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
7983 if (!INTEGERP (value
) || XINT (value
) < 0)
7987 case IMAGE_DONT_CHECK_VALUE_TYPE
:
7990 case IMAGE_FUNCTION_VALUE
:
7991 value
= indirect_function (value
);
7993 || COMPILEDP (value
)
7994 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
7998 case IMAGE_NUMBER_VALUE
:
7999 if (!INTEGERP (value
) && !FLOATP (value
))
8003 case IMAGE_INTEGER_VALUE
:
8004 if (!INTEGERP (value
))
8008 case IMAGE_BOOL_VALUE
:
8009 if (!NILP (value
) && !EQ (value
, Qt
))
8018 if (EQ (key
, QCtype
) && !EQ (type
, value
))
8022 /* Check that all mandatory fields are present. */
8023 for (i
= 0; i
< nkeywords
; ++i
)
8024 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
8027 return NILP (plist
);
8031 /* Return the value of KEY in image specification SPEC. Value is nil
8032 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8033 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8036 image_spec_value (spec
, key
, found
)
8037 Lisp_Object spec
, key
;
8042 xassert (valid_image_p (spec
));
8044 for (tail
= XCDR (spec
);
8045 CONSP (tail
) && CONSP (XCDR (tail
));
8046 tail
= XCDR (XCDR (tail
)))
8048 if (EQ (XCAR (tail
), key
))
8052 return XCAR (XCDR (tail
));
8064 /***********************************************************************
8065 Image type independent image structures
8066 ***********************************************************************/
8068 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
8069 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
8072 /* Allocate and return a new image structure for image specification
8073 SPEC. SPEC has a hash value of HASH. */
8075 static struct image
*
8076 make_image (spec
, hash
)
8080 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
8082 xassert (valid_image_p (spec
));
8083 bzero (img
, sizeof *img
);
8084 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
8085 xassert (img
->type
!= NULL
);
8087 img
->data
.lisp_val
= Qnil
;
8088 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
8094 /* Free image IMG which was used on frame F, including its resources. */
8103 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8105 /* Remove IMG from the hash table of its cache. */
8107 img
->prev
->next
= img
->next
;
8109 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
8112 img
->next
->prev
= img
->prev
;
8114 c
->images
[img
->id
] = NULL
;
8116 /* Free resources, then free IMG. */
8117 img
->type
->free (f
, img
);
8123 /* Prepare image IMG for display on frame F. Must be called before
8124 drawing an image. */
8127 prepare_image_for_display (f
, img
)
8133 /* We're about to display IMG, so set its timestamp to `now'. */
8135 img
->timestamp
= EMACS_SECS (t
);
8137 /* If IMG doesn't have a pixmap yet, load it now, using the image
8138 type dependent loader function. */
8139 if (img
->pixmap
== 0 && !img
->load_failed_p
)
8140 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8144 /* Value is the number of pixels for the ascent of image IMG when
8145 drawn in face FACE. */
8148 image_ascent (img
, face
)
8152 int height
= img
->height
+ img
->vmargin
;
8155 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
8158 ascent
= height
/ 2 - (FONT_DESCENT(face
->font
)
8159 - FONT_BASE(face
->font
)) / 2;
8161 ascent
= height
/ 2;
8164 ascent
= height
* img
->ascent
/ 100.0;
8171 /***********************************************************************
8172 Helper functions for X image types
8173 ***********************************************************************/
8175 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8176 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
8178 Lisp_Object color_name
,
8179 unsigned long dflt
));
8181 /* Free X resources of image IMG which is used on frame F. */
8184 x_clear_image (f
, img
)
8188 #if 0 /* TODO: W32 image support */
8193 XFreePixmap (NULL
, img
->pixmap
);
8200 int class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
8202 /* If display has an immutable color map, freeing colors is not
8203 necessary and some servers don't allow it. So don't do it. */
8204 if (class != StaticColor
8205 && class != StaticGray
8206 && class != TrueColor
)
8210 cmap
= DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f
)->screen
);
8211 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
, img
->colors
,
8216 xfree (img
->colors
);
8224 /* Allocate color COLOR_NAME for image IMG on frame F. If color
8225 cannot be allocated, use DFLT. Add a newly allocated color to
8226 IMG->colors, so that it can be freed again. Value is the pixel
8229 static unsigned long
8230 x_alloc_image_color (f
, img
, color_name
, dflt
)
8233 Lisp_Object color_name
;
8236 #if 0 /* TODO: allocing colors. */
8238 unsigned long result
;
8240 xassert (STRINGP (color_name
));
8242 if (w32_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
8244 /* This isn't called frequently so we get away with simply
8245 reallocating the color vector to the needed size, here. */
8248 (unsigned long *) xrealloc (img
->colors
,
8249 img
->ncolors
* sizeof *img
->colors
);
8250 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
8251 result
= color
.pixel
;
8262 /***********************************************************************
8264 ***********************************************************************/
8266 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
8267 static void postprocess_image
P_ ((struct frame
*, struct image
*));
8270 /* Return a new, initialized image cache that is allocated from the
8271 heap. Call free_image_cache to free an image cache. */
8273 struct image_cache
*
8276 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
8279 bzero (c
, sizeof *c
);
8281 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
8282 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
8283 c
->buckets
= (struct image
**) xmalloc (size
);
8284 bzero (c
->buckets
, size
);
8289 /* Free image cache of frame F. Be aware that X frames share images
8293 free_image_cache (f
)
8296 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8301 /* Cache should not be referenced by any frame when freed. */
8302 xassert (c
->refcount
== 0);
8304 for (i
= 0; i
< c
->used
; ++i
)
8305 free_image (f
, c
->images
[i
]);
8309 FRAME_X_IMAGE_CACHE (f
) = NULL
;
8314 /* Clear image cache of frame F. FORCE_P non-zero means free all
8315 images. FORCE_P zero means clear only images that haven't been
8316 displayed for some time. Should be called from time to time to
8317 reduce the number of loaded images. If image-eviction-seconds is
8318 non-nil, this frees images in the cache which weren't displayed for
8319 at least that many seconds. */
8322 clear_image_cache (f
, force_p
)
8326 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8328 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
8332 int i
, any_freed_p
= 0;
8335 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
8337 for (i
= 0; i
< c
->used
; ++i
)
8339 struct image
*img
= c
->images
[i
];
8342 || (img
->timestamp
> old
)))
8344 free_image (f
, img
);
8349 /* We may be clearing the image cache because, for example,
8350 Emacs was iconified for a longer period of time. In that
8351 case, current matrices may still contain references to
8352 images freed above. So, clear these matrices. */
8355 clear_current_matrices (f
);
8356 ++windows_or_buffers_changed
;
8362 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
8364 "Clear the image cache of FRAME.\n\
8365 FRAME nil or omitted means use the selected frame.\n\
8366 FRAME t means clear the image caches of all frames.")
8374 FOR_EACH_FRAME (tail
, frame
)
8375 if (FRAME_W32_P (XFRAME (frame
)))
8376 clear_image_cache (XFRAME (frame
), 1);
8379 clear_image_cache (check_x_frame (frame
), 1);
8385 /* Compute masks and transform image IMG on frame F, as specified
8386 by the image's specification, */
8389 postprocess_image (f
, img
)
8393 #if 0 /* TODO: image support. */
8394 /* Manipulation of the image's mask. */
8397 Lisp_Object conversion
, spec
;
8402 /* `:heuristic-mask t'
8404 means build a mask heuristically.
8405 `:heuristic-mask (R G B)'
8406 `:mask (heuristic (R G B))'
8407 means build a mask from color (R G B) in the
8410 means remove a mask, if any. */
8412 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
8414 x_build_heuristic_mask (f
, img
, mask
);
8419 mask
= image_spec_value (spec
, QCmask
, &found_p
);
8421 if (EQ (mask
, Qheuristic
))
8422 x_build_heuristic_mask (f
, img
, Qt
);
8423 else if (CONSP (mask
)
8424 && EQ (XCAR (mask
), Qheuristic
))
8426 if (CONSP (XCDR (mask
)))
8427 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
8429 x_build_heuristic_mask (f
, img
, XCDR (mask
));
8431 else if (NILP (mask
) && found_p
&& img
->mask
)
8433 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8439 /* Should we apply an image transformation algorithm? */
8440 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
8441 if (EQ (conversion
, Qdisabled
))
8442 x_disable_image (f
, img
);
8443 else if (EQ (conversion
, Qlaplace
))
8445 else if (EQ (conversion
, Qemboss
))
8447 else if (CONSP (conversion
)
8448 && EQ (XCAR (conversion
), Qedge_detection
))
8451 tem
= XCDR (conversion
);
8453 x_edge_detection (f
, img
,
8454 Fplist_get (tem
, QCmatrix
),
8455 Fplist_get (tem
, QCcolor_adjustment
));
8462 /* Return the id of image with Lisp specification SPEC on frame F.
8463 SPEC must be a valid Lisp image specification (see valid_image_p). */
8466 lookup_image (f
, spec
)
8470 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8474 struct gcpro gcpro1
;
8477 /* F must be a window-system frame, and SPEC must be a valid image
8479 xassert (FRAME_WINDOW_P (f
));
8480 xassert (valid_image_p (spec
));
8484 /* Look up SPEC in the hash table of the image cache. */
8485 hash
= sxhash (spec
, 0);
8486 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8488 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
8489 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
8492 /* If not found, create a new image and cache it. */
8495 extern Lisp_Object Qpostscript
;
8498 img
= make_image (spec
, hash
);
8499 cache_image (f
, img
);
8500 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8502 /* If we can't load the image, and we don't have a width and
8503 height, use some arbitrary width and height so that we can
8504 draw a rectangle for it. */
8505 if (img
->load_failed_p
)
8509 value
= image_spec_value (spec
, QCwidth
, NULL
);
8510 img
->width
= (INTEGERP (value
)
8511 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
8512 value
= image_spec_value (spec
, QCheight
, NULL
);
8513 img
->height
= (INTEGERP (value
)
8514 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
8518 /* Handle image type independent image attributes
8519 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
8520 Lisp_Object ascent
, margin
, relief
;
8522 ascent
= image_spec_value (spec
, QCascent
, NULL
);
8523 if (INTEGERP (ascent
))
8524 img
->ascent
= XFASTINT (ascent
);
8525 else if (EQ (ascent
, Qcenter
))
8526 img
->ascent
= CENTERED_IMAGE_ASCENT
;
8528 margin
= image_spec_value (spec
, QCmargin
, NULL
);
8529 if (INTEGERP (margin
) && XINT (margin
) >= 0)
8530 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
8531 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
8532 && INTEGERP (XCDR (margin
)))
8534 if (XINT (XCAR (margin
)) > 0)
8535 img
->hmargin
= XFASTINT (XCAR (margin
));
8536 if (XINT (XCDR (margin
)) > 0)
8537 img
->vmargin
= XFASTINT (XCDR (margin
));
8540 relief
= image_spec_value (spec
, QCrelief
, NULL
);
8541 if (INTEGERP (relief
))
8543 img
->relief
= XINT (relief
);
8544 img
->hmargin
+= abs (img
->relief
);
8545 img
->vmargin
+= abs (img
->relief
);
8548 /* Do image transformations and compute masks, unless we
8549 don't have the image yet. */
8550 if (!EQ (*img
->type
->type
, Qpostscript
))
8551 postprocess_image (f
, img
);
8555 xassert (!interrupt_input_blocked
);
8558 /* We're using IMG, so set its timestamp to `now'. */
8559 EMACS_GET_TIME (now
);
8560 img
->timestamp
= EMACS_SECS (now
);
8564 /* Value is the image id. */
8569 /* Cache image IMG in the image cache of frame F. */
8572 cache_image (f
, img
)
8576 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8579 /* Find a free slot in c->images. */
8580 for (i
= 0; i
< c
->used
; ++i
)
8581 if (c
->images
[i
] == NULL
)
8584 /* If no free slot found, maybe enlarge c->images. */
8585 if (i
== c
->used
&& c
->used
== c
->size
)
8588 c
->images
= (struct image
**) xrealloc (c
->images
,
8589 c
->size
* sizeof *c
->images
);
8592 /* Add IMG to c->images, and assign IMG an id. */
8598 /* Add IMG to the cache's hash table. */
8599 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8600 img
->next
= c
->buckets
[i
];
8602 img
->next
->prev
= img
;
8604 c
->buckets
[i
] = img
;
8608 /* Call FN on every image in the image cache of frame F. Used to mark
8609 Lisp Objects in the image cache. */
8612 forall_images_in_image_cache (f
, fn
)
8614 void (*fn
) P_ ((struct image
*img
));
8616 if (FRAME_LIVE_P (f
) && FRAME_W32_P (f
))
8618 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8622 for (i
= 0; i
< c
->used
; ++i
)
8631 /***********************************************************************
8633 ***********************************************************************/
8635 #if 0 /* TODO: W32 specific image code. */
8637 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
8638 XImage
**, Pixmap
*));
8639 static void x_destroy_x_image
P_ ((XImage
*));
8640 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
8643 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
8644 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
8645 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
8646 via xmalloc. Print error messages via image_error if an error
8647 occurs. Value is non-zero if successful. */
8650 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
8652 int width
, height
, depth
;
8656 #if 0 /* TODO: Image support for W32 */
8657 Display
*display
= FRAME_W32_DISPLAY (f
);
8658 Screen
*screen
= FRAME_X_SCREEN (f
);
8659 Window window
= FRAME_W32_WINDOW (f
);
8661 xassert (interrupt_input_blocked
);
8664 depth
= DefaultDepthOfScreen (screen
);
8665 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
8666 depth
, ZPixmap
, 0, NULL
, width
, height
,
8667 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
8670 image_error ("Unable to allocate X image", Qnil
, Qnil
);
8674 /* Allocate image raster. */
8675 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
8677 /* Allocate a pixmap of the same size. */
8678 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
8681 x_destroy_x_image (*ximg
);
8683 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
8691 /* Destroy XImage XIMG. Free XIMG->data. */
8694 x_destroy_x_image (ximg
)
8697 xassert (interrupt_input_blocked
);
8702 XDestroyImage (ximg
);
8707 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
8708 are width and height of both the image and pixmap. */
8711 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
8718 xassert (interrupt_input_blocked
);
8719 gc
= XCreateGC (NULL
, pixmap
, 0, NULL
);
8720 XPutImage (NULL
, pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
8727 /***********************************************************************
8729 ***********************************************************************/
8731 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
8732 static char *slurp_file
P_ ((char *, int *));
8735 /* Find image file FILE. Look in data-directory, then
8736 x-bitmap-file-path. Value is the full name of the file found, or
8737 nil if not found. */
8740 x_find_image_file (file
)
8743 Lisp_Object file_found
, search_path
;
8744 struct gcpro gcpro1
, gcpro2
;
8748 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
8749 GCPRO2 (file_found
, search_path
);
8751 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
8752 fd
= openp (search_path
, file
, Qnil
, &file_found
, 0);
8764 /* Read FILE into memory. Value is a pointer to a buffer allocated
8765 with xmalloc holding FILE's contents. Value is null if an error
8766 occurred. *SIZE is set to the size of the file. */
8769 slurp_file (file
, size
)
8777 if (stat (file
, &st
) == 0
8778 && (fp
= fopen (file
, "r")) != NULL
8779 && (buf
= (char *) xmalloc (st
.st_size
),
8780 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
8801 /***********************************************************************
8803 ***********************************************************************/
8805 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
8806 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
8808 static int xbm_image_p
P_ ((Lisp_Object object
));
8809 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
8813 /* Indices of image specification fields in xbm_format, below. */
8815 enum xbm_keyword_index
8832 /* Vector of image_keyword structures describing the format
8833 of valid XBM image specifications. */
8835 static struct image_keyword xbm_format
[XBM_LAST
] =
8837 {":type", IMAGE_SYMBOL_VALUE
, 1},
8838 {":file", IMAGE_STRING_VALUE
, 0},
8839 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8840 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8841 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8842 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8843 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
8844 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8845 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8846 {":relief", IMAGE_INTEGER_VALUE
, 0},
8847 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8848 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8851 /* Structure describing the image type XBM. */
8853 static struct image_type xbm_type
=
8862 /* Tokens returned from xbm_scan. */
8871 /* Return non-zero if OBJECT is a valid XBM-type image specification.
8872 A valid specification is a list starting with the symbol `image'
8873 The rest of the list is a property list which must contain an
8876 If the specification specifies a file to load, it must contain
8877 an entry `:file FILENAME' where FILENAME is a string.
8879 If the specification is for a bitmap loaded from memory it must
8880 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
8881 WIDTH and HEIGHT are integers > 0. DATA may be:
8883 1. a string large enough to hold the bitmap data, i.e. it must
8884 have a size >= (WIDTH + 7) / 8 * HEIGHT
8886 2. a bool-vector of size >= WIDTH * HEIGHT
8888 3. a vector of strings or bool-vectors, one for each line of the
8891 Both the file and data forms may contain the additional entries
8892 `:background COLOR' and `:foreground COLOR'. If not present,
8893 foreground and background of the frame on which the image is
8894 displayed, is used. */
8897 xbm_image_p (object
)
8900 struct image_keyword kw
[XBM_LAST
];
8902 bcopy (xbm_format
, kw
, sizeof kw
);
8903 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
8906 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
8908 if (kw
[XBM_FILE
].count
)
8910 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
8918 /* Entries for `:width', `:height' and `:data' must be present. */
8919 if (!kw
[XBM_WIDTH
].count
8920 || !kw
[XBM_HEIGHT
].count
8921 || !kw
[XBM_DATA
].count
)
8924 data
= kw
[XBM_DATA
].value
;
8925 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
8926 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
8928 /* Check type of data, and width and height against contents of
8934 /* Number of elements of the vector must be >= height. */
8935 if (XVECTOR (data
)->size
< height
)
8938 /* Each string or bool-vector in data must be large enough
8939 for one line of the image. */
8940 for (i
= 0; i
< height
; ++i
)
8942 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
8946 if (XSTRING (elt
)->size
8947 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
8950 else if (BOOL_VECTOR_P (elt
))
8952 if (XBOOL_VECTOR (elt
)->size
< width
)
8959 else if (STRINGP (data
))
8961 if (XSTRING (data
)->size
8962 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
8965 else if (BOOL_VECTOR_P (data
))
8967 if (XBOOL_VECTOR (data
)->size
< width
* height
)
8974 /* Baseline must be a value between 0 and 100 (a percentage). */
8975 if (kw
[XBM_ASCENT
].count
8976 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
8983 /* Scan a bitmap file. FP is the stream to read from. Value is
8984 either an enumerator from enum xbm_token, or a character for a
8985 single-character token, or 0 at end of file. If scanning an
8986 identifier, store the lexeme of the identifier in SVAL. If
8987 scanning a number, store its value in *IVAL. */
8990 xbm_scan (s
, end
, sval
, ival
)
8999 /* Skip white space. */
9000 while (*s
< end
&&(c
= *(*s
)++, isspace (c
)))
9005 else if (isdigit (c
))
9007 int value
= 0, digit
;
9009 if (c
== '0' && *s
< end
)
9012 if (c
== 'x' || c
== 'X')
9019 else if (c
>= 'a' && c
<= 'f')
9020 digit
= c
- 'a' + 10;
9021 else if (c
>= 'A' && c
<= 'F')
9022 digit
= c
- 'A' + 10;
9025 value
= 16 * value
+ digit
;
9028 else if (isdigit (c
))
9032 && (c
= *(*s
)++, isdigit (c
)))
9033 value
= 8 * value
+ c
- '0';
9040 && (c
= *(*s
)++, isdigit (c
)))
9041 value
= 10 * value
+ c
- '0';
9049 else if (isalpha (c
) || c
== '_')
9053 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
9060 else if (c
== '/' && **s
== '*')
9062 /* C-style comment. */
9064 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
9077 /* Replacement for XReadBitmapFileData which isn't available under old
9078 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9079 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9080 the image. Return in *DATA the bitmap data allocated with xmalloc.
9081 Value is non-zero if successful. DATA null means just test if
9082 CONTENTS looks like an in-memory XBM file. */
9085 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
9086 char *contents
, *end
;
9087 int *width
, *height
;
9088 unsigned char **data
;
9091 char buffer
[BUFSIZ
];
9094 int bytes_per_line
, i
, nbytes
;
9100 LA1 = xbm_scan (contents, end, buffer, &value)
9102 #define expect(TOKEN) \
9103 if (LA1 != (TOKEN)) \
9108 #define expect_ident(IDENT) \
9109 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9114 *width
= *height
= -1;
9117 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
9119 /* Parse defines for width, height and hot-spots. */
9123 expect_ident ("define");
9124 expect (XBM_TK_IDENT
);
9126 if (LA1
== XBM_TK_NUMBER
);
9128 char *p
= strrchr (buffer
, '_');
9129 p
= p
? p
+ 1 : buffer
;
9130 if (strcmp (p
, "width") == 0)
9132 else if (strcmp (p
, "height") == 0)
9135 expect (XBM_TK_NUMBER
);
9138 if (*width
< 0 || *height
< 0)
9140 else if (data
== NULL
)
9143 /* Parse bits. Must start with `static'. */
9144 expect_ident ("static");
9145 if (LA1
== XBM_TK_IDENT
)
9147 if (strcmp (buffer
, "unsigned") == 0)
9150 expect_ident ("char");
9152 else if (strcmp (buffer
, "short") == 0)
9156 if (*width
% 16 && *width
% 16 < 9)
9159 else if (strcmp (buffer
, "char") == 0)
9167 expect (XBM_TK_IDENT
);
9173 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
9174 nbytes
= bytes_per_line
* *height
;
9175 p
= *data
= (char *) xmalloc (nbytes
);
9180 for (i
= 0; i
< nbytes
; i
+= 2)
9183 expect (XBM_TK_NUMBER
);
9186 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
9189 if (LA1
== ',' || LA1
== '}')
9197 for (i
= 0; i
< nbytes
; ++i
)
9200 expect (XBM_TK_NUMBER
);
9204 if (LA1
== ',' || LA1
== '}')
9229 /* Load XBM image IMG which will be displayed on frame F from buffer
9230 CONTENTS. END is the end of the buffer. Value is non-zero if
9234 xbm_load_image (f
, img
, contents
, end
)
9237 char *contents
, *end
;
9240 unsigned char *data
;
9243 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
9246 int depth
= one_w32_display_info
.n_cbits
;
9247 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
9248 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
9251 xassert (img
->width
> 0 && img
->height
> 0);
9253 /* Get foreground and background colors, maybe allocate colors. */
9254 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
9256 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
9258 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
9260 background
= x_alloc_image_color (f
, img
, value
, background
);
9262 #if 0 /* TODO : Port image display to W32 */
9264 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f
),
9265 FRAME_W32_WINDOW (f
),
9267 img
->width
, img
->height
,
9268 foreground
, background
,
9272 if (img
->pixmap
== 0)
9274 x_clear_image (f
, img
);
9275 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
9282 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
9288 /* Value is non-zero if DATA looks like an in-memory XBM file. */
9295 return (STRINGP (data
)
9296 && xbm_read_bitmap_data (XSTRING (data
)->data
,
9297 (XSTRING (data
)->data
9298 + STRING_BYTES (XSTRING (data
))),
9303 /* Fill image IMG which is used on frame F with pixmap data. Value is
9304 non-zero if successful. */
9312 Lisp_Object file_name
;
9314 xassert (xbm_image_p (img
->spec
));
9316 /* If IMG->spec specifies a file name, create a non-file spec from it. */
9317 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
9318 if (STRINGP (file_name
))
9323 struct gcpro gcpro1
;
9325 file
= x_find_image_file (file_name
);
9327 if (!STRINGP (file
))
9329 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
9334 contents
= slurp_file (XSTRING (file
)->data
, &size
);
9335 if (contents
== NULL
)
9337 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
9342 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
9347 struct image_keyword fmt
[XBM_LAST
];
9350 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
9351 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
9354 int in_memory_file_p
= 0;
9356 /* See if data looks like an in-memory XBM file. */
9357 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9358 in_memory_file_p
= xbm_file_p (data
);
9360 /* Parse the list specification. */
9361 bcopy (xbm_format
, fmt
, sizeof fmt
);
9362 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
9365 /* Get specified width, and height. */
9366 if (!in_memory_file_p
)
9368 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
9369 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
9370 xassert (img
->width
> 0 && img
->height
> 0);
9372 /* Get foreground and background colors, maybe allocate colors. */
9373 if (fmt
[XBM_FOREGROUND
].count
9374 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
9375 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
9377 if (fmt
[XBM_BACKGROUND
].count
9378 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
9379 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
9382 if (in_memory_file_p
)
9383 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
9384 (XSTRING (data
)->data
9385 + STRING_BYTES (XSTRING (data
))));
9392 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
9394 p
= bits
= (char *) alloca (nbytes
* img
->height
);
9395 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
9397 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
9399 bcopy (XSTRING (line
)->data
, p
, nbytes
);
9401 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
9404 else if (STRINGP (data
))
9405 bits
= XSTRING (data
)->data
;
9407 bits
= XBOOL_VECTOR (data
)->data
;
9408 #ifdef TODO /* image support. */
9409 /* Create the pixmap. */
9410 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
9412 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
9415 img
->width
, img
->height
,
9416 foreground
, background
,
9423 image_error ("Unable to create pixmap for XBM image `%s'",
9425 x_clear_image (f
, img
);
9435 /***********************************************************************
9437 ***********************************************************************/
9441 static int xpm_image_p
P_ ((Lisp_Object object
));
9442 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
9443 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
9445 #include "X11/xpm.h"
9447 /* The symbol `xpm' identifying XPM-format images. */
9451 /* Indices of image specification fields in xpm_format, below. */
9453 enum xpm_keyword_index
9467 /* Vector of image_keyword structures describing the format
9468 of valid XPM image specifications. */
9470 static struct image_keyword xpm_format
[XPM_LAST
] =
9472 {":type", IMAGE_SYMBOL_VALUE
, 1},
9473 {":file", IMAGE_STRING_VALUE
, 0},
9474 {":data", IMAGE_STRING_VALUE
, 0},
9475 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9476 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9477 {":relief", IMAGE_INTEGER_VALUE
, 0},
9478 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9479 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9480 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9483 /* Structure describing the image type XBM. */
9485 static struct image_type xpm_type
=
9495 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
9496 for XPM images. Such a list must consist of conses whose car and
9500 xpm_valid_color_symbols_p (color_symbols
)
9501 Lisp_Object color_symbols
;
9503 while (CONSP (color_symbols
))
9505 Lisp_Object sym
= XCAR (color_symbols
);
9507 || !STRINGP (XCAR (sym
))
9508 || !STRINGP (XCDR (sym
)))
9510 color_symbols
= XCDR (color_symbols
);
9513 return NILP (color_symbols
);
9517 /* Value is non-zero if OBJECT is a valid XPM image specification. */
9520 xpm_image_p (object
)
9523 struct image_keyword fmt
[XPM_LAST
];
9524 bcopy (xpm_format
, fmt
, sizeof fmt
);
9525 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
9526 /* Either `:file' or `:data' must be present. */
9527 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
9528 /* Either no `:color-symbols' or it's a list of conses
9529 whose car and cdr are strings. */
9530 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
9531 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
9532 && (fmt
[XPM_ASCENT
].count
== 0
9533 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
9537 /* Load image IMG which will be displayed on frame F. Value is
9538 non-zero if successful. */
9546 XpmAttributes attrs
;
9547 Lisp_Object specified_file
, color_symbols
;
9549 /* Configure the XPM lib. Use the visual of frame F. Allocate
9550 close colors. Return colors allocated. */
9551 bzero (&attrs
, sizeof attrs
);
9552 attrs
.visual
= FRAME_X_VISUAL (f
);
9553 attrs
.colormap
= FRAME_X_COLORMAP (f
);
9554 attrs
.valuemask
|= XpmVisual
;
9555 attrs
.valuemask
|= XpmColormap
;
9556 attrs
.valuemask
|= XpmReturnAllocPixels
;
9557 #ifdef XpmAllocCloseColors
9558 attrs
.alloc_close_colors
= 1;
9559 attrs
.valuemask
|= XpmAllocCloseColors
;
9561 attrs
.closeness
= 600;
9562 attrs
.valuemask
|= XpmCloseness
;
9565 /* If image specification contains symbolic color definitions, add
9566 these to `attrs'. */
9567 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
9568 if (CONSP (color_symbols
))
9571 XpmColorSymbol
*xpm_syms
;
9574 attrs
.valuemask
|= XpmColorSymbols
;
9576 /* Count number of symbols. */
9577 attrs
.numsymbols
= 0;
9578 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
9581 /* Allocate an XpmColorSymbol array. */
9582 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
9583 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
9584 bzero (xpm_syms
, size
);
9585 attrs
.colorsymbols
= xpm_syms
;
9587 /* Fill the color symbol array. */
9588 for (tail
= color_symbols
, i
= 0;
9590 ++i
, tail
= XCDR (tail
))
9592 Lisp_Object name
= XCAR (XCAR (tail
));
9593 Lisp_Object color
= XCDR (XCAR (tail
));
9594 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
9595 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
9596 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
9597 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
9601 /* Create a pixmap for the image, either from a file, or from a
9602 string buffer containing data in the same format as an XPM file. */
9604 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9605 if (STRINGP (specified_file
))
9607 Lisp_Object file
= x_find_image_file (specified_file
);
9608 if (!STRINGP (file
))
9610 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9615 rc
= XpmReadFileToPixmap (NULL
, FRAME_W32_WINDOW (f
),
9616 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
9621 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
9622 rc
= XpmCreatePixmapFromBuffer (NULL
, FRAME_W32_WINDOW (f
),
9623 XSTRING (buffer
)->data
,
9624 &img
->pixmap
, &img
->mask
,
9629 if (rc
== XpmSuccess
)
9631 /* Remember allocated colors. */
9632 img
->ncolors
= attrs
.nalloc_pixels
;
9633 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
9634 * sizeof *img
->colors
);
9635 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
9636 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
9638 img
->width
= attrs
.width
;
9639 img
->height
= attrs
.height
;
9640 xassert (img
->width
> 0 && img
->height
> 0);
9642 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
9644 XpmFreeAttributes (&attrs
);
9652 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
9655 case XpmFileInvalid
:
9656 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
9660 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
9663 case XpmColorFailed
:
9664 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
9668 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
9673 return rc
== XpmSuccess
;
9676 #endif /* HAVE_XPM != 0 */
9679 #if 0 /* TODO : Color tables on W32. */
9680 /***********************************************************************
9682 ***********************************************************************/
9684 /* An entry in the color table mapping an RGB color to a pixel color. */
9689 unsigned long pixel
;
9691 /* Next in color table collision list. */
9692 struct ct_color
*next
;
9695 /* The bucket vector size to use. Must be prime. */
9699 /* Value is a hash of the RGB color given by R, G, and B. */
9701 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
9703 /* The color hash table. */
9705 struct ct_color
**ct_table
;
9707 /* Number of entries in the color table. */
9709 int ct_colors_allocated
;
9711 /* Function prototypes. */
9713 static void init_color_table
P_ ((void));
9714 static void free_color_table
P_ ((void));
9715 static unsigned long *colors_in_color_table
P_ ((int *n
));
9716 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
9717 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
9720 /* Initialize the color table. */
9725 int size
= CT_SIZE
* sizeof (*ct_table
);
9726 ct_table
= (struct ct_color
**) xmalloc (size
);
9727 bzero (ct_table
, size
);
9728 ct_colors_allocated
= 0;
9732 /* Free memory associated with the color table. */
9738 struct ct_color
*p
, *next
;
9740 for (i
= 0; i
< CT_SIZE
; ++i
)
9741 for (p
= ct_table
[i
]; p
; p
= next
)
9752 /* Value is a pixel color for RGB color R, G, B on frame F. If an
9753 entry for that color already is in the color table, return the
9754 pixel color of that entry. Otherwise, allocate a new color for R,
9755 G, B, and make an entry in the color table. */
9757 static unsigned long
9758 lookup_rgb_color (f
, r
, g
, b
)
9762 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
9763 int i
= hash
% CT_SIZE
;
9766 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9767 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
9776 color
= PALETTERGB (r
, g
, b
);
9778 ++ct_colors_allocated
;
9780 p
= (struct ct_color
*) xmalloc (sizeof *p
);
9785 p
->next
= ct_table
[i
];
9793 /* Look up pixel color PIXEL which is used on frame F in the color
9794 table. If not already present, allocate it. Value is PIXEL. */
9796 static unsigned long
9797 lookup_pixel_color (f
, pixel
)
9799 unsigned long pixel
;
9801 int i
= pixel
% CT_SIZE
;
9804 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9805 if (p
->pixel
== pixel
)
9816 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9817 color
.pixel
= pixel
;
9818 XQueryColor (NULL
, cmap
, &color
);
9819 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
9824 ++ct_colors_allocated
;
9826 p
= (struct ct_color
*) xmalloc (sizeof *p
);
9831 p
->next
= ct_table
[i
];
9835 return FRAME_FOREGROUND_PIXEL (f
);
9841 /* Value is a vector of all pixel colors contained in the color table,
9842 allocated via xmalloc. Set *N to the number of colors. */
9844 static unsigned long *
9845 colors_in_color_table (n
)
9850 unsigned long *colors
;
9852 if (ct_colors_allocated
== 0)
9859 colors
= (unsigned long *) xmalloc (ct_colors_allocated
9861 *n
= ct_colors_allocated
;
9863 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
9864 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9865 colors
[j
++] = p
->pixel
;
9874 /***********************************************************************
9876 ***********************************************************************/
9877 #if 0 /* TODO: image support. */
9878 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
9879 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
9880 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
9882 /* Non-zero means draw a cross on images having `:conversion
9885 int cross_disabled_images
;
9887 /* Edge detection matrices for different edge-detection
9890 static int emboss_matrix
[9] = {
9892 2, -1, 0, /* y - 1 */
9894 0, 1, -2 /* y + 1 */
9897 static int laplace_matrix
[9] = {
9899 1, 0, 0, /* y - 1 */
9901 0, 0, -1 /* y + 1 */
9904 /* Value is the intensity of the color whose red/green/blue values
9907 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
9910 /* On frame F, return an array of XColor structures describing image
9911 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
9912 non-zero means also fill the red/green/blue members of the XColor
9913 structures. Value is a pointer to the array of XColors structures,
9914 allocated with xmalloc; it must be freed by the caller. */
9917 x_to_xcolors (f
, img
, rgb_p
)
9926 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
9928 /* Get the X image IMG->pixmap. */
9929 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9930 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9932 /* Fill the `pixel' members of the XColor array. I wished there
9933 were an easy and portable way to circumvent XGetPixel. */
9935 for (y
= 0; y
< img
->height
; ++y
)
9939 for (x
= 0; x
< img
->width
; ++x
, ++p
)
9940 p
->pixel
= XGetPixel (ximg
, x
, y
);
9943 x_query_colors (f
, row
, img
->width
);
9946 XDestroyImage (ximg
);
9951 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
9952 RGB members are set. F is the frame on which this all happens.
9953 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
9956 x_from_xcolors (f
, img
, colors
)
9966 init_color_table ();
9968 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
9971 for (y
= 0; y
< img
->height
; ++y
)
9972 for (x
= 0; x
< img
->width
; ++x
, ++p
)
9974 unsigned long pixel
;
9975 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
9976 XPutPixel (oimg
, x
, y
, pixel
);
9980 x_clear_image_1 (f
, img
, 1, 0, 1);
9982 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
9983 x_destroy_x_image (oimg
);
9984 img
->pixmap
= pixmap
;
9985 img
->colors
= colors_in_color_table (&img
->ncolors
);
9986 free_color_table ();
9990 /* On frame F, perform edge-detection on image IMG.
9992 MATRIX is a nine-element array specifying the transformation
9993 matrix. See emboss_matrix for an example.
9995 COLOR_ADJUST is a color adjustment added to each pixel of the
9999 x_detect_edges (f
, img
, matrix
, color_adjust
)
10002 int matrix
[9], color_adjust
;
10004 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10008 for (i
= sum
= 0; i
< 9; ++i
)
10009 sum
+= abs (matrix
[i
]);
10011 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
10013 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
10015 for (y
= 0; y
< img
->height
; ++y
)
10017 p
= COLOR (new, 0, y
);
10018 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10019 p
= COLOR (new, img
->width
- 1, y
);
10020 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10023 for (x
= 1; x
< img
->width
- 1; ++x
)
10025 p
= COLOR (new, x
, 0);
10026 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10027 p
= COLOR (new, x
, img
->height
- 1);
10028 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10031 for (y
= 1; y
< img
->height
- 1; ++y
)
10033 p
= COLOR (new, 1, y
);
10035 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
10037 int r
, g
, b
, y1
, x1
;
10040 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
10041 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
10044 XColor
*t
= COLOR (colors
, x1
, y1
);
10045 r
+= matrix
[i
] * t
->red
;
10046 g
+= matrix
[i
] * t
->green
;
10047 b
+= matrix
[i
] * t
->blue
;
10050 r
= (r
/ sum
+ color_adjust
) & 0xffff;
10051 g
= (g
/ sum
+ color_adjust
) & 0xffff;
10052 b
= (b
/ sum
+ color_adjust
) & 0xffff;
10053 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
10058 x_from_xcolors (f
, img
, new);
10064 /* Perform the pre-defined `emboss' edge-detection on image IMG
10072 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
10076 /* Transform image IMG which is used on frame F with a Laplace
10077 edge-detection algorithm. The result is an image that can be used
10078 to draw disabled buttons, for example. */
10085 x_detect_edges (f
, img
, laplace_matrix
, 45000);
10089 /* Perform edge-detection on image IMG on frame F, with specified
10090 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
10092 MATRIX must be either
10094 - a list of at least 9 numbers in row-major form
10095 - a vector of at least 9 numbers
10097 COLOR_ADJUST nil means use a default; otherwise it must be a
10101 x_edge_detection (f
, img
, matrix
, color_adjust
)
10104 Lisp_Object matrix
, color_adjust
;
10109 if (CONSP (matrix
))
10112 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
10113 ++i
, matrix
= XCDR (matrix
))
10114 trans
[i
] = XFLOATINT (XCAR (matrix
));
10116 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
10118 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
10119 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
10122 if (NILP (color_adjust
))
10123 color_adjust
= make_number (0xffff / 2);
10125 if (i
== 9 && NUMBERP (color_adjust
))
10126 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
10130 /* Transform image IMG on frame F so that it looks disabled. */
10133 x_disable_image (f
, img
)
10137 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
10139 if (dpyinfo
->n_planes
>= 2)
10141 /* Color (or grayscale). Convert to gray, and equalize. Just
10142 drawing such images with a stipple can look very odd, so
10143 we're using this method instead. */
10144 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10146 const int h
= 15000;
10147 const int l
= 30000;
10149 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
10153 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
10154 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
10155 p
->red
= p
->green
= p
->blue
= i2
;
10158 x_from_xcolors (f
, img
, colors
);
10161 /* Draw a cross over the disabled image, if we must or if we
10163 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
10165 Display
*dpy
= FRAME_X_DISPLAY (f
);
10168 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
10169 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
10170 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
10171 img
->width
- 1, img
->height
- 1);
10172 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
10173 img
->width
- 1, 0);
10178 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
10179 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
10180 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
10181 img
->width
- 1, img
->height
- 1);
10182 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
10183 img
->width
- 1, 0);
10190 /* Build a mask for image IMG which is used on frame F. FILE is the
10191 name of an image file, for error messages. HOW determines how to
10192 determine the background color of IMG. If it is a list '(R G B)',
10193 with R, G, and B being integers >= 0, take that as the color of the
10194 background. Otherwise, determine the background color of IMG
10195 heuristically. Value is non-zero if successful. */
10198 x_build_heuristic_mask (f
, img
, how
)
10203 Display
*dpy
= FRAME_W32_DISPLAY (f
);
10204 XImage
*ximg
, *mask_img
;
10205 int x
, y
, rc
, look_at_corners_p
;
10210 /* Create an image and pixmap serving as mask. */
10211 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
10212 &mask_img
, &img
->mask
);
10219 /* Get the X image of IMG->pixmap. */
10220 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
10223 /* Determine the background color of ximg. If HOW is `(R G B)'
10224 take that as color. Otherwise, try to determine the color
10226 look_at_corners_p
= 1;
10234 && NATNUMP (XCAR (how
)))
10236 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
10240 if (i
== 3 && NILP (how
))
10242 char color_name
[30];
10243 XColor exact
, color
;
10246 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
10248 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
10249 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
10252 look_at_corners_p
= 0;
10257 if (look_at_corners_p
)
10259 unsigned long corners
[4];
10262 /* Get the colors at the corners of ximg. */
10263 corners
[0] = XGetPixel (ximg
, 0, 0);
10264 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
10265 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
10266 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
10268 /* Choose the most frequently found color as background. */
10269 for (i
= best_count
= 0; i
< 4; ++i
)
10273 for (j
= n
= 0; j
< 4; ++j
)
10274 if (corners
[i
] == corners
[j
])
10277 if (n
> best_count
)
10278 bg
= corners
[i
], best_count
= n
;
10282 /* Set all bits in mask_img to 1 whose color in ximg is different
10283 from the background color bg. */
10284 for (y
= 0; y
< img
->height
; ++y
)
10285 for (x
= 0; x
< img
->width
; ++x
)
10286 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
10288 /* Put mask_img into img->mask. */
10289 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
10290 x_destroy_x_image (mask_img
);
10291 XDestroyImage (ximg
);
10300 /***********************************************************************
10301 PBM (mono, gray, color)
10302 ***********************************************************************/
10305 static int pbm_image_p
P_ ((Lisp_Object object
));
10306 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
10307 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
10309 /* The symbol `pbm' identifying images of this type. */
10313 /* Indices of image specification fields in gs_format, below. */
10315 enum pbm_keyword_index
10324 PBM_HEURISTIC_MASK
,
10328 /* Vector of image_keyword structures describing the format
10329 of valid user-defined image specifications. */
10331 static struct image_keyword pbm_format
[PBM_LAST
] =
10333 {":type", IMAGE_SYMBOL_VALUE
, 1},
10334 {":file", IMAGE_STRING_VALUE
, 0},
10335 {":data", IMAGE_STRING_VALUE
, 0},
10336 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10337 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10338 {":relief", IMAGE_INTEGER_VALUE
, 0},
10339 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10340 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10341 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10342 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
10343 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10346 /* Structure describing the image type `pbm'. */
10348 static struct image_type pbm_type
=
10358 /* Return non-zero if OBJECT is a valid PBM image specification. */
10361 pbm_image_p (object
)
10362 Lisp_Object object
;
10364 struct image_keyword fmt
[PBM_LAST
];
10366 bcopy (pbm_format
, fmt
, sizeof fmt
);
10368 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
10369 || (fmt
[PBM_ASCENT
].count
10370 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
10373 /* Must specify either :data or :file. */
10374 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
10378 /* Scan a decimal number from *S and return it. Advance *S while
10379 reading the number. END is the end of the string. Value is -1 at
10383 pbm_scan_number (s
, end
)
10384 unsigned char **s
, *end
;
10390 /* Skip white-space. */
10391 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
10396 /* Skip comment to end of line. */
10397 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
10400 else if (isdigit (c
))
10402 /* Read decimal number. */
10404 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
10405 val
= 10 * val
+ c
- '0';
10416 /* Read FILE into memory. Value is a pointer to a buffer allocated
10417 with xmalloc holding FILE's contents. Value is null if an error
10418 occured. *SIZE is set to the size of the file. */
10421 pbm_read_file (file
, size
)
10429 if (stat (XSTRING (file
)->data
, &st
) == 0
10430 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
10431 && (buf
= (char *) xmalloc (st
.st_size
),
10432 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
10434 *size
= st
.st_size
;
10452 /* Load PBM image IMG for use on frame F. */
10460 int width
, height
, max_color_idx
= 0;
10462 Lisp_Object file
, specified_file
;
10463 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
10464 struct gcpro gcpro1
;
10465 unsigned char *contents
= NULL
;
10466 unsigned char *end
, *p
;
10469 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10473 if (STRINGP (specified_file
))
10475 file
= x_find_image_file (specified_file
);
10476 if (!STRINGP (file
))
10478 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10483 contents
= slurp_file (XSTRING (file
)->data
, &size
);
10484 if (contents
== NULL
)
10486 image_error ("Error reading `%s'", file
, Qnil
);
10492 end
= contents
+ size
;
10497 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10498 p
= XSTRING (data
)->data
;
10499 end
= p
+ STRING_BYTES (XSTRING (data
));
10502 /* Check magic number. */
10503 if (end
- p
< 2 || *p
++ != 'P')
10505 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10515 raw_p
= 0, type
= PBM_MONO
;
10519 raw_p
= 0, type
= PBM_GRAY
;
10523 raw_p
= 0, type
= PBM_COLOR
;
10527 raw_p
= 1, type
= PBM_MONO
;
10531 raw_p
= 1, type
= PBM_GRAY
;
10535 raw_p
= 1, type
= PBM_COLOR
;
10539 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10543 /* Read width, height, maximum color-component. Characters
10544 starting with `#' up to the end of a line are ignored. */
10545 width
= pbm_scan_number (&p
, end
);
10546 height
= pbm_scan_number (&p
, end
);
10548 if (type
!= PBM_MONO
)
10550 max_color_idx
= pbm_scan_number (&p
, end
);
10551 if (raw_p
&& max_color_idx
> 255)
10552 max_color_idx
= 255;
10557 || (type
!= PBM_MONO
&& max_color_idx
< 0))
10560 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
10561 &ximg
, &img
->pixmap
))
10564 /* Initialize the color hash table. */
10565 init_color_table ();
10567 if (type
== PBM_MONO
)
10570 struct image_keyword fmt
[PBM_LAST
];
10571 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
10572 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
10574 /* Parse the image specification. */
10575 bcopy (pbm_format
, fmt
, sizeof fmt
);
10576 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
10578 /* Get foreground and background colors, maybe allocate colors. */
10579 if (fmt
[PBM_FOREGROUND
].count
10580 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
10581 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
10582 if (fmt
[PBM_BACKGROUND
].count
10583 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
10584 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
10586 for (y
= 0; y
< height
; ++y
)
10587 for (x
= 0; x
< width
; ++x
)
10597 g
= pbm_scan_number (&p
, end
);
10599 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
10604 for (y
= 0; y
< height
; ++y
)
10605 for (x
= 0; x
< width
; ++x
)
10609 if (type
== PBM_GRAY
)
10610 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
10619 r
= pbm_scan_number (&p
, end
);
10620 g
= pbm_scan_number (&p
, end
);
10621 b
= pbm_scan_number (&p
, end
);
10624 if (r
< 0 || g
< 0 || b
< 0)
10626 xfree (ximg
->data
);
10628 XDestroyImage (ximg
);
10629 image_error ("Invalid pixel value in image `%s'",
10634 /* RGB values are now in the range 0..max_color_idx.
10635 Scale this to the range 0..0xffff supported by X. */
10636 r
= (double) r
* 65535 / max_color_idx
;
10637 g
= (double) g
* 65535 / max_color_idx
;
10638 b
= (double) b
* 65535 / max_color_idx
;
10639 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
10643 /* Store in IMG->colors the colors allocated for the image, and
10644 free the color table. */
10645 img
->colors
= colors_in_color_table (&img
->ncolors
);
10646 free_color_table ();
10648 /* Put the image into a pixmap. */
10649 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10650 x_destroy_x_image (ximg
);
10652 img
->width
= width
;
10653 img
->height
= height
;
10659 #endif /* HAVE_PBM */
10662 /***********************************************************************
10664 ***********************************************************************/
10670 /* Function prototypes. */
10672 static int png_image_p
P_ ((Lisp_Object object
));
10673 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
10675 /* The symbol `png' identifying images of this type. */
10679 /* Indices of image specification fields in png_format, below. */
10681 enum png_keyword_index
10690 PNG_HEURISTIC_MASK
,
10694 /* Vector of image_keyword structures describing the format
10695 of valid user-defined image specifications. */
10697 static struct image_keyword png_format
[PNG_LAST
] =
10699 {":type", IMAGE_SYMBOL_VALUE
, 1},
10700 {":data", IMAGE_STRING_VALUE
, 0},
10701 {":file", IMAGE_STRING_VALUE
, 0},
10702 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10703 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10704 {":relief", IMAGE_INTEGER_VALUE
, 0},
10705 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10706 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
10709 /* Structure describing the image type `png'. */
10711 static struct image_type png_type
=
10721 /* Return non-zero if OBJECT is a valid PNG image specification. */
10724 png_image_p (object
)
10725 Lisp_Object object
;
10727 struct image_keyword fmt
[PNG_LAST
];
10728 bcopy (png_format
, fmt
, sizeof fmt
);
10730 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
10731 || (fmt
[PNG_ASCENT
].count
10732 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
10735 /* Must specify either the :data or :file keyword. */
10736 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
10740 /* Error and warning handlers installed when the PNG library
10744 my_png_error (png_ptr
, msg
)
10745 png_struct
*png_ptr
;
10748 xassert (png_ptr
!= NULL
);
10749 image_error ("PNG error: %s", build_string (msg
), Qnil
);
10750 longjmp (png_ptr
->jmpbuf
, 1);
10755 my_png_warning (png_ptr
, msg
)
10756 png_struct
*png_ptr
;
10759 xassert (png_ptr
!= NULL
);
10760 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
10763 /* Memory source for PNG decoding. */
10765 struct png_memory_storage
10767 unsigned char *bytes
; /* The data */
10768 size_t len
; /* How big is it? */
10769 int index
; /* Where are we? */
10773 /* Function set as reader function when reading PNG image from memory.
10774 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
10775 bytes from the input to DATA. */
10778 png_read_from_memory (png_ptr
, data
, length
)
10779 png_structp png_ptr
;
10783 struct png_memory_storage
*tbr
10784 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
10786 if (length
> tbr
->len
- tbr
->index
)
10787 png_error (png_ptr
, "Read error");
10789 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
10790 tbr
->index
= tbr
->index
+ length
;
10793 /* Load PNG image IMG for use on frame F. Value is non-zero if
10801 Lisp_Object file
, specified_file
;
10802 Lisp_Object specified_data
;
10804 XImage
*ximg
, *mask_img
= NULL
;
10805 struct gcpro gcpro1
;
10806 png_struct
*png_ptr
= NULL
;
10807 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
10810 png_byte
*pixels
= NULL
;
10811 png_byte
**rows
= NULL
;
10812 png_uint_32 width
, height
;
10813 int bit_depth
, color_type
, interlace_type
;
10815 png_uint_32 row_bytes
;
10818 double screen_gamma
, image_gamma
;
10820 struct png_memory_storage tbr
; /* Data to be read */
10822 /* Find out what file to load. */
10823 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10824 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10828 if (NILP (specified_data
))
10830 file
= x_find_image_file (specified_file
);
10831 if (!STRINGP (file
))
10833 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10838 /* Open the image file. */
10839 fp
= fopen (XSTRING (file
)->data
, "rb");
10842 image_error ("Cannot open image file `%s'", file
, Qnil
);
10848 /* Check PNG signature. */
10849 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
10850 || !png_check_sig (sig
, sizeof sig
))
10852 image_error ("Not a PNG file:` %s'", file
, Qnil
);
10860 /* Read from memory. */
10861 tbr
.bytes
= XSTRING (specified_data
)->data
;
10862 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
10865 /* Check PNG signature. */
10866 if (tbr
.len
< sizeof sig
10867 || !png_check_sig (tbr
.bytes
, sizeof sig
))
10869 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
10874 /* Need to skip past the signature. */
10875 tbr
.bytes
+= sizeof (sig
);
10878 /* Initialize read and info structs for PNG lib. */
10879 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
10880 my_png_error
, my_png_warning
);
10883 if (fp
) fclose (fp
);
10888 info_ptr
= png_create_info_struct (png_ptr
);
10891 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
10892 if (fp
) fclose (fp
);
10897 end_info
= png_create_info_struct (png_ptr
);
10900 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
10901 if (fp
) fclose (fp
);
10906 /* Set error jump-back. We come back here when the PNG library
10907 detects an error. */
10908 if (setjmp (png_ptr
->jmpbuf
))
10912 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
10915 if (fp
) fclose (fp
);
10920 /* Read image info. */
10921 if (!NILP (specified_data
))
10922 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
10924 png_init_io (png_ptr
, fp
);
10926 png_set_sig_bytes (png_ptr
, sizeof sig
);
10927 png_read_info (png_ptr
, info_ptr
);
10928 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
10929 &interlace_type
, NULL
, NULL
);
10931 /* If image contains simply transparency data, we prefer to
10932 construct a clipping mask. */
10933 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
10938 /* This function is easier to write if we only have to handle
10939 one data format: RGB or RGBA with 8 bits per channel. Let's
10940 transform other formats into that format. */
10942 /* Strip more than 8 bits per channel. */
10943 if (bit_depth
== 16)
10944 png_set_strip_16 (png_ptr
);
10946 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
10948 png_set_expand (png_ptr
);
10950 /* Convert grayscale images to RGB. */
10951 if (color_type
== PNG_COLOR_TYPE_GRAY
10952 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
10953 png_set_gray_to_rgb (png_ptr
);
10955 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
10956 gamma_str
= getenv ("SCREEN_GAMMA");
10957 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
10959 /* Tell the PNG lib to handle gamma correction for us. */
10961 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
10962 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
10963 /* There is a special chunk in the image specifying the gamma. */
10964 png_set_sRGB (png_ptr
, info_ptr
, intent
);
10967 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
10968 /* Image contains gamma information. */
10969 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
10971 /* Use a default of 0.5 for the image gamma. */
10972 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
10974 /* Handle alpha channel by combining the image with a background
10975 color. Do this only if a real alpha channel is supplied. For
10976 simple transparency, we prefer a clipping mask. */
10977 if (!transparent_p
)
10979 png_color_16
*image_background
;
10981 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
10982 /* Image contains a background color with which to
10983 combine the image. */
10984 png_set_background (png_ptr
, image_background
,
10985 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
10988 /* Image does not contain a background color with which
10989 to combine the image data via an alpha channel. Use
10990 the frame's background instead. */
10993 png_color_16 frame_background
;
10996 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
10997 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
10998 XQueryColor (FRAME_W32_DISPLAY (f
), cmap
, &color
);
11001 bzero (&frame_background
, sizeof frame_background
);
11002 frame_background
.red
= color
.red
;
11003 frame_background
.green
= color
.green
;
11004 frame_background
.blue
= color
.blue
;
11006 png_set_background (png_ptr
, &frame_background
,
11007 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
11011 /* Update info structure. */
11012 png_read_update_info (png_ptr
, info_ptr
);
11014 /* Get number of channels. Valid values are 1 for grayscale images
11015 and images with a palette, 2 for grayscale images with transparency
11016 information (alpha channel), 3 for RGB images, and 4 for RGB
11017 images with alpha channel, i.e. RGBA. If conversions above were
11018 sufficient we should only have 3 or 4 channels here. */
11019 channels
= png_get_channels (png_ptr
, info_ptr
);
11020 xassert (channels
== 3 || channels
== 4);
11022 /* Number of bytes needed for one row of the image. */
11023 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
11025 /* Allocate memory for the image. */
11026 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
11027 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
11028 for (i
= 0; i
< height
; ++i
)
11029 rows
[i
] = pixels
+ i
* row_bytes
;
11031 /* Read the entire image. */
11032 png_read_image (png_ptr
, rows
);
11033 png_read_end (png_ptr
, info_ptr
);
11042 /* Create the X image and pixmap. */
11043 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
11050 /* Create an image and pixmap serving as mask if the PNG image
11051 contains an alpha channel. */
11054 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
11055 &mask_img
, &img
->mask
))
11057 x_destroy_x_image (ximg
);
11058 XFreePixmap (FRAME_W32_DISPLAY (f
), img
->pixmap
);
11064 /* Fill the X image and mask from PNG data. */
11065 init_color_table ();
11067 for (y
= 0; y
< height
; ++y
)
11069 png_byte
*p
= rows
[y
];
11071 for (x
= 0; x
< width
; ++x
)
11078 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
11080 /* An alpha channel, aka mask channel, associates variable
11081 transparency with an image. Where other image formats
11082 support binary transparency---fully transparent or fully
11083 opaque---PNG allows up to 254 levels of partial transparency.
11084 The PNG library implements partial transparency by combining
11085 the image with a specified background color.
11087 I'm not sure how to handle this here nicely: because the
11088 background on which the image is displayed may change, for
11089 real alpha channel support, it would be necessary to create
11090 a new image for each possible background.
11092 What I'm doing now is that a mask is created if we have
11093 boolean transparency information. Otherwise I'm using
11094 the frame's background color to combine the image with. */
11099 XPutPixel (mask_img
, x
, y
, *p
> 0);
11105 /* Remember colors allocated for this image. */
11106 img
->colors
= colors_in_color_table (&img
->ncolors
);
11107 free_color_table ();
11110 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
11114 img
->width
= width
;
11115 img
->height
= height
;
11117 /* Put the image into the pixmap, then free the X image and its buffer. */
11118 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11119 x_destroy_x_image (ximg
);
11121 /* Same for the mask. */
11124 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
11125 x_destroy_x_image (mask_img
);
11133 #endif /* HAVE_PNG != 0 */
11137 /***********************************************************************
11139 ***********************************************************************/
11143 /* Work around a warning about HAVE_STDLIB_H being redefined in
11145 #ifdef HAVE_STDLIB_H
11146 #define HAVE_STDLIB_H_1
11147 #undef HAVE_STDLIB_H
11148 #endif /* HAVE_STLIB_H */
11150 #include <jpeglib.h>
11151 #include <jerror.h>
11152 #include <setjmp.h>
11154 #ifdef HAVE_STLIB_H_1
11155 #define HAVE_STDLIB_H 1
11158 static int jpeg_image_p
P_ ((Lisp_Object object
));
11159 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
11161 /* The symbol `jpeg' identifying images of this type. */
11165 /* Indices of image specification fields in gs_format, below. */
11167 enum jpeg_keyword_index
11176 JPEG_HEURISTIC_MASK
,
11180 /* Vector of image_keyword structures describing the format
11181 of valid user-defined image specifications. */
11183 static struct image_keyword jpeg_format
[JPEG_LAST
] =
11185 {":type", IMAGE_SYMBOL_VALUE
, 1},
11186 {":data", IMAGE_STRING_VALUE
, 0},
11187 {":file", IMAGE_STRING_VALUE
, 0},
11188 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11189 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11190 {":relief", IMAGE_INTEGER_VALUE
, 0},
11191 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11192 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
11195 /* Structure describing the image type `jpeg'. */
11197 static struct image_type jpeg_type
=
11207 /* Return non-zero if OBJECT is a valid JPEG image specification. */
11210 jpeg_image_p (object
)
11211 Lisp_Object object
;
11213 struct image_keyword fmt
[JPEG_LAST
];
11215 bcopy (jpeg_format
, fmt
, sizeof fmt
);
11217 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
11218 || (fmt
[JPEG_ASCENT
].count
11219 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
11222 /* Must specify either the :data or :file keyword. */
11223 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
11227 struct my_jpeg_error_mgr
11229 struct jpeg_error_mgr pub
;
11230 jmp_buf setjmp_buffer
;
11234 my_error_exit (cinfo
)
11235 j_common_ptr cinfo
;
11237 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
11238 longjmp (mgr
->setjmp_buffer
, 1);
11241 /* Init source method for JPEG data source manager. Called by
11242 jpeg_read_header() before any data is actually read. See
11243 libjpeg.doc from the JPEG lib distribution. */
11246 our_init_source (cinfo
)
11247 j_decompress_ptr cinfo
;
11252 /* Fill input buffer method for JPEG data source manager. Called
11253 whenever more data is needed. We read the whole image in one step,
11254 so this only adds a fake end of input marker at the end. */
11257 our_fill_input_buffer (cinfo
)
11258 j_decompress_ptr cinfo
;
11260 /* Insert a fake EOI marker. */
11261 struct jpeg_source_mgr
*src
= cinfo
->src
;
11262 static JOCTET buffer
[2];
11264 buffer
[0] = (JOCTET
) 0xFF;
11265 buffer
[1] = (JOCTET
) JPEG_EOI
;
11267 src
->next_input_byte
= buffer
;
11268 src
->bytes_in_buffer
= 2;
11273 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
11274 is the JPEG data source manager. */
11277 our_skip_input_data (cinfo
, num_bytes
)
11278 j_decompress_ptr cinfo
;
11281 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11285 if (num_bytes
> src
->bytes_in_buffer
)
11286 ERREXIT (cinfo
, JERR_INPUT_EOF
);
11288 src
->bytes_in_buffer
-= num_bytes
;
11289 src
->next_input_byte
+= num_bytes
;
11294 /* Method to terminate data source. Called by
11295 jpeg_finish_decompress() after all data has been processed. */
11298 our_term_source (cinfo
)
11299 j_decompress_ptr cinfo
;
11304 /* Set up the JPEG lib for reading an image from DATA which contains
11305 LEN bytes. CINFO is the decompression info structure created for
11306 reading the image. */
11309 jpeg_memory_src (cinfo
, data
, len
)
11310 j_decompress_ptr cinfo
;
11314 struct jpeg_source_mgr
*src
;
11316 if (cinfo
->src
== NULL
)
11318 /* First time for this JPEG object? */
11319 cinfo
->src
= (struct jpeg_source_mgr
*)
11320 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
11321 sizeof (struct jpeg_source_mgr
));
11322 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11323 src
->next_input_byte
= data
;
11326 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11327 src
->init_source
= our_init_source
;
11328 src
->fill_input_buffer
= our_fill_input_buffer
;
11329 src
->skip_input_data
= our_skip_input_data
;
11330 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
11331 src
->term_source
= our_term_source
;
11332 src
->bytes_in_buffer
= len
;
11333 src
->next_input_byte
= data
;
11337 /* Load image IMG for use on frame F. Patterned after example.c
11338 from the JPEG lib. */
11345 struct jpeg_decompress_struct cinfo
;
11346 struct my_jpeg_error_mgr mgr
;
11347 Lisp_Object file
, specified_file
;
11348 Lisp_Object specified_data
;
11351 int row_stride
, x
, y
;
11352 XImage
*ximg
= NULL
;
11354 unsigned long *colors
;
11356 struct gcpro gcpro1
;
11358 /* Open the JPEG file. */
11359 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11360 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11364 if (NILP (specified_data
))
11366 file
= x_find_image_file (specified_file
);
11367 if (!STRINGP (file
))
11369 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11374 fp
= fopen (XSTRING (file
)->data
, "r");
11377 image_error ("Cannot open `%s'", file
, Qnil
);
11383 /* Customize libjpeg's error handling to call my_error_exit when an
11384 error is detected. This function will perform a longjmp. */
11385 mgr
.pub
.error_exit
= my_error_exit
;
11386 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
11388 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
11392 /* Called from my_error_exit. Display a JPEG error. */
11393 char buffer
[JMSG_LENGTH_MAX
];
11394 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
11395 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
11396 build_string (buffer
));
11399 /* Close the input file and destroy the JPEG object. */
11402 jpeg_destroy_decompress (&cinfo
);
11406 /* If we already have an XImage, free that. */
11407 x_destroy_x_image (ximg
);
11409 /* Free pixmap and colors. */
11410 x_clear_image (f
, img
);
11417 /* Create the JPEG decompression object. Let it read from fp.
11418 Read the JPEG image header. */
11419 jpeg_create_decompress (&cinfo
);
11421 if (NILP (specified_data
))
11422 jpeg_stdio_src (&cinfo
, fp
);
11424 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
11425 STRING_BYTES (XSTRING (specified_data
)));
11427 jpeg_read_header (&cinfo
, TRUE
);
11429 /* Customize decompression so that color quantization will be used.
11430 Start decompression. */
11431 cinfo
.quantize_colors
= TRUE
;
11432 jpeg_start_decompress (&cinfo
);
11433 width
= img
->width
= cinfo
.output_width
;
11434 height
= img
->height
= cinfo
.output_height
;
11438 /* Create X image and pixmap. */
11439 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
11443 longjmp (mgr
.setjmp_buffer
, 2);
11446 /* Allocate colors. When color quantization is used,
11447 cinfo.actual_number_of_colors has been set with the number of
11448 colors generated, and cinfo.colormap is a two-dimensional array
11449 of color indices in the range 0..cinfo.actual_number_of_colors.
11450 No more than 255 colors will be generated. */
11454 if (cinfo
.out_color_components
> 2)
11455 ir
= 0, ig
= 1, ib
= 2;
11456 else if (cinfo
.out_color_components
> 1)
11457 ir
= 0, ig
= 1, ib
= 0;
11459 ir
= 0, ig
= 0, ib
= 0;
11461 /* Use the color table mechanism because it handles colors that
11462 cannot be allocated nicely. Such colors will be replaced with
11463 a default color, and we don't have to care about which colors
11464 can be freed safely, and which can't. */
11465 init_color_table ();
11466 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
11469 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
11471 /* Multiply RGB values with 255 because X expects RGB values
11472 in the range 0..0xffff. */
11473 int r
= cinfo
.colormap
[ir
][i
] << 8;
11474 int g
= cinfo
.colormap
[ig
][i
] << 8;
11475 int b
= cinfo
.colormap
[ib
][i
] << 8;
11476 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
11479 /* Remember those colors actually allocated. */
11480 img
->colors
= colors_in_color_table (&img
->ncolors
);
11481 free_color_table ();
11485 row_stride
= width
* cinfo
.output_components
;
11486 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
11488 for (y
= 0; y
< height
; ++y
)
11490 jpeg_read_scanlines (&cinfo
, buffer
, 1);
11491 for (x
= 0; x
< cinfo
.output_width
; ++x
)
11492 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
11496 jpeg_finish_decompress (&cinfo
);
11497 jpeg_destroy_decompress (&cinfo
);
11501 /* Put the image into the pixmap. */
11502 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11503 x_destroy_x_image (ximg
);
11509 #endif /* HAVE_JPEG */
11513 /***********************************************************************
11515 ***********************************************************************/
11519 #include <tiffio.h>
11521 static int tiff_image_p
P_ ((Lisp_Object object
));
11522 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
11524 /* The symbol `tiff' identifying images of this type. */
11528 /* Indices of image specification fields in tiff_format, below. */
11530 enum tiff_keyword_index
11539 TIFF_HEURISTIC_MASK
,
11543 /* Vector of image_keyword structures describing the format
11544 of valid user-defined image specifications. */
11546 static struct image_keyword tiff_format
[TIFF_LAST
] =
11548 {":type", IMAGE_SYMBOL_VALUE
, 1},
11549 {":data", IMAGE_STRING_VALUE
, 0},
11550 {":file", IMAGE_STRING_VALUE
, 0},
11551 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11552 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11553 {":relief", IMAGE_INTEGER_VALUE
, 0},
11554 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11555 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
11558 /* Structure describing the image type `tiff'. */
11560 static struct image_type tiff_type
=
11570 /* Return non-zero if OBJECT is a valid TIFF image specification. */
11573 tiff_image_p (object
)
11574 Lisp_Object object
;
11576 struct image_keyword fmt
[TIFF_LAST
];
11577 bcopy (tiff_format
, fmt
, sizeof fmt
);
11579 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
11580 || (fmt
[TIFF_ASCENT
].count
11581 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
11584 /* Must specify either the :data or :file keyword. */
11585 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
11589 /* Reading from a memory buffer for TIFF images Based on the PNG
11590 memory source, but we have to provide a lot of extra functions.
11593 We really only need to implement read and seek, but I am not
11594 convinced that the TIFF library is smart enough not to destroy
11595 itself if we only hand it the function pointers we need to
11600 unsigned char *bytes
;
11604 tiff_memory_source
;
11607 tiff_read_from_memory (data
, buf
, size
)
11612 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11614 if (size
> src
->len
- src
->index
)
11615 return (size_t) -1;
11616 bcopy (src
->bytes
+ src
->index
, buf
, size
);
11617 src
->index
+= size
;
11622 tiff_write_from_memory (data
, buf
, size
)
11627 return (size_t) -1;
11631 tiff_seek_in_memory (data
, off
, whence
)
11636 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11641 case SEEK_SET
: /* Go from beginning of source. */
11645 case SEEK_END
: /* Go from end of source. */
11646 idx
= src
->len
+ off
;
11649 case SEEK_CUR
: /* Go from current position. */
11650 idx
= src
->index
+ off
;
11653 default: /* Invalid `whence'. */
11657 if (idx
> src
->len
|| idx
< 0)
11665 tiff_close_memory (data
)
11673 tiff_mmap_memory (data
, pbase
, psize
)
11678 /* It is already _IN_ memory. */
11683 tiff_unmap_memory (data
, base
, size
)
11688 /* We don't need to do this. */
11692 tiff_size_of_memory (data
)
11695 return ((tiff_memory_source
*) data
)->len
;
11700 tiff_error_handler (title
, format
, ap
)
11701 const char *title
, *format
;
11707 len
= sprintf (buf
, "TIFF error: %s ", title
);
11708 vsprintf (buf
+ len
, format
, ap
);
11709 add_to_log (buf
, Qnil
, Qnil
);
11714 tiff_warning_handler (title
, format
, ap
)
11715 const char *title
, *format
;
11721 len
= sprintf (buf
, "TIFF warning: %s ", title
);
11722 vsprintf (buf
+ len
, format
, ap
);
11723 add_to_log (buf
, Qnil
, Qnil
);
11727 /* Load TIFF image IMG for use on frame F. Value is non-zero if
11735 Lisp_Object file
, specified_file
;
11736 Lisp_Object specified_data
;
11738 int width
, height
, x
, y
;
11742 struct gcpro gcpro1
;
11743 tiff_memory_source memsrc
;
11745 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11746 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11750 TIFFSetErrorHandler (tiff_error_handler
);
11751 TIFFSetWarningHandler (tiff_warning_handler
);
11753 if (NILP (specified_data
))
11755 /* Read from a file */
11756 file
= x_find_image_file (specified_file
);
11757 if (!STRINGP (file
))
11759 image_error ("Cannot find image file `%s'", file
, Qnil
);
11764 /* Try to open the image file. */
11765 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
11768 image_error ("Cannot open `%s'", file
, Qnil
);
11775 /* Memory source! */
11776 memsrc
.bytes
= XSTRING (specified_data
)->data
;
11777 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
11780 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
11781 (TIFFReadWriteProc
) tiff_read_from_memory
,
11782 (TIFFReadWriteProc
) tiff_write_from_memory
,
11783 tiff_seek_in_memory
,
11785 tiff_size_of_memory
,
11787 tiff_unmap_memory
);
11791 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
11797 /* Get width and height of the image, and allocate a raster buffer
11798 of width x height 32-bit values. */
11799 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
11800 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
11801 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
11803 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
11807 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
11813 /* Create the X image and pixmap. */
11814 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11821 /* Initialize the color table. */
11822 init_color_table ();
11824 /* Process the pixel raster. Origin is in the lower-left corner. */
11825 for (y
= 0; y
< height
; ++y
)
11827 uint32
*row
= buf
+ y
* width
;
11829 for (x
= 0; x
< width
; ++x
)
11831 uint32 abgr
= row
[x
];
11832 int r
= TIFFGetR (abgr
) << 8;
11833 int g
= TIFFGetG (abgr
) << 8;
11834 int b
= TIFFGetB (abgr
) << 8;
11835 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
11839 /* Remember the colors allocated for the image. Free the color table. */
11840 img
->colors
= colors_in_color_table (&img
->ncolors
);
11841 free_color_table ();
11843 /* Put the image into the pixmap, then free the X image and its buffer. */
11844 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11845 x_destroy_x_image (ximg
);
11848 img
->width
= width
;
11849 img
->height
= height
;
11855 #endif /* HAVE_TIFF != 0 */
11859 /***********************************************************************
11861 ***********************************************************************/
11865 #include <gif_lib.h>
11867 static int gif_image_p
P_ ((Lisp_Object object
));
11868 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
11870 /* The symbol `gif' identifying images of this type. */
11874 /* Indices of image specification fields in gif_format, below. */
11876 enum gif_keyword_index
11885 GIF_HEURISTIC_MASK
,
11890 /* Vector of image_keyword structures describing the format
11891 of valid user-defined image specifications. */
11893 static struct image_keyword gif_format
[GIF_LAST
] =
11895 {":type", IMAGE_SYMBOL_VALUE
, 1},
11896 {":data", IMAGE_STRING_VALUE
, 0},
11897 {":file", IMAGE_STRING_VALUE
, 0},
11898 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11899 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11900 {":relief", IMAGE_INTEGER_VALUE
, 0},
11901 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11902 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11903 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
11906 /* Structure describing the image type `gif'. */
11908 static struct image_type gif_type
=
11917 /* Return non-zero if OBJECT is a valid GIF image specification. */
11920 gif_image_p (object
)
11921 Lisp_Object object
;
11923 struct image_keyword fmt
[GIF_LAST
];
11924 bcopy (gif_format
, fmt
, sizeof fmt
);
11926 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
11927 || (fmt
[GIF_ASCENT
].count
11928 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
11931 /* Must specify either the :data or :file keyword. */
11932 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
11935 /* Reading a GIF image from memory
11936 Based on the PNG memory stuff to a certain extent. */
11940 unsigned char *bytes
;
11946 /* Make the current memory source available to gif_read_from_memory.
11947 It's done this way because not all versions of libungif support
11948 a UserData field in the GifFileType structure. */
11949 static gif_memory_source
*current_gif_memory_src
;
11952 gif_read_from_memory (file
, buf
, len
)
11957 gif_memory_source
*src
= current_gif_memory_src
;
11959 if (len
> src
->len
- src
->index
)
11962 bcopy (src
->bytes
+ src
->index
, buf
, len
);
11968 /* Load GIF image IMG for use on frame F. Value is non-zero if
11976 Lisp_Object file
, specified_file
;
11977 Lisp_Object specified_data
;
11978 int rc
, width
, height
, x
, y
, i
;
11980 ColorMapObject
*gif_color_map
;
11981 unsigned long pixel_colors
[256];
11983 struct gcpro gcpro1
;
11985 int ino
, image_left
, image_top
, image_width
, image_height
;
11986 gif_memory_source memsrc
;
11987 unsigned char *raster
;
11989 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11990 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11994 if (NILP (specified_data
))
11996 file
= x_find_image_file (specified_file
);
11997 if (!STRINGP (file
))
11999 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
12004 /* Open the GIF file. */
12005 gif
= DGifOpenFileName (XSTRING (file
)->data
);
12008 image_error ("Cannot open `%s'", file
, Qnil
);
12015 /* Read from memory! */
12016 current_gif_memory_src
= &memsrc
;
12017 memsrc
.bytes
= XSTRING (specified_data
)->data
;
12018 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
12021 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
12024 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
12030 /* Read entire contents. */
12031 rc
= DGifSlurp (gif
);
12032 if (rc
== GIF_ERROR
)
12034 image_error ("Error reading `%s'", img
->spec
, Qnil
);
12035 DGifCloseFile (gif
);
12040 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
12041 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
12042 if (ino
>= gif
->ImageCount
)
12044 image_error ("Invalid image number `%s' in image `%s'",
12046 DGifCloseFile (gif
);
12051 width
= img
->width
= gif
->SWidth
;
12052 height
= img
->height
= gif
->SHeight
;
12056 /* Create the X image and pixmap. */
12057 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12060 DGifCloseFile (gif
);
12065 /* Allocate colors. */
12066 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
12067 if (!gif_color_map
)
12068 gif_color_map
= gif
->SColorMap
;
12069 init_color_table ();
12070 bzero (pixel_colors
, sizeof pixel_colors
);
12072 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
12074 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
12075 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
12076 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
12077 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
12080 img
->colors
= colors_in_color_table (&img
->ncolors
);
12081 free_color_table ();
12083 /* Clear the part of the screen image that are not covered by
12084 the image from the GIF file. Full animated GIF support
12085 requires more than can be done here (see the gif89 spec,
12086 disposal methods). Let's simply assume that the part
12087 not covered by a sub-image is in the frame's background color. */
12088 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
12089 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
12090 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
12091 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
12093 for (y
= 0; y
< image_top
; ++y
)
12094 for (x
= 0; x
< width
; ++x
)
12095 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12097 for (y
= image_top
+ image_height
; y
< height
; ++y
)
12098 for (x
= 0; x
< width
; ++x
)
12099 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12101 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
12103 for (x
= 0; x
< image_left
; ++x
)
12104 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12105 for (x
= image_left
+ image_width
; x
< width
; ++x
)
12106 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12109 /* Read the GIF image into the X image. We use a local variable
12110 `raster' here because RasterBits below is a char *, and invites
12111 problems with bytes >= 0x80. */
12112 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
12114 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
12116 static int interlace_start
[] = {0, 4, 2, 1};
12117 static int interlace_increment
[] = {8, 8, 4, 2};
12119 int row
= interlace_start
[0];
12123 for (y
= 0; y
< image_height
; y
++)
12125 if (row
>= image_height
)
12127 row
= interlace_start
[++pass
];
12128 while (row
>= image_height
)
12129 row
= interlace_start
[++pass
];
12132 for (x
= 0; x
< image_width
; x
++)
12134 int i
= raster
[(y
* image_width
) + x
];
12135 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
12139 row
+= interlace_increment
[pass
];
12144 for (y
= 0; y
< image_height
; ++y
)
12145 for (x
= 0; x
< image_width
; ++x
)
12147 int i
= raster
[y
* image_width
+ x
];
12148 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
12152 DGifCloseFile (gif
);
12154 /* Put the image into the pixmap, then free the X image and its buffer. */
12155 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12156 x_destroy_x_image (ximg
);
12163 #endif /* HAVE_GIF != 0 */
12167 /***********************************************************************
12169 ***********************************************************************/
12171 Lisp_Object Qpostscript
;
12173 #ifdef HAVE_GHOSTSCRIPT
12174 static int gs_image_p
P_ ((Lisp_Object object
));
12175 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
12176 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
12178 /* The symbol `postscript' identifying images of this type. */
12180 /* Keyword symbols. */
12182 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
12184 /* Indices of image specification fields in gs_format, below. */
12186 enum gs_keyword_index
12202 /* Vector of image_keyword structures describing the format
12203 of valid user-defined image specifications. */
12205 static struct image_keyword gs_format
[GS_LAST
] =
12207 {":type", IMAGE_SYMBOL_VALUE
, 1},
12208 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12209 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12210 {":file", IMAGE_STRING_VALUE
, 1},
12211 {":loader", IMAGE_FUNCTION_VALUE
, 0},
12212 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
12213 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
12214 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12215 {":relief", IMAGE_INTEGER_VALUE
, 0},
12216 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12217 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
12220 /* Structure describing the image type `ghostscript'. */
12222 static struct image_type gs_type
=
12232 /* Free X resources of Ghostscript image IMG which is used on frame F. */
12235 gs_clear_image (f
, img
)
12239 /* IMG->data.ptr_val may contain a recorded colormap. */
12240 xfree (img
->data
.ptr_val
);
12241 x_clear_image (f
, img
);
12245 /* Return non-zero if OBJECT is a valid Ghostscript image
12249 gs_image_p (object
)
12250 Lisp_Object object
;
12252 struct image_keyword fmt
[GS_LAST
];
12256 bcopy (gs_format
, fmt
, sizeof fmt
);
12258 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
12259 || (fmt
[GS_ASCENT
].count
12260 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
12263 /* Bounding box must be a list or vector containing 4 integers. */
12264 tem
= fmt
[GS_BOUNDING_BOX
].value
;
12267 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
12268 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
12273 else if (VECTORP (tem
))
12275 if (XVECTOR (tem
)->size
!= 4)
12277 for (i
= 0; i
< 4; ++i
)
12278 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
12288 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
12297 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
12298 struct gcpro gcpro1
, gcpro2
;
12300 double in_width
, in_height
;
12301 Lisp_Object pixel_colors
= Qnil
;
12303 /* Compute pixel size of pixmap needed from the given size in the
12304 image specification. Sizes in the specification are in pt. 1 pt
12305 = 1/72 in, xdpi and ydpi are stored in the frame's X display
12307 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
12308 in_width
= XFASTINT (pt_width
) / 72.0;
12309 img
->width
= in_width
* FRAME_W32_DISPLAY_INFO (f
)->resx
;
12310 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
12311 in_height
= XFASTINT (pt_height
) / 72.0;
12312 img
->height
= in_height
* FRAME_W32_DISPLAY_INFO (f
)->resy
;
12314 /* Create the pixmap. */
12316 xassert (img
->pixmap
== 0);
12317 img
->pixmap
= XCreatePixmap (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12318 img
->width
, img
->height
,
12319 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
12324 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
12328 /* Call the loader to fill the pixmap. It returns a process object
12329 if successful. We do not record_unwind_protect here because
12330 other places in redisplay like calling window scroll functions
12331 don't either. Let the Lisp loader use `unwind-protect' instead. */
12332 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
12334 sprintf (buffer
, "%lu %lu",
12335 (unsigned long) FRAME_W32_WINDOW (f
),
12336 (unsigned long) img
->pixmap
);
12337 window_and_pixmap_id
= build_string (buffer
);
12339 sprintf (buffer
, "%lu %lu",
12340 FRAME_FOREGROUND_PIXEL (f
),
12341 FRAME_BACKGROUND_PIXEL (f
));
12342 pixel_colors
= build_string (buffer
);
12344 XSETFRAME (frame
, f
);
12345 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
12347 loader
= intern ("gs-load-image");
12349 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
12350 make_number (img
->width
),
12351 make_number (img
->height
),
12352 window_and_pixmap_id
,
12355 return PROCESSP (img
->data
.lisp_val
);
12359 /* Kill the Ghostscript process that was started to fill PIXMAP on
12360 frame F. Called from XTread_socket when receiving an event
12361 telling Emacs that Ghostscript has finished drawing. */
12364 x_kill_gs_process (pixmap
, f
)
12368 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
12372 /* Find the image containing PIXMAP. */
12373 for (i
= 0; i
< c
->used
; ++i
)
12374 if (c
->images
[i
]->pixmap
== pixmap
)
12377 /* Should someone in between have cleared the image cache, for
12378 instance, give up. */
12382 /* Kill the GS process. We should have found PIXMAP in the image
12383 cache and its image should contain a process object. */
12384 img
= c
->images
[i
];
12385 xassert (PROCESSP (img
->data
.lisp_val
));
12386 Fkill_process (img
->data
.lisp_val
, Qnil
);
12387 img
->data
.lisp_val
= Qnil
;
12389 /* On displays with a mutable colormap, figure out the colors
12390 allocated for the image by looking at the pixels of an XImage for
12392 class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
12393 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
12399 /* Try to get an XImage for img->pixmep. */
12400 ximg
= XGetImage (FRAME_W32_DISPLAY (f
), img
->pixmap
,
12401 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
12406 /* Initialize the color table. */
12407 init_color_table ();
12409 /* For each pixel of the image, look its color up in the
12410 color table. After having done so, the color table will
12411 contain an entry for each color used by the image. */
12412 for (y
= 0; y
< img
->height
; ++y
)
12413 for (x
= 0; x
< img
->width
; ++x
)
12415 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
12416 lookup_pixel_color (f
, pixel
);
12419 /* Record colors in the image. Free color table and XImage. */
12420 img
->colors
= colors_in_color_table (&img
->ncolors
);
12421 free_color_table ();
12422 XDestroyImage (ximg
);
12424 #if 0 /* This doesn't seem to be the case. If we free the colors
12425 here, we get a BadAccess later in x_clear_image when
12426 freeing the colors. */
12427 /* We have allocated colors once, but Ghostscript has also
12428 allocated colors on behalf of us. So, to get the
12429 reference counts right, free them once. */
12431 x_free_colors (FRAME_W32_DISPLAY (f
), cmap
,
12432 img
->colors
, img
->ncolors
, 0);
12436 image_error ("Cannot get X image of `%s'; colors will not be freed",
12442 /* Now that we have the pixmap, compute mask and transform the
12443 image if requested. */
12445 postprocess_image (f
, img
);
12449 #endif /* HAVE_GHOSTSCRIPT */
12452 /***********************************************************************
12454 ***********************************************************************/
12456 DEFUN ("x-change-window-property", Fx_change_window_property
,
12457 Sx_change_window_property
, 2, 3, 0,
12458 "Change window property PROP to VALUE on the X window of FRAME.\n\
12459 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
12460 selected frame. Value is VALUE.")
12461 (prop
, value
, frame
)
12462 Lisp_Object frame
, prop
, value
;
12464 #if 0 /* TODO : port window properties to W32 */
12465 struct frame
*f
= check_x_frame (frame
);
12468 CHECK_STRING (prop
);
12469 CHECK_STRING (value
);
12472 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12473 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12474 prop_atom
, XA_STRING
, 8, PropModeReplace
,
12475 XSTRING (value
)->data
, XSTRING (value
)->size
);
12477 /* Make sure the property is set when we return. */
12478 XFlush (FRAME_W32_DISPLAY (f
));
12487 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
12488 Sx_delete_window_property
, 1, 2, 0,
12489 "Remove window property PROP from X window of FRAME.\n\
12490 FRAME nil or omitted means use the selected frame. Value is PROP.")
12492 Lisp_Object prop
, frame
;
12494 #if 0 /* TODO : port window properties to W32 */
12496 struct frame
*f
= check_x_frame (frame
);
12499 CHECK_STRING (prop
);
12501 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12502 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
12504 /* Make sure the property is removed when we return. */
12505 XFlush (FRAME_W32_DISPLAY (f
));
12513 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
12515 "Value is the value of window property PROP on FRAME.\n\
12516 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
12517 if FRAME hasn't a property with name PROP or if PROP has no string\n\
12520 Lisp_Object prop
, frame
;
12522 #if 0 /* TODO : port window properties to W32 */
12524 struct frame
*f
= check_x_frame (frame
);
12527 Lisp_Object prop_value
= Qnil
;
12528 char *tmp_data
= NULL
;
12531 unsigned long actual_size
, bytes_remaining
;
12533 CHECK_STRING (prop
);
12535 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12536 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12537 prop_atom
, 0, 0, False
, XA_STRING
,
12538 &actual_type
, &actual_format
, &actual_size
,
12539 &bytes_remaining
, (unsigned char **) &tmp_data
);
12542 int size
= bytes_remaining
;
12547 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12548 prop_atom
, 0, bytes_remaining
,
12550 &actual_type
, &actual_format
,
12551 &actual_size
, &bytes_remaining
,
12552 (unsigned char **) &tmp_data
);
12554 prop_value
= make_string (tmp_data
, size
);
12569 /***********************************************************************
12571 ***********************************************************************/
12573 /* If non-null, an asynchronous timer that, when it expires, displays
12574 an hourglass cursor on all frames. */
12576 static struct atimer
*hourglass_atimer
;
12578 /* Non-zero means an hourglass cursor is currently shown. */
12580 static int hourglass_shown_p
;
12582 /* Number of seconds to wait before displaying an hourglass cursor. */
12584 static Lisp_Object Vhourglass_delay
;
12586 /* Default number of seconds to wait before displaying an hourglass
12589 #define DEFAULT_HOURGLASS_DELAY 1
12591 /* Function prototypes. */
12593 static void show_hourglass
P_ ((struct atimer
*));
12594 static void hide_hourglass
P_ ((void));
12597 /* Cancel a currently active hourglass timer, and start a new one. */
12602 #if 0 /* TODO: cursor shape changes. */
12604 int secs
, usecs
= 0;
12606 cancel_hourglass ();
12608 if (INTEGERP (Vhourglass_delay
)
12609 && XINT (Vhourglass_delay
) > 0)
12610 secs
= XFASTINT (Vhourglass_delay
);
12611 else if (FLOATP (Vhourglass_delay
)
12612 && XFLOAT_DATA (Vhourglass_delay
) > 0)
12615 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
12616 secs
= XFASTINT (tem
);
12617 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
12620 secs
= DEFAULT_HOURGLASS_DELAY
;
12622 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
12623 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
12624 show_hourglass
, NULL
);
12629 /* Cancel the hourglass cursor timer if active, hide an hourglass
12630 cursor if shown. */
12633 cancel_hourglass ()
12635 if (hourglass_atimer
)
12637 cancel_atimer (hourglass_atimer
);
12638 hourglass_atimer
= NULL
;
12641 if (hourglass_shown_p
)
12646 /* Timer function of hourglass_atimer. TIMER is equal to
12649 Display an hourglass cursor on all frames by mapping the frames'
12650 hourglass_window. Set the hourglass_p flag in the frames'
12651 output_data.x structure to indicate that an hourglass cursor is
12652 shown on the frames. */
12655 show_hourglass (timer
)
12656 struct atimer
*timer
;
12658 #if 0 /* TODO: cursor shape changes. */
12659 /* The timer implementation will cancel this timer automatically
12660 after this function has run. Set hourglass_atimer to null
12661 so that we know the timer doesn't have to be canceled. */
12662 hourglass_atimer
= NULL
;
12664 if (!hourglass_shown_p
)
12666 Lisp_Object rest
, frame
;
12670 FOR_EACH_FRAME (rest
, frame
)
12671 if (FRAME_W32_P (XFRAME (frame
)))
12673 struct frame
*f
= XFRAME (frame
);
12675 f
->output_data
.w32
->hourglass_p
= 1;
12677 if (!f
->output_data
.w32
->hourglass_window
)
12679 unsigned long mask
= CWCursor
;
12680 XSetWindowAttributes attrs
;
12682 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
12684 f
->output_data
.w32
->hourglass_window
12685 = XCreateWindow (FRAME_X_DISPLAY (f
),
12686 FRAME_OUTER_WINDOW (f
),
12687 0, 0, 32000, 32000, 0, 0,
12693 XMapRaised (FRAME_X_DISPLAY (f
),
12694 f
->output_data
.w32
->hourglass_window
);
12695 XFlush (FRAME_X_DISPLAY (f
));
12698 hourglass_shown_p
= 1;
12705 /* Hide the hourglass cursor on all frames, if it is currently shown. */
12710 #if 0 /* TODO: cursor shape changes. */
12711 if (hourglass_shown_p
)
12713 Lisp_Object rest
, frame
;
12716 FOR_EACH_FRAME (rest
, frame
)
12718 struct frame
*f
= XFRAME (frame
);
12720 if (FRAME_W32_P (f
)
12721 /* Watch out for newly created frames. */
12722 && f
->output_data
.x
->hourglass_window
)
12724 XUnmapWindow (FRAME_X_DISPLAY (f
),
12725 f
->output_data
.x
->hourglass_window
);
12726 /* Sync here because XTread_socket looks at the
12727 hourglass_p flag that is reset to zero below. */
12728 XSync (FRAME_X_DISPLAY (f
), False
);
12729 f
->output_data
.x
->hourglass_p
= 0;
12733 hourglass_shown_p
= 0;
12741 /***********************************************************************
12743 ***********************************************************************/
12745 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
12746 Lisp_Object
, Lisp_Object
));
12747 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
12748 Lisp_Object
, int, int, int *, int *));
12750 /* The frame of a currently visible tooltip. */
12752 Lisp_Object tip_frame
;
12754 /* If non-nil, a timer started that hides the last tooltip when it
12757 Lisp_Object tip_timer
;
12760 /* If non-nil, a vector of 3 elements containing the last args
12761 with which x-show-tip was called. See there. */
12763 Lisp_Object last_show_tip_args
;
12765 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
12767 Lisp_Object Vx_max_tooltip_size
;
12771 unwind_create_tip_frame (frame
)
12774 Lisp_Object deleted
;
12776 deleted
= unwind_create_frame (frame
);
12777 if (EQ (deleted
, Qt
))
12787 /* Create a frame for a tooltip on the display described by DPYINFO.
12788 PARMS is a list of frame parameters. TEXT is the string to
12789 display in the tip frame. Value is the frame.
12791 Note that functions called here, esp. x_default_parameter can
12792 signal errors, for instance when a specified color name is
12793 undefined. We have to make sure that we're in a consistent state
12794 when this happens. */
12797 x_create_tip_frame (dpyinfo
, parms
, text
)
12798 struct w32_display_info
*dpyinfo
;
12799 Lisp_Object parms
, text
;
12801 #if 0 /* TODO : w32 version */
12803 Lisp_Object frame
, tem
;
12805 long window_prompting
= 0;
12807 int count
= BINDING_STACK_SIZE ();
12808 struct gcpro gcpro1
, gcpro2
, gcpro3
;
12810 int face_change_count_before
= face_change_count
;
12811 Lisp_Object buffer
;
12812 struct buffer
*old_buffer
;
12816 /* Use this general default value to start with until we know if
12817 this frame has a specified name. */
12818 Vx_resource_name
= Vinvocation_name
;
12820 #ifdef MULTI_KBOARD
12821 kb
= dpyinfo
->kboard
;
12823 kb
= &the_only_kboard
;
12826 /* Get the name of the frame to use for resource lookup. */
12827 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
12828 if (!STRINGP (name
)
12829 && !EQ (name
, Qunbound
)
12831 error ("Invalid frame name--not a string or nil");
12832 Vx_resource_name
= name
;
12835 GCPRO3 (parms
, name
, frame
);
12836 f
= make_frame (1);
12837 XSETFRAME (frame
, f
);
12839 buffer
= Fget_buffer_create (build_string (" *tip*"));
12840 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
12841 old_buffer
= current_buffer
;
12842 set_buffer_internal_1 (XBUFFER (buffer
));
12843 current_buffer
->truncate_lines
= Qnil
;
12845 Finsert (1, &text
);
12846 set_buffer_internal_1 (old_buffer
);
12848 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
12849 record_unwind_protect (unwind_create_tip_frame
, frame
);
12851 /* By setting the output method, we're essentially saying that
12852 the frame is live, as per FRAME_LIVE_P. If we get a signal
12853 from this point on, x_destroy_window might screw up reference
12855 f
->output_method
= output_w32
;
12856 f
->output_data
.w32
=
12857 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
12858 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
12860 f
->output_data
.w32
->icon_bitmap
= -1;
12862 f
->output_data
.w32
->fontset
= -1;
12863 f
->icon_name
= Qnil
;
12866 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
12867 dpyinfo_refcount
= dpyinfo
->reference_count
;
12868 #endif /* GLYPH_DEBUG */
12869 #ifdef MULTI_KBOARD
12870 FRAME_KBOARD (f
) = kb
;
12872 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
12873 f
->output_data
.w32
->explicit_parent
= 0;
12875 /* Set the name; the functions to which we pass f expect the name to
12877 if (EQ (name
, Qunbound
) || NILP (name
))
12879 f
->name
= build_string (dpyinfo
->x_id_name
);
12880 f
->explicit_name
= 0;
12885 f
->explicit_name
= 1;
12886 /* use the frame's title when getting resources for this frame. */
12887 specbind (Qx_resource_name
, name
);
12890 /* Extract the window parameters from the supplied values
12891 that are needed to determine window geometry. */
12895 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
12898 /* First, try whatever font the caller has specified. */
12899 if (STRINGP (font
))
12901 tem
= Fquery_fontset (font
, Qnil
);
12903 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
12905 font
= x_new_font (f
, XSTRING (font
)->data
);
12908 /* Try out a font which we hope has bold and italic variations. */
12909 if (!STRINGP (font
))
12910 font
= x_new_font (f
, "-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
12911 if (!STRINGP (font
))
12912 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12913 if (! STRINGP (font
))
12914 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12915 if (! STRINGP (font
))
12916 /* This was formerly the first thing tried, but it finds too many fonts
12917 and takes too long. */
12918 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
12919 /* If those didn't work, look for something which will at least work. */
12920 if (! STRINGP (font
))
12921 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
12923 if (! STRINGP (font
))
12924 font
= build_string ("fixed");
12926 x_default_parameter (f
, parms
, Qfont
, font
,
12927 "font", "Font", RES_TYPE_STRING
);
12930 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
12931 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
12933 /* This defaults to 2 in order to match xterm. We recognize either
12934 internalBorderWidth or internalBorder (which is what xterm calls
12936 if (NILP (Fassq (Qinternal_border_width
, parms
)))
12940 value
= w32_get_arg (parms
, Qinternal_border_width
,
12941 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
12942 if (! EQ (value
, Qunbound
))
12943 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
12947 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
12948 "internalBorderWidth", "internalBorderWidth",
12951 /* Also do the stuff which must be set before the window exists. */
12952 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
12953 "foreground", "Foreground", RES_TYPE_STRING
);
12954 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
12955 "background", "Background", RES_TYPE_STRING
);
12956 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
12957 "pointerColor", "Foreground", RES_TYPE_STRING
);
12958 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
12959 "cursorColor", "Foreground", RES_TYPE_STRING
);
12960 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
12961 "borderColor", "BorderColor", RES_TYPE_STRING
);
12963 /* Init faces before x_default_parameter is called for scroll-bar
12964 parameters because that function calls x_set_scroll_bar_width,
12965 which calls change_frame_size, which calls Fset_window_buffer,
12966 which runs hooks, which call Fvertical_motion. At the end, we
12967 end up in init_iterator with a null face cache, which should not
12969 init_frame_faces (f
);
12971 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
12972 window_prompting
= x_figure_window_size (f
, parms
);
12974 if (window_prompting
& XNegative
)
12976 if (window_prompting
& YNegative
)
12977 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
12979 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
12983 if (window_prompting
& YNegative
)
12984 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
12986 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
12989 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
12991 XSetWindowAttributes attrs
;
12992 unsigned long mask
;
12995 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
12996 if (DoesSaveUnders (dpyinfo
->screen
))
12997 mask
|= CWSaveUnder
;
12999 /* Window managers looks at the override-redirect flag to
13000 determine whether or net to give windows a decoration (Xlib
13002 attrs
.override_redirect
= True
;
13003 attrs
.save_under
= True
;
13004 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
13005 /* Arrange for getting MapNotify and UnmapNotify events. */
13006 attrs
.event_mask
= StructureNotifyMask
;
13008 = FRAME_W32_WINDOW (f
)
13009 = XCreateWindow (FRAME_W32_DISPLAY (f
),
13010 FRAME_W32_DISPLAY_INFO (f
)->root_window
,
13011 /* x, y, width, height */
13015 CopyFromParent
, InputOutput
, CopyFromParent
,
13022 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
13023 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
13024 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
13025 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
13026 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
13027 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
13029 /* Dimensions, especially f->height, must be done via change_frame_size.
13030 Change will not be effected unless different from the current
13033 height
= f
->height
;
13035 SET_FRAME_WIDTH (f
, 0);
13036 change_frame_size (f
, height
, width
, 1, 0, 0);
13038 /* Set up faces after all frame parameters are known. This call
13039 also merges in face attributes specified for new frames.
13041 Frame parameters may be changed if .Xdefaults contains
13042 specifications for the default font. For example, if there is an
13043 `Emacs.default.attributeBackground: pink', the `background-color'
13044 attribute of the frame get's set, which let's the internal border
13045 of the tooltip frame appear in pink. Prevent this. */
13047 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
13049 /* Set tip_frame here, so that */
13051 call1 (Qface_set_after_frame_default
, frame
);
13053 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
13054 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
13062 /* It is now ok to make the frame official even if we get an error
13063 below. And the frame needs to be on Vframe_list or making it
13064 visible won't work. */
13065 Vframe_list
= Fcons (frame
, Vframe_list
);
13067 /* Now that the frame is official, it counts as a reference to
13069 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
13071 /* Setting attributes of faces of the tooltip frame from resources
13072 and similar will increment face_change_count, which leads to the
13073 clearing of all current matrices. Since this isn't necessary
13074 here, avoid it by resetting face_change_count to the value it
13075 had before we created the tip frame. */
13076 face_change_count
= face_change_count_before
;
13078 /* Discard the unwind_protect. */
13079 return unbind_to (count
, frame
);
13085 /* Compute where to display tip frame F. PARMS is the list of frame
13086 parameters for F. DX and DY are specified offsets from the current
13087 location of the mouse. WIDTH and HEIGHT are the width and height
13088 of the tooltip. Return coordinates relative to the root window of
13089 the display in *ROOT_X, and *ROOT_Y. */
13092 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
13094 Lisp_Object parms
, dx
, dy
;
13096 int *root_x
, *root_y
;
13098 #ifdef TODO /* Tool tips not supported. */
13099 Lisp_Object left
, top
;
13101 Window root
, child
;
13104 /* User-specified position? */
13105 left
= Fcdr (Fassq (Qleft
, parms
));
13106 top
= Fcdr (Fassq (Qtop
, parms
));
13108 /* Move the tooltip window where the mouse pointer is. Resize and
13110 if (!INTEGERP (left
) && !INTEGERP (top
))
13113 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
13114 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
13118 if (INTEGERP (top
))
13119 *root_y
= XINT (top
);
13120 else if (*root_y
+ XINT (dy
) - height
< 0)
13121 *root_y
-= XINT (dy
);
13125 *root_y
+= XINT (dy
);
13128 if (INTEGERP (left
))
13129 *root_x
= XINT (left
);
13130 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
13131 *root_x
-= width
+ XINT (dx
);
13133 *root_x
+= XINT (dx
);
13135 #endif /* Tooltip support. */
13139 #ifdef TODO /* Tooltip support not complete. */
13140 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
13141 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
13142 A tooltip window is a small window displaying a string.\n\
13144 FRAME nil or omitted means use the selected frame.\n\
13146 PARMS is an optional list of frame parameters which can be\n\
13147 used to change the tooltip's appearance.\n\
13149 Automatically hide the tooltip after TIMEOUT seconds.\n\
13150 TIMEOUT nil means use the default timeout of 5 seconds.\n\
13152 If the list of frame parameters PARAMS contains a `left' parameters,\n\
13153 the tooltip is displayed at that x-position. Otherwise it is\n\
13154 displayed at the mouse position, with offset DX added (default is 5 if\n\
13155 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
13156 parameter is specified, it determines the y-position of the tooltip\n\
13157 window, otherwise it is displayed at the mouse position, with offset\n\
13158 DY added (default is -10).\n\
13160 A tooltip's maximum size is specified by `x-max-tooltip-size'.\n\
13161 Text larger than the specified size is clipped.")
13162 (string
, frame
, parms
, timeout
, dx
, dy
)
13163 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
13167 Lisp_Object buffer
, top
, left
, max_width
, max_height
;
13168 int root_x
, root_y
;
13169 struct buffer
*old_buffer
;
13170 struct text_pos pos
;
13171 int i
, width
, height
;
13172 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
13173 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
13174 int count
= specpdl_ptr
- specpdl
;
13176 specbind (Qinhibit_redisplay
, Qt
);
13178 GCPRO4 (string
, parms
, frame
, timeout
);
13180 CHECK_STRING (string
);
13181 f
= check_x_frame (frame
);
13182 if (NILP (timeout
))
13183 timeout
= make_number (5);
13185 CHECK_NATNUM (timeout
);
13188 dx
= make_number (5);
13193 dy
= make_number (-10);
13197 if (NILP (last_show_tip_args
))
13198 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
13200 if (!NILP (tip_frame
))
13202 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
13203 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
13204 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
13206 if (EQ (frame
, last_frame
)
13207 && !NILP (Fequal (last_string
, string
))
13208 && !NILP (Fequal (last_parms
, parms
)))
13210 struct frame
*f
= XFRAME (tip_frame
);
13212 /* Only DX and DY have changed. */
13213 if (!NILP (tip_timer
))
13215 Lisp_Object timer
= tip_timer
;
13217 call1 (Qcancel_timer
, timer
);
13221 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
13222 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
13223 root_x
, root_y
- PIXEL_HEIGHT (f
));
13229 /* Hide a previous tip, if any. */
13232 ASET (last_show_tip_args
, 0, string
);
13233 ASET (last_show_tip_args
, 1, frame
);
13234 ASET (last_show_tip_args
, 2, parms
);
13236 /* Add default values to frame parameters. */
13237 if (NILP (Fassq (Qname
, parms
)))
13238 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
13239 if (NILP (Fassq (Qinternal_border_width
, parms
)))
13240 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
13241 if (NILP (Fassq (Qborder_width
, parms
)))
13242 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
13243 if (NILP (Fassq (Qborder_color
, parms
)))
13244 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
13245 if (NILP (Fassq (Qbackground_color
, parms
)))
13246 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
13249 /* Create a frame for the tooltip, and record it in the global
13250 variable tip_frame. */
13251 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
);
13252 f
= XFRAME (frame
);
13254 /* Set up the frame's root window. */
13255 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
13256 w
->left
= w
->top
= make_number (0);
13258 if (CONSP (Vx_max_tooltip_size
)
13259 && INTEGERP (XCAR (Vx_max_tooltip_size
))
13260 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
13261 && INTEGERP (XCDR (Vx_max_tooltip_size
))
13262 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
13264 w
->width
= XCAR (Vx_max_tooltip_size
);
13265 w
->height
= XCDR (Vx_max_tooltip_size
);
13269 w
->width
= make_number (80);
13270 w
->height
= make_number (40);
13273 f
->window_width
= XINT (w
->width
);
13275 w
->pseudo_window_p
= 1;
13277 /* Display the tooltip text in a temporary buffer. */
13278 old_buffer
= current_buffer
;
13279 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
13280 current_buffer
->truncate_lines
= Qnil
;
13281 clear_glyph_matrix (w
->desired_matrix
);
13282 clear_glyph_matrix (w
->current_matrix
);
13283 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
13284 try_window (FRAME_ROOT_WINDOW (f
), pos
);
13286 /* Compute width and height of the tooltip. */
13287 width
= height
= 0;
13288 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
13290 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
13291 struct glyph
*last
;
13294 /* Stop at the first empty row at the end. */
13295 if (!row
->enabled_p
|| !row
->displays_text_p
)
13298 /* Let the row go over the full width of the frame. */
13299 row
->full_width_p
= 1;
13301 /* There's a glyph at the end of rows that is use to place
13302 the cursor there. Don't include the width of this glyph. */
13303 if (row
->used
[TEXT_AREA
])
13305 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
13306 row_width
= row
->pixel_width
- last
->pixel_width
;
13309 row_width
= row
->pixel_width
;
13311 height
+= row
->height
;
13312 width
= max (width
, row_width
);
13315 /* Add the frame's internal border to the width and height the X
13316 window should have. */
13317 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13318 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13320 /* Move the tooltip window where the mouse pointer is. Resize and
13322 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
13325 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
13326 root_x
, root_y
- height
, width
, height
);
13327 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
13330 /* Draw into the window. */
13331 w
->must_be_updated_p
= 1;
13332 update_single_window (w
, 1);
13334 /* Restore original current buffer. */
13335 set_buffer_internal_1 (old_buffer
);
13336 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
13339 /* Let the tip disappear after timeout seconds. */
13340 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
13341 intern ("x-hide-tip"));
13344 return unbind_to (count
, Qnil
);
13348 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
13349 "Hide the current tooltip window, if there is any.\n\
13350 Value is t if tooltip was open, nil otherwise.")
13354 Lisp_Object deleted
, frame
, timer
;
13355 struct gcpro gcpro1
, gcpro2
;
13357 /* Return quickly if nothing to do. */
13358 if (NILP (tip_timer
) && NILP (tip_frame
))
13363 GCPRO2 (frame
, timer
);
13364 tip_frame
= tip_timer
= deleted
= Qnil
;
13366 count
= BINDING_STACK_SIZE ();
13367 specbind (Qinhibit_redisplay
, Qt
);
13368 specbind (Qinhibit_quit
, Qt
);
13371 call1 (Qcancel_timer
, timer
);
13373 if (FRAMEP (frame
))
13375 Fdelete_frame (frame
, Qnil
);
13380 return unbind_to (count
, deleted
);
13386 /***********************************************************************
13387 File selection dialog
13388 ***********************************************************************/
13390 extern Lisp_Object Qfile_name_history
;
13392 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
13393 "Read file name, prompting with PROMPT in directory DIR.\n\
13394 Use a file selection dialog.\n\
13395 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
13396 specified. Ensure that file exists if MUSTMATCH is non-nil.")
13397 (prompt
, dir
, default_filename
, mustmatch
)
13398 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
13400 struct frame
*f
= SELECTED_FRAME ();
13401 Lisp_Object file
= Qnil
;
13402 int count
= specpdl_ptr
- specpdl
;
13403 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
13404 char filename
[MAX_PATH
+ 1];
13405 char init_dir
[MAX_PATH
+ 1];
13406 int use_dialog_p
= 1;
13408 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
13409 CHECK_STRING (prompt
);
13410 CHECK_STRING (dir
);
13412 /* Create the dialog with PROMPT as title, using DIR as initial
13413 directory and using "*" as pattern. */
13414 dir
= Fexpand_file_name (dir
, Qnil
);
13415 strncpy (init_dir
, XSTRING (dir
)->data
, MAX_PATH
);
13416 init_dir
[MAX_PATH
] = '\0';
13417 unixtodos_filename (init_dir
);
13419 if (STRINGP (default_filename
))
13421 char *file_name_only
;
13422 char *full_path_name
= XSTRING (default_filename
)->data
;
13424 unixtodos_filename (full_path_name
);
13426 file_name_only
= strrchr (full_path_name
, '\\');
13427 if (!file_name_only
)
13428 file_name_only
= full_path_name
;
13433 /* If default_file_name is a directory, don't use the open
13434 file dialog, as it does not support selecting
13436 if (!(*file_name_only
))
13440 strncpy (filename
, file_name_only
, MAX_PATH
);
13441 filename
[MAX_PATH
] = '\0';
13444 filename
[0] = '\0';
13448 OPENFILENAME file_details
;
13450 /* Prevent redisplay. */
13451 specbind (Qinhibit_redisplay
, Qt
);
13454 bzero (&file_details
, sizeof (file_details
));
13455 file_details
.lStructSize
= sizeof (file_details
);
13456 file_details
.hwndOwner
= FRAME_W32_WINDOW (f
);
13457 /* Undocumented Bug in Common File Dialog:
13458 If a filter is not specified, shell links are not resolved. */
13459 file_details
.lpstrFilter
= "ALL Files (*.*)\0*.*\0\0";
13460 file_details
.lpstrFile
= filename
;
13461 file_details
.nMaxFile
= sizeof (filename
);
13462 file_details
.lpstrInitialDir
= init_dir
;
13463 file_details
.lpstrTitle
= XSTRING (prompt
)->data
;
13464 file_details
.Flags
= OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
;
13466 if (!NILP (mustmatch
))
13467 file_details
.Flags
|= OFN_FILEMUSTEXIST
| OFN_PATHMUSTEXIST
;
13469 if (GetOpenFileName (&file_details
))
13471 dostounix_filename (filename
);
13472 file
= build_string (filename
);
13478 file
= unbind_to (count
, file
);
13480 /* Open File dialog will not allow folders to be selected, so resort
13481 to minibuffer completing reads for directories. */
13483 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
13484 dir
, mustmatch
, dir
, Qfile_name_history
,
13485 default_filename
, Qnil
);
13489 /* Make "Cancel" equivalent to C-g. */
13491 Fsignal (Qquit
, Qnil
);
13493 return unbind_to (count
, file
);
13498 /***********************************************************************
13500 ***********************************************************************/
13504 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
13505 "Value is non-nil if SPEC is a valid image specification.")
13509 return valid_image_p (spec
) ? Qt
: Qnil
;
13513 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
13519 if (valid_image_p (spec
))
13520 id
= lookup_image (SELECTED_FRAME (), spec
);
13522 debug_print (spec
);
13523 return make_number (id
);
13526 #endif /* GLYPH_DEBUG != 0 */
13530 /***********************************************************************
13531 w32 specialized functions
13532 ***********************************************************************/
13534 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
13535 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
13539 FRAME_PTR f
= check_x_frame (frame
);
13547 bzero (&cf
, sizeof (cf
));
13548 bzero (&lf
, sizeof (lf
));
13550 cf
.lStructSize
= sizeof (cf
);
13551 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
13552 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
13553 cf
.lpLogFont
= &lf
;
13555 /* Initialize as much of the font details as we can from the current
13557 hdc
= GetDC (FRAME_W32_WINDOW (f
));
13558 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
13559 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
13560 if (GetTextMetrics (hdc
, &tm
))
13562 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
13563 lf
.lfWeight
= tm
.tmWeight
;
13564 lf
.lfItalic
= tm
.tmItalic
;
13565 lf
.lfUnderline
= tm
.tmUnderlined
;
13566 lf
.lfStrikeOut
= tm
.tmStruckOut
;
13567 lf
.lfCharSet
= tm
.tmCharSet
;
13568 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
13570 SelectObject (hdc
, oldobj
);
13571 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
13573 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
13576 return build_string (buf
);
13579 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
, Sw32_send_sys_command
, 1, 2, 0,
13580 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
13581 Some useful values for command are 0xf030 to maximise frame (0xf020\n\
13582 to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
13583 to activate the menubar for keyboard access. 0xf140 activates the\n\
13584 screen saver if defined.\n\
13586 If optional parameter FRAME is not specified, use selected frame.")
13588 Lisp_Object command
, frame
;
13590 FRAME_PTR f
= check_x_frame (frame
);
13592 CHECK_NUMBER (command
);
13594 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
13599 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
13600 "Get Windows to perform OPERATION on DOCUMENT.\n\
13601 This is a wrapper around the ShellExecute system function, which\n\
13602 invokes the application registered to handle OPERATION for DOCUMENT.\n\
13603 OPERATION is typically \"open\", \"print\" or \"explore\" (but can be\n\
13604 nil for the default action), and DOCUMENT is typically the name of a\n\
13605 document file or URL, but can also be a program executable to run or\n\
13606 a directory to open in the Windows Explorer.\n\
13608 If DOCUMENT is a program executable, PARAMETERS can be a string\n\
13609 containing command line parameters, but otherwise should be nil.\n\
13611 SHOW-FLAG can be used to control whether the invoked application is hidden\n\
13612 or minimized. If SHOW-FLAG is nil, the application is displayed normally,\n\
13613 otherwise it is an integer representing a ShowWindow flag:\n\
13615 0 - start hidden\n\
13616 1 - start normally\n\
13617 3 - start maximized\n\
13618 6 - start minimized")
13619 (operation
, document
, parameters
, show_flag
)
13620 Lisp_Object operation
, document
, parameters
, show_flag
;
13622 Lisp_Object current_dir
;
13624 CHECK_STRING (document
);
13626 /* Encode filename and current directory. */
13627 current_dir
= ENCODE_FILE (current_buffer
->directory
);
13628 document
= ENCODE_FILE (document
);
13629 if ((int) ShellExecute (NULL
,
13630 (STRINGP (operation
) ?
13631 XSTRING (operation
)->data
: NULL
),
13632 XSTRING (document
)->data
,
13633 (STRINGP (parameters
) ?
13634 XSTRING (parameters
)->data
: NULL
),
13635 XSTRING (current_dir
)->data
,
13636 (INTEGERP (show_flag
) ?
13637 XINT (show_flag
) : SW_SHOWDEFAULT
))
13640 error ("ShellExecute failed: %s", w32_strerror (0));
13643 /* Lookup virtual keycode from string representing the name of a
13644 non-ascii keystroke into the corresponding virtual key, using
13645 lispy_function_keys. */
13647 lookup_vk_code (char *key
)
13651 for (i
= 0; i
< 256; i
++)
13652 if (lispy_function_keys
[i
] != 0
13653 && strcmp (lispy_function_keys
[i
], key
) == 0)
13659 /* Convert a one-element vector style key sequence to a hot key
13662 w32_parse_hot_key (key
)
13665 /* Copied from Fdefine_key and store_in_keymap. */
13666 register Lisp_Object c
;
13668 int lisp_modifiers
;
13670 struct gcpro gcpro1
;
13672 CHECK_VECTOR (key
);
13674 if (XFASTINT (Flength (key
)) != 1)
13679 c
= Faref (key
, make_number (0));
13681 if (CONSP (c
) && lucid_event_type_list_p (c
))
13682 c
= Fevent_convert_list (c
);
13686 if (! INTEGERP (c
) && ! SYMBOLP (c
))
13687 error ("Key definition is invalid");
13689 /* Work out the base key and the modifiers. */
13692 c
= parse_modifiers (c
);
13693 lisp_modifiers
= Fcar (Fcdr (c
));
13697 vk_code
= lookup_vk_code (XSYMBOL (c
)->name
->data
);
13699 else if (INTEGERP (c
))
13701 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
13702 /* Many ascii characters are their own virtual key code. */
13703 vk_code
= XINT (c
) & CHARACTERBITS
;
13706 if (vk_code
< 0 || vk_code
> 255)
13709 if ((lisp_modifiers
& meta_modifier
) != 0
13710 && !NILP (Vw32_alt_is_meta
))
13711 lisp_modifiers
|= alt_modifier
;
13713 /* Supply defs missing from mingw32. */
13715 #define MOD_ALT 0x0001
13716 #define MOD_CONTROL 0x0002
13717 #define MOD_SHIFT 0x0004
13718 #define MOD_WIN 0x0008
13721 /* Convert lisp modifiers to Windows hot-key form. */
13722 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
13723 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
13724 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
13725 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
13727 return HOTKEY (vk_code
, w32_modifiers
);
13730 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
, Sw32_register_hot_key
, 1, 1, 0,
13731 "Register KEY as a hot-key combination.\n\
13732 Certain key combinations like Alt-Tab are reserved for system use on\n\
13733 Windows, and therefore are normally intercepted by the system. However,\n\
13734 most of these key combinations can be received by registering them as\n\
13735 hot-keys, overriding their special meaning.\n\
13737 KEY must be a one element key definition in vector form that would be\n\
13738 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta\n\
13739 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper\n\
13740 is always interpreted as the Windows modifier keys.\n\
13742 The return value is the hotkey-id if registered, otherwise nil.")
13746 key
= w32_parse_hot_key (key
);
13748 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
13750 /* Reuse an empty slot if possible. */
13751 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
13753 /* Safe to add new key to list, even if we have focus. */
13755 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
13757 XSETCAR (item
, key
);
13759 /* Notify input thread about new hot-key definition, so that it
13760 takes effect without needing to switch focus. */
13761 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
13768 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
, Sw32_unregister_hot_key
, 1, 1, 0,
13769 "Unregister HOTKEY as a hot-key combination.")
13775 if (!INTEGERP (key
))
13776 key
= w32_parse_hot_key (key
);
13778 item
= Fmemq (key
, w32_grabbed_keys
);
13782 /* Notify input thread about hot-key definition being removed, so
13783 that it takes effect without needing focus switch. */
13784 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
13785 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
13788 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
13795 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
, Sw32_registered_hot_keys
, 0, 0, 0,
13796 "Return list of registered hot-key IDs.")
13799 return Fcopy_sequence (w32_grabbed_keys
);
13802 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
, Sw32_reconstruct_hot_key
, 1, 1, 0,
13803 "Convert hot-key ID to a lisp key combination.")
13805 Lisp_Object hotkeyid
;
13807 int vk_code
, w32_modifiers
;
13810 CHECK_NUMBER (hotkeyid
);
13812 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
13813 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
13815 if (lispy_function_keys
[vk_code
])
13816 key
= intern (lispy_function_keys
[vk_code
]);
13818 key
= make_number (vk_code
);
13820 key
= Fcons (key
, Qnil
);
13821 if (w32_modifiers
& MOD_SHIFT
)
13822 key
= Fcons (Qshift
, key
);
13823 if (w32_modifiers
& MOD_CONTROL
)
13824 key
= Fcons (Qctrl
, key
);
13825 if (w32_modifiers
& MOD_ALT
)
13826 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
13827 if (w32_modifiers
& MOD_WIN
)
13828 key
= Fcons (Qhyper
, key
);
13833 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
, Sw32_toggle_lock_key
, 1, 2, 0,
13834 "Toggle the state of the lock key KEY.\n\
13835 KEY can be `capslock', `kp-numlock', or `scroll'.\n\
13836 If the optional parameter NEW-STATE is a number, then the state of KEY\n\
13837 is set to off if the low bit of NEW-STATE is zero, otherwise on.")
13839 Lisp_Object key
, new_state
;
13843 if (EQ (key
, intern ("capslock")))
13844 vk_code
= VK_CAPITAL
;
13845 else if (EQ (key
, intern ("kp-numlock")))
13846 vk_code
= VK_NUMLOCK
;
13847 else if (EQ (key
, intern ("scroll")))
13848 vk_code
= VK_SCROLL
;
13852 if (!dwWindowsThreadId
)
13853 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
13855 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
13856 (WPARAM
) vk_code
, (LPARAM
) new_state
))
13859 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
13860 return make_number (msg
.wParam
);
13865 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
13866 "Return storage information about the file system FILENAME is on.\n\
13867 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total\n\
13868 storage of the file system, FREE is the free storage, and AVAIL is the\n\
13869 storage available to a non-superuser. All 3 numbers are in bytes.\n\
13870 If the underlying system call fails, value is nil.")
13872 Lisp_Object filename
;
13874 Lisp_Object encoded
, value
;
13876 CHECK_STRING (filename
);
13877 filename
= Fexpand_file_name (filename
, Qnil
);
13878 encoded
= ENCODE_FILE (filename
);
13882 /* Determining the required information on Windows turns out, sadly,
13883 to be more involved than one would hope. The original Win32 api
13884 call for this will return bogus information on some systems, but we
13885 must dynamically probe for the replacement api, since that was
13886 added rather late on. */
13888 HMODULE hKernel
= GetModuleHandle ("kernel32");
13889 BOOL (*pfn_GetDiskFreeSpaceEx
)
13890 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
13891 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
13893 /* On Windows, we may need to specify the root directory of the
13894 volume holding FILENAME. */
13895 char rootname
[MAX_PATH
];
13896 char *name
= XSTRING (encoded
)->data
;
13898 /* find the root name of the volume if given */
13899 if (isalpha (name
[0]) && name
[1] == ':')
13901 rootname
[0] = name
[0];
13902 rootname
[1] = name
[1];
13903 rootname
[2] = '\\';
13906 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
13908 char *str
= rootname
;
13912 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
13922 if (pfn_GetDiskFreeSpaceEx
)
13924 LARGE_INTEGER availbytes
;
13925 LARGE_INTEGER freebytes
;
13926 LARGE_INTEGER totalbytes
;
13928 if (pfn_GetDiskFreeSpaceEx(rootname
,
13932 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
13933 make_float ((double) freebytes
.QuadPart
),
13934 make_float ((double) availbytes
.QuadPart
));
13938 DWORD sectors_per_cluster
;
13939 DWORD bytes_per_sector
;
13940 DWORD free_clusters
;
13941 DWORD total_clusters
;
13943 if (GetDiskFreeSpace(rootname
,
13944 §ors_per_cluster
,
13948 value
= list3 (make_float ((double) total_clusters
13949 * sectors_per_cluster
* bytes_per_sector
),
13950 make_float ((double) free_clusters
13951 * sectors_per_cluster
* bytes_per_sector
),
13952 make_float ((double) free_clusters
13953 * sectors_per_cluster
* bytes_per_sector
));
13962 /* This is zero if not using MS-Windows. */
13965 /* The section below is built by the lisp expression at the top of the file,
13966 just above where these variables are declared. */
13967 /*&&& init symbols here &&&*/
13968 Qauto_raise
= intern ("auto-raise");
13969 staticpro (&Qauto_raise
);
13970 Qauto_lower
= intern ("auto-lower");
13971 staticpro (&Qauto_lower
);
13972 Qbar
= intern ("bar");
13974 Qborder_color
= intern ("border-color");
13975 staticpro (&Qborder_color
);
13976 Qborder_width
= intern ("border-width");
13977 staticpro (&Qborder_width
);
13978 Qbox
= intern ("box");
13980 Qcursor_color
= intern ("cursor-color");
13981 staticpro (&Qcursor_color
);
13982 Qcursor_type
= intern ("cursor-type");
13983 staticpro (&Qcursor_type
);
13984 Qgeometry
= intern ("geometry");
13985 staticpro (&Qgeometry
);
13986 Qicon_left
= intern ("icon-left");
13987 staticpro (&Qicon_left
);
13988 Qicon_top
= intern ("icon-top");
13989 staticpro (&Qicon_top
);
13990 Qicon_type
= intern ("icon-type");
13991 staticpro (&Qicon_type
);
13992 Qicon_name
= intern ("icon-name");
13993 staticpro (&Qicon_name
);
13994 Qinternal_border_width
= intern ("internal-border-width");
13995 staticpro (&Qinternal_border_width
);
13996 Qleft
= intern ("left");
13997 staticpro (&Qleft
);
13998 Qright
= intern ("right");
13999 staticpro (&Qright
);
14000 Qmouse_color
= intern ("mouse-color");
14001 staticpro (&Qmouse_color
);
14002 Qnone
= intern ("none");
14003 staticpro (&Qnone
);
14004 Qparent_id
= intern ("parent-id");
14005 staticpro (&Qparent_id
);
14006 Qscroll_bar_width
= intern ("scroll-bar-width");
14007 staticpro (&Qscroll_bar_width
);
14008 Qsuppress_icon
= intern ("suppress-icon");
14009 staticpro (&Qsuppress_icon
);
14010 Qundefined_color
= intern ("undefined-color");
14011 staticpro (&Qundefined_color
);
14012 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
14013 staticpro (&Qvertical_scroll_bars
);
14014 Qvisibility
= intern ("visibility");
14015 staticpro (&Qvisibility
);
14016 Qwindow_id
= intern ("window-id");
14017 staticpro (&Qwindow_id
);
14018 Qx_frame_parameter
= intern ("x-frame-parameter");
14019 staticpro (&Qx_frame_parameter
);
14020 Qx_resource_name
= intern ("x-resource-name");
14021 staticpro (&Qx_resource_name
);
14022 Quser_position
= intern ("user-position");
14023 staticpro (&Quser_position
);
14024 Quser_size
= intern ("user-size");
14025 staticpro (&Quser_size
);
14026 Qscreen_gamma
= intern ("screen-gamma");
14027 staticpro (&Qscreen_gamma
);
14028 Qline_spacing
= intern ("line-spacing");
14029 staticpro (&Qline_spacing
);
14030 Qcenter
= intern ("center");
14031 staticpro (&Qcenter
);
14032 Qcancel_timer
= intern ("cancel-timer");
14033 staticpro (&Qcancel_timer
);
14034 /* This is the end of symbol initialization. */
14036 Qhyper
= intern ("hyper");
14037 staticpro (&Qhyper
);
14038 Qsuper
= intern ("super");
14039 staticpro (&Qsuper
);
14040 Qmeta
= intern ("meta");
14041 staticpro (&Qmeta
);
14042 Qalt
= intern ("alt");
14044 Qctrl
= intern ("ctrl");
14045 staticpro (&Qctrl
);
14046 Qcontrol
= intern ("control");
14047 staticpro (&Qcontrol
);
14048 Qshift
= intern ("shift");
14049 staticpro (&Qshift
);
14051 /* Text property `display' should be nonsticky by default. */
14052 Vtext_property_default_nonsticky
14053 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
14056 Qlaplace
= intern ("laplace");
14057 staticpro (&Qlaplace
);
14058 Qemboss
= intern ("emboss");
14059 staticpro (&Qemboss
);
14060 Qedge_detection
= intern ("edge-detection");
14061 staticpro (&Qedge_detection
);
14062 Qheuristic
= intern ("heuristic");
14063 staticpro (&Qheuristic
);
14064 QCmatrix
= intern (":matrix");
14065 staticpro (&QCmatrix
);
14066 QCcolor_adjustment
= intern (":color-adjustment");
14067 staticpro (&QCcolor_adjustment
);
14068 QCmask
= intern (":mask");
14069 staticpro (&QCmask
);
14071 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
14072 staticpro (&Qface_set_after_frame_default
);
14074 Fput (Qundefined_color
, Qerror_conditions
,
14075 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
14076 Fput (Qundefined_color
, Qerror_message
,
14077 build_string ("Undefined color"));
14079 staticpro (&w32_grabbed_keys
);
14080 w32_grabbed_keys
= Qnil
;
14082 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
14083 "An array of color name mappings for windows.");
14084 Vw32_color_map
= Qnil
;
14086 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
14087 "Non-nil if alt key presses are passed on to Windows.\n\
14088 When non-nil, for example, alt pressed and released and then space will\n\
14089 open the System menu. When nil, Emacs silently swallows alt key events.");
14090 Vw32_pass_alt_to_system
= Qnil
;
14092 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
14093 "Non-nil if the alt key is to be considered the same as the meta key.\n\
14094 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
14095 Vw32_alt_is_meta
= Qt
;
14097 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
14098 "If non-zero, the virtual key code for an alternative quit key.");
14099 XSETINT (Vw32_quit_key
, 0);
14101 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14102 &Vw32_pass_lwindow_to_system
,
14103 "Non-nil if the left \"Windows\" key is passed on to Windows.\n\
14104 When non-nil, the Start menu is opened by tapping the key.");
14105 Vw32_pass_lwindow_to_system
= Qt
;
14107 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14108 &Vw32_pass_rwindow_to_system
,
14109 "Non-nil if the right \"Windows\" key is passed on to Windows.\n\
14110 When non-nil, the Start menu is opened by tapping the key.");
14111 Vw32_pass_rwindow_to_system
= Qt
;
14113 DEFVAR_INT ("w32-phantom-key-code",
14114 &Vw32_phantom_key_code
,
14115 "Virtual key code used to generate \"phantom\" key presses.\n\
14116 Value is a number between 0 and 255.\n\
14118 Phantom key presses are generated in order to stop the system from\n\
14119 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or\n\
14120 `w32-pass-rwindow-to-system' is nil.");
14121 /* Although 255 is technically not a valid key code, it works and
14122 means that this hack won't interfere with any real key code. */
14123 Vw32_phantom_key_code
= 255;
14125 DEFVAR_LISP ("w32-enable-num-lock",
14126 &Vw32_enable_num_lock
,
14127 "Non-nil if Num Lock should act normally.\n\
14128 Set to nil to see Num Lock as the key `kp-numlock'.");
14129 Vw32_enable_num_lock
= Qt
;
14131 DEFVAR_LISP ("w32-enable-caps-lock",
14132 &Vw32_enable_caps_lock
,
14133 "Non-nil if Caps Lock should act normally.\n\
14134 Set to nil to see Caps Lock as the key `capslock'.");
14135 Vw32_enable_caps_lock
= Qt
;
14137 DEFVAR_LISP ("w32-scroll-lock-modifier",
14138 &Vw32_scroll_lock_modifier
,
14139 "Modifier to use for the Scroll Lock on state.\n\
14140 The value can be hyper, super, meta, alt, control or shift for the\n\
14141 respective modifier, or nil to see Scroll Lock as the key `scroll'.\n\
14142 Any other value will cause the key to be ignored.");
14143 Vw32_scroll_lock_modifier
= Qt
;
14145 DEFVAR_LISP ("w32-lwindow-modifier",
14146 &Vw32_lwindow_modifier
,
14147 "Modifier to use for the left \"Windows\" key.\n\
14148 The value can be hyper, super, meta, alt, control or shift for the\n\
14149 respective modifier, or nil to appear as the key `lwindow'.\n\
14150 Any other value will cause the key to be ignored.");
14151 Vw32_lwindow_modifier
= Qnil
;
14153 DEFVAR_LISP ("w32-rwindow-modifier",
14154 &Vw32_rwindow_modifier
,
14155 "Modifier to use for the right \"Windows\" key.\n\
14156 The value can be hyper, super, meta, alt, control or shift for the\n\
14157 respective modifier, or nil to appear as the key `rwindow'.\n\
14158 Any other value will cause the key to be ignored.");
14159 Vw32_rwindow_modifier
= Qnil
;
14161 DEFVAR_LISP ("w32-apps-modifier",
14162 &Vw32_apps_modifier
,
14163 "Modifier to use for the \"Apps\" key.\n\
14164 The value can be hyper, super, meta, alt, control or shift for the\n\
14165 respective modifier, or nil to appear as the key `apps'.\n\
14166 Any other value will cause the key to be ignored.");
14167 Vw32_apps_modifier
= Qnil
;
14169 DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts
,
14170 "Non-nil enables selection of artificially italicized and bold fonts.");
14171 Vw32_enable_synthesized_fonts
= Qnil
;
14173 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
14174 "Non-nil enables Windows palette management to map colors exactly.");
14175 Vw32_enable_palette
= Qt
;
14177 DEFVAR_INT ("w32-mouse-button-tolerance",
14178 &Vw32_mouse_button_tolerance
,
14179 "Analogue of double click interval for faking middle mouse events.\n\
14180 The value is the minimum time in milliseconds that must elapse between\n\
14181 left/right button down events before they are considered distinct events.\n\
14182 If both mouse buttons are depressed within this interval, a middle mouse\n\
14183 button down event is generated instead.");
14184 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
14186 DEFVAR_INT ("w32-mouse-move-interval",
14187 &Vw32_mouse_move_interval
,
14188 "Minimum interval between mouse move events.\n\
14189 The value is the minimum time in milliseconds that must elapse between\n\
14190 successive mouse move (or scroll bar drag) events before they are\n\
14191 reported as lisp events.");
14192 XSETINT (Vw32_mouse_move_interval
, 0);
14194 init_x_parm_symbols ();
14196 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
14197 "List of directories to search for bitmap files for w32.");
14198 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
14200 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
14201 "The shape of the pointer when over text.\n\
14202 Changing the value does not affect existing frames\n\
14203 unless you set the mouse color.");
14204 Vx_pointer_shape
= Qnil
;
14206 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
14207 "The name Emacs uses to look up resources; for internal use only.\n\
14208 `x-get-resource' uses this as the first component of the instance name\n\
14209 when requesting resource values.\n\
14210 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
14211 was invoked, or to the value specified with the `-name' or `-rn'\n\
14212 switches, if present.");
14213 Vx_resource_name
= Qnil
;
14215 Vx_nontext_pointer_shape
= Qnil
;
14217 Vx_mode_pointer_shape
= Qnil
;
14219 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
14220 "The shape of the pointer when Emacs is busy.\n\
14221 This variable takes effect when you create a new frame\n\
14222 or when you set the mouse color.");
14223 Vx_hourglass_pointer_shape
= Qnil
;
14225 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
14226 "Non-zero means Emacs displays an hourglass pointer on window systems.");
14227 display_hourglass_p
= 1;
14229 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
14230 "*Seconds to wait before displaying an hourglass pointer.\n\
14231 Value must be an integer or float.");
14232 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
14234 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
14235 &Vx_sensitive_text_pointer_shape
,
14236 "The shape of the pointer when over mouse-sensitive text.\n\
14237 This variable takes effect when you create a new frame\n\
14238 or when you set the mouse color.");
14239 Vx_sensitive_text_pointer_shape
= Qnil
;
14241 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
14242 &Vx_window_horizontal_drag_shape
,
14243 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
14244 This variable takes effect when you create a new frame\n\
14245 or when you set the mouse color.");
14246 Vx_window_horizontal_drag_shape
= Qnil
;
14248 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
14249 "A string indicating the foreground color of the cursor box.");
14250 Vx_cursor_fore_pixel
= Qnil
;
14252 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
14253 "Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).\n\
14254 Text larger than this is clipped.");
14255 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
14257 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
14258 "Non-nil if no window manager is in use.\n\
14259 Emacs doesn't try to figure this out; this is always nil\n\
14260 unless you set it to something else.");
14261 /* We don't have any way to find this out, so set it to nil
14262 and maybe the user would like to set it to t. */
14263 Vx_no_window_manager
= Qnil
;
14265 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
14266 &Vx_pixel_size_width_font_regexp
,
14267 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
14269 Since Emacs gets width of a font matching with this regexp from\n\
14270 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
14271 such a font. This is especially effective for such large fonts as\n\
14272 Chinese, Japanese, and Korean.");
14273 Vx_pixel_size_width_font_regexp
= Qnil
;
14275 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
14276 "Time after which cached images are removed from the cache.\n\
14277 When an image has not been displayed this many seconds, remove it\n\
14278 from the image cache. Value must be an integer or nil with nil\n\
14279 meaning don't clear the cache.");
14280 Vimage_cache_eviction_delay
= make_number (30 * 60);
14282 DEFVAR_LISP ("w32-bdf-filename-alist",
14283 &Vw32_bdf_filename_alist
,
14284 "List of bdf fonts and their corresponding filenames.");
14285 Vw32_bdf_filename_alist
= Qnil
;
14287 DEFVAR_BOOL ("w32-strict-fontnames",
14288 &w32_strict_fontnames
,
14289 "Non-nil means only use fonts that are exact matches for those requested.\n\
14290 Default is nil, which allows old fontnames that are not XLFD compliant,\n\
14291 and allows third-party CJK display to work by specifying false charset\n\
14292 fields to trick Emacs into translating to Big5, SJIS etc.\n\
14293 Setting this to t will prevent wrong fonts being selected when\n\
14294 fontsets are automatically created.");
14295 w32_strict_fontnames
= 0;
14297 DEFVAR_BOOL ("w32-strict-painting",
14298 &w32_strict_painting
,
14299 "Non-nil means use strict rules for repainting frames.\n\
14300 Set this to nil to get the old behaviour for repainting; this should\n\
14301 only be necessary if the default setting causes problems.");
14302 w32_strict_painting
= 1;
14304 DEFVAR_LISP ("w32-system-coding-system",
14305 &Vw32_system_coding_system
,
14306 "Coding system used by Windows system functions, such as for font names.");
14307 Vw32_system_coding_system
= Qnil
;
14309 DEFVAR_LISP ("w32-charset-info-alist",
14310 &Vw32_charset_info_alist
,
14311 "Alist linking Emacs character sets to Windows fonts\n\
14312 and codepages. Each entry should be of the form:\n\
14314 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))\n\
14316 where CHARSET_NAME is a string used in font names to identify the charset,\n\
14317 WINDOWS_CHARSET is a symbol that can be one of:\n\
14318 w32-charset-ansi, w32-charset-default, w32-charset-symbol,\n\
14319 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,\n\
14320 w32-charset-chinesebig5, "
14321 #ifdef JOHAB_CHARSET
14322 "w32-charset-johab, w32-charset-hebrew,\n\
14323 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,\n\
14324 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,\n\
14325 w32-charset-russian, w32-charset-mac, w32-charset-baltic,\n"
14327 #ifdef UNICODE_CHARSET
14328 "w32-charset-unicode, "
14330 "or w32-charset-oem.\n\
14331 CODEPAGE should be an integer specifying the codepage that should be used\n\
14332 to display the character set, t to do no translation and output as Unicode,\n\
14333 or nil to do no translation and output as 8 bit (or multibyte on far-east\n\
14334 versions of Windows) characters.");
14335 Vw32_charset_info_alist
= Qnil
;
14337 staticpro (&Qw32_charset_ansi
);
14338 Qw32_charset_ansi
= intern ("w32-charset-ansi");
14339 staticpro (&Qw32_charset_symbol
);
14340 Qw32_charset_symbol
= intern ("w32-charset-symbol");
14341 staticpro (&Qw32_charset_shiftjis
);
14342 Qw32_charset_shiftjis
= intern ("w32-charset-shiftjis");
14343 staticpro (&Qw32_charset_hangeul
);
14344 Qw32_charset_hangeul
= intern ("w32-charset-hangeul");
14345 staticpro (&Qw32_charset_chinesebig5
);
14346 Qw32_charset_chinesebig5
= intern ("w32-charset-chinesebig5");
14347 staticpro (&Qw32_charset_gb2312
);
14348 Qw32_charset_gb2312
= intern ("w32-charset-gb2312");
14349 staticpro (&Qw32_charset_oem
);
14350 Qw32_charset_oem
= intern ("w32-charset-oem");
14352 #ifdef JOHAB_CHARSET
14354 static int w32_extra_charsets_defined
= 1;
14355 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
, "");
14357 staticpro (&Qw32_charset_johab
);
14358 Qw32_charset_johab
= intern ("w32-charset-johab");
14359 staticpro (&Qw32_charset_easteurope
);
14360 Qw32_charset_easteurope
= intern ("w32-charset-easteurope");
14361 staticpro (&Qw32_charset_turkish
);
14362 Qw32_charset_turkish
= intern ("w32-charset-turkish");
14363 staticpro (&Qw32_charset_baltic
);
14364 Qw32_charset_baltic
= intern ("w32-charset-baltic");
14365 staticpro (&Qw32_charset_russian
);
14366 Qw32_charset_russian
= intern ("w32-charset-russian");
14367 staticpro (&Qw32_charset_arabic
);
14368 Qw32_charset_arabic
= intern ("w32-charset-arabic");
14369 staticpro (&Qw32_charset_greek
);
14370 Qw32_charset_greek
= intern ("w32-charset-greek");
14371 staticpro (&Qw32_charset_hebrew
);
14372 Qw32_charset_hebrew
= intern ("w32-charset-hebrew");
14373 staticpro (&Qw32_charset_vietnamese
);
14374 Qw32_charset_vietnamese
= intern ("w32-charset-vietnamese");
14375 staticpro (&Qw32_charset_thai
);
14376 Qw32_charset_thai
= intern ("w32-charset-thai");
14377 staticpro (&Qw32_charset_mac
);
14378 Qw32_charset_mac
= intern ("w32-charset-mac");
14382 #ifdef UNICODE_CHARSET
14384 static int w32_unicode_charset_defined
= 1;
14385 DEFVAR_BOOL ("w32-unicode-charset-defined",
14386 &w32_unicode_charset_defined
, "");
14388 staticpro (&Qw32_charset_unicode
);
14389 Qw32_charset_unicode
= intern ("w32-charset-unicode");
14392 defsubr (&Sx_get_resource
);
14393 #if 0 /* TODO: Port to W32 */
14394 defsubr (&Sx_change_window_property
);
14395 defsubr (&Sx_delete_window_property
);
14396 defsubr (&Sx_window_property
);
14398 defsubr (&Sxw_display_color_p
);
14399 defsubr (&Sx_display_grayscale_p
);
14400 defsubr (&Sxw_color_defined_p
);
14401 defsubr (&Sxw_color_values
);
14402 defsubr (&Sx_server_max_request_size
);
14403 defsubr (&Sx_server_vendor
);
14404 defsubr (&Sx_server_version
);
14405 defsubr (&Sx_display_pixel_width
);
14406 defsubr (&Sx_display_pixel_height
);
14407 defsubr (&Sx_display_mm_width
);
14408 defsubr (&Sx_display_mm_height
);
14409 defsubr (&Sx_display_screens
);
14410 defsubr (&Sx_display_planes
);
14411 defsubr (&Sx_display_color_cells
);
14412 defsubr (&Sx_display_visual_class
);
14413 defsubr (&Sx_display_backing_store
);
14414 defsubr (&Sx_display_save_under
);
14415 defsubr (&Sx_parse_geometry
);
14416 defsubr (&Sx_create_frame
);
14417 defsubr (&Sx_open_connection
);
14418 defsubr (&Sx_close_connection
);
14419 defsubr (&Sx_display_list
);
14420 defsubr (&Sx_synchronize
);
14422 /* W32 specific functions */
14424 defsubr (&Sw32_focus_frame
);
14425 defsubr (&Sw32_select_font
);
14426 defsubr (&Sw32_define_rgb_color
);
14427 defsubr (&Sw32_default_color_map
);
14428 defsubr (&Sw32_load_color_file
);
14429 defsubr (&Sw32_send_sys_command
);
14430 defsubr (&Sw32_shell_execute
);
14431 defsubr (&Sw32_register_hot_key
);
14432 defsubr (&Sw32_unregister_hot_key
);
14433 defsubr (&Sw32_registered_hot_keys
);
14434 defsubr (&Sw32_reconstruct_hot_key
);
14435 defsubr (&Sw32_toggle_lock_key
);
14436 defsubr (&Sw32_find_bdf_fonts
);
14438 defsubr (&Sfile_system_info
);
14440 /* Setting callback functions for fontset handler. */
14441 get_font_info_func
= w32_get_font_info
;
14443 #if 0 /* This function pointer doesn't seem to be used anywhere.
14444 And the pointer assigned has the wrong type, anyway. */
14445 list_fonts_func
= w32_list_fonts
;
14448 load_font_func
= w32_load_font
;
14449 find_ccl_program_func
= w32_find_ccl_program
;
14450 query_font_func
= w32_query_font
;
14451 set_frame_fontset_func
= x_set_font
;
14452 check_window_system_func
= check_w32
;
14454 #if 0 /* TODO Image support for W32 */
14456 Qxbm
= intern ("xbm");
14458 QCtype
= intern (":type");
14459 staticpro (&QCtype
);
14460 QCconversion
= intern (":conversion");
14461 staticpro (&QCconversion
);
14462 QCheuristic_mask
= intern (":heuristic-mask");
14463 staticpro (&QCheuristic_mask
);
14464 QCcolor_symbols
= intern (":color-symbols");
14465 staticpro (&QCcolor_symbols
);
14466 QCascent
= intern (":ascent");
14467 staticpro (&QCascent
);
14468 QCmargin
= intern (":margin");
14469 staticpro (&QCmargin
);
14470 QCrelief
= intern (":relief");
14471 staticpro (&QCrelief
);
14472 Qpostscript
= intern ("postscript");
14473 staticpro (&Qpostscript
);
14474 QCloader
= intern (":loader");
14475 staticpro (&QCloader
);
14476 QCbounding_box
= intern (":bounding-box");
14477 staticpro (&QCbounding_box
);
14478 QCpt_width
= intern (":pt-width");
14479 staticpro (&QCpt_width
);
14480 QCpt_height
= intern (":pt-height");
14481 staticpro (&QCpt_height
);
14482 QCindex
= intern (":index");
14483 staticpro (&QCindex
);
14484 Qpbm
= intern ("pbm");
14488 Qxpm
= intern ("xpm");
14493 Qjpeg
= intern ("jpeg");
14494 staticpro (&Qjpeg
);
14498 Qtiff
= intern ("tiff");
14499 staticpro (&Qtiff
);
14503 Qgif
= intern ("gif");
14508 Qpng
= intern ("png");
14512 defsubr (&Sclear_image_cache
);
14515 defsubr (&Simagep
);
14516 defsubr (&Slookup_image
);
14520 hourglass_atimer
= NULL
;
14521 hourglass_shown_p
= 0;
14522 #ifdef TODO /* Tooltip support not complete. */
14523 defsubr (&Sx_show_tip
);
14524 defsubr (&Sx_hide_tip
);
14527 staticpro (&tip_timer
);
14529 staticpro (&tip_frame
);
14531 defsubr (&Sx_file_dialog
);
14538 image_types
= NULL
;
14539 Vimage_types
= Qnil
;
14541 #if 0 /* TODO : Image support for W32 */
14542 define_image_type (&xbm_type
);
14543 define_image_type (&gs_type
);
14544 define_image_type (&pbm_type
);
14547 define_image_type (&xpm_type
);
14551 define_image_type (&jpeg_type
);
14555 define_image_type (&tiff_type
);
14559 define_image_type (&gif_type
);
14563 define_image_type (&png_type
);
14574 button
= MessageBox (NULL
,
14575 "A fatal error has occurred!\n\n"
14576 "Select Abort to exit, Retry to debug, Ignore to continue",
14577 "Emacs Abort Dialog",
14578 MB_ICONEXCLAMATION
| MB_TASKMODAL
14579 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
14594 /* For convenience when debugging. */
14598 return GetLastError ();