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 extern void free_frame_menubar ();
56 extern double atof ();
57 extern int w32_console_toggle_lock_key (int vk_code
, Lisp_Object new_state
);
60 /* A definition of XColor for non-X frames. */
61 #ifndef HAVE_X_WINDOWS
64 unsigned short red
, green
, blue
;
70 extern char *lispy_function_keys
[];
72 /* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
73 it, and including `bitmaps/gray' more than once is a problem when
74 config.h defines `static' as an empty replacement string. */
76 int gray_bitmap_width
= gray_width
;
77 int gray_bitmap_height
= gray_height
;
78 unsigned char *gray_bitmap_bits
= gray_bits
;
80 /* The colormap for converting color names to RGB values */
81 Lisp_Object Vw32_color_map
;
83 /* Non nil if alt key presses are passed on to Windows. */
84 Lisp_Object Vw32_pass_alt_to_system
;
86 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
88 Lisp_Object Vw32_alt_is_meta
;
90 /* If non-zero, the windows virtual key code for an alternative quit key. */
91 Lisp_Object Vw32_quit_key
;
93 /* Non nil if left window key events are passed on to Windows (this only
94 affects whether "tapping" the key opens the Start menu). */
95 Lisp_Object Vw32_pass_lwindow_to_system
;
97 /* Non nil if right window key events are passed on to Windows (this
98 only affects whether "tapping" the key opens the Start menu). */
99 Lisp_Object Vw32_pass_rwindow_to_system
;
101 /* Virtual key code used to generate "phantom" key presses in order
102 to stop system from acting on Windows key events. */
103 Lisp_Object Vw32_phantom_key_code
;
105 /* Modifier associated with the left "Windows" key, or nil to act as a
107 Lisp_Object Vw32_lwindow_modifier
;
109 /* Modifier associated with the right "Windows" key, or nil to act as a
111 Lisp_Object Vw32_rwindow_modifier
;
113 /* Modifier associated with the "Apps" key, or nil to act as a normal
115 Lisp_Object Vw32_apps_modifier
;
117 /* Value is nil if Num Lock acts as a function key. */
118 Lisp_Object Vw32_enable_num_lock
;
120 /* Value is nil if Caps Lock acts as a function key. */
121 Lisp_Object Vw32_enable_caps_lock
;
123 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
124 Lisp_Object Vw32_scroll_lock_modifier
;
126 /* Switch to control whether we inhibit requests for synthesized bold
127 and italic versions of fonts. */
128 Lisp_Object Vw32_enable_synthesized_fonts
;
130 /* Enable palette management. */
131 Lisp_Object Vw32_enable_palette
;
133 /* Control how close left/right button down events must be to
134 be converted to a middle button down event. */
135 Lisp_Object Vw32_mouse_button_tolerance
;
137 /* Minimum interval between mouse movement (and scroll bar drag)
138 events that are passed on to the event loop. */
139 Lisp_Object Vw32_mouse_move_interval
;
141 /* The name we're using in resource queries. */
142 Lisp_Object Vx_resource_name
;
144 /* Non nil if no window manager is in use. */
145 Lisp_Object Vx_no_window_manager
;
147 /* Non-zero means we're allowed to display a hourglass pointer. */
149 int display_hourglass_p
;
151 /* The background and shape of the mouse pointer, and shape when not
152 over text or in the modeline. */
154 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
155 Lisp_Object Vx_hourglass_pointer_shape
, Vx_window_horizontal_drag_shape
;
157 /* The shape when over mouse-sensitive text. */
159 Lisp_Object Vx_sensitive_text_pointer_shape
;
161 /* Color of chars displayed in cursor box. */
163 Lisp_Object Vx_cursor_fore_pixel
;
165 /* Nonzero if using Windows. */
167 static int w32_in_use
;
169 /* Search path for bitmap files. */
171 Lisp_Object Vx_bitmap_file_path
;
173 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
175 Lisp_Object Vx_pixel_size_width_font_regexp
;
177 /* Alist of bdf fonts and the files that define them. */
178 Lisp_Object Vw32_bdf_filename_alist
;
180 Lisp_Object Vw32_system_coding_system
;
182 /* A flag to control whether fonts are matched strictly or not. */
183 int w32_strict_fontnames
;
185 /* A flag to control whether we should only repaint if GetUpdateRect
186 indicates there is an update region. */
187 int w32_strict_painting
;
189 /* Associative list linking character set strings to Windows codepages. */
190 Lisp_Object Vw32_charset_info_alist
;
192 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
193 #ifndef VIETNAMESE_CHARSET
194 #define VIETNAMESE_CHARSET 163
197 Lisp_Object Qauto_raise
;
198 Lisp_Object Qauto_lower
;
200 Lisp_Object Qborder_color
;
201 Lisp_Object Qborder_width
;
203 Lisp_Object Qcursor_color
;
204 Lisp_Object Qcursor_type
;
205 Lisp_Object Qgeometry
;
206 Lisp_Object Qicon_left
;
207 Lisp_Object Qicon_top
;
208 Lisp_Object Qicon_type
;
209 Lisp_Object Qicon_name
;
210 Lisp_Object Qinternal_border_width
;
213 Lisp_Object Qmouse_color
;
215 Lisp_Object Qparent_id
;
216 Lisp_Object Qscroll_bar_width
;
217 Lisp_Object Qsuppress_icon
;
218 Lisp_Object Qundefined_color
;
219 Lisp_Object Qvertical_scroll_bars
;
220 Lisp_Object Qvisibility
;
221 Lisp_Object Qwindow_id
;
222 Lisp_Object Qx_frame_parameter
;
223 Lisp_Object Qx_resource_name
;
224 Lisp_Object Quser_position
;
225 Lisp_Object Quser_size
;
226 Lisp_Object Qscreen_gamma
;
227 Lisp_Object Qline_spacing
;
229 Lisp_Object Qcancel_timer
;
235 Lisp_Object Qcontrol
;
238 Lisp_Object Qw32_charset_ansi
;
239 Lisp_Object Qw32_charset_default
;
240 Lisp_Object Qw32_charset_symbol
;
241 Lisp_Object Qw32_charset_shiftjis
;
242 Lisp_Object Qw32_charset_hangeul
;
243 Lisp_Object Qw32_charset_gb2312
;
244 Lisp_Object Qw32_charset_chinesebig5
;
245 Lisp_Object Qw32_charset_oem
;
247 #ifndef JOHAB_CHARSET
248 #define JOHAB_CHARSET 130
251 Lisp_Object Qw32_charset_easteurope
;
252 Lisp_Object Qw32_charset_turkish
;
253 Lisp_Object Qw32_charset_baltic
;
254 Lisp_Object Qw32_charset_russian
;
255 Lisp_Object Qw32_charset_arabic
;
256 Lisp_Object Qw32_charset_greek
;
257 Lisp_Object Qw32_charset_hebrew
;
258 Lisp_Object Qw32_charset_vietnamese
;
259 Lisp_Object Qw32_charset_thai
;
260 Lisp_Object Qw32_charset_johab
;
261 Lisp_Object Qw32_charset_mac
;
264 #ifdef UNICODE_CHARSET
265 Lisp_Object Qw32_charset_unicode
;
268 extern Lisp_Object Qtop
;
269 extern Lisp_Object Qdisplay
;
270 extern Lisp_Object Qtool_bar_lines
;
272 /* State variables for emulating a three button mouse. */
277 static int button_state
= 0;
278 static W32Msg saved_mouse_button_msg
;
279 static unsigned mouse_button_timer
; /* non-zero when timer is active */
280 static W32Msg saved_mouse_move_msg
;
281 static unsigned mouse_move_timer
;
283 /* W95 mousewheel handler */
284 unsigned int msh_mousewheel
= 0;
286 #define MOUSE_BUTTON_ID 1
287 #define MOUSE_MOVE_ID 2
289 /* The below are defined in frame.c. */
291 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
292 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
293 extern Lisp_Object Qtool_bar_lines
;
295 extern Lisp_Object Vwindow_system_version
;
297 Lisp_Object Qface_set_after_frame_default
;
300 int image_cache_refcount
, dpyinfo_refcount
;
304 /* From w32term.c. */
305 extern Lisp_Object Vw32_num_mouse_buttons
;
306 extern Lisp_Object Vw32_recognize_altgr
;
308 extern HWND w32_system_caret_hwnd
;
309 extern int w32_system_caret_width
;
310 extern int w32_system_caret_height
;
311 extern int w32_system_caret_x
;
312 extern int w32_system_caret_y
;
315 /* Error if we are not connected to MS-Windows. */
320 error ("MS-Windows not in use or not initialized");
323 /* Nonzero if we can use mouse menus.
324 You should not call this unless HAVE_MENUS is defined. */
332 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
333 and checking validity for W32. */
336 check_x_frame (frame
)
342 frame
= selected_frame
;
343 CHECK_LIVE_FRAME (frame
);
345 if (! FRAME_W32_P (f
))
346 error ("non-w32 frame used");
350 /* Let the user specify an display with a frame.
351 nil stands for the selected frame--or, if that is not a w32 frame,
352 the first display on the list. */
354 static struct w32_display_info
*
355 check_x_display_info (frame
)
360 struct frame
*sf
= XFRAME (selected_frame
);
362 if (FRAME_W32_P (sf
) && FRAME_LIVE_P (sf
))
363 return FRAME_W32_DISPLAY_INFO (sf
);
365 return &one_w32_display_info
;
367 else if (STRINGP (frame
))
368 return x_display_info_for_name (frame
);
373 CHECK_LIVE_FRAME (frame
);
375 if (! FRAME_W32_P (f
))
376 error ("non-w32 frame used");
377 return FRAME_W32_DISPLAY_INFO (f
);
381 /* Return the Emacs frame-object corresponding to an w32 window.
382 It could be the frame's main window or an icon window. */
384 /* This function can be called during GC, so use GC_xxx type test macros. */
387 x_window_to_frame (dpyinfo
, wdesc
)
388 struct w32_display_info
*dpyinfo
;
391 Lisp_Object tail
, frame
;
394 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
397 if (!GC_FRAMEP (frame
))
400 if (!FRAME_W32_P (f
) || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
402 if (f
->output_data
.w32
->hourglass_window
== wdesc
)
405 /* TODO: Check tooltips when supported. */
406 if (FRAME_W32_WINDOW (f
) == wdesc
)
414 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
415 id, which is just an int that this section returns. Bitmaps are
416 reference counted so they can be shared among frames.
418 Bitmap indices are guaranteed to be > 0, so a negative number can
419 be used to indicate no bitmap.
421 If you use x_create_bitmap_from_data, then you must keep track of
422 the bitmaps yourself. That is, creating a bitmap from the same
423 data more than once will not be caught. */
426 /* Functions to access the contents of a bitmap, given an id. */
429 x_bitmap_height (f
, id
)
433 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
437 x_bitmap_width (f
, id
)
441 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
445 x_bitmap_pixmap (f
, id
)
449 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
453 /* Allocate a new bitmap record. Returns index of new record. */
456 x_allocate_bitmap_record (f
)
459 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
462 if (dpyinfo
->bitmaps
== NULL
)
464 dpyinfo
->bitmaps_size
= 10;
466 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
467 dpyinfo
->bitmaps_last
= 1;
471 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
472 return ++dpyinfo
->bitmaps_last
;
474 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
475 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
478 dpyinfo
->bitmaps_size
*= 2;
480 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
481 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
482 return ++dpyinfo
->bitmaps_last
;
485 /* Add one reference to the reference count of the bitmap with id ID. */
488 x_reference_bitmap (f
, id
)
492 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
495 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
498 x_create_bitmap_from_data (f
, bits
, width
, height
)
501 unsigned int width
, height
;
503 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
507 bitmap
= CreateBitmap (width
, height
,
508 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
509 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
515 id
= x_allocate_bitmap_record (f
);
516 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
517 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
518 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
519 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
520 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
521 dpyinfo
->bitmaps
[id
- 1].height
= height
;
522 dpyinfo
->bitmaps
[id
- 1].width
= width
;
527 /* Create bitmap from file FILE for frame F. */
530 x_create_bitmap_from_file (f
, file
)
535 #if 0 /* TODO : bitmap support */
536 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
537 unsigned int width
, height
;
539 int xhot
, yhot
, result
, id
;
545 /* Look for an existing bitmap with the same name. */
546 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
548 if (dpyinfo
->bitmaps
[id
].refcount
549 && dpyinfo
->bitmaps
[id
].file
550 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
552 ++dpyinfo
->bitmaps
[id
].refcount
;
557 /* Search bitmap-file-path for the file, if appropriate. */
558 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, 0);
563 filename
= (char *) XSTRING (found
)->data
;
565 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
571 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
572 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
573 if (result
!= BitmapSuccess
)
576 id
= x_allocate_bitmap_record (f
);
577 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
578 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
579 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
580 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
581 dpyinfo
->bitmaps
[id
- 1].height
= height
;
582 dpyinfo
->bitmaps
[id
- 1].width
= width
;
583 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
589 /* Remove reference to bitmap with id number ID. */
592 x_destroy_bitmap (f
, id
)
596 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
600 --dpyinfo
->bitmaps
[id
- 1].refcount
;
601 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
604 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
605 if (dpyinfo
->bitmaps
[id
- 1].file
)
607 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
608 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
615 /* Free all the bitmaps for the display specified by DPYINFO. */
618 x_destroy_all_bitmaps (dpyinfo
)
619 struct w32_display_info
*dpyinfo
;
622 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
623 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
625 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
626 if (dpyinfo
->bitmaps
[i
].file
)
627 xfree (dpyinfo
->bitmaps
[i
].file
);
629 dpyinfo
->bitmaps_last
= 0;
632 /* Connect the frame-parameter names for W32 frames
633 to the ways of passing the parameter values to the window system.
635 The name of a parameter, as a Lisp symbol,
636 has an `x-frame-parameter' property which is an integer in Lisp
637 but can be interpreted as an `enum x_frame_parm' in C. */
641 X_PARM_FOREGROUND_COLOR
,
642 X_PARM_BACKGROUND_COLOR
,
649 X_PARM_INTERNAL_BORDER_WIDTH
,
653 X_PARM_VERT_SCROLL_BAR
,
655 X_PARM_MENU_BAR_LINES
659 struct x_frame_parm_table
662 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
665 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
666 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
667 static void x_change_window_heights
P_ ((Lisp_Object
, int));
668 /* TODO: Native Input Method support; see x_create_im. */
669 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
670 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
671 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
672 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
673 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
674 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
675 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
676 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
677 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
678 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
679 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
680 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
682 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
683 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
684 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
685 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
687 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
688 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
689 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
690 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
691 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
692 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
693 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
694 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
697 static struct x_frame_parm_table x_frame_parms
[] =
699 "auto-raise", x_set_autoraise
,
700 "auto-lower", x_set_autolower
,
701 "background-color", x_set_background_color
,
702 "border-color", x_set_border_color
,
703 "border-width", x_set_border_width
,
704 "cursor-color", x_set_cursor_color
,
705 "cursor-type", x_set_cursor_type
,
707 "foreground-color", x_set_foreground_color
,
708 "icon-name", x_set_icon_name
,
709 "icon-type", x_set_icon_type
,
710 "internal-border-width", x_set_internal_border_width
,
711 "menu-bar-lines", x_set_menu_bar_lines
,
712 "mouse-color", x_set_mouse_color
,
713 "name", x_explicitly_set_name
,
714 "scroll-bar-width", x_set_scroll_bar_width
,
715 "title", x_set_title
,
716 "unsplittable", x_set_unsplittable
,
717 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
718 "visibility", x_set_visibility
,
719 "tool-bar-lines", x_set_tool_bar_lines
,
720 "screen-gamma", x_set_screen_gamma
,
721 "line-spacing", x_set_line_spacing
724 /* Attach the `x-frame-parameter' properties to
725 the Lisp symbol names of parameters relevant to W32. */
728 init_x_parm_symbols ()
732 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
733 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
737 /* Change the parameters of frame F as specified by ALIST.
738 If a parameter is not specially recognized, do nothing;
739 otherwise call the `x_set_...' function for that parameter. */
742 x_set_frame_parameters (f
, alist
)
748 /* If both of these parameters are present, it's more efficient to
749 set them both at once. So we wait until we've looked at the
750 entire list before we set them. */
754 Lisp_Object left
, top
;
756 /* Same with these. */
757 Lisp_Object icon_left
, icon_top
;
759 /* Record in these vectors all the parms specified. */
763 int left_no_change
= 0, top_no_change
= 0;
764 int icon_left_no_change
= 0, icon_top_no_change
= 0;
766 struct gcpro gcpro1
, gcpro2
;
769 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
772 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
773 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
775 /* Extract parm names and values into those vectors. */
778 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
783 parms
[i
] = Fcar (elt
);
784 values
[i
] = Fcdr (elt
);
787 /* TAIL and ALIST are not used again below here. */
790 GCPRO2 (*parms
, *values
);
794 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
795 because their values appear in VALUES and strings are not valid. */
796 top
= left
= Qunbound
;
797 icon_left
= icon_top
= Qunbound
;
799 /* Provide default values for HEIGHT and WIDTH. */
800 if (FRAME_NEW_WIDTH (f
))
801 width
= FRAME_NEW_WIDTH (f
);
803 width
= FRAME_WIDTH (f
);
805 if (FRAME_NEW_HEIGHT (f
))
806 height
= FRAME_NEW_HEIGHT (f
);
808 height
= FRAME_HEIGHT (f
);
810 /* Process foreground_color and background_color before anything else.
811 They are independent of other properties, but other properties (e.g.,
812 cursor_color) are dependent upon them. */
813 for (p
= 0; p
< i
; p
++)
815 Lisp_Object prop
, val
;
819 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
821 register Lisp_Object param_index
, old_value
;
823 param_index
= Fget (prop
, Qx_frame_parameter
);
824 old_value
= get_frame_param (f
, prop
);
825 store_frame_param (f
, prop
, val
);
826 if (NATNUMP (param_index
)
827 && (XFASTINT (param_index
)
828 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
829 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
833 /* Now process them in reverse of specified order. */
834 for (i
--; i
>= 0; i
--)
836 Lisp_Object prop
, val
;
841 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
842 width
= XFASTINT (val
);
843 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
844 height
= XFASTINT (val
);
845 else if (EQ (prop
, Qtop
))
847 else if (EQ (prop
, Qleft
))
849 else if (EQ (prop
, Qicon_top
))
851 else if (EQ (prop
, Qicon_left
))
853 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
854 /* Processed above. */
858 register Lisp_Object param_index
, old_value
;
860 param_index
= Fget (prop
, Qx_frame_parameter
);
861 old_value
= get_frame_param (f
, prop
);
862 store_frame_param (f
, prop
, val
);
863 if (NATNUMP (param_index
)
864 && (XFASTINT (param_index
)
865 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
866 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
870 /* Don't die if just one of these was set. */
871 if (EQ (left
, Qunbound
))
874 if (f
->output_data
.w32
->left_pos
< 0)
875 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
877 XSETINT (left
, f
->output_data
.w32
->left_pos
);
879 if (EQ (top
, Qunbound
))
882 if (f
->output_data
.w32
->top_pos
< 0)
883 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
885 XSETINT (top
, f
->output_data
.w32
->top_pos
);
888 /* If one of the icon positions was not set, preserve or default it. */
889 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
891 icon_left_no_change
= 1;
892 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
893 if (NILP (icon_left
))
894 XSETINT (icon_left
, 0);
896 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
898 icon_top_no_change
= 1;
899 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
901 XSETINT (icon_top
, 0);
904 /* Don't set these parameters unless they've been explicitly
905 specified. The window might be mapped or resized while we're in
906 this function, and we don't want to override that unless the lisp
907 code has asked for it.
909 Don't set these parameters unless they actually differ from the
910 window's current parameters; the window may not actually exist
915 check_frame_size (f
, &height
, &width
);
917 XSETFRAME (frame
, f
);
919 if (width
!= FRAME_WIDTH (f
)
920 || height
!= FRAME_HEIGHT (f
)
921 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
922 Fset_frame_size (frame
, make_number (width
), make_number (height
));
924 if ((!NILP (left
) || !NILP (top
))
925 && ! (left_no_change
&& top_no_change
)
926 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
927 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
932 /* Record the signs. */
933 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
934 if (EQ (left
, Qminus
))
935 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
936 else if (INTEGERP (left
))
938 leftpos
= XINT (left
);
940 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
942 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
943 && CONSP (XCDR (left
))
944 && INTEGERP (XCAR (XCDR (left
))))
946 leftpos
= - XINT (XCAR (XCDR (left
)));
947 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
949 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
950 && CONSP (XCDR (left
))
951 && INTEGERP (XCAR (XCDR (left
))))
953 leftpos
= XINT (XCAR (XCDR (left
)));
956 if (EQ (top
, Qminus
))
957 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
958 else if (INTEGERP (top
))
962 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
964 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
965 && CONSP (XCDR (top
))
966 && INTEGERP (XCAR (XCDR (top
))))
968 toppos
= - XINT (XCAR (XCDR (top
)));
969 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
971 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
972 && CONSP (XCDR (top
))
973 && INTEGERP (XCAR (XCDR (top
))))
975 toppos
= XINT (XCAR (XCDR (top
)));
979 /* Store the numeric value of the position. */
980 f
->output_data
.w32
->top_pos
= toppos
;
981 f
->output_data
.w32
->left_pos
= leftpos
;
983 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
985 /* Actually set that position, and convert to absolute. */
986 x_set_offset (f
, leftpos
, toppos
, -1);
989 if ((!NILP (icon_left
) || !NILP (icon_top
))
990 && ! (icon_left_no_change
&& icon_top_no_change
))
991 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
997 /* Store the screen positions of frame F into XPTR and YPTR.
998 These are the positions of the containing window manager window,
999 not Emacs's own window. */
1002 x_real_positions (f
, xptr
, yptr
)
1011 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
1012 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
1018 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
1024 /* Insert a description of internally-recorded parameters of frame X
1025 into the parameter alist *ALISTPTR that is to be given to the user.
1026 Only parameters that are specific to W32
1027 and whose values are not correctly recorded in the frame's
1028 param_alist need to be considered here. */
1031 x_report_frame_params (f
, alistptr
)
1033 Lisp_Object
*alistptr
;
1038 /* Represent negative positions (off the top or left screen edge)
1039 in a way that Fmodify_frame_parameters will understand correctly. */
1040 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
1041 if (f
->output_data
.w32
->left_pos
>= 0)
1042 store_in_alist (alistptr
, Qleft
, tem
);
1044 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1046 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
1047 if (f
->output_data
.w32
->top_pos
>= 0)
1048 store_in_alist (alistptr
, Qtop
, tem
);
1050 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1052 store_in_alist (alistptr
, Qborder_width
,
1053 make_number (f
->output_data
.w32
->border_width
));
1054 store_in_alist (alistptr
, Qinternal_border_width
,
1055 make_number (f
->output_data
.w32
->internal_border_width
));
1056 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
1057 store_in_alist (alistptr
, Qwindow_id
,
1058 build_string (buf
));
1059 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1060 FRAME_SAMPLE_VISIBILITY (f
);
1061 store_in_alist (alistptr
, Qvisibility
,
1062 (FRAME_VISIBLE_P (f
) ? Qt
1063 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1064 store_in_alist (alistptr
, Qdisplay
,
1065 XCAR (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
));
1069 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
,
1070 Sw32_define_rgb_color
, 4, 4, 0,
1071 doc
: /* Convert RGB numbers to a windows color reference and associate with NAME.
1072 This adds or updates a named color to w32-color-map, making it
1073 available for use. The original entry's RGB ref is returned, or nil
1074 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
,
1110 Sw32_load_color_file
, 1, 1, 0,
1111 doc
: /* Create an alist of color entries from an external file.
1112 Assign this value to w32-color-map to replace the existing color map.
1114 The file should define one named RGB color per line like so:
1116 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
1118 Lisp_Object filename
;
1121 Lisp_Object cmap
= Qnil
;
1122 Lisp_Object abspath
;
1124 CHECK_STRING (filename
);
1125 abspath
= Fexpand_file_name (filename
, Qnil
);
1127 fp
= fopen (XSTRING (filename
)->data
, "rt");
1131 int red
, green
, blue
;
1136 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
1137 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
1139 char *name
= buf
+ num
;
1140 num
= strlen (name
) - 1;
1141 if (name
[num
] == '\n')
1143 cmap
= Fcons (Fcons (build_string (name
),
1144 make_number (RGB (red
, green
, blue
))),
1156 /* The default colors for the w32 color map */
1157 typedef struct colormap_t
1163 colormap_t w32_color_map
[] =
1165 {"snow" , PALETTERGB (255,250,250)},
1166 {"ghost white" , PALETTERGB (248,248,255)},
1167 {"GhostWhite" , PALETTERGB (248,248,255)},
1168 {"white smoke" , PALETTERGB (245,245,245)},
1169 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1170 {"gainsboro" , PALETTERGB (220,220,220)},
1171 {"floral white" , PALETTERGB (255,250,240)},
1172 {"FloralWhite" , PALETTERGB (255,250,240)},
1173 {"old lace" , PALETTERGB (253,245,230)},
1174 {"OldLace" , PALETTERGB (253,245,230)},
1175 {"linen" , PALETTERGB (250,240,230)},
1176 {"antique white" , PALETTERGB (250,235,215)},
1177 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1178 {"papaya whip" , PALETTERGB (255,239,213)},
1179 {"PapayaWhip" , PALETTERGB (255,239,213)},
1180 {"blanched almond" , PALETTERGB (255,235,205)},
1181 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1182 {"bisque" , PALETTERGB (255,228,196)},
1183 {"peach puff" , PALETTERGB (255,218,185)},
1184 {"PeachPuff" , PALETTERGB (255,218,185)},
1185 {"navajo white" , PALETTERGB (255,222,173)},
1186 {"NavajoWhite" , PALETTERGB (255,222,173)},
1187 {"moccasin" , PALETTERGB (255,228,181)},
1188 {"cornsilk" , PALETTERGB (255,248,220)},
1189 {"ivory" , PALETTERGB (255,255,240)},
1190 {"lemon chiffon" , PALETTERGB (255,250,205)},
1191 {"LemonChiffon" , PALETTERGB (255,250,205)},
1192 {"seashell" , PALETTERGB (255,245,238)},
1193 {"honeydew" , PALETTERGB (240,255,240)},
1194 {"mint cream" , PALETTERGB (245,255,250)},
1195 {"MintCream" , PALETTERGB (245,255,250)},
1196 {"azure" , PALETTERGB (240,255,255)},
1197 {"alice blue" , PALETTERGB (240,248,255)},
1198 {"AliceBlue" , PALETTERGB (240,248,255)},
1199 {"lavender" , PALETTERGB (230,230,250)},
1200 {"lavender blush" , PALETTERGB (255,240,245)},
1201 {"LavenderBlush" , PALETTERGB (255,240,245)},
1202 {"misty rose" , PALETTERGB (255,228,225)},
1203 {"MistyRose" , PALETTERGB (255,228,225)},
1204 {"white" , PALETTERGB (255,255,255)},
1205 {"black" , PALETTERGB ( 0, 0, 0)},
1206 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1207 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1208 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1209 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1210 {"dim gray" , PALETTERGB (105,105,105)},
1211 {"DimGray" , PALETTERGB (105,105,105)},
1212 {"dim grey" , PALETTERGB (105,105,105)},
1213 {"DimGrey" , PALETTERGB (105,105,105)},
1214 {"slate gray" , PALETTERGB (112,128,144)},
1215 {"SlateGray" , PALETTERGB (112,128,144)},
1216 {"slate grey" , PALETTERGB (112,128,144)},
1217 {"SlateGrey" , PALETTERGB (112,128,144)},
1218 {"light slate gray" , PALETTERGB (119,136,153)},
1219 {"LightSlateGray" , PALETTERGB (119,136,153)},
1220 {"light slate grey" , PALETTERGB (119,136,153)},
1221 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1222 {"gray" , PALETTERGB (190,190,190)},
1223 {"grey" , PALETTERGB (190,190,190)},
1224 {"light grey" , PALETTERGB (211,211,211)},
1225 {"LightGrey" , PALETTERGB (211,211,211)},
1226 {"light gray" , PALETTERGB (211,211,211)},
1227 {"LightGray" , PALETTERGB (211,211,211)},
1228 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1229 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1230 {"navy" , PALETTERGB ( 0, 0,128)},
1231 {"navy blue" , PALETTERGB ( 0, 0,128)},
1232 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1233 {"cornflower blue" , PALETTERGB (100,149,237)},
1234 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1235 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1236 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1237 {"slate blue" , PALETTERGB (106, 90,205)},
1238 {"SlateBlue" , PALETTERGB (106, 90,205)},
1239 {"medium slate blue" , PALETTERGB (123,104,238)},
1240 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1241 {"light slate blue" , PALETTERGB (132,112,255)},
1242 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1243 {"medium blue" , PALETTERGB ( 0, 0,205)},
1244 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1245 {"royal blue" , PALETTERGB ( 65,105,225)},
1246 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1247 {"blue" , PALETTERGB ( 0, 0,255)},
1248 {"dodger blue" , PALETTERGB ( 30,144,255)},
1249 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1250 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1251 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1252 {"sky blue" , PALETTERGB (135,206,235)},
1253 {"SkyBlue" , PALETTERGB (135,206,235)},
1254 {"light sky blue" , PALETTERGB (135,206,250)},
1255 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1256 {"steel blue" , PALETTERGB ( 70,130,180)},
1257 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1258 {"light steel blue" , PALETTERGB (176,196,222)},
1259 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1260 {"light blue" , PALETTERGB (173,216,230)},
1261 {"LightBlue" , PALETTERGB (173,216,230)},
1262 {"powder blue" , PALETTERGB (176,224,230)},
1263 {"PowderBlue" , PALETTERGB (176,224,230)},
1264 {"pale turquoise" , PALETTERGB (175,238,238)},
1265 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1266 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1267 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1268 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1269 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1270 {"turquoise" , PALETTERGB ( 64,224,208)},
1271 {"cyan" , PALETTERGB ( 0,255,255)},
1272 {"light cyan" , PALETTERGB (224,255,255)},
1273 {"LightCyan" , PALETTERGB (224,255,255)},
1274 {"cadet blue" , PALETTERGB ( 95,158,160)},
1275 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1276 {"medium aquamarine" , PALETTERGB (102,205,170)},
1277 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1278 {"aquamarine" , PALETTERGB (127,255,212)},
1279 {"dark green" , PALETTERGB ( 0,100, 0)},
1280 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1281 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1282 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1283 {"dark sea green" , PALETTERGB (143,188,143)},
1284 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1285 {"sea green" , PALETTERGB ( 46,139, 87)},
1286 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1287 {"medium sea green" , PALETTERGB ( 60,179,113)},
1288 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1289 {"light sea green" , PALETTERGB ( 32,178,170)},
1290 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1291 {"pale green" , PALETTERGB (152,251,152)},
1292 {"PaleGreen" , PALETTERGB (152,251,152)},
1293 {"spring green" , PALETTERGB ( 0,255,127)},
1294 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1295 {"lawn green" , PALETTERGB (124,252, 0)},
1296 {"LawnGreen" , PALETTERGB (124,252, 0)},
1297 {"green" , PALETTERGB ( 0,255, 0)},
1298 {"chartreuse" , PALETTERGB (127,255, 0)},
1299 {"medium spring green" , PALETTERGB ( 0,250,154)},
1300 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1301 {"green yellow" , PALETTERGB (173,255, 47)},
1302 {"GreenYellow" , PALETTERGB (173,255, 47)},
1303 {"lime green" , PALETTERGB ( 50,205, 50)},
1304 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1305 {"yellow green" , PALETTERGB (154,205, 50)},
1306 {"YellowGreen" , PALETTERGB (154,205, 50)},
1307 {"forest green" , PALETTERGB ( 34,139, 34)},
1308 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1309 {"olive drab" , PALETTERGB (107,142, 35)},
1310 {"OliveDrab" , PALETTERGB (107,142, 35)},
1311 {"dark khaki" , PALETTERGB (189,183,107)},
1312 {"DarkKhaki" , PALETTERGB (189,183,107)},
1313 {"khaki" , PALETTERGB (240,230,140)},
1314 {"pale goldenrod" , PALETTERGB (238,232,170)},
1315 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1316 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1317 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1318 {"light yellow" , PALETTERGB (255,255,224)},
1319 {"LightYellow" , PALETTERGB (255,255,224)},
1320 {"yellow" , PALETTERGB (255,255, 0)},
1321 {"gold" , PALETTERGB (255,215, 0)},
1322 {"light goldenrod" , PALETTERGB (238,221,130)},
1323 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1324 {"goldenrod" , PALETTERGB (218,165, 32)},
1325 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1326 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1327 {"rosy brown" , PALETTERGB (188,143,143)},
1328 {"RosyBrown" , PALETTERGB (188,143,143)},
1329 {"indian red" , PALETTERGB (205, 92, 92)},
1330 {"IndianRed" , PALETTERGB (205, 92, 92)},
1331 {"saddle brown" , PALETTERGB (139, 69, 19)},
1332 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1333 {"sienna" , PALETTERGB (160, 82, 45)},
1334 {"peru" , PALETTERGB (205,133, 63)},
1335 {"burlywood" , PALETTERGB (222,184,135)},
1336 {"beige" , PALETTERGB (245,245,220)},
1337 {"wheat" , PALETTERGB (245,222,179)},
1338 {"sandy brown" , PALETTERGB (244,164, 96)},
1339 {"SandyBrown" , PALETTERGB (244,164, 96)},
1340 {"tan" , PALETTERGB (210,180,140)},
1341 {"chocolate" , PALETTERGB (210,105, 30)},
1342 {"firebrick" , PALETTERGB (178,34, 34)},
1343 {"brown" , PALETTERGB (165,42, 42)},
1344 {"dark salmon" , PALETTERGB (233,150,122)},
1345 {"DarkSalmon" , PALETTERGB (233,150,122)},
1346 {"salmon" , PALETTERGB (250,128,114)},
1347 {"light salmon" , PALETTERGB (255,160,122)},
1348 {"LightSalmon" , PALETTERGB (255,160,122)},
1349 {"orange" , PALETTERGB (255,165, 0)},
1350 {"dark orange" , PALETTERGB (255,140, 0)},
1351 {"DarkOrange" , PALETTERGB (255,140, 0)},
1352 {"coral" , PALETTERGB (255,127, 80)},
1353 {"light coral" , PALETTERGB (240,128,128)},
1354 {"LightCoral" , PALETTERGB (240,128,128)},
1355 {"tomato" , PALETTERGB (255, 99, 71)},
1356 {"orange red" , PALETTERGB (255, 69, 0)},
1357 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1358 {"red" , PALETTERGB (255, 0, 0)},
1359 {"hot pink" , PALETTERGB (255,105,180)},
1360 {"HotPink" , PALETTERGB (255,105,180)},
1361 {"deep pink" , PALETTERGB (255, 20,147)},
1362 {"DeepPink" , PALETTERGB (255, 20,147)},
1363 {"pink" , PALETTERGB (255,192,203)},
1364 {"light pink" , PALETTERGB (255,182,193)},
1365 {"LightPink" , PALETTERGB (255,182,193)},
1366 {"pale violet red" , PALETTERGB (219,112,147)},
1367 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1368 {"maroon" , PALETTERGB (176, 48, 96)},
1369 {"medium violet red" , PALETTERGB (199, 21,133)},
1370 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1371 {"violet red" , PALETTERGB (208, 32,144)},
1372 {"VioletRed" , PALETTERGB (208, 32,144)},
1373 {"magenta" , PALETTERGB (255, 0,255)},
1374 {"violet" , PALETTERGB (238,130,238)},
1375 {"plum" , PALETTERGB (221,160,221)},
1376 {"orchid" , PALETTERGB (218,112,214)},
1377 {"medium orchid" , PALETTERGB (186, 85,211)},
1378 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1379 {"dark orchid" , PALETTERGB (153, 50,204)},
1380 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1381 {"dark violet" , PALETTERGB (148, 0,211)},
1382 {"DarkViolet" , PALETTERGB (148, 0,211)},
1383 {"blue violet" , PALETTERGB (138, 43,226)},
1384 {"BlueViolet" , PALETTERGB (138, 43,226)},
1385 {"purple" , PALETTERGB (160, 32,240)},
1386 {"medium purple" , PALETTERGB (147,112,219)},
1387 {"MediumPurple" , PALETTERGB (147,112,219)},
1388 {"thistle" , PALETTERGB (216,191,216)},
1389 {"gray0" , PALETTERGB ( 0, 0, 0)},
1390 {"grey0" , PALETTERGB ( 0, 0, 0)},
1391 {"dark grey" , PALETTERGB (169,169,169)},
1392 {"DarkGrey" , PALETTERGB (169,169,169)},
1393 {"dark gray" , PALETTERGB (169,169,169)},
1394 {"DarkGray" , PALETTERGB (169,169,169)},
1395 {"dark blue" , PALETTERGB ( 0, 0,139)},
1396 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1397 {"dark cyan" , PALETTERGB ( 0,139,139)},
1398 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1399 {"dark magenta" , PALETTERGB (139, 0,139)},
1400 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1401 {"dark red" , PALETTERGB (139, 0, 0)},
1402 {"DarkRed" , PALETTERGB (139, 0, 0)},
1403 {"light green" , PALETTERGB (144,238,144)},
1404 {"LightGreen" , PALETTERGB (144,238,144)},
1407 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1408 0, 0, 0, doc
: /* Return the default color map. */)
1412 colormap_t
*pc
= w32_color_map
;
1419 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1421 cmap
= Fcons (Fcons (build_string (pc
->name
),
1422 make_number (pc
->colorref
)),
1431 w32_to_x_color (rgb
)
1440 color
= Frassq (rgb
, Vw32_color_map
);
1445 return (Fcar (color
));
1451 w32_color_map_lookup (colorname
)
1454 Lisp_Object tail
, ret
= Qnil
;
1458 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1460 register Lisp_Object elt
, tem
;
1463 if (!CONSP (elt
)) continue;
1467 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1469 ret
= XUINT (Fcdr (elt
));
1483 x_to_w32_color (colorname
)
1486 register Lisp_Object ret
= Qnil
;
1490 if (colorname
[0] == '#')
1492 /* Could be an old-style RGB Device specification. */
1495 color
= colorname
+ 1;
1497 size
= strlen(color
);
1498 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1506 for (i
= 0; i
< 3; i
++)
1510 unsigned long value
;
1512 /* The check for 'x' in the following conditional takes into
1513 account the fact that strtol allows a "0x" in front of
1514 our numbers, and we don't. */
1515 if (!isxdigit(color
[0]) || color
[1] == 'x')
1519 value
= strtoul(color
, &end
, 16);
1521 if (errno
== ERANGE
|| end
- color
!= size
)
1526 value
= value
* 0x10;
1537 colorval
|= (value
<< pos
);
1548 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1556 color
= colorname
+ 4;
1557 for (i
= 0; i
< 3; i
++)
1560 unsigned long value
;
1562 /* The check for 'x' in the following conditional takes into
1563 account the fact that strtol allows a "0x" in front of
1564 our numbers, and we don't. */
1565 if (!isxdigit(color
[0]) || color
[1] == 'x')
1567 value
= strtoul(color
, &end
, 16);
1568 if (errno
== ERANGE
)
1570 switch (end
- color
)
1573 value
= value
* 0x10 + value
;
1586 if (value
== ULONG_MAX
)
1588 colorval
|= (value
<< pos
);
1602 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1604 /* This is an RGB Intensity specification. */
1611 color
= colorname
+ 5;
1612 for (i
= 0; i
< 3; i
++)
1618 value
= strtod(color
, &end
);
1619 if (errno
== ERANGE
)
1621 if (value
< 0.0 || value
> 1.0)
1623 val
= (UINT
)(0x100 * value
);
1624 /* We used 0x100 instead of 0xFF to give an continuous
1625 range between 0.0 and 1.0 inclusive. The next statement
1626 fixes the 1.0 case. */
1629 colorval
|= (val
<< pos
);
1643 /* I am not going to attempt to handle any of the CIE color schemes
1644 or TekHVC, since I don't know the algorithms for conversion to
1647 /* If we fail to lookup the color name in w32_color_map, then check the
1648 colorname to see if it can be crudely approximated: If the X color
1649 ends in a number (e.g., "darkseagreen2"), strip the number and
1650 return the result of looking up the base color name. */
1651 ret
= w32_color_map_lookup (colorname
);
1654 int len
= strlen (colorname
);
1656 if (isdigit (colorname
[len
- 1]))
1658 char *ptr
, *approx
= alloca (len
+ 1);
1660 strcpy (approx
, colorname
);
1661 ptr
= &approx
[len
- 1];
1662 while (ptr
> approx
&& isdigit (*ptr
))
1665 ret
= w32_color_map_lookup (approx
);
1675 w32_regenerate_palette (FRAME_PTR f
)
1677 struct w32_palette_entry
* list
;
1678 LOGPALETTE
* log_palette
;
1679 HPALETTE new_palette
;
1682 /* don't bother trying to create palette if not supported */
1683 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1686 log_palette
= (LOGPALETTE
*)
1687 alloca (sizeof (LOGPALETTE
) +
1688 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1689 log_palette
->palVersion
= 0x300;
1690 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1692 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1694 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1695 i
++, list
= list
->next
)
1696 log_palette
->palPalEntry
[i
] = list
->entry
;
1698 new_palette
= CreatePalette (log_palette
);
1702 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1703 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1704 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1706 /* Realize display palette and garbage all frames. */
1707 release_frame_dc (f
, get_frame_dc (f
));
1712 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1713 #define SET_W32_COLOR(pe, color) \
1716 pe.peRed = GetRValue (color); \
1717 pe.peGreen = GetGValue (color); \
1718 pe.peBlue = GetBValue (color); \
1723 /* Keep these around in case we ever want to track color usage. */
1725 w32_map_color (FRAME_PTR f
, COLORREF color
)
1727 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1729 if (NILP (Vw32_enable_palette
))
1732 /* check if color is already mapped */
1735 if (W32_COLOR (list
->entry
) == color
)
1743 /* not already mapped, so add to list and recreate Windows palette */
1744 list
= (struct w32_palette_entry
*)
1745 xmalloc (sizeof (struct w32_palette_entry
));
1746 SET_W32_COLOR (list
->entry
, color
);
1748 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1749 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1750 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1752 /* set flag that palette must be regenerated */
1753 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1757 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1759 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1760 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1762 if (NILP (Vw32_enable_palette
))
1765 /* check if color is already mapped */
1768 if (W32_COLOR (list
->entry
) == color
)
1770 if (--list
->refcount
== 0)
1774 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1784 /* set flag that palette must be regenerated */
1785 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1790 /* Gamma-correct COLOR on frame F. */
1793 gamma_correct (f
, color
)
1799 *color
= PALETTERGB (
1800 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1801 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1802 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1807 /* Decide if color named COLOR is valid for the display associated with
1808 the selected frame; if so, return the rgb values in COLOR_DEF.
1809 If ALLOC is nonzero, allocate a new colormap cell. */
1812 w32_defined_color (f
, color
, color_def
, alloc
)
1818 register Lisp_Object tem
;
1819 COLORREF w32_color_ref
;
1821 tem
= x_to_w32_color (color
);
1827 /* Apply gamma correction. */
1828 w32_color_ref
= XUINT (tem
);
1829 gamma_correct (f
, &w32_color_ref
);
1830 XSETINT (tem
, w32_color_ref
);
1833 /* Map this color to the palette if it is enabled. */
1834 if (!NILP (Vw32_enable_palette
))
1836 struct w32_palette_entry
* entry
=
1837 one_w32_display_info
.color_list
;
1838 struct w32_palette_entry
** prev
=
1839 &one_w32_display_info
.color_list
;
1841 /* check if color is already mapped */
1844 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1846 prev
= &entry
->next
;
1847 entry
= entry
->next
;
1850 if (entry
== NULL
&& alloc
)
1852 /* not already mapped, so add to list */
1853 entry
= (struct w32_palette_entry
*)
1854 xmalloc (sizeof (struct w32_palette_entry
));
1855 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1858 one_w32_display_info
.num_colors
++;
1860 /* set flag that palette must be regenerated */
1861 one_w32_display_info
.regen_palette
= TRUE
;
1864 /* Ensure COLORREF value is snapped to nearest color in (default)
1865 palette by simulating the PALETTERGB macro. This works whether
1866 or not the display device has a palette. */
1867 w32_color_ref
= XUINT (tem
) | 0x2000000;
1869 color_def
->pixel
= w32_color_ref
;
1870 color_def
->red
= GetRValue (w32_color_ref
);
1871 color_def
->green
= GetGValue (w32_color_ref
);
1872 color_def
->blue
= GetBValue (w32_color_ref
);
1882 /* Given a string ARG naming a color, compute a pixel value from it
1883 suitable for screen F.
1884 If F is not a color screen, return DEF (default) regardless of what
1888 x_decode_color (f
, arg
, def
)
1897 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1898 return BLACK_PIX_DEFAULT (f
);
1899 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1900 return WHITE_PIX_DEFAULT (f
);
1902 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1905 /* w32_defined_color is responsible for coping with failures
1906 by looking for a near-miss. */
1907 if (w32_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1910 /* defined_color failed; return an ultimate default. */
1914 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1915 the previous value of that parameter, NEW_VALUE is the new value. */
1918 x_set_line_spacing (f
, new_value
, old_value
)
1920 Lisp_Object new_value
, old_value
;
1922 if (NILP (new_value
))
1923 f
->extra_line_spacing
= 0;
1924 else if (NATNUMP (new_value
))
1925 f
->extra_line_spacing
= XFASTINT (new_value
);
1927 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1928 Fcons (new_value
, Qnil
)));
1929 if (FRAME_VISIBLE_P (f
))
1934 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1935 the previous value of that parameter, NEW_VALUE is the new value. */
1938 x_set_screen_gamma (f
, new_value
, old_value
)
1940 Lisp_Object new_value
, old_value
;
1942 if (NILP (new_value
))
1944 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1945 /* The value 0.4545 is the normal viewing gamma. */
1946 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1948 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1949 Fcons (new_value
, Qnil
)));
1951 clear_face_cache (0);
1955 /* Functions called only from `x_set_frame_param'
1956 to set individual parameters.
1958 If FRAME_W32_WINDOW (f) is 0,
1959 the frame is being created and its window does not exist yet.
1960 In that case, just record the parameter's new value
1961 in the standard place; do not attempt to change the window. */
1964 x_set_foreground_color (f
, arg
, oldval
)
1966 Lisp_Object arg
, oldval
;
1968 struct w32_output
*x
= f
->output_data
.w32
;
1969 PIX_TYPE fg
, old_fg
;
1971 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1972 old_fg
= FRAME_FOREGROUND_PIXEL (f
);
1973 FRAME_FOREGROUND_PIXEL (f
) = fg
;
1975 if (FRAME_W32_WINDOW (f
) != 0)
1977 if (x
->cursor_pixel
== old_fg
)
1978 x
->cursor_pixel
= fg
;
1980 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1981 if (FRAME_VISIBLE_P (f
))
1987 x_set_background_color (f
, arg
, oldval
)
1989 Lisp_Object arg
, oldval
;
1991 FRAME_BACKGROUND_PIXEL (f
)
1992 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1994 if (FRAME_W32_WINDOW (f
) != 0)
1996 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
1997 FRAME_BACKGROUND_PIXEL (f
));
1999 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
2001 if (FRAME_VISIBLE_P (f
))
2007 x_set_mouse_color (f
, arg
, oldval
)
2009 Lisp_Object arg
, oldval
;
2011 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
2015 if (!EQ (Qnil
, arg
))
2016 f
->output_data
.w32
->mouse_pixel
2017 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2018 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
2020 /* Don't let pointers be invisible. */
2021 if (mask_color
== f
->output_data
.w32
->mouse_pixel
2022 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
2023 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
2025 #if 0 /* TODO : cursor changes */
2028 /* It's not okay to crash if the user selects a screwy cursor. */
2029 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
2031 if (!EQ (Qnil
, Vx_pointer_shape
))
2033 CHECK_NUMBER (Vx_pointer_shape
);
2034 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
2037 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2038 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
2040 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
2042 CHECK_NUMBER (Vx_nontext_pointer_shape
);
2043 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2044 XINT (Vx_nontext_pointer_shape
));
2047 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
2048 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2050 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
2052 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
2053 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2054 XINT (Vx_hourglass_pointer_shape
));
2057 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
2058 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
2060 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2061 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
2063 CHECK_NUMBER (Vx_mode_pointer_shape
);
2064 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2065 XINT (Vx_mode_pointer_shape
));
2068 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2069 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
2071 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
2073 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
2075 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2076 XINT (Vx_sensitive_text_pointer_shape
));
2079 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
2081 if (!NILP (Vx_window_horizontal_drag_shape
))
2083 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
2084 horizontal_drag_cursor
2085 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
2086 XINT (Vx_window_horizontal_drag_shape
));
2089 horizontal_drag_cursor
2090 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
2092 /* Check and report errors with the above calls. */
2093 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
2094 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
2097 XColor fore_color
, back_color
;
2099 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
2100 back_color
.pixel
= mask_color
;
2101 XQueryColor (FRAME_W32_DISPLAY (f
),
2102 DefaultColormap (FRAME_W32_DISPLAY (f
),
2103 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2105 XQueryColor (FRAME_W32_DISPLAY (f
),
2106 DefaultColormap (FRAME_W32_DISPLAY (f
),
2107 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2109 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
2110 &fore_color
, &back_color
);
2111 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
2112 &fore_color
, &back_color
);
2113 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
2114 &fore_color
, &back_color
);
2115 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
2116 &fore_color
, &back_color
);
2117 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
2118 &fore_color
, &back_color
);
2121 if (FRAME_W32_WINDOW (f
) != 0)
2122 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
2124 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
2125 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
2126 f
->output_data
.w32
->text_cursor
= cursor
;
2128 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
2129 && f
->output_data
.w32
->nontext_cursor
!= 0)
2130 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
2131 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
2133 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
2134 && f
->output_data
.w32
->hourglass_cursor
!= 0)
2135 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
2136 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
2138 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
2139 && f
->output_data
.w32
->modeline_cursor
!= 0)
2140 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
2141 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
2143 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
2144 && f
->output_data
.w32
->cross_cursor
!= 0)
2145 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
2146 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
2148 XFlush (FRAME_W32_DISPLAY (f
));
2151 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
2155 /* Defined in w32term.c. */
2156 void x_update_cursor (struct frame
*f
, int on_p
);
2159 x_set_cursor_color (f
, arg
, oldval
)
2161 Lisp_Object arg
, oldval
;
2163 unsigned long fore_pixel
, pixel
;
2165 if (!NILP (Vx_cursor_fore_pixel
))
2166 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
2167 WHITE_PIX_DEFAULT (f
));
2169 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2171 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2173 /* Make sure that the cursor color differs from the background color. */
2174 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
2176 pixel
= f
->output_data
.w32
->mouse_pixel
;
2177 if (pixel
== fore_pixel
)
2178 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2181 FRAME_FOREGROUND_PIXEL (f
) = fore_pixel
;
2182 f
->output_data
.w32
->cursor_pixel
= pixel
;
2184 if (FRAME_W32_WINDOW (f
) != 0)
2186 if (FRAME_VISIBLE_P (f
))
2188 x_update_cursor (f
, 0);
2189 x_update_cursor (f
, 1);
2193 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
2196 /* Set the border-color of frame F to pixel value PIX.
2197 Note that this does not fully take effect if done before
2200 x_set_border_pixel (f
, pix
)
2204 f
->output_data
.w32
->border_pixel
= pix
;
2206 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
2208 if (FRAME_VISIBLE_P (f
))
2213 /* Set the border-color of frame F to value described by ARG.
2214 ARG can be a string naming a color.
2215 The border-color is used for the border that is drawn by the server.
2216 Note that this does not fully take effect if done before
2217 F has a window; it must be redone when the window is created. */
2220 x_set_border_color (f
, arg
, oldval
)
2222 Lisp_Object arg
, oldval
;
2227 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2228 x_set_border_pixel (f
, pix
);
2229 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
2232 /* Value is the internal representation of the specified cursor type
2233 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
2234 of the bar cursor. */
2236 enum text_cursor_kinds
2237 x_specified_cursor_type (arg
, width
)
2241 enum text_cursor_kinds type
;
2248 else if (CONSP (arg
)
2249 && EQ (XCAR (arg
), Qbar
)
2250 && INTEGERP (XCDR (arg
))
2251 && XINT (XCDR (arg
)) >= 0)
2254 *width
= XINT (XCDR (arg
));
2256 else if (NILP (arg
))
2259 /* Treat anything unknown as "box cursor".
2260 It was bad to signal an error; people have trouble fixing
2261 .Xdefaults with Emacs, when it has something bad in it. */
2262 type
= FILLED_BOX_CURSOR
;
2268 x_set_cursor_type (f
, arg
, oldval
)
2270 Lisp_Object arg
, oldval
;
2274 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
2275 f
->output_data
.w32
->cursor_width
= width
;
2277 /* Make sure the cursor gets redrawn. This is overkill, but how
2278 often do people change cursor types? */
2279 update_mode_lines
++;
2283 x_set_icon_type (f
, arg
, oldval
)
2285 Lisp_Object arg
, oldval
;
2289 if (NILP (arg
) && NILP (oldval
))
2292 if (STRINGP (arg
) && STRINGP (oldval
)
2293 && EQ (Fstring_equal (oldval
, arg
), Qt
))
2296 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
2301 result
= x_bitmap_icon (f
, arg
);
2305 error ("No icon window available");
2311 /* Return non-nil if frame F wants a bitmap icon. */
2319 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
2327 x_set_icon_name (f
, arg
, oldval
)
2329 Lisp_Object arg
, oldval
;
2333 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2336 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2342 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2347 result
= x_text_icon (f
,
2348 (char *) XSTRING ((!NILP (f
->icon_name
)
2357 error ("No icon window available");
2360 /* If the window was unmapped (and its icon was mapped),
2361 the new icon is not mapped, so map the window in its stead. */
2362 if (FRAME_VISIBLE_P (f
))
2364 #ifdef USE_X_TOOLKIT
2365 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2367 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2370 XFlush (FRAME_W32_DISPLAY (f
));
2375 extern Lisp_Object
x_new_font ();
2376 extern Lisp_Object
x_new_fontset();
2379 x_set_font (f
, arg
, oldval
)
2381 Lisp_Object arg
, oldval
;
2384 Lisp_Object fontset_name
;
2386 int old_fontset
= FRAME_FONTSET(f
);
2390 fontset_name
= Fquery_fontset (arg
, Qnil
);
2393 result
= (STRINGP (fontset_name
)
2394 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
2395 : x_new_font (f
, XSTRING (arg
)->data
));
2398 if (EQ (result
, Qnil
))
2399 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
2400 else if (EQ (result
, Qt
))
2401 error ("The characters of the given font have varying widths");
2402 else if (STRINGP (result
))
2404 if (STRINGP (fontset_name
))
2406 /* Fontset names are built from ASCII font names, so the
2407 names may be equal despite there was a change. */
2408 if (old_fontset
== FRAME_FONTSET (f
))
2411 else if (!NILP (Fequal (result
, oldval
)))
2414 store_frame_param (f
, Qfont
, result
);
2415 recompute_basic_faces (f
);
2420 do_pending_window_change (0);
2422 /* Don't call `face-set-after-frame-default' when faces haven't been
2423 initialized yet. This is the case when called from
2424 Fx_create_frame. In that case, the X widget or window doesn't
2425 exist either, and we can end up in x_report_frame_params with a
2426 null widget which gives a segfault. */
2427 if (FRAME_FACE_CACHE (f
))
2429 XSETFRAME (frame
, f
);
2430 call1 (Qface_set_after_frame_default
, frame
);
2435 x_set_border_width (f
, arg
, oldval
)
2437 Lisp_Object arg
, oldval
;
2441 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2444 if (FRAME_W32_WINDOW (f
) != 0)
2445 error ("Cannot change the border width of a window");
2447 f
->output_data
.w32
->border_width
= XINT (arg
);
2451 x_set_internal_border_width (f
, arg
, oldval
)
2453 Lisp_Object arg
, oldval
;
2455 int old
= f
->output_data
.w32
->internal_border_width
;
2458 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2459 if (f
->output_data
.w32
->internal_border_width
< 0)
2460 f
->output_data
.w32
->internal_border_width
= 0;
2462 if (f
->output_data
.w32
->internal_border_width
== old
)
2465 if (FRAME_W32_WINDOW (f
) != 0)
2467 x_set_window_size (f
, 0, f
->width
, f
->height
);
2468 SET_FRAME_GARBAGED (f
);
2469 do_pending_window_change (0);
2474 x_set_visibility (f
, value
, oldval
)
2476 Lisp_Object value
, oldval
;
2479 XSETFRAME (frame
, f
);
2482 Fmake_frame_invisible (frame
, Qt
);
2483 else if (EQ (value
, Qicon
))
2484 Ficonify_frame (frame
);
2486 Fmake_frame_visible (frame
);
2490 /* Change window heights in windows rooted in WINDOW by N lines. */
2493 x_change_window_heights (window
, n
)
2497 struct window
*w
= XWINDOW (window
);
2499 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2500 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2502 if (INTEGERP (w
->orig_top
))
2503 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2504 if (INTEGERP (w
->orig_height
))
2505 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2507 /* Handle just the top child in a vertical split. */
2508 if (!NILP (w
->vchild
))
2509 x_change_window_heights (w
->vchild
, n
);
2511 /* Adjust all children in a horizontal split. */
2512 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2514 w
= XWINDOW (window
);
2515 x_change_window_heights (window
, n
);
2520 x_set_menu_bar_lines (f
, value
, oldval
)
2522 Lisp_Object value
, oldval
;
2525 int olines
= FRAME_MENU_BAR_LINES (f
);
2527 /* Right now, menu bars don't work properly in minibuf-only frames;
2528 most of the commands try to apply themselves to the minibuffer
2529 frame itself, and get an error because you can't switch buffers
2530 in or split the minibuffer window. */
2531 if (FRAME_MINIBUF_ONLY_P (f
))
2534 if (INTEGERP (value
))
2535 nlines
= XINT (value
);
2539 FRAME_MENU_BAR_LINES (f
) = 0;
2541 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2544 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2545 free_frame_menubar (f
);
2546 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2548 /* Adjust the frame size so that the client (text) dimensions
2549 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2551 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2552 do_pending_window_change (0);
2558 /* Set the number of lines used for the tool bar of frame F to VALUE.
2559 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2560 is the old number of tool bar lines. This function changes the
2561 height of all windows on frame F to match the new tool bar height.
2562 The frame's height doesn't change. */
2565 x_set_tool_bar_lines (f
, value
, oldval
)
2567 Lisp_Object value
, oldval
;
2569 int delta
, nlines
, root_height
;
2570 Lisp_Object root_window
;
2572 /* Treat tool bars like menu bars. */
2573 if (FRAME_MINIBUF_ONLY_P (f
))
2576 /* Use VALUE only if an integer >= 0. */
2577 if (INTEGERP (value
) && XINT (value
) >= 0)
2578 nlines
= XFASTINT (value
);
2582 /* Make sure we redisplay all windows in this frame. */
2583 ++windows_or_buffers_changed
;
2585 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2587 /* Don't resize the tool-bar to more than we have room for. */
2588 root_window
= FRAME_ROOT_WINDOW (f
);
2589 root_height
= XINT (XWINDOW (root_window
)->height
);
2590 if (root_height
- delta
< 1)
2592 delta
= root_height
- 1;
2593 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2596 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2597 x_change_window_heights (root_window
, delta
);
2600 /* We also have to make sure that the internal border at the top of
2601 the frame, below the menu bar or tool bar, is redrawn when the
2602 tool bar disappears. This is so because the internal border is
2603 below the tool bar if one is displayed, but is below the menu bar
2604 if there isn't a tool bar. The tool bar draws into the area
2605 below the menu bar. */
2606 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2610 clear_current_matrices (f
);
2611 updating_frame
= NULL
;
2614 /* If the tool bar gets smaller, the internal border below it
2615 has to be cleared. It was formerly part of the display
2616 of the larger tool bar, and updating windows won't clear it. */
2619 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2620 int width
= PIXEL_WIDTH (f
);
2621 int y
= nlines
* CANON_Y_UNIT (f
);
2625 HDC hdc
= get_frame_dc (f
);
2626 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
2627 release_frame_dc (f
, hdc
);
2631 if (WINDOWP (f
->tool_bar_window
))
2632 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2637 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2640 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2641 name; if NAME is a string, set F's name to NAME and set
2642 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2644 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2645 suggesting a new name, which lisp code should override; if
2646 F->explicit_name is set, ignore the new name; otherwise, set it. */
2649 x_set_name (f
, name
, explicit)
2654 /* Make sure that requests from lisp code override requests from
2655 Emacs redisplay code. */
2658 /* If we're switching from explicit to implicit, we had better
2659 update the mode lines and thereby update the title. */
2660 if (f
->explicit_name
&& NILP (name
))
2661 update_mode_lines
= 1;
2663 f
->explicit_name
= ! NILP (name
);
2665 else if (f
->explicit_name
)
2668 /* If NAME is nil, set the name to the w32_id_name. */
2671 /* Check for no change needed in this very common case
2672 before we do any consing. */
2673 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2674 XSTRING (f
->name
)->data
))
2676 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2679 CHECK_STRING (name
);
2681 /* Don't change the name if it's already NAME. */
2682 if (! NILP (Fstring_equal (name
, f
->name
)))
2687 /* For setting the frame title, the title parameter should override
2688 the name parameter. */
2689 if (! NILP (f
->title
))
2692 if (FRAME_W32_WINDOW (f
))
2694 if (STRING_MULTIBYTE (name
))
2695 name
= ENCODE_SYSTEM (name
);
2698 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2703 /* This function should be called when the user's lisp code has
2704 specified a name for the frame; the name will override any set by the
2707 x_explicitly_set_name (f
, arg
, oldval
)
2709 Lisp_Object arg
, oldval
;
2711 x_set_name (f
, arg
, 1);
2714 /* This function should be called by Emacs redisplay code to set the
2715 name; names set this way will never override names set by the user's
2718 x_implicitly_set_name (f
, arg
, oldval
)
2720 Lisp_Object arg
, oldval
;
2722 x_set_name (f
, arg
, 0);
2725 /* Change the title of frame F to NAME.
2726 If NAME is nil, use the frame name as the title.
2728 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2729 name; if NAME is a string, set F's name to NAME and set
2730 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2732 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2733 suggesting a new name, which lisp code should override; if
2734 F->explicit_name is set, ignore the new name; otherwise, set it. */
2737 x_set_title (f
, name
, old_name
)
2739 Lisp_Object name
, old_name
;
2741 /* Don't change the title if it's already NAME. */
2742 if (EQ (name
, f
->title
))
2745 update_mode_lines
= 1;
2752 if (FRAME_W32_WINDOW (f
))
2754 if (STRING_MULTIBYTE (name
))
2755 name
= ENCODE_SYSTEM (name
);
2758 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2764 x_set_autoraise (f
, arg
, oldval
)
2766 Lisp_Object arg
, oldval
;
2768 f
->auto_raise
= !EQ (Qnil
, arg
);
2772 x_set_autolower (f
, arg
, oldval
)
2774 Lisp_Object arg
, oldval
;
2776 f
->auto_lower
= !EQ (Qnil
, arg
);
2780 x_set_unsplittable (f
, arg
, oldval
)
2782 Lisp_Object arg
, oldval
;
2784 f
->no_split
= !NILP (arg
);
2788 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2790 Lisp_Object arg
, oldval
;
2792 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2793 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2794 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2795 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2797 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2798 vertical_scroll_bar_none
:
2799 /* Put scroll bars on the right by default, as is conventional
2802 ? vertical_scroll_bar_left
2803 : vertical_scroll_bar_right
;
2805 /* We set this parameter before creating the window for the
2806 frame, so we can get the geometry right from the start.
2807 However, if the window hasn't been created yet, we shouldn't
2808 call x_set_window_size. */
2809 if (FRAME_W32_WINDOW (f
))
2810 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2811 do_pending_window_change (0);
2816 x_set_scroll_bar_width (f
, arg
, oldval
)
2818 Lisp_Object arg
, oldval
;
2820 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2824 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
2825 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) +
2827 if (FRAME_W32_WINDOW (f
))
2828 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2829 do_pending_window_change (0);
2831 else if (INTEGERP (arg
) && XINT (arg
) > 0
2832 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2834 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2835 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2837 if (FRAME_W32_WINDOW (f
))
2838 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2839 do_pending_window_change (0);
2841 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2842 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2843 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2846 /* Subroutines of creating an frame. */
2848 /* Make sure that Vx_resource_name is set to a reasonable value.
2849 Fix it up, or set it to `emacs' if it is too hopeless. */
2852 validate_x_resource_name ()
2855 /* Number of valid characters in the resource name. */
2857 /* Number of invalid characters in the resource name. */
2862 if (STRINGP (Vx_resource_name
))
2864 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2867 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2869 /* Only letters, digits, - and _ are valid in resource names.
2870 Count the valid characters and count the invalid ones. */
2871 for (i
= 0; i
< len
; i
++)
2874 if (! ((c
>= 'a' && c
<= 'z')
2875 || (c
>= 'A' && c
<= 'Z')
2876 || (c
>= '0' && c
<= '9')
2877 || c
== '-' || c
== '_'))
2884 /* Not a string => completely invalid. */
2885 bad_count
= 5, good_count
= 0;
2887 /* If name is valid already, return. */
2891 /* If name is entirely invalid, or nearly so, use `emacs'. */
2893 || (good_count
== 1 && bad_count
> 0))
2895 Vx_resource_name
= build_string ("emacs");
2899 /* Name is partly valid. Copy it and replace the invalid characters
2900 with underscores. */
2902 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2904 for (i
= 0; i
< len
; i
++)
2906 int c
= XSTRING (new)->data
[i
];
2907 if (! ((c
>= 'a' && c
<= 'z')
2908 || (c
>= 'A' && c
<= 'Z')
2909 || (c
>= '0' && c
<= '9')
2910 || c
== '-' || c
== '_'))
2911 XSTRING (new)->data
[i
] = '_';
2916 extern char *x_get_string_resource ();
2918 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2919 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2920 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2921 class, where INSTANCE is the name under which Emacs was invoked, or
2922 the name specified by the `-name' or `-rn' command-line arguments.
2924 The optional arguments COMPONENT and SUBCLASS add to the key and the
2925 class, respectively. You must specify both of them or neither.
2926 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2927 and the class is `Emacs.CLASS.SUBCLASS'. */)
2928 (attribute
, class, component
, subclass
)
2929 Lisp_Object attribute
, class, component
, subclass
;
2931 register char *value
;
2935 CHECK_STRING (attribute
);
2936 CHECK_STRING (class);
2938 if (!NILP (component
))
2939 CHECK_STRING (component
);
2940 if (!NILP (subclass
))
2941 CHECK_STRING (subclass
);
2942 if (NILP (component
) != NILP (subclass
))
2943 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2945 validate_x_resource_name ();
2947 /* Allocate space for the components, the dots which separate them,
2948 and the final '\0'. Make them big enough for the worst case. */
2949 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2950 + (STRINGP (component
)
2951 ? STRING_BYTES (XSTRING (component
)) : 0)
2952 + STRING_BYTES (XSTRING (attribute
))
2955 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2956 + STRING_BYTES (XSTRING (class))
2957 + (STRINGP (subclass
)
2958 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2961 /* Start with emacs.FRAMENAME for the name (the specific one)
2962 and with `Emacs' for the class key (the general one). */
2963 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2964 strcpy (class_key
, EMACS_CLASS
);
2966 strcat (class_key
, ".");
2967 strcat (class_key
, XSTRING (class)->data
);
2969 if (!NILP (component
))
2971 strcat (class_key
, ".");
2972 strcat (class_key
, XSTRING (subclass
)->data
);
2974 strcat (name_key
, ".");
2975 strcat (name_key
, XSTRING (component
)->data
);
2978 strcat (name_key
, ".");
2979 strcat (name_key
, XSTRING (attribute
)->data
);
2981 value
= x_get_string_resource (Qnil
,
2982 name_key
, class_key
);
2984 if (value
!= (char *) 0)
2985 return build_string (value
);
2990 /* Used when C code wants a resource value. */
2993 x_get_resource_string (attribute
, class)
2994 char *attribute
, *class;
2998 struct frame
*sf
= SELECTED_FRAME ();
3000 /* Allocate space for the components, the dots which separate them,
3001 and the final '\0'. */
3002 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
3003 + strlen (attribute
) + 2);
3004 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3005 + strlen (class) + 2);
3007 sprintf (name_key
, "%s.%s",
3008 XSTRING (Vinvocation_name
)->data
,
3010 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3012 return x_get_string_resource (sf
, name_key
, class_key
);
3015 /* Types we might convert a resource string into. */
3025 /* Return the value of parameter PARAM.
3027 First search ALIST, then Vdefault_frame_alist, then the X defaults
3028 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3030 Convert the resource to the type specified by desired_type.
3032 If no default is specified, return Qunbound. If you call
3033 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
3034 and don't let it get stored in any Lisp-visible variables! */
3037 w32_get_arg (alist
, param
, attribute
, class, type
)
3038 Lisp_Object alist
, param
;
3041 enum resource_types type
;
3043 register Lisp_Object tem
;
3045 tem
= Fassq (param
, alist
);
3047 tem
= Fassq (param
, Vdefault_frame_alist
);
3053 tem
= Fx_get_resource (build_string (attribute
),
3054 build_string (class),
3062 case RES_TYPE_NUMBER
:
3063 return make_number (atoi (XSTRING (tem
)->data
));
3065 case RES_TYPE_FLOAT
:
3066 return make_float (atof (XSTRING (tem
)->data
));
3068 case RES_TYPE_BOOLEAN
:
3069 tem
= Fdowncase (tem
);
3070 if (!strcmp (XSTRING (tem
)->data
, "on")
3071 || !strcmp (XSTRING (tem
)->data
, "true"))
3076 case RES_TYPE_STRING
:
3079 case RES_TYPE_SYMBOL
:
3080 /* As a special case, we map the values `true' and `on'
3081 to Qt, and `false' and `off' to Qnil. */
3084 lower
= Fdowncase (tem
);
3085 if (!strcmp (XSTRING (lower
)->data
, "on")
3086 || !strcmp (XSTRING (lower
)->data
, "true"))
3088 else if (!strcmp (XSTRING (lower
)->data
, "off")
3089 || !strcmp (XSTRING (lower
)->data
, "false"))
3092 return Fintern (tem
, Qnil
);
3105 /* Record in frame F the specified or default value according to ALIST
3106 of the parameter named PROP (a Lisp symbol).
3107 If no value is specified for PROP, look for an X default for XPROP
3108 on the frame named NAME.
3109 If that is not found either, use the value DEFLT. */
3112 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3119 enum resource_types type
;
3123 tem
= w32_get_arg (alist
, prop
, xprop
, xclass
, type
);
3124 if (EQ (tem
, Qunbound
))
3126 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3130 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3131 doc
: /* Parse an X-style geometry string STRING.
3132 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3133 The properties returned may include `top', `left', `height', and `width'.
3134 The value of `left' or `top' may be an integer,
3135 or a list (+ N) meaning N pixels relative to top/left corner,
3136 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3141 unsigned int width
, height
;
3144 CHECK_STRING (string
);
3146 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3147 &x
, &y
, &width
, &height
);
3150 if (geometry
& XValue
)
3152 Lisp_Object element
;
3154 if (x
>= 0 && (geometry
& XNegative
))
3155 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3156 else if (x
< 0 && ! (geometry
& XNegative
))
3157 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3159 element
= Fcons (Qleft
, make_number (x
));
3160 result
= Fcons (element
, result
);
3163 if (geometry
& YValue
)
3165 Lisp_Object element
;
3167 if (y
>= 0 && (geometry
& YNegative
))
3168 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3169 else if (y
< 0 && ! (geometry
& YNegative
))
3170 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3172 element
= Fcons (Qtop
, make_number (y
));
3173 result
= Fcons (element
, result
);
3176 if (geometry
& WidthValue
)
3177 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3178 if (geometry
& HeightValue
)
3179 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3184 /* Calculate the desired size and position of this window,
3185 and return the flags saying which aspects were specified.
3187 This function does not make the coordinates positive. */
3189 #define DEFAULT_ROWS 40
3190 #define DEFAULT_COLS 80
3193 x_figure_window_size (f
, parms
)
3197 register Lisp_Object tem0
, tem1
, tem2
;
3198 long window_prompting
= 0;
3200 /* Default values if we fall through.
3201 Actually, if that happens we should get
3202 window manager prompting. */
3203 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3204 f
->height
= DEFAULT_ROWS
;
3205 /* Window managers expect that if program-specified
3206 positions are not (0,0), they're intentional, not defaults. */
3207 f
->output_data
.w32
->top_pos
= 0;
3208 f
->output_data
.w32
->left_pos
= 0;
3210 /* Ensure that old new_width and new_height will not override the
3212 FRAME_NEW_WIDTH (f
) = 0;
3213 FRAME_NEW_HEIGHT (f
) = 0;
3215 tem0
= w32_get_arg (parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3216 tem1
= w32_get_arg (parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3217 tem2
= w32_get_arg (parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3218 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3220 if (!EQ (tem0
, Qunbound
))
3222 CHECK_NUMBER (tem0
);
3223 f
->height
= XINT (tem0
);
3225 if (!EQ (tem1
, Qunbound
))
3227 CHECK_NUMBER (tem1
);
3228 SET_FRAME_WIDTH (f
, XINT (tem1
));
3230 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3231 window_prompting
|= USSize
;
3233 window_prompting
|= PSize
;
3236 f
->output_data
.w32
->vertical_scroll_bar_extra
3237 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3239 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
3240 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
3241 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
3242 f
->output_data
.w32
->fringes_extra
3243 = FRAME_FRINGE_WIDTH (f
);
3244 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3245 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3247 tem0
= w32_get_arg (parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3248 tem1
= w32_get_arg (parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3249 tem2
= w32_get_arg (parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3250 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3252 if (EQ (tem0
, Qminus
))
3254 f
->output_data
.w32
->top_pos
= 0;
3255 window_prompting
|= YNegative
;
3257 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3258 && CONSP (XCDR (tem0
))
3259 && INTEGERP (XCAR (XCDR (tem0
))))
3261 f
->output_data
.w32
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3262 window_prompting
|= YNegative
;
3264 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3265 && CONSP (XCDR (tem0
))
3266 && INTEGERP (XCAR (XCDR (tem0
))))
3268 f
->output_data
.w32
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3270 else if (EQ (tem0
, Qunbound
))
3271 f
->output_data
.w32
->top_pos
= 0;
3274 CHECK_NUMBER (tem0
);
3275 f
->output_data
.w32
->top_pos
= XINT (tem0
);
3276 if (f
->output_data
.w32
->top_pos
< 0)
3277 window_prompting
|= YNegative
;
3280 if (EQ (tem1
, Qminus
))
3282 f
->output_data
.w32
->left_pos
= 0;
3283 window_prompting
|= XNegative
;
3285 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3286 && CONSP (XCDR (tem1
))
3287 && INTEGERP (XCAR (XCDR (tem1
))))
3289 f
->output_data
.w32
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3290 window_prompting
|= XNegative
;
3292 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3293 && CONSP (XCDR (tem1
))
3294 && INTEGERP (XCAR (XCDR (tem1
))))
3296 f
->output_data
.w32
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3298 else if (EQ (tem1
, Qunbound
))
3299 f
->output_data
.w32
->left_pos
= 0;
3302 CHECK_NUMBER (tem1
);
3303 f
->output_data
.w32
->left_pos
= XINT (tem1
);
3304 if (f
->output_data
.w32
->left_pos
< 0)
3305 window_prompting
|= XNegative
;
3308 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3309 window_prompting
|= USPosition
;
3311 window_prompting
|= PPosition
;
3314 return window_prompting
;
3319 extern LRESULT CALLBACK
w32_wnd_proc ();
3322 w32_init_class (hinst
)
3327 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
3328 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
3330 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
3331 wc
.hInstance
= hinst
;
3332 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
3333 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
3334 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
3335 wc
.lpszMenuName
= NULL
;
3336 wc
.lpszClassName
= EMACS_CLASS
;
3338 return (RegisterClass (&wc
));
3342 w32_createscrollbar (f
, bar
)
3344 struct scroll_bar
* bar
;
3346 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
3347 /* Position and size of scroll bar. */
3348 XINT(bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
3350 XINT(bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
3352 FRAME_W32_WINDOW (f
),
3359 w32_createwindow (f
)
3365 rect
.left
= rect
.top
= 0;
3366 rect
.right
= PIXEL_WIDTH (f
);
3367 rect
.bottom
= PIXEL_HEIGHT (f
);
3369 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
3370 FRAME_EXTERNAL_MENU_BAR (f
));
3372 /* Do first time app init */
3376 w32_init_class (hinst
);
3379 FRAME_W32_WINDOW (f
) = hwnd
3380 = CreateWindow (EMACS_CLASS
,
3382 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
3383 f
->output_data
.w32
->left_pos
,
3384 f
->output_data
.w32
->top_pos
,
3385 rect
.right
- rect
.left
,
3386 rect
.bottom
- rect
.top
,
3394 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
3395 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
3396 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
3397 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
3398 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
3400 /* Enable drag-n-drop. */
3401 DragAcceptFiles (hwnd
, TRUE
);
3403 /* Do this to discard the default setting specified by our parent. */
3404 ShowWindow (hwnd
, SW_HIDE
);
3409 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
3416 wmsg
->msg
.hwnd
= hwnd
;
3417 wmsg
->msg
.message
= msg
;
3418 wmsg
->msg
.wParam
= wParam
;
3419 wmsg
->msg
.lParam
= lParam
;
3420 wmsg
->msg
.time
= GetMessageTime ();
3425 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
3426 between left and right keys as advertised. We test for this
3427 support dynamically, and set a flag when the support is absent. If
3428 absent, we keep track of the left and right control and alt keys
3429 ourselves. This is particularly necessary on keyboards that rely
3430 upon the AltGr key, which is represented as having the left control
3431 and right alt keys pressed. For these keyboards, we need to know
3432 when the left alt key has been pressed in addition to the AltGr key
3433 so that we can properly support M-AltGr-key sequences (such as M-@
3434 on Swedish keyboards). */
3436 #define EMACS_LCONTROL 0
3437 #define EMACS_RCONTROL 1
3438 #define EMACS_LMENU 2
3439 #define EMACS_RMENU 3
3441 static int modifiers
[4];
3442 static int modifiers_recorded
;
3443 static int modifier_key_support_tested
;
3446 test_modifier_support (unsigned int wparam
)
3450 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3452 if (wparam
== VK_CONTROL
)
3462 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
3463 modifiers_recorded
= 1;
3465 modifiers_recorded
= 0;
3466 modifier_key_support_tested
= 1;
3470 record_keydown (unsigned int wparam
, unsigned int lparam
)
3474 if (!modifier_key_support_tested
)
3475 test_modifier_support (wparam
);
3477 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3480 if (wparam
== VK_CONTROL
)
3481 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3483 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3489 record_keyup (unsigned int wparam
, unsigned int lparam
)
3493 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3496 if (wparam
== VK_CONTROL
)
3497 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3499 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3504 /* Emacs can lose focus while a modifier key has been pressed. When
3505 it regains focus, be conservative and clear all modifiers since
3506 we cannot reconstruct the left and right modifier state. */
3512 if (GetFocus () == NULL
)
3513 /* Emacs doesn't have keyboard focus. Do nothing. */
3516 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3517 alt
= GetAsyncKeyState (VK_MENU
);
3519 if (!(ctrl
& 0x08000))
3520 /* Clear any recorded control modifier state. */
3521 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3523 if (!(alt
& 0x08000))
3524 /* Clear any recorded alt modifier state. */
3525 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3527 /* Update the state of all modifier keys, because modifiers used in
3528 hot-key combinations can get stuck on if Emacs loses focus as a
3529 result of a hot-key being pressed. */
3533 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3535 GetKeyboardState (keystate
);
3536 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
3537 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
3538 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
3539 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
3540 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
3541 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
3542 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
3543 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
3544 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
3545 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
3546 SetKeyboardState (keystate
);
3550 /* Synchronize modifier state with what is reported with the current
3551 keystroke. Even if we cannot distinguish between left and right
3552 modifier keys, we know that, if no modifiers are set, then neither
3553 the left or right modifier should be set. */
3557 if (!modifiers_recorded
)
3560 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3561 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3563 if (!(GetKeyState (VK_MENU
) & 0x8000))
3564 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3568 modifier_set (int vkey
)
3570 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
3571 return (GetKeyState (vkey
) & 0x1);
3572 if (!modifiers_recorded
)
3573 return (GetKeyState (vkey
) & 0x8000);
3578 return modifiers
[EMACS_LCONTROL
];
3580 return modifiers
[EMACS_RCONTROL
];
3582 return modifiers
[EMACS_LMENU
];
3584 return modifiers
[EMACS_RMENU
];
3586 return (GetKeyState (vkey
) & 0x8000);
3589 /* Convert between the modifier bits W32 uses and the modifier bits
3593 w32_key_to_modifier (int key
)
3595 Lisp_Object key_mapping
;
3600 key_mapping
= Vw32_lwindow_modifier
;
3603 key_mapping
= Vw32_rwindow_modifier
;
3606 key_mapping
= Vw32_apps_modifier
;
3609 key_mapping
= Vw32_scroll_lock_modifier
;
3615 /* NB. This code runs in the input thread, asychronously to the lisp
3616 thread, so we must be careful to ensure access to lisp data is
3617 thread-safe. The following code is safe because the modifier
3618 variable values are updated atomically from lisp and symbols are
3619 not relocated by GC. Also, we don't have to worry about seeing GC
3621 if (EQ (key_mapping
, Qhyper
))
3622 return hyper_modifier
;
3623 if (EQ (key_mapping
, Qsuper
))
3624 return super_modifier
;
3625 if (EQ (key_mapping
, Qmeta
))
3626 return meta_modifier
;
3627 if (EQ (key_mapping
, Qalt
))
3628 return alt_modifier
;
3629 if (EQ (key_mapping
, Qctrl
))
3630 return ctrl_modifier
;
3631 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
3632 return ctrl_modifier
;
3633 if (EQ (key_mapping
, Qshift
))
3634 return shift_modifier
;
3636 /* Don't generate any modifier if not explicitly requested. */
3641 w32_get_modifiers ()
3643 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
3644 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
3645 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
3646 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
3647 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
3648 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
3649 (modifier_set (VK_MENU
) ?
3650 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
3653 /* We map the VK_* modifiers into console modifier constants
3654 so that we can use the same routines to handle both console
3655 and window input. */
3658 construct_console_modifiers ()
3663 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3664 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3665 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
3666 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
3667 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3668 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3669 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3670 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3671 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
3672 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
3673 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
3679 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
3683 /* Convert to emacs modifiers. */
3684 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
3690 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
3692 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
3695 if (virt_key
== VK_RETURN
)
3696 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3698 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
3699 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
3701 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
3702 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
3704 if (virt_key
== VK_CLEAR
)
3705 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
3710 /* List of special key combinations which w32 would normally capture,
3711 but emacs should grab instead. Not directly visible to lisp, to
3712 simplify synchronization. Each item is an integer encoding a virtual
3713 key code and modifier combination to capture. */
3714 Lisp_Object w32_grabbed_keys
;
3716 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3717 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3718 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3719 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3721 /* Register hot-keys for reserved key combinations when Emacs has
3722 keyboard focus, since this is the only way Emacs can receive key
3723 combinations like Alt-Tab which are used by the system. */
3726 register_hot_keys (hwnd
)
3729 Lisp_Object keylist
;
3731 /* Use GC_CONSP, since we are called asynchronously. */
3732 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3734 Lisp_Object key
= XCAR (keylist
);
3736 /* Deleted entries get set to nil. */
3737 if (!INTEGERP (key
))
3740 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
3741 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
3746 unregister_hot_keys (hwnd
)
3749 Lisp_Object keylist
;
3751 /* Use GC_CONSP, since we are called asynchronously. */
3752 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3754 Lisp_Object key
= XCAR (keylist
);
3756 if (!INTEGERP (key
))
3759 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
3763 /* Main message dispatch loop. */
3766 w32_msg_pump (deferred_msg
* msg_buf
)
3772 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3774 while (GetMessage (&msg
, NULL
, 0, 0))
3776 if (msg
.hwnd
== NULL
)
3778 switch (msg
.message
)
3781 /* Produced by complete_deferred_msg; just ignore. */
3783 case WM_EMACS_CREATEWINDOW
:
3784 w32_createwindow ((struct frame
*) msg
.wParam
);
3785 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3788 case WM_EMACS_SETLOCALE
:
3789 SetThreadLocale (msg
.wParam
);
3790 /* Reply is not expected. */
3792 case WM_EMACS_SETKEYBOARDLAYOUT
:
3793 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
3794 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3798 case WM_EMACS_REGISTER_HOT_KEY
:
3799 focus_window
= GetFocus ();
3800 if (focus_window
!= NULL
)
3801 RegisterHotKey (focus_window
,
3802 HOTKEY_ID (msg
.wParam
),
3803 HOTKEY_MODIFIERS (msg
.wParam
),
3804 HOTKEY_VK_CODE (msg
.wParam
));
3805 /* Reply is not expected. */
3807 case WM_EMACS_UNREGISTER_HOT_KEY
:
3808 focus_window
= GetFocus ();
3809 if (focus_window
!= NULL
)
3810 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
3811 /* Mark item as erased. NB: this code must be
3812 thread-safe. The next line is okay because the cons
3813 cell is never made into garbage and is not relocated by
3815 XSETCAR ((Lisp_Object
) msg
.lParam
, Qnil
);
3816 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3819 case WM_EMACS_TOGGLE_LOCK_KEY
:
3821 int vk_code
= (int) msg
.wParam
;
3822 int cur_state
= (GetKeyState (vk_code
) & 1);
3823 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
3825 /* NB: This code must be thread-safe. It is safe to
3826 call NILP because symbols are not relocated by GC,
3827 and pointer here is not touched by GC (so the markbit
3828 can't be set). Numbers are safe because they are
3829 immediate values. */
3830 if (NILP (new_state
)
3831 || (NUMBERP (new_state
)
3832 && ((XUINT (new_state
)) & 1) != cur_state
))
3834 one_w32_display_info
.faked_key
= vk_code
;
3836 keybd_event ((BYTE
) vk_code
,
3837 (BYTE
) MapVirtualKey (vk_code
, 0),
3838 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3839 keybd_event ((BYTE
) vk_code
,
3840 (BYTE
) MapVirtualKey (vk_code
, 0),
3841 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3842 keybd_event ((BYTE
) vk_code
,
3843 (BYTE
) MapVirtualKey (vk_code
, 0),
3844 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3845 cur_state
= !cur_state
;
3847 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3853 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3858 DispatchMessage (&msg
);
3861 /* Exit nested loop when our deferred message has completed. */
3862 if (msg_buf
->completed
)
3867 deferred_msg
* deferred_msg_head
;
3869 static deferred_msg
*
3870 find_deferred_msg (HWND hwnd
, UINT msg
)
3872 deferred_msg
* item
;
3874 /* Don't actually need synchronization for read access, since
3875 modification of single pointer is always atomic. */
3876 /* enter_crit (); */
3878 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3879 if (item
->w32msg
.msg
.hwnd
== hwnd
3880 && item
->w32msg
.msg
.message
== msg
)
3883 /* leave_crit (); */
3889 send_deferred_msg (deferred_msg
* msg_buf
,
3895 /* Only input thread can send deferred messages. */
3896 if (GetCurrentThreadId () != dwWindowsThreadId
)
3899 /* It is an error to send a message that is already deferred. */
3900 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3903 /* Enforced synchronization is not needed because this is the only
3904 function that alters deferred_msg_head, and the following critical
3905 section is guaranteed to only be serially reentered (since only the
3906 input thread can call us). */
3908 /* enter_crit (); */
3910 msg_buf
->completed
= 0;
3911 msg_buf
->next
= deferred_msg_head
;
3912 deferred_msg_head
= msg_buf
;
3913 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
3915 /* leave_crit (); */
3917 /* Start a new nested message loop to process other messages until
3918 this one is completed. */
3919 w32_msg_pump (msg_buf
);
3921 deferred_msg_head
= msg_buf
->next
;
3923 return msg_buf
->result
;
3927 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
3929 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
3931 if (msg_buf
== NULL
)
3932 /* Message may have been cancelled, so don't abort(). */
3935 msg_buf
->result
= result
;
3936 msg_buf
->completed
= 1;
3938 /* Ensure input thread is woken so it notices the completion. */
3939 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3943 cancel_all_deferred_msgs ()
3945 deferred_msg
* item
;
3947 /* Don't actually need synchronization for read access, since
3948 modification of single pointer is always atomic. */
3949 /* enter_crit (); */
3951 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3954 item
->completed
= 1;
3957 /* leave_crit (); */
3959 /* Ensure input thread is woken so it notices the completion. */
3960 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3968 deferred_msg dummy_buf
;
3970 /* Ensure our message queue is created */
3972 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
3974 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3977 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
3978 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
3979 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
3981 /* This is the inital message loop which should only exit when the
3982 application quits. */
3983 w32_msg_pump (&dummy_buf
);
3989 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
3999 wmsg
.dwModifiers
= modifiers
;
4001 /* Detect quit_char and set quit-flag directly. Note that we
4002 still need to post a message to ensure the main thread will be
4003 woken up if blocked in sys_select(), but we do NOT want to post
4004 the quit_char message itself (because it will usually be as if
4005 the user had typed quit_char twice). Instead, we post a dummy
4006 message that has no particular effect. */
4009 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
4010 c
= make_ctrl_char (c
) & 0377;
4012 || (wmsg
.dwModifiers
== 0 &&
4013 XFASTINT (Vw32_quit_key
) && wParam
== XFASTINT (Vw32_quit_key
)))
4017 /* The choice of message is somewhat arbitrary, as long as
4018 the main thread handler just ignores it. */
4021 /* Interrupt any blocking system calls. */
4024 /* As a safety precaution, forcibly complete any deferred
4025 messages. This is a kludge, but I don't see any particularly
4026 clean way to handle the situation where a deferred message is
4027 "dropped" in the lisp thread, and will thus never be
4028 completed, eg. by the user trying to activate the menubar
4029 when the lisp thread is busy, and then typing C-g when the
4030 menubar doesn't open promptly (with the result that the
4031 menubar never responds at all because the deferred
4032 WM_INITMENU message is never completed). Another problem
4033 situation is when the lisp thread calls SendMessage (to send
4034 a window manager command) when a message has been deferred;
4035 the lisp thread gets blocked indefinitely waiting for the
4036 deferred message to be completed, which itself is waiting for
4037 the lisp thread to respond.
4039 Note that we don't want to block the input thread waiting for
4040 a reponse from the lisp thread (although that would at least
4041 solve the deadlock problem above), because we want to be able
4042 to receive C-g to interrupt the lisp thread. */
4043 cancel_all_deferred_msgs ();
4047 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4050 /* Main window procedure */
4053 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
4060 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
4062 int windows_translate
;
4065 /* Note that it is okay to call x_window_to_frame, even though we are
4066 not running in the main lisp thread, because frame deletion
4067 requires the lisp thread to synchronize with this thread. Thus, if
4068 a frame struct is returned, it can be used without concern that the
4069 lisp thread might make it disappear while we are using it.
4071 NB. Walking the frame list in this thread is safe (as long as
4072 writes of Lisp_Object slots are atomic, which they are on Windows).
4073 Although delete-frame can destructively modify the frame list while
4074 we are walking it, a garbage collection cannot occur until after
4075 delete-frame has synchronized with this thread.
4077 It is also safe to use functions that make GDI calls, such as
4078 w32_clear_rect, because these functions must obtain a DC handle
4079 from the frame struct using get_frame_dc which is thread-aware. */
4084 f
= x_window_to_frame (dpyinfo
, hwnd
);
4087 HDC hdc
= get_frame_dc (f
);
4088 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
4089 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
4090 release_frame_dc (f
, hdc
);
4092 #if defined (W32_DEBUG_DISPLAY)
4093 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4095 wmsg
.rect
.left
, wmsg
.rect
.top
,
4096 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4097 #endif /* W32_DEBUG_DISPLAY */
4100 case WM_PALETTECHANGED
:
4101 /* ignore our own changes */
4102 if ((HWND
)wParam
!= hwnd
)
4104 f
= x_window_to_frame (dpyinfo
, hwnd
);
4106 /* get_frame_dc will realize our palette and force all
4107 frames to be redrawn if needed. */
4108 release_frame_dc (f
, get_frame_dc (f
));
4113 PAINTSTRUCT paintStruct
;
4116 f
= x_window_to_frame (dpyinfo
, hwnd
);
4119 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
4123 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4124 fails. Apparently this can happen under some
4126 if (!w32_strict_painting
|| GetUpdateRect (hwnd
, &update_rect
, FALSE
))
4129 BeginPaint (hwnd
, &paintStruct
);
4131 if (w32_strict_painting
)
4132 /* The rectangles returned by GetUpdateRect and BeginPaint
4133 do not always match. GetUpdateRect seems to be the
4134 more reliable of the two. */
4135 wmsg
.rect
= update_rect
;
4137 wmsg
.rect
= paintStruct
.rcPaint
;
4139 #if defined (W32_DEBUG_DISPLAY)
4140 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4142 wmsg
.rect
.left
, wmsg
.rect
.top
,
4143 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4144 DebPrint ((" [update region is %d,%d-%d,%d]\n",
4145 update_rect
.left
, update_rect
.top
,
4146 update_rect
.right
, update_rect
.bottom
));
4148 EndPaint (hwnd
, &paintStruct
);
4151 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4156 /* If GetUpdateRect returns 0 (meaning there is no update
4157 region), assume the whole window needs to be repainted. */
4158 GetClientRect(hwnd
, &wmsg
.rect
);
4159 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4163 case WM_INPUTLANGCHANGE
:
4164 /* Inform lisp thread of keyboard layout changes. */
4165 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4167 /* Clear dead keys in the keyboard state; for simplicity only
4168 preserve modifier key states. */
4173 GetKeyboardState (keystate
);
4174 for (i
= 0; i
< 256; i
++)
4191 SetKeyboardState (keystate
);
4196 /* Synchronize hot keys with normal input. */
4197 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
4202 record_keyup (wParam
, lParam
);
4207 /* Ignore keystrokes we fake ourself; see below. */
4208 if (dpyinfo
->faked_key
== wParam
)
4210 dpyinfo
->faked_key
= 0;
4211 /* Make sure TranslateMessage sees them though (as long as
4212 they don't produce WM_CHAR messages). This ensures that
4213 indicator lights are toggled promptly on Windows 9x, for
4215 if (lispy_function_keys
[wParam
] != 0)
4217 windows_translate
= 1;
4223 /* Synchronize modifiers with current keystroke. */
4225 record_keydown (wParam
, lParam
);
4226 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
4228 windows_translate
= 0;
4233 if (NILP (Vw32_pass_lwindow_to_system
))
4235 /* Prevent system from acting on keyup (which opens the
4236 Start menu if no other key was pressed) by simulating a
4237 press of Space which we will ignore. */
4238 if (GetAsyncKeyState (wParam
) & 1)
4240 if (NUMBERP (Vw32_phantom_key_code
))
4241 key
= XUINT (Vw32_phantom_key_code
) & 255;
4244 dpyinfo
->faked_key
= key
;
4245 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4248 if (!NILP (Vw32_lwindow_modifier
))
4252 if (NILP (Vw32_pass_rwindow_to_system
))
4254 if (GetAsyncKeyState (wParam
) & 1)
4256 if (NUMBERP (Vw32_phantom_key_code
))
4257 key
= XUINT (Vw32_phantom_key_code
) & 255;
4260 dpyinfo
->faked_key
= key
;
4261 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4264 if (!NILP (Vw32_rwindow_modifier
))
4268 if (!NILP (Vw32_apps_modifier
))
4272 if (NILP (Vw32_pass_alt_to_system
))
4273 /* Prevent DefWindowProc from activating the menu bar if an
4274 Alt key is pressed and released by itself. */
4276 windows_translate
= 1;
4279 /* Decide whether to treat as modifier or function key. */
4280 if (NILP (Vw32_enable_caps_lock
))
4281 goto disable_lock_key
;
4282 windows_translate
= 1;
4285 /* Decide whether to treat as modifier or function key. */
4286 if (NILP (Vw32_enable_num_lock
))
4287 goto disable_lock_key
;
4288 windows_translate
= 1;
4291 /* Decide whether to treat as modifier or function key. */
4292 if (NILP (Vw32_scroll_lock_modifier
))
4293 goto disable_lock_key
;
4294 windows_translate
= 1;
4297 /* Ensure the appropriate lock key state (and indicator light)
4298 remains in the same state. We do this by faking another
4299 press of the relevant key. Apparently, this really is the
4300 only way to toggle the state of the indicator lights. */
4301 dpyinfo
->faked_key
= wParam
;
4302 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4303 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4304 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4305 KEYEVENTF_EXTENDEDKEY
| 0, 0);
4306 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4307 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4308 /* Ensure indicator lights are updated promptly on Windows 9x
4309 (TranslateMessage apparently does this), after forwarding
4311 post_character_message (hwnd
, msg
, wParam
, lParam
,
4312 w32_get_key_modifiers (wParam
, lParam
));
4313 windows_translate
= 1;
4317 case VK_PROCESSKEY
: /* Generated by IME. */
4318 windows_translate
= 1;
4321 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4322 which is confusing for purposes of key binding; convert
4323 VK_CANCEL events into VK_PAUSE events. */
4327 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4328 for purposes of key binding; convert these back into
4329 VK_NUMLOCK events, at least when we want to see NumLock key
4330 presses. (Note that there is never any possibility that
4331 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4332 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
4333 wParam
= VK_NUMLOCK
;
4336 /* If not defined as a function key, change it to a WM_CHAR message. */
4337 if (lispy_function_keys
[wParam
] == 0)
4339 DWORD modifiers
= construct_console_modifiers ();
4341 if (!NILP (Vw32_recognize_altgr
)
4342 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
4344 /* Always let TranslateMessage handle AltGr key chords;
4345 for some reason, ToAscii doesn't always process AltGr
4346 chords correctly. */
4347 windows_translate
= 1;
4349 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
4351 /* Handle key chords including any modifiers other
4352 than shift directly, in order to preserve as much
4353 modifier information as possible. */
4354 if ('A' <= wParam
&& wParam
<= 'Z')
4356 /* Don't translate modified alphabetic keystrokes,
4357 so the user doesn't need to constantly switch
4358 layout to type control or meta keystrokes when
4359 the normal layout translates alphabetic
4360 characters to non-ascii characters. */
4361 if (!modifier_set (VK_SHIFT
))
4362 wParam
+= ('a' - 'A');
4367 /* Try to handle other keystrokes by determining the
4368 base character (ie. translating the base key plus
4372 KEY_EVENT_RECORD key
;
4374 key
.bKeyDown
= TRUE
;
4375 key
.wRepeatCount
= 1;
4376 key
.wVirtualKeyCode
= wParam
;
4377 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
4378 key
.uChar
.AsciiChar
= 0;
4379 key
.dwControlKeyState
= modifiers
;
4381 add
= w32_kbd_patch_key (&key
);
4382 /* 0 means an unrecognised keycode, negative means
4383 dead key. Ignore both. */
4386 /* Forward asciified character sequence. */
4387 post_character_message
4388 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
4389 w32_get_key_modifiers (wParam
, lParam
));
4390 w32_kbd_patch_key (&key
);
4397 /* Let TranslateMessage handle everything else. */
4398 windows_translate
= 1;
4404 if (windows_translate
)
4406 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
4408 windows_msg
.time
= GetMessageTime ();
4409 TranslateMessage (&windows_msg
);
4417 post_character_message (hwnd
, msg
, wParam
, lParam
,
4418 w32_get_key_modifiers (wParam
, lParam
));
4421 /* Simulate middle mouse button events when left and right buttons
4422 are used together, but only if user has two button mouse. */
4423 case WM_LBUTTONDOWN
:
4424 case WM_RBUTTONDOWN
:
4425 if (XINT (Vw32_num_mouse_buttons
) > 2)
4426 goto handle_plain_button
;
4429 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
4430 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
4432 if (button_state
& this)
4435 if (button_state
== 0)
4438 button_state
|= this;
4440 if (button_state
& other
)
4442 if (mouse_button_timer
)
4444 KillTimer (hwnd
, mouse_button_timer
);
4445 mouse_button_timer
= 0;
4447 /* Generate middle mouse event instead. */
4448 msg
= WM_MBUTTONDOWN
;
4449 button_state
|= MMOUSE
;
4451 else if (button_state
& MMOUSE
)
4453 /* Ignore button event if we've already generated a
4454 middle mouse down event. This happens if the
4455 user releases and press one of the two buttons
4456 after we've faked a middle mouse event. */
4461 /* Flush out saved message. */
4462 post_msg (&saved_mouse_button_msg
);
4464 wmsg
.dwModifiers
= w32_get_modifiers ();
4465 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4467 /* Clear message buffer. */
4468 saved_mouse_button_msg
.msg
.hwnd
= 0;
4472 /* Hold onto message for now. */
4473 mouse_button_timer
=
4474 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
4475 XINT (Vw32_mouse_button_tolerance
), NULL
);
4476 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
4477 saved_mouse_button_msg
.msg
.message
= msg
;
4478 saved_mouse_button_msg
.msg
.wParam
= wParam
;
4479 saved_mouse_button_msg
.msg
.lParam
= lParam
;
4480 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
4481 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
4488 if (XINT (Vw32_num_mouse_buttons
) > 2)
4489 goto handle_plain_button
;
4492 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
4493 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
4495 if ((button_state
& this) == 0)
4498 button_state
&= ~this;
4500 if (button_state
& MMOUSE
)
4502 /* Only generate event when second button is released. */
4503 if ((button_state
& other
) == 0)
4506 button_state
&= ~MMOUSE
;
4508 if (button_state
) abort ();
4515 /* Flush out saved message if necessary. */
4516 if (saved_mouse_button_msg
.msg
.hwnd
)
4518 post_msg (&saved_mouse_button_msg
);
4521 wmsg
.dwModifiers
= w32_get_modifiers ();
4522 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4524 /* Always clear message buffer and cancel timer. */
4525 saved_mouse_button_msg
.msg
.hwnd
= 0;
4526 KillTimer (hwnd
, mouse_button_timer
);
4527 mouse_button_timer
= 0;
4529 if (button_state
== 0)
4534 case WM_MBUTTONDOWN
:
4536 handle_plain_button
:
4541 if (parse_button (msg
, &button
, &up
))
4543 if (up
) ReleaseCapture ();
4544 else SetCapture (hwnd
);
4545 button
= (button
== 0) ? LMOUSE
:
4546 ((button
== 1) ? MMOUSE
: RMOUSE
);
4548 button_state
&= ~button
;
4550 button_state
|= button
;
4554 wmsg
.dwModifiers
= w32_get_modifiers ();
4555 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4560 if (XINT (Vw32_mouse_move_interval
) <= 0
4561 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
4563 wmsg
.dwModifiers
= w32_get_modifiers ();
4564 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4568 /* Hang onto mouse move and scroll messages for a bit, to avoid
4569 sending such events to Emacs faster than it can process them.
4570 If we get more events before the timer from the first message
4571 expires, we just replace the first message. */
4573 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
4575 SetTimer (hwnd
, MOUSE_MOVE_ID
,
4576 XINT (Vw32_mouse_move_interval
), NULL
);
4578 /* Hold onto message for now. */
4579 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
4580 saved_mouse_move_msg
.msg
.message
= msg
;
4581 saved_mouse_move_msg
.msg
.wParam
= wParam
;
4582 saved_mouse_move_msg
.msg
.lParam
= lParam
;
4583 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
4584 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
4589 wmsg
.dwModifiers
= w32_get_modifiers ();
4590 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4594 wmsg
.dwModifiers
= w32_get_modifiers ();
4595 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4599 /* Flush out saved messages if necessary. */
4600 if (wParam
== mouse_button_timer
)
4602 if (saved_mouse_button_msg
.msg
.hwnd
)
4604 post_msg (&saved_mouse_button_msg
);
4605 saved_mouse_button_msg
.msg
.hwnd
= 0;
4607 KillTimer (hwnd
, mouse_button_timer
);
4608 mouse_button_timer
= 0;
4610 else if (wParam
== mouse_move_timer
)
4612 if (saved_mouse_move_msg
.msg
.hwnd
)
4614 post_msg (&saved_mouse_move_msg
);
4615 saved_mouse_move_msg
.msg
.hwnd
= 0;
4617 KillTimer (hwnd
, mouse_move_timer
);
4618 mouse_move_timer
= 0;
4623 /* Windows doesn't send us focus messages when putting up and
4624 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4625 The only indication we get that something happened is receiving
4626 this message afterwards. So this is a good time to reset our
4627 keyboard modifiers' state. */
4634 /* We must ensure menu bar is fully constructed and up to date
4635 before allowing user interaction with it. To achieve this
4636 we send this message to the lisp thread and wait for a
4637 reply (whose value is not actually needed) to indicate that
4638 the menu bar is now ready for use, so we can now return.
4640 To remain responsive in the meantime, we enter a nested message
4641 loop that can process all other messages.
4643 However, we skip all this if the message results from calling
4644 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4645 thread a message because it is blocked on us at this point. We
4646 set menubar_active before calling TrackPopupMenu to indicate
4647 this (there is no possibility of confusion with real menubar
4650 f
= x_window_to_frame (dpyinfo
, hwnd
);
4652 && (f
->output_data
.w32
->menubar_active
4653 /* We can receive this message even in the absence of a
4654 menubar (ie. when the system menu is activated) - in this
4655 case we do NOT want to forward the message, otherwise it
4656 will cause the menubar to suddenly appear when the user
4657 had requested it to be turned off! */
4658 || f
->output_data
.w32
->menubar_widget
== NULL
))
4662 deferred_msg msg_buf
;
4664 /* Detect if message has already been deferred; in this case
4665 we cannot return any sensible value to ignore this. */
4666 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4669 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
4672 case WM_EXITMENULOOP
:
4673 f
= x_window_to_frame (dpyinfo
, hwnd
);
4675 /* Indicate that menubar can be modified again. */
4677 f
->output_data
.w32
->menubar_active
= 0;
4681 wmsg
.dwModifiers
= w32_get_modifiers ();
4682 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4685 case WM_MEASUREITEM
:
4686 f
= x_window_to_frame (dpyinfo
, hwnd
);
4689 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
4691 if (pMis
->CtlType
== ODT_MENU
)
4693 /* Work out dimensions for popup menu titles. */
4694 char * title
= (char *) pMis
->itemData
;
4695 HDC hdc
= GetDC (hwnd
);
4696 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4697 LOGFONT menu_logfont
;
4701 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4702 menu_logfont
.lfWeight
= FW_BOLD
;
4703 menu_font
= CreateFontIndirect (&menu_logfont
);
4704 old_font
= SelectObject (hdc
, menu_font
);
4706 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
4709 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
4710 pMis
->itemWidth
= size
.cx
;
4711 if (pMis
->itemHeight
< size
.cy
)
4712 pMis
->itemHeight
= size
.cy
;
4715 pMis
->itemWidth
= 0;
4717 SelectObject (hdc
, old_font
);
4718 DeleteObject (menu_font
);
4719 ReleaseDC (hwnd
, hdc
);
4726 f
= x_window_to_frame (dpyinfo
, hwnd
);
4729 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
4731 if (pDis
->CtlType
== ODT_MENU
)
4733 /* Draw popup menu title. */
4734 char * title
= (char *) pDis
->itemData
;
4737 HDC hdc
= pDis
->hDC
;
4738 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4739 LOGFONT menu_logfont
;
4742 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4743 menu_logfont
.lfWeight
= FW_BOLD
;
4744 menu_font
= CreateFontIndirect (&menu_logfont
);
4745 old_font
= SelectObject (hdc
, menu_font
);
4747 /* Always draw title as if not selected. */
4750 + GetSystemMetrics (SM_CXMENUCHECK
),
4752 ETO_OPAQUE
, &pDis
->rcItem
,
4753 title
, strlen (title
), NULL
);
4755 SelectObject (hdc
, old_font
);
4756 DeleteObject (menu_font
);
4764 /* Still not right - can't distinguish between clicks in the
4765 client area of the frame from clicks forwarded from the scroll
4766 bars - may have to hook WM_NCHITTEST to remember the mouse
4767 position and then check if it is in the client area ourselves. */
4768 case WM_MOUSEACTIVATE
:
4769 /* Discard the mouse click that activates a frame, allowing the
4770 user to click anywhere without changing point (or worse!).
4771 Don't eat mouse clicks on scrollbars though!! */
4772 if (LOWORD (lParam
) == HTCLIENT
)
4773 return MA_ACTIVATEANDEAT
;
4777 case WM_ACTIVATEAPP
:
4779 case WM_WINDOWPOSCHANGED
:
4781 /* Inform lisp thread that a frame might have just been obscured
4782 or exposed, so should recheck visibility of all frames. */
4783 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4787 dpyinfo
->faked_key
= 0;
4789 register_hot_keys (hwnd
);
4792 unregister_hot_keys (hwnd
);
4795 /* Relinquish the system caret. */
4796 if (w32_system_caret_hwnd
)
4799 w32_system_caret_hwnd
= NULL
;
4805 wmsg
.dwModifiers
= w32_get_modifiers ();
4806 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4810 wmsg
.dwModifiers
= w32_get_modifiers ();
4811 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4814 case WM_WINDOWPOSCHANGING
:
4817 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
4819 wp
.length
= sizeof (WINDOWPLACEMENT
);
4820 GetWindowPlacement (hwnd
, &wp
);
4822 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
4829 DWORD internal_border
;
4830 DWORD scrollbar_extra
;
4833 wp
.length
= sizeof(wp
);
4834 GetWindowRect (hwnd
, &wr
);
4838 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
4839 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
4840 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
4841 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
4845 memset (&rect
, 0, sizeof (rect
));
4846 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
4847 GetMenu (hwnd
) != NULL
);
4849 /* Force width and height of client area to be exact
4850 multiples of the character cell dimensions. */
4851 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
4852 - 2 * internal_border
- scrollbar_extra
)
4854 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
4855 - 2 * internal_border
)
4860 /* For right/bottom sizing we can just fix the sizes.
4861 However for top/left sizing we will need to fix the X
4862 and Y positions as well. */
4867 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
4868 && (lppos
->flags
& SWP_NOMOVE
) == 0)
4870 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
4877 lppos
->flags
|= SWP_NOMOVE
;
4888 case WM_GETMINMAXINFO
:
4889 /* Hack to correct bug that allows Emacs frames to be resized
4890 below the Minimum Tracking Size. */
4891 ((LPMINMAXINFO
) lParam
)->ptMinTrackSize
.y
++;
4892 /* Hack to allow resizing the Emacs frame above the screen size.
4893 Note that Windows 9x limits coordinates to 16-bits. */
4894 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
4895 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
4898 case WM_EMACS_CREATESCROLLBAR
:
4899 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
4900 (struct scroll_bar
*) lParam
);
4902 case WM_EMACS_SHOWWINDOW
:
4903 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
4905 case WM_EMACS_SETFOREGROUND
:
4907 HWND foreground_window
;
4908 DWORD foreground_thread
, retval
;
4910 /* On NT 5.0, and apparently Windows 98, it is necessary to
4911 attach to the thread that currently has focus in order to
4912 pull the focus away from it. */
4913 foreground_window
= GetForegroundWindow ();
4914 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
4915 if (!foreground_window
4916 || foreground_thread
== GetCurrentThreadId ()
4917 || !AttachThreadInput (GetCurrentThreadId (),
4918 foreground_thread
, TRUE
))
4919 foreground_thread
= 0;
4921 retval
= SetForegroundWindow ((HWND
) wParam
);
4923 /* Detach from the previous foreground thread. */
4924 if (foreground_thread
)
4925 AttachThreadInput (GetCurrentThreadId (),
4926 foreground_thread
, FALSE
);
4931 case WM_EMACS_SETWINDOWPOS
:
4933 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
4934 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
4935 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
4938 case WM_EMACS_DESTROYWINDOW
:
4939 DragAcceptFiles ((HWND
) wParam
, FALSE
);
4940 return DestroyWindow ((HWND
) wParam
);
4942 case WM_EMACS_DESTROY_CARET
:
4943 w32_system_caret_hwnd
= NULL
;
4944 return DestroyCaret ();
4946 case WM_EMACS_TRACK_CARET
:
4947 /* If there is currently no system caret, create one. */
4948 if (w32_system_caret_hwnd
== NULL
)
4950 w32_system_caret_hwnd
= hwnd
;
4951 CreateCaret (hwnd
, NULL
, w32_system_caret_width
,
4952 w32_system_caret_height
);
4954 return SetCaretPos (w32_system_caret_x
, w32_system_caret_y
);
4956 case WM_EMACS_TRACKPOPUPMENU
:
4961 pos
= (POINT
*)lParam
;
4962 flags
= TPM_CENTERALIGN
;
4963 if (button_state
& LMOUSE
)
4964 flags
|= TPM_LEFTBUTTON
;
4965 else if (button_state
& RMOUSE
)
4966 flags
|= TPM_RIGHTBUTTON
;
4968 /* Remember we did a SetCapture on the initial mouse down event,
4969 so for safety, we make sure the capture is cancelled now. */
4973 /* Use menubar_active to indicate that WM_INITMENU is from
4974 TrackPopupMenu below, and should be ignored. */
4975 f
= x_window_to_frame (dpyinfo
, hwnd
);
4977 f
->output_data
.w32
->menubar_active
= 1;
4979 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
4983 /* Eat any mouse messages during popupmenu */
4984 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
4986 /* Get the menu selection, if any */
4987 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
4989 retval
= LOWORD (amsg
.wParam
);
5005 /* Check for messages registered at runtime. */
5006 if (msg
== msh_mousewheel
)
5008 wmsg
.dwModifiers
= w32_get_modifiers ();
5009 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
5014 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
5018 /* The most common default return code for handled messages is 0. */
5023 my_create_window (f
)
5028 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
5030 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
5033 /* Create and set up the w32 window for frame F. */
5036 w32_window (f
, window_prompting
, minibuffer_only
)
5038 long window_prompting
;
5039 int minibuffer_only
;
5043 /* Use the resource name as the top-level window name
5044 for looking up resources. Make a non-Lisp copy
5045 for the window manager, so GC relocation won't bother it.
5047 Elsewhere we specify the window name for the window manager. */
5050 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
5051 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
5052 strcpy (f
->namebuf
, str
);
5055 my_create_window (f
);
5057 validate_x_resource_name ();
5059 /* x_set_name normally ignores requests to set the name if the
5060 requested name is the same as the current name. This is the one
5061 place where that assumption isn't correct; f->name is set, but
5062 the server hasn't been told. */
5065 int explicit = f
->explicit_name
;
5067 f
->explicit_name
= 0;
5070 x_set_name (f
, name
, explicit);
5075 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
5076 initialize_frame_menubar (f
);
5078 if (FRAME_W32_WINDOW (f
) == 0)
5079 error ("Unable to create window");
5082 /* Handle the icon stuff for this window. Perhaps later we might
5083 want an x_set_icon_position which can be called interactively as
5091 Lisp_Object icon_x
, icon_y
;
5093 /* Set the position of the icon. Note that Windows 95 groups all
5094 icons in the tray. */
5095 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
5096 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
5097 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
5099 CHECK_NUMBER (icon_x
);
5100 CHECK_NUMBER (icon_y
);
5102 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
5103 error ("Both left and top icon corners of icon must be specified");
5107 if (! EQ (icon_x
, Qunbound
))
5108 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
5111 /* Start up iconic or window? */
5112 x_wm_set_window_state
5113 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
5117 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
5130 XGCValues gc_values
;
5134 /* Create the GC's of this frame.
5135 Note that many default values are used. */
5138 gc_values
.font
= f
->output_data
.w32
->font
;
5140 /* Cursor has cursor-color background, background-color foreground. */
5141 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
5142 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
5143 f
->output_data
.w32
->cursor_gc
5144 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
5145 (GCFont
| GCForeground
| GCBackground
),
5149 f
->output_data
.w32
->white_relief
.gc
= 0;
5150 f
->output_data
.w32
->black_relief
.gc
= 0;
5156 /* Handler for signals raised during x_create_frame and
5157 x_create_top_frame. FRAME is the frame which is partially
5161 unwind_create_frame (frame
)
5164 struct frame
*f
= XFRAME (frame
);
5166 /* If frame is ``official'', nothing to do. */
5167 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
5170 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5173 x_free_frame_resources (f
);
5175 /* Check that reference counts are indeed correct. */
5176 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
5177 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
5186 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
5188 doc
: /* Make a new window, which is called a \"frame\" in Emacs terms.
5189 Returns an Emacs frame object.
5190 ALIST is an alist of frame parameters.
5191 If the parameters specify that the frame should not have a minibuffer,
5192 and do not specify a specific minibuffer window to use,
5193 then `default-minibuffer-frame' must be a frame whose minibuffer can
5194 be shared by the new frame.
5196 This function is an internal primitive--use `make-frame' instead. */)
5201 Lisp_Object frame
, tem
;
5203 int minibuffer_only
= 0;
5204 long window_prompting
= 0;
5206 int count
= BINDING_STACK_SIZE ();
5207 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
5208 Lisp_Object display
;
5209 struct w32_display_info
*dpyinfo
= NULL
;
5215 /* Use this general default value to start with
5216 until we know if this frame has a specified name. */
5217 Vx_resource_name
= Vinvocation_name
;
5219 display
= w32_get_arg (parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
5220 if (EQ (display
, Qunbound
))
5222 dpyinfo
= check_x_display_info (display
);
5224 kb
= dpyinfo
->kboard
;
5226 kb
= &the_only_kboard
;
5229 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
5231 && ! EQ (name
, Qunbound
)
5233 error ("Invalid frame name--not a string or nil");
5236 Vx_resource_name
= name
;
5238 /* See if parent window is specified. */
5239 parent
= w32_get_arg (parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
5240 if (EQ (parent
, Qunbound
))
5242 if (! NILP (parent
))
5243 CHECK_NUMBER (parent
);
5245 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5246 /* No need to protect DISPLAY because that's not used after passing
5247 it to make_frame_without_minibuffer. */
5249 GCPRO4 (parms
, parent
, name
, frame
);
5250 tem
= w32_get_arg (parms
, Qminibuffer
, "minibuffer", "Minibuffer",
5252 if (EQ (tem
, Qnone
) || NILP (tem
))
5253 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
5254 else if (EQ (tem
, Qonly
))
5256 f
= make_minibuffer_frame ();
5257 minibuffer_only
= 1;
5259 else if (WINDOWP (tem
))
5260 f
= make_frame_without_minibuffer (tem
, kb
, display
);
5264 XSETFRAME (frame
, f
);
5266 /* Note that Windows does support scroll bars. */
5267 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
5268 /* By default, make scrollbars the system standard width. */
5269 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
5271 f
->output_method
= output_w32
;
5272 f
->output_data
.w32
=
5273 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
5274 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
5275 FRAME_FONTSET (f
) = -1;
5276 record_unwind_protect (unwind_create_frame
, frame
);
5279 = w32_get_arg (parms
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
5280 if (! STRINGP (f
->icon_name
))
5281 f
->icon_name
= Qnil
;
5283 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
5285 FRAME_KBOARD (f
) = kb
;
5288 /* Specify the parent under which to make this window. */
5292 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
5293 f
->output_data
.w32
->explicit_parent
= 1;
5297 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5298 f
->output_data
.w32
->explicit_parent
= 0;
5301 /* Set the name; the functions to which we pass f expect the name to
5303 if (EQ (name
, Qunbound
) || NILP (name
))
5305 f
->name
= build_string (dpyinfo
->w32_id_name
);
5306 f
->explicit_name
= 0;
5311 f
->explicit_name
= 1;
5312 /* use the frame's title when getting resources for this frame. */
5313 specbind (Qx_resource_name
, name
);
5316 /* Extract the window parameters from the supplied values
5317 that are needed to determine window geometry. */
5321 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
5324 /* First, try whatever font the caller has specified. */
5327 tem
= Fquery_fontset (font
, Qnil
);
5329 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
5331 font
= x_new_font (f
, XSTRING (font
)->data
);
5333 /* Try out a font which we hope has bold and italic variations. */
5334 if (!STRINGP (font
))
5335 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
5336 if (! STRINGP (font
))
5337 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
5338 /* If those didn't work, look for something which will at least work. */
5339 if (! STRINGP (font
))
5340 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
5342 if (! STRINGP (font
))
5343 font
= build_string ("Fixedsys");
5345 x_default_parameter (f
, parms
, Qfont
, font
,
5346 "font", "Font", RES_TYPE_STRING
);
5349 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
5350 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
5351 /* This defaults to 2 in order to match xterm. We recognize either
5352 internalBorderWidth or internalBorder (which is what xterm calls
5354 if (NILP (Fassq (Qinternal_border_width
, parms
)))
5358 value
= w32_get_arg (parms
, Qinternal_border_width
,
5359 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
5360 if (! EQ (value
, Qunbound
))
5361 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
5364 /* Default internalBorderWidth to 0 on Windows to match other programs. */
5365 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
5366 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
5367 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qright
,
5368 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
5370 /* Also do the stuff which must be set before the window exists. */
5371 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
5372 "foreground", "Foreground", RES_TYPE_STRING
);
5373 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
5374 "background", "Background", RES_TYPE_STRING
);
5375 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
5376 "pointerColor", "Foreground", RES_TYPE_STRING
);
5377 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
5378 "cursorColor", "Foreground", RES_TYPE_STRING
);
5379 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
5380 "borderColor", "BorderColor", RES_TYPE_STRING
);
5381 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
5382 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
5383 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
5384 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
5387 /* Init faces before x_default_parameter is called for scroll-bar
5388 parameters because that function calls x_set_scroll_bar_width,
5389 which calls change_frame_size, which calls Fset_window_buffer,
5390 which runs hooks, which call Fvertical_motion. At the end, we
5391 end up in init_iterator with a null face cache, which should not
5393 init_frame_faces (f
);
5395 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
5396 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
5397 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
5398 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
5399 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
5400 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
5401 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
5402 "title", "Title", RES_TYPE_STRING
);
5404 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
5405 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5407 /* Add the tool-bar height to the initial frame height so that the
5408 user gets a text display area of the size he specified with -g or
5409 via .Xdefaults. Later changes of the tool-bar height don't
5410 change the frame size. This is done so that users can create
5411 tall Emacs frames without having to guess how tall the tool-bar
5413 if (FRAME_TOOL_BAR_LINES (f
))
5415 int margin
, relief
, bar_height
;
5417 relief
= (tool_bar_button_relief
> 0
5418 ? tool_bar_button_relief
5419 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
5421 if (INTEGERP (Vtool_bar_button_margin
)
5422 && XINT (Vtool_bar_button_margin
) > 0)
5423 margin
= XFASTINT (Vtool_bar_button_margin
);
5424 else if (CONSP (Vtool_bar_button_margin
)
5425 && INTEGERP (XCDR (Vtool_bar_button_margin
))
5426 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
5427 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
5431 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
5432 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
5435 window_prompting
= x_figure_window_size (f
, parms
);
5437 if (window_prompting
& XNegative
)
5439 if (window_prompting
& YNegative
)
5440 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
5442 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
5446 if (window_prompting
& YNegative
)
5447 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
5449 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
5452 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
5454 tem
= w32_get_arg (parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
5455 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
5457 w32_window (f
, window_prompting
, minibuffer_only
);
5462 /* Now consider the frame official. */
5463 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
5464 Vframe_list
= Fcons (frame
, Vframe_list
);
5466 /* We need to do this after creating the window, so that the
5467 icon-creation functions can say whose icon they're describing. */
5468 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
5469 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
5471 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
5472 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5473 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
5474 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5475 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
5476 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
5477 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
5478 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
5480 /* Dimensions, especially f->height, must be done via change_frame_size.
5481 Change will not be effected unless different from the current
5487 SET_FRAME_WIDTH (f
, 0);
5488 change_frame_size (f
, height
, width
, 1, 0, 0);
5490 /* Tell the server what size and position, etc, we want, and how
5491 badly we want them. This should be done after we have the menu
5492 bar so that its size can be taken into account. */
5494 x_wm_set_size_hint (f
, window_prompting
, 0);
5497 /* Set up faces after all frame parameters are known. This call
5498 also merges in face attributes specified for new frames. If we
5499 don't do this, the `menu' face for instance won't have the right
5500 colors, and the menu bar won't appear in the specified colors for
5502 call1 (Qface_set_after_frame_default
, frame
);
5504 /* Make the window appear on the frame and enable display, unless
5505 the caller says not to. However, with explicit parent, Emacs
5506 cannot control visibility, so don't try. */
5507 if (! f
->output_data
.w32
->explicit_parent
)
5509 Lisp_Object visibility
;
5511 visibility
= w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
5512 if (EQ (visibility
, Qunbound
))
5515 if (EQ (visibility
, Qicon
))
5516 x_iconify_frame (f
);
5517 else if (! NILP (visibility
))
5518 x_make_frame_visible (f
);
5520 /* Must have been Qnil. */
5525 /* Make sure windows on this frame appear in calls to next-window
5526 and similar functions. */
5527 Vwindow_list
= Qnil
;
5529 return unbind_to (count
, frame
);
5532 /* FRAME is used only to get a handle on the X display. We don't pass the
5533 display info directly because we're called from frame.c, which doesn't
5534 know about that structure. */
5536 x_get_focus_frame (frame
)
5537 struct frame
*frame
;
5539 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
5541 if (! dpyinfo
->w32_focus_frame
)
5544 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
5548 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
5549 doc
: /* Give FRAME input focus, raising to foreground if necessary. */)
5553 x_focus_on_frame (check_x_frame (frame
));
5558 /* Return the charset portion of a font name. */
5559 char * xlfd_charset_of_font (char * fontname
)
5561 char *charset
, *encoding
;
5563 encoding
= strrchr(fontname
, '-');
5564 if (!encoding
|| encoding
== fontname
)
5567 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
5568 if (*charset
== '-')
5571 if (charset
== fontname
|| strcmp(charset
, "-*-*") == 0)
5577 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
5578 int size
, char* filename
);
5579 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
5580 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
5582 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
5584 static struct font_info
*
5585 w32_load_system_font (f
,fontname
,size
)
5590 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5591 Lisp_Object font_names
;
5593 /* Get a list of all the fonts that match this name. Once we
5594 have a list of matching fonts, we compare them against the fonts
5595 we already have loaded by comparing names. */
5596 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
5598 if (!NILP (font_names
))
5603 /* First check if any are already loaded, as that is cheaper
5604 than loading another one. */
5605 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5606 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
5607 if (dpyinfo
->font_table
[i
].name
5608 && (!strcmp (dpyinfo
->font_table
[i
].name
,
5609 XSTRING (XCAR (tail
))->data
)
5610 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
5611 XSTRING (XCAR (tail
))->data
)))
5612 return (dpyinfo
->font_table
+ i
);
5614 fontname
= (char *) XSTRING (XCAR (font_names
))->data
;
5616 else if (w32_strict_fontnames
)
5618 /* If EnumFontFamiliesEx was available, we got a full list of
5619 fonts back so stop now to avoid the possibility of loading a
5620 random font. If we had to fall back to EnumFontFamilies, the
5621 list is incomplete, so continue whether the font we want was
5623 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5624 FARPROC enum_font_families_ex
5625 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
5626 if (enum_font_families_ex
)
5630 /* Load the font and add it to the table. */
5632 char *full_name
, *encoding
, *charset
;
5634 struct font_info
*fontp
;
5640 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
5643 if (!*lf
.lfFaceName
)
5644 /* If no name was specified for the font, we get a random font
5645 from CreateFontIndirect - this is not particularly
5646 desirable, especially since CreateFontIndirect does not
5647 fill out the missing name in lf, so we never know what we
5651 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
5652 bzero (font
, sizeof (*font
));
5654 /* Set bdf to NULL to indicate that this is a Windows font. */
5659 font
->hfont
= CreateFontIndirect (&lf
);
5661 if (font
->hfont
== NULL
)
5670 codepage
= w32_codepage_for_font (fontname
);
5672 hdc
= GetDC (dpyinfo
->root_window
);
5673 oldobj
= SelectObject (hdc
, font
->hfont
);
5675 ok
= GetTextMetrics (hdc
, &font
->tm
);
5676 if (codepage
== CP_UNICODE
)
5677 font
->double_byte_p
= 1;
5680 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5681 don't report themselves as double byte fonts, when
5682 patently they are. So instead of trusting
5683 GetFontLanguageInfo, we check the properties of the
5684 codepage directly, since that is ultimately what we are
5685 working from anyway. */
5686 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5688 GetCPInfo (codepage
, &cpi
);
5689 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
5692 SelectObject (hdc
, oldobj
);
5693 ReleaseDC (dpyinfo
->root_window
, hdc
);
5694 /* Fill out details in lf according to the font that was
5696 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
5697 lf
.lfWidth
= font
->tm
.tmAveCharWidth
;
5698 lf
.lfWeight
= font
->tm
.tmWeight
;
5699 lf
.lfItalic
= font
->tm
.tmItalic
;
5700 lf
.lfCharSet
= font
->tm
.tmCharSet
;
5701 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
5702 ? VARIABLE_PITCH
: FIXED_PITCH
);
5703 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
5704 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
5706 w32_cache_char_metrics (font
);
5713 w32_unload_font (dpyinfo
, font
);
5717 /* Find a free slot in the font table. */
5718 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
5719 if (dpyinfo
->font_table
[i
].name
== NULL
)
5722 /* If no free slot found, maybe enlarge the font table. */
5723 if (i
== dpyinfo
->n_fonts
5724 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
5727 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
5728 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
5730 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
5733 fontp
= dpyinfo
->font_table
+ i
;
5734 if (i
== dpyinfo
->n_fonts
)
5737 /* Now fill in the slots of *FONTP. */
5740 fontp
->font_idx
= i
;
5741 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
5742 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
5744 charset
= xlfd_charset_of_font (fontname
);
5746 /* Cache the W32 codepage for a font. This makes w32_encode_char
5747 (called for every glyph during redisplay) much faster. */
5748 fontp
->codepage
= codepage
;
5750 /* Work out the font's full name. */
5751 full_name
= (char *)xmalloc (100);
5752 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
5753 fontp
->full_name
= full_name
;
5756 /* If all else fails - just use the name we used to load it. */
5758 fontp
->full_name
= fontp
->name
;
5761 fontp
->size
= FONT_WIDTH (font
);
5762 fontp
->height
= FONT_HEIGHT (font
);
5764 /* The slot `encoding' specifies how to map a character
5765 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
5766 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
5767 (0:0x20..0x7F, 1:0xA0..0xFF,
5768 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
5769 2:0xA020..0xFF7F). For the moment, we don't know which charset
5770 uses this font. So, we set information in fontp->encoding[1]
5771 which is never used by any charset. If mapping can't be
5772 decided, set FONT_ENCODING_NOT_DECIDED. */
5774 /* SJIS fonts need to be set to type 4, all others seem to work as
5775 type FONT_ENCODING_NOT_DECIDED. */
5776 encoding
= strrchr (fontp
->name
, '-');
5777 if (encoding
&& stricmp (encoding
+1, "sjis") == 0)
5778 fontp
->encoding
[1] = 4;
5780 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
5782 /* The following three values are set to 0 under W32, which is
5783 what they get set to if XGetFontProperty fails under X. */
5784 fontp
->baseline_offset
= 0;
5785 fontp
->relative_compose
= 0;
5786 fontp
->default_ascent
= 0;
5788 /* Set global flag fonts_changed_p to non-zero if the font loaded
5789 has a character with a smaller width than any other character
5790 before, or if the font loaded has a smalle>r height than any
5791 other font loaded before. If this happens, it will make a
5792 glyph matrix reallocation necessary. */
5793 fonts_changed_p
= x_compute_min_glyph_bounds (f
);
5799 /* Load font named FONTNAME of size SIZE for frame F, and return a
5800 pointer to the structure font_info while allocating it dynamically.
5801 If loading fails, return NULL. */
5803 w32_load_font (f
,fontname
,size
)
5808 Lisp_Object bdf_fonts
;
5809 struct font_info
*retval
= NULL
;
5811 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
5813 while (!retval
&& CONSP (bdf_fonts
))
5815 char *bdf_name
, *bdf_file
;
5816 Lisp_Object bdf_pair
;
5818 bdf_name
= XSTRING (XCAR (bdf_fonts
))->data
;
5819 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
5820 bdf_file
= XSTRING (XCDR (bdf_pair
))->data
;
5822 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
5824 bdf_fonts
= XCDR (bdf_fonts
);
5830 return w32_load_system_font(f
, fontname
, size
);
5835 w32_unload_font (dpyinfo
, font
)
5836 struct w32_display_info
*dpyinfo
;
5841 if (font
->per_char
) xfree (font
->per_char
);
5842 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
5844 if (font
->hfont
) DeleteObject(font
->hfont
);
5849 /* The font conversion stuff between x and w32 */
5851 /* X font string is as follows (from faces.el)
5855 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5856 * (weight\? "\\([^-]*\\)") ; 1
5857 * (slant "\\([ior]\\)") ; 2
5858 * (slant\? "\\([^-]?\\)") ; 2
5859 * (swidth "\\([^-]*\\)") ; 3
5860 * (adstyle "[^-]*") ; 4
5861 * (pixelsize "[0-9]+")
5862 * (pointsize "[0-9][0-9]+")
5863 * (resx "[0-9][0-9]+")
5864 * (resy "[0-9][0-9]+")
5865 * (spacing "[cmp?*]")
5866 * (avgwidth "[0-9]+")
5867 * (registry "[^-]+")
5868 * (encoding "[^-]+")
5873 x_to_w32_weight (lpw
)
5876 if (!lpw
) return (FW_DONTCARE
);
5878 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
5879 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
5880 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
5881 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
5882 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
5883 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
5884 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
5885 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
5886 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
5887 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
5894 w32_to_x_weight (fnweight
)
5897 if (fnweight
>= FW_HEAVY
) return "heavy";
5898 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
5899 if (fnweight
>= FW_BOLD
) return "bold";
5900 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
5901 if (fnweight
>= FW_MEDIUM
) return "medium";
5902 if (fnweight
>= FW_NORMAL
) return "normal";
5903 if (fnweight
>= FW_LIGHT
) return "light";
5904 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
5905 if (fnweight
>= FW_THIN
) return "thin";
5911 x_to_w32_charset (lpcs
)
5914 Lisp_Object this_entry
, w32_charset
;
5916 int len
= strlen (lpcs
);
5918 /* Support "*-#nnn" format for unknown charsets. */
5919 if (strncmp (lpcs
, "*-#", 3) == 0)
5920 return atoi (lpcs
+ 3);
5922 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5923 charset
= alloca (len
+ 1);
5924 strcpy (charset
, lpcs
);
5925 lpcs
= strchr (charset
, '*');
5929 /* Look through w32-charset-info-alist for the character set.
5930 Format of each entry is
5931 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5933 this_entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
5935 if (NILP(this_entry
))
5937 /* At startup, we want iso8859-1 fonts to come up properly. */
5938 if (stricmp(charset
, "iso8859-1") == 0)
5939 return ANSI_CHARSET
;
5941 return DEFAULT_CHARSET
;
5944 w32_charset
= Fcar (Fcdr (this_entry
));
5946 // Translate Lisp symbol to number.
5947 if (w32_charset
== Qw32_charset_ansi
)
5948 return ANSI_CHARSET
;
5949 if (w32_charset
== Qw32_charset_symbol
)
5950 return SYMBOL_CHARSET
;
5951 if (w32_charset
== Qw32_charset_shiftjis
)
5952 return SHIFTJIS_CHARSET
;
5953 if (w32_charset
== Qw32_charset_hangeul
)
5954 return HANGEUL_CHARSET
;
5955 if (w32_charset
== Qw32_charset_chinesebig5
)
5956 return CHINESEBIG5_CHARSET
;
5957 if (w32_charset
== Qw32_charset_gb2312
)
5958 return GB2312_CHARSET
;
5959 if (w32_charset
== Qw32_charset_oem
)
5961 #ifdef JOHAB_CHARSET
5962 if (w32_charset
== Qw32_charset_johab
)
5963 return JOHAB_CHARSET
;
5964 if (w32_charset
== Qw32_charset_easteurope
)
5965 return EASTEUROPE_CHARSET
;
5966 if (w32_charset
== Qw32_charset_turkish
)
5967 return TURKISH_CHARSET
;
5968 if (w32_charset
== Qw32_charset_baltic
)
5969 return BALTIC_CHARSET
;
5970 if (w32_charset
== Qw32_charset_russian
)
5971 return RUSSIAN_CHARSET
;
5972 if (w32_charset
== Qw32_charset_arabic
)
5973 return ARABIC_CHARSET
;
5974 if (w32_charset
== Qw32_charset_greek
)
5975 return GREEK_CHARSET
;
5976 if (w32_charset
== Qw32_charset_hebrew
)
5977 return HEBREW_CHARSET
;
5978 if (w32_charset
== Qw32_charset_vietnamese
)
5979 return VIETNAMESE_CHARSET
;
5980 if (w32_charset
== Qw32_charset_thai
)
5981 return THAI_CHARSET
;
5982 if (w32_charset
== Qw32_charset_mac
)
5984 #endif /* JOHAB_CHARSET */
5985 #ifdef UNICODE_CHARSET
5986 if (w32_charset
== Qw32_charset_unicode
)
5987 return UNICODE_CHARSET
;
5990 return DEFAULT_CHARSET
;
5995 w32_to_x_charset (fncharset
)
5998 static char buf
[32];
5999 Lisp_Object charset_type
;
6004 /* Handle startup case of w32-charset-info-alist not
6005 being set up yet. */
6006 if (NILP(Vw32_charset_info_alist
))
6008 charset_type
= Qw32_charset_ansi
;
6010 case DEFAULT_CHARSET
:
6011 charset_type
= Qw32_charset_default
;
6013 case SYMBOL_CHARSET
:
6014 charset_type
= Qw32_charset_symbol
;
6016 case SHIFTJIS_CHARSET
:
6017 charset_type
= Qw32_charset_shiftjis
;
6019 case HANGEUL_CHARSET
:
6020 charset_type
= Qw32_charset_hangeul
;
6022 case GB2312_CHARSET
:
6023 charset_type
= Qw32_charset_gb2312
;
6025 case CHINESEBIG5_CHARSET
:
6026 charset_type
= Qw32_charset_chinesebig5
;
6029 charset_type
= Qw32_charset_oem
;
6032 /* More recent versions of Windows (95 and NT4.0) define more
6034 #ifdef EASTEUROPE_CHARSET
6035 case EASTEUROPE_CHARSET
:
6036 charset_type
= Qw32_charset_easteurope
;
6038 case TURKISH_CHARSET
:
6039 charset_type
= Qw32_charset_turkish
;
6041 case BALTIC_CHARSET
:
6042 charset_type
= Qw32_charset_baltic
;
6044 case RUSSIAN_CHARSET
:
6045 charset_type
= Qw32_charset_russian
;
6047 case ARABIC_CHARSET
:
6048 charset_type
= Qw32_charset_arabic
;
6051 charset_type
= Qw32_charset_greek
;
6053 case HEBREW_CHARSET
:
6054 charset_type
= Qw32_charset_hebrew
;
6056 case VIETNAMESE_CHARSET
:
6057 charset_type
= Qw32_charset_vietnamese
;
6060 charset_type
= Qw32_charset_thai
;
6063 charset_type
= Qw32_charset_mac
;
6066 charset_type
= Qw32_charset_johab
;
6070 #ifdef UNICODE_CHARSET
6071 case UNICODE_CHARSET
:
6072 charset_type
= Qw32_charset_unicode
;
6076 /* Encode numerical value of unknown charset. */
6077 sprintf (buf
, "*-#%u", fncharset
);
6083 char * best_match
= NULL
;
6085 /* Look through w32-charset-info-alist for the character set.
6086 Prefer ISO codepages, and prefer lower numbers in the ISO
6087 range. Only return charsets for codepages which are installed.
6089 Format of each entry is
6090 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6092 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
6095 Lisp_Object w32_charset
;
6096 Lisp_Object codepage
;
6098 Lisp_Object this_entry
= XCAR (rest
);
6100 /* Skip invalid entries in alist. */
6101 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
6102 || !CONSP (XCDR (this_entry
))
6103 || !SYMBOLP (XCAR (XCDR (this_entry
))))
6106 x_charset
= XSTRING (XCAR (this_entry
))->data
;
6107 w32_charset
= XCAR (XCDR (this_entry
));
6108 codepage
= XCDR (XCDR (this_entry
));
6110 /* Look for Same charset and a valid codepage (or non-int
6111 which means ignore). */
6112 if (w32_charset
== charset_type
6113 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
6114 || IsValidCodePage (XINT (codepage
))))
6116 /* If we don't have a match already, then this is the
6119 best_match
= x_charset
;
6120 /* If this is an ISO codepage, and the best so far isn't,
6121 then this is better. */
6122 else if (stricmp (best_match
, "iso") != 0
6123 && stricmp (x_charset
, "iso") == 0)
6124 best_match
= x_charset
;
6125 /* If both are ISO8859 codepages, choose the one with the
6126 lowest number in the encoding field. */
6127 else if (stricmp (best_match
, "iso8859-") == 0
6128 && stricmp (x_charset
, "iso8859-") == 0)
6130 int best_enc
= atoi (best_match
+ 8);
6131 int this_enc
= atoi (x_charset
+ 8);
6132 if (this_enc
> 0 && this_enc
< best_enc
)
6133 best_match
= x_charset
;
6138 /* If no match, encode the numeric value. */
6141 sprintf (buf
, "*-#%u", fncharset
);
6145 strncpy(buf
, best_match
, 31);
6152 /* Get the Windows codepage corresponding to the specified font. The
6153 charset info in the font name is used to look up
6154 w32-charset-to-codepage-alist. */
6156 w32_codepage_for_font (char *fontname
)
6158 Lisp_Object codepage
, entry
;
6159 char *charset_str
, *charset
, *end
;
6161 if (NILP (Vw32_charset_info_alist
))
6164 /* Extract charset part of font string. */
6165 charset
= xlfd_charset_of_font (fontname
);
6170 charset_str
= (char *) alloca (strlen (charset
) + 1);
6171 strcpy (charset_str
, charset
);
6174 /* Remove leading "*-". */
6175 if (strncmp ("*-", charset_str
, 2) == 0)
6176 charset
= charset_str
+ 2;
6179 charset
= charset_str
;
6181 /* Stop match at wildcard (including preceding '-'). */
6182 if (end
= strchr (charset
, '*'))
6184 if (end
> charset
&& *(end
-1) == '-')
6189 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6193 codepage
= Fcdr (Fcdr (entry
));
6195 if (NILP (codepage
))
6197 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
6199 else if (INTEGERP (codepage
))
6200 return XINT (codepage
);
6207 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
6208 LOGFONT
* lplogfont
;
6211 char * specific_charset
;
6215 char height_pixels
[8];
6217 char width_pixels
[8];
6218 char *fontname_dash
;
6219 int display_resy
= one_w32_display_info
.resy
;
6220 int display_resx
= one_w32_display_info
.resx
;
6222 struct coding_system coding
;
6224 if (!lpxstr
) abort ();
6229 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
6230 fonttype
= "raster";
6231 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
6232 fonttype
= "outline";
6234 fonttype
= "unknown";
6236 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system
),
6238 coding
.src_multibyte
= 0;
6239 coding
.dst_multibyte
= 1;
6240 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6241 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
6243 fontname
= alloca(sizeof(*fontname
) * bufsz
);
6244 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
6245 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
6246 *(fontname
+ coding
.produced
) = '\0';
6248 /* Replace dashes with underscores so the dashes are not
6250 fontname_dash
= fontname
;
6251 while (fontname_dash
= strchr (fontname_dash
, '-'))
6252 *fontname_dash
= '_';
6254 if (lplogfont
->lfHeight
)
6256 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
6257 sprintf (height_dpi
, "%u",
6258 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
6262 strcpy (height_pixels
, "*");
6263 strcpy (height_dpi
, "*");
6265 if (lplogfont
->lfWidth
)
6266 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
6268 strcpy (width_pixels
, "*");
6270 _snprintf (lpxstr
, len
- 1,
6271 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6272 fonttype
, /* foundry */
6273 fontname
, /* family */
6274 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
6275 lplogfont
->lfItalic
?'i':'r', /* slant */
6277 /* add style name */
6278 height_pixels
, /* pixel size */
6279 height_dpi
, /* point size */
6280 display_resx
, /* resx */
6281 display_resy
, /* resy */
6282 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
6283 ? 'p' : 'c', /* spacing */
6284 width_pixels
, /* avg width */
6285 specific_charset
? specific_charset
6286 : w32_to_x_charset (lplogfont
->lfCharSet
)
6287 /* charset registry and encoding */
6290 lpxstr
[len
- 1] = 0; /* just to be sure */
6295 x_to_w32_font (lpxstr
, lplogfont
)
6297 LOGFONT
* lplogfont
;
6299 struct coding_system coding
;
6301 if (!lplogfont
) return (FALSE
);
6303 memset (lplogfont
, 0, sizeof (*lplogfont
));
6305 /* Set default value for each field. */
6307 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
6308 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
6309 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
6311 /* go for maximum quality */
6312 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
6313 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
6314 lplogfont
->lfQuality
= PROOF_QUALITY
;
6317 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
6318 lplogfont
->lfWeight
= FW_DONTCARE
;
6319 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
6324 /* Provide a simple escape mechanism for specifying Windows font names
6325 * directly -- if font spec does not beginning with '-', assume this
6327 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6333 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
6334 width
[10], resy
[10], remainder
[50];
6336 int dpi
= one_w32_display_info
.resy
;
6338 fields
= sscanf (lpxstr
,
6339 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
6340 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
6344 /* In the general case when wildcards cover more than one field,
6345 we don't know which field is which, so don't fill any in.
6346 However, we need to cope with this particular form, which is
6347 generated by font_list_1 (invoked by try_font_list):
6348 "-raster-6x10-*-gb2312*-*"
6349 and make sure to correctly parse the charset field. */
6352 fields
= sscanf (lpxstr
,
6353 "-%*[^-]-%49[^-]-*-%49s",
6356 else if (fields
< 9)
6362 if (fields
> 0 && name
[0] != '*')
6368 (Fcheck_coding_system (Vw32_system_coding_system
), &coding
);
6369 coding
.src_multibyte
= 1;
6370 coding
.dst_multibyte
= 1;
6371 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
6372 buf
= (unsigned char *) alloca (bufsize
);
6373 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6374 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
6375 if (coding
.produced
>= LF_FACESIZE
)
6376 coding
.produced
= LF_FACESIZE
- 1;
6377 buf
[coding
.produced
] = 0;
6378 strcpy (lplogfont
->lfFaceName
, buf
);
6382 lplogfont
->lfFaceName
[0] = '\0';
6387 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6391 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
6395 if (fields
> 0 && pixels
[0] != '*')
6396 lplogfont
->lfHeight
= atoi (pixels
);
6400 if (fields
> 0 && resy
[0] != '*')
6403 if (tem
> 0) dpi
= tem
;
6406 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
6407 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
6410 lplogfont
->lfPitchAndFamily
=
6411 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
6415 if (fields
> 0 && width
[0] != '*')
6416 lplogfont
->lfWidth
= atoi (width
) / 10;
6420 /* Strip the trailing '-' if present. (it shouldn't be, as it
6421 fails the test against xlfd-tight-regexp in fontset.el). */
6423 int len
= strlen (remainder
);
6424 if (len
> 0 && remainder
[len
-1] == '-')
6425 remainder
[len
-1] = 0;
6427 encoding
= remainder
;
6429 if (strncmp (encoding
, "*-", 2) == 0)
6432 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
6437 char name
[100], height
[10], width
[10], weight
[20];
6439 fields
= sscanf (lpxstr
,
6440 "%99[^:]:%9[^:]:%9[^:]:%19s",
6441 name
, height
, width
, weight
);
6443 if (fields
== EOF
) return (FALSE
);
6447 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
6448 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
6452 lplogfont
->lfFaceName
[0] = 0;
6458 lplogfont
->lfHeight
= atoi (height
);
6463 lplogfont
->lfWidth
= atoi (width
);
6467 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6470 /* This makes TrueType fonts work better. */
6471 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
6476 /* Strip the pixel height and point height from the given xlfd, and
6477 return the pixel height. If no pixel height is specified, calculate
6478 one from the point height, or if that isn't defined either, return
6479 0 (which usually signifies a scalable font).
6482 xlfd_strip_height (char *fontname
)
6484 int pixel_height
, field_number
;
6485 char *read_from
, *write_to
;
6489 pixel_height
= field_number
= 0;
6492 /* Look for height fields. */
6493 for (read_from
= fontname
; *read_from
; read_from
++)
6495 if (*read_from
== '-')
6498 if (field_number
== 7) /* Pixel height. */
6501 write_to
= read_from
;
6503 /* Find end of field. */
6504 for (;*read_from
&& *read_from
!= '-'; read_from
++)
6507 /* Split the fontname at end of field. */
6513 pixel_height
= atoi (write_to
);
6514 /* Blank out field. */
6515 if (read_from
> write_to
)
6520 /* If the pixel height field is at the end (partial xlfd),
6523 return pixel_height
;
6525 /* If we got a pixel height, the point height can be
6526 ignored. Just blank it out and break now. */
6529 /* Find end of point size field. */
6530 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6536 /* Blank out the point size field. */
6537 if (read_from
> write_to
)
6543 return pixel_height
;
6547 /* If the point height is already blank, break now. */
6548 if (*read_from
== '-')
6554 else if (field_number
== 8)
6556 /* If we didn't get a pixel height, try to get the point
6557 height and convert that. */
6559 char *point_size_start
= read_from
++;
6561 /* Find end of field. */
6562 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6571 point_size
= atoi (point_size_start
);
6573 /* Convert to pixel height. */
6574 pixel_height
= point_size
6575 * one_w32_display_info
.height_in
/ 720;
6577 /* Blank out this field and break. */
6585 /* Shift the rest of the font spec into place. */
6586 if (write_to
&& read_from
> write_to
)
6588 for (; *read_from
; read_from
++, write_to
++)
6589 *write_to
= *read_from
;
6593 return pixel_height
;
6596 /* Assume parameter 1 is fully qualified, no wildcards. */
6598 w32_font_match (fontname
, pattern
)
6602 char *regex
= alloca (strlen (pattern
) * 2 + 3);
6603 char *font_name_copy
= alloca (strlen (fontname
) + 1);
6606 /* Copy fontname so we can modify it during comparison. */
6607 strcpy (font_name_copy
, fontname
);
6612 /* Turn pattern into a regexp and do a regexp match. */
6613 for (; *pattern
; pattern
++)
6615 if (*pattern
== '?')
6617 else if (*pattern
== '*')
6628 /* Strip out font heights and compare them seperately, since
6629 rounding error can cause mismatches. This also allows a
6630 comparison between a font that declares only a pixel height and a
6631 pattern that declares the point height.
6634 int font_height
, pattern_height
;
6636 font_height
= xlfd_strip_height (font_name_copy
);
6637 pattern_height
= xlfd_strip_height (regex
);
6639 /* Compare now, and don't bother doing expensive regexp matching
6640 if the heights differ. */
6641 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
6645 return (fast_c_string_match_ignore_case (build_string (regex
),
6646 font_name_copy
) >= 0);
6649 /* Callback functions, and a structure holding info they need, for
6650 listing system fonts on W32. We need one set of functions to do the
6651 job properly, but these don't work on NT 3.51 and earlier, so we
6652 have a second set which don't handle character sets properly to
6655 In both cases, there are two passes made. The first pass gets one
6656 font from each family, the second pass lists all the fonts from
6659 typedef struct enumfont_t
6664 XFontStruct
*size_ref
;
6665 Lisp_Object
*pattern
;
6670 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
6672 NEWTEXTMETRIC
* lptm
;
6676 /* Ignore struck out and underlined versions of fonts. */
6677 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
6680 /* Only return fonts with names starting with @ if they were
6681 explicitly specified, since Microsoft uses an initial @ to
6682 denote fonts for vertical writing, without providing a more
6683 convenient way of identifying them. */
6684 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
6685 && lpef
->logfont
.lfFaceName
[0] != '@')
6688 /* Check that the character set matches if it was specified */
6689 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
6690 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
6695 Lisp_Object width
= Qnil
;
6696 char *charset
= NULL
;
6698 /* Truetype fonts do not report their true metrics until loaded */
6699 if (FontType
!= RASTER_FONTTYPE
)
6701 if (!NILP (*(lpef
->pattern
)))
6703 /* Scalable fonts are as big as you want them to be. */
6704 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
6705 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
6706 width
= make_number (lpef
->logfont
.lfWidth
);
6710 lplf
->elfLogFont
.lfHeight
= 0;
6711 lplf
->elfLogFont
.lfWidth
= 0;
6715 /* Make sure the height used here is the same as everywhere
6716 else (ie character height, not cell height). */
6717 if (lplf
->elfLogFont
.lfHeight
> 0)
6719 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6720 if (FontType
== RASTER_FONTTYPE
)
6721 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
6723 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
6726 if (!NILP (*(lpef
->pattern
)))
6728 charset
= xlfd_charset_of_font (XSTRING(*(lpef
->pattern
))->data
);
6730 /* Ensure that charset is valid for this font. */
6732 && (x_to_w32_charset (charset
) != lplf
->elfLogFont
.lfCharSet
))
6736 /* TODO: List all relevant charsets if charset not specified. */
6737 if (!w32_to_x_font (&(lplf
->elfLogFont
), buf
, 100, charset
))
6740 if (NILP (*(lpef
->pattern
))
6741 || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
6743 *lpef
->tail
= Fcons (Fcons (build_string (buf
), width
), Qnil
);
6744 lpef
->tail
= &(XCDR (*lpef
->tail
));
6753 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
6755 NEWTEXTMETRIC
* lptm
;
6759 return EnumFontFamilies (lpef
->hdc
,
6760 lplf
->elfLogFont
.lfFaceName
,
6761 (FONTENUMPROC
) enum_font_cb2
,
6767 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
6768 ENUMLOGFONTEX
* lplf
;
6769 NEWTEXTMETRICEX
* lptm
;
6773 /* We are not interested in the extra info we get back from the 'Ex
6774 version - only the fact that we get character set variations
6775 enumerated seperately. */
6776 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
6781 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
6782 ENUMLOGFONTEX
* lplf
;
6783 NEWTEXTMETRICEX
* lptm
;
6787 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6788 FARPROC enum_font_families_ex
6789 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6790 /* We don't really expect EnumFontFamiliesEx to disappear once we
6791 get here, so don't bother handling it gracefully. */
6792 if (enum_font_families_ex
== NULL
)
6793 error ("gdi32.dll has disappeared!");
6794 return enum_font_families_ex (lpef
->hdc
,
6796 (FONTENUMPROC
) enum_fontex_cb2
,
6800 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6801 and xterm.c in Emacs 20.3) */
6803 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
6805 char *fontname
, *ptnstr
;
6806 Lisp_Object list
, tem
, newlist
= Qnil
;
6809 list
= Vw32_bdf_filename_alist
;
6810 ptnstr
= XSTRING (pattern
)->data
;
6812 for ( ; CONSP (list
); list
= XCDR (list
))
6816 fontname
= XSTRING (XCAR (tem
))->data
;
6817 else if (STRINGP (tem
))
6818 fontname
= XSTRING (tem
)->data
;
6822 if (w32_font_match (fontname
, ptnstr
))
6824 newlist
= Fcons (XCAR (tem
), newlist
);
6826 if (n_fonts
>= max_names
)
6834 static Lisp_Object
w32_list_synthesized_fonts (FRAME_PTR f
,
6835 Lisp_Object pattern
,
6836 int size
, int max_names
);
6838 /* Return a list of names of available fonts matching PATTERN on frame
6839 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6840 to be listed. Frame F NULL means we have not yet created any
6841 frame, which means we can't get proper size info, as we don't have
6842 a device context to use for GetTextMetrics.
6843 MAXNAMES sets a limit on how many fonts to match. */
6846 w32_list_fonts (f
, pattern
, size
, maxnames
)
6848 Lisp_Object pattern
;
6852 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
6853 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
6854 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
6857 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
6858 if (NILP (patterns
))
6859 patterns
= Fcons (pattern
, Qnil
);
6861 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
6866 tpat
= XCAR (patterns
);
6868 if (!STRINGP (tpat
))
6871 /* Avoid expensive EnumFontFamilies functions if we are not
6872 going to be able to output one of these anyway. */
6873 codepage
= w32_codepage_for_font (XSTRING (tpat
)->data
);
6874 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
6875 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
6876 && !IsValidCodePage(codepage
))
6879 /* See if we cached the result for this particular query.
6880 The cache is an alist of the form:
6881 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6883 if (tem
= XCDR (dpyinfo
->name_list_element
),
6884 !NILP (list
= Fassoc (tpat
, tem
)))
6886 list
= Fcdr_safe (list
);
6887 /* We have a cached list. Don't have to get the list again. */
6892 /* At first, put PATTERN in the cache. */
6898 /* Use EnumFontFamiliesEx where it is available, as it knows
6899 about character sets. Fall back to EnumFontFamilies for
6900 older versions of NT that don't support the 'Ex function. */
6901 x_to_w32_font (XSTRING (tpat
)->data
, &ef
.logfont
);
6903 LOGFONT font_match_pattern
;
6904 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6905 FARPROC enum_font_families_ex
6906 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6908 /* We do our own pattern matching so we can handle wildcards. */
6909 font_match_pattern
.lfFaceName
[0] = 0;
6910 font_match_pattern
.lfPitchAndFamily
= 0;
6911 /* We can use the charset, because if it is a wildcard it will
6912 be DEFAULT_CHARSET anyway. */
6913 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
6915 ef
.hdc
= GetDC (dpyinfo
->root_window
);
6917 if (enum_font_families_ex
)
6918 enum_font_families_ex (ef
.hdc
,
6919 &font_match_pattern
,
6920 (FONTENUMPROC
) enum_fontex_cb1
,
6923 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
6926 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
6931 /* Make a list of the fonts we got back.
6932 Store that in the font cache for the display. */
6933 XSETCDR (dpyinfo
->name_list_element
,
6934 Fcons (Fcons (tpat
, list
),
6935 XCDR (dpyinfo
->name_list_element
)));
6938 if (NILP (list
)) continue; /* Try the remaining alternatives. */
6940 newlist
= second_best
= Qnil
;
6942 /* Make a list of the fonts that have the right width. */
6943 for (; CONSP (list
); list
= XCDR (list
))
6950 if (NILP (XCAR (tem
)))
6954 newlist
= Fcons (XCAR (tem
), newlist
);
6956 if (n_fonts
>= maxnames
)
6961 if (!INTEGERP (XCDR (tem
)))
6963 /* Since we don't yet know the size of the font, we must
6964 load it and try GetTextMetrics. */
6965 W32FontStruct thisinfo
;
6970 if (!x_to_w32_font (XSTRING (XCAR (tem
))->data
, &lf
))
6974 thisinfo
.bdf
= NULL
;
6975 thisinfo
.hfont
= CreateFontIndirect (&lf
);
6976 if (thisinfo
.hfont
== NULL
)
6979 hdc
= GetDC (dpyinfo
->root_window
);
6980 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
6981 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
6982 XSETCDR (tem
, make_number (FONT_WIDTH (&thisinfo
)));
6984 XSETCDR (tem
, make_number (0));
6985 SelectObject (hdc
, oldobj
);
6986 ReleaseDC (dpyinfo
->root_window
, hdc
);
6987 DeleteObject(thisinfo
.hfont
);
6990 found_size
= XINT (XCDR (tem
));
6991 if (found_size
== size
)
6993 newlist
= Fcons (XCAR (tem
), newlist
);
6995 if (n_fonts
>= maxnames
)
6998 /* keep track of the closest matching size in case
6999 no exact match is found. */
7000 else if (found_size
> 0)
7002 if (NILP (second_best
))
7005 else if (found_size
< size
)
7007 if (XINT (XCDR (second_best
)) > size
7008 || XINT (XCDR (second_best
)) < found_size
)
7013 if (XINT (XCDR (second_best
)) > size
7014 && XINT (XCDR (second_best
)) >
7021 if (!NILP (newlist
))
7023 else if (!NILP (second_best
))
7025 newlist
= Fcons (XCAR (second_best
), Qnil
);
7030 /* Include any bdf fonts. */
7031 if (n_fonts
< maxnames
)
7033 Lisp_Object combined
[2];
7034 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
7035 combined
[1] = newlist
;
7036 newlist
= Fnconc(2, combined
);
7039 /* If we can't find a font that matches, check if Windows would be
7040 able to synthesize it from a different style. */
7041 if (NILP (newlist
) && !NILP (Vw32_enable_synthesized_fonts
))
7042 newlist
= w32_list_synthesized_fonts (f
, pattern
, size
, maxnames
);
7048 w32_list_synthesized_fonts (f
, pattern
, size
, max_names
)
7050 Lisp_Object pattern
;
7055 char *full_pattn
, *new_pattn
, foundary
[50], family
[50], *pattn_part2
;
7056 char style
[20], slant
;
7057 Lisp_Object matches
, tem
, synthed_matches
= Qnil
;
7059 full_pattn
= XSTRING (pattern
)->data
;
7061 pattn_part2
= alloca (XSTRING (pattern
)->size
+ 1);
7062 /* Allow some space for wildcard expansion. */
7063 new_pattn
= alloca (XSTRING (pattern
)->size
+ 100);
7065 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
7066 foundary
, family
, style
, &slant
, pattn_part2
);
7067 if (fields
== EOF
|| fields
< 5)
7070 /* If the style and slant are wildcards already there is no point
7071 checking again (and we don't want to keep recursing). */
7072 if (*style
== '*' && slant
== '*')
7075 sprintf (new_pattn
, "-%s-%s-*-*-%s", foundary
, family
, pattn_part2
);
7077 matches
= w32_list_fonts (f
, build_string (new_pattn
), size
, max_names
);
7079 for ( ; CONSP (matches
); matches
= XCDR (matches
))
7081 tem
= XCAR (matches
);
7085 full_pattn
= XSTRING (tem
)->data
;
7086 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
7087 foundary
, family
, pattn_part2
);
7088 if (fields
== EOF
|| fields
< 3)
7091 sprintf (new_pattn
, "-%s-%s-%s-%c-%s", foundary
, family
, style
,
7092 slant
, pattn_part2
);
7094 synthed_matches
= Fcons (build_string (new_pattn
),
7098 return synthed_matches
;
7102 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7104 w32_get_font_info (f
, font_idx
)
7108 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
7113 w32_query_font (struct frame
*f
, char *fontname
)
7116 struct font_info
*pfi
;
7118 pfi
= FRAME_W32_FONT_TABLE (f
);
7120 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
7122 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
7128 /* Find a CCL program for a font specified by FONTP, and set the member
7129 `encoder' of the structure. */
7132 w32_find_ccl_program (fontp
)
7133 struct font_info
*fontp
;
7135 Lisp_Object list
, elt
;
7137 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
7141 && STRINGP (XCAR (elt
))
7142 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
7148 struct ccl_program
*ccl
7149 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
7151 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
7154 fontp
->font_encoder
= ccl
;
7159 /* Find BDF files in a specified directory. (use GCPRO when calling,
7160 as this calls lisp to get a directory listing). */
7162 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
7164 Lisp_Object filelist
, list
= Qnil
;
7167 if (!STRINGP(directory
))
7170 filelist
= Fdirectory_files (directory
, Qt
,
7171 build_string (".*\\.[bB][dD][fF]"), Qt
);
7173 for ( ; CONSP(filelist
); filelist
= XCDR (filelist
))
7175 Lisp_Object filename
= XCAR (filelist
);
7176 if (w32_BDF_to_x_font (XSTRING (filename
)->data
, fontname
, 100))
7177 store_in_alist (&list
, build_string (fontname
), filename
);
7182 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
7184 doc
: /* Return a list of BDF fonts in DIR.
7185 The list is suitable for appending to w32-bdf-filename-alist. Fonts
7186 which do not contain an xlfd description will not be included in the
7187 list. DIR may be a list of directories. */)
7189 Lisp_Object directory
;
7191 Lisp_Object list
= Qnil
;
7192 struct gcpro gcpro1
, gcpro2
;
7194 if (!CONSP (directory
))
7195 return w32_find_bdf_fonts_in_dir (directory
);
7197 for ( ; CONSP (directory
); directory
= XCDR (directory
))
7199 Lisp_Object pair
[2];
7202 GCPRO2 (directory
, list
);
7203 pair
[1] = w32_find_bdf_fonts_in_dir( XCAR (directory
) );
7204 list
= Fnconc( 2, pair
);
7211 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
7212 doc
: /* Internal function called by `color-defined-p', which see. */)
7214 Lisp_Object color
, frame
;
7217 FRAME_PTR f
= check_x_frame (frame
);
7219 CHECK_STRING (color
);
7221 if (w32_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
7227 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
7228 doc
: /* Internal function called by `color-values', which see. */)
7230 Lisp_Object color
, frame
;
7233 FRAME_PTR f
= check_x_frame (frame
);
7235 CHECK_STRING (color
);
7237 if (w32_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
7241 rgb
[0] = make_number ((GetRValue (foo
.pixel
) << 8)
7242 | GetRValue (foo
.pixel
));
7243 rgb
[1] = make_number ((GetGValue (foo
.pixel
) << 8)
7244 | GetGValue (foo
.pixel
));
7245 rgb
[2] = make_number ((GetBValue (foo
.pixel
) << 8)
7246 | GetBValue (foo
.pixel
));
7247 return Flist (3, rgb
);
7253 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
7254 doc
: /* Internal function called by `display-color-p', which see. */)
7256 Lisp_Object display
;
7258 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7260 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
7266 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
7267 Sx_display_grayscale_p
, 0, 1, 0,
7268 doc
: /* Return t if the X display supports shades of gray.
7269 Note that color displays do support shades of gray.
7270 The optional argument DISPLAY specifies which display to ask about.
7271 DISPLAY should be either a frame or a display name (a string).
7272 If omitted or nil, that stands for the selected frame's display. */)
7274 Lisp_Object display
;
7276 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7278 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
7284 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
7285 Sx_display_pixel_width
, 0, 1, 0,
7286 doc
: /* Returns the width in pixels of DISPLAY.
7287 The optional argument DISPLAY specifies which display to ask about.
7288 DISPLAY should be either a frame or a display name (a string).
7289 If omitted or nil, that stands for the selected frame's display. */)
7291 Lisp_Object display
;
7293 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7295 return make_number (dpyinfo
->width
);
7298 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
7299 Sx_display_pixel_height
, 0, 1, 0,
7300 doc
: /* Returns the height in pixels of DISPLAY.
7301 The optional argument DISPLAY specifies which display to ask about.
7302 DISPLAY should be either a frame or a display name (a string).
7303 If omitted or nil, that stands for the selected frame's display. */)
7305 Lisp_Object display
;
7307 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7309 return make_number (dpyinfo
->height
);
7312 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
7314 doc
: /* Returns the number of bitplanes of DISPLAY.
7315 The optional argument DISPLAY specifies which display to ask about.
7316 DISPLAY should be either a frame or a display name (a string).
7317 If omitted or nil, that stands for the selected frame's display. */)
7319 Lisp_Object display
;
7321 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7323 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7326 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
7328 doc
: /* Returns the number of color cells of DISPLAY.
7329 The optional argument DISPLAY specifies which display to ask about.
7330 DISPLAY should be either a frame or a display name (a string).
7331 If omitted or nil, that stands for the selected frame's display. */)
7333 Lisp_Object display
;
7335 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7339 hdc
= GetDC (dpyinfo
->root_window
);
7340 if (dpyinfo
->has_palette
)
7341 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
7343 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
7346 cap
= 1 << (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7348 ReleaseDC (dpyinfo
->root_window
, hdc
);
7350 return make_number (cap
);
7353 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
7354 Sx_server_max_request_size
,
7356 doc
: /* Returns the maximum request size of the server of DISPLAY.
7357 The optional argument DISPLAY specifies which display to ask about.
7358 DISPLAY should be either a frame or a display name (a string).
7359 If omitted or nil, that stands for the selected frame's display. */)
7361 Lisp_Object display
;
7363 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7365 return make_number (1);
7368 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
7369 doc
: /* Returns the vendor ID string of the W32 system (Microsoft).
7370 The optional argument DISPLAY specifies which display to ask about.
7371 DISPLAY should be either a frame or a display name (a string).
7372 If omitted or nil, that stands for the selected frame's display. */)
7374 Lisp_Object display
;
7376 return build_string ("Microsoft Corp.");
7379 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
7380 doc
: /* Returns the version numbers of the server of DISPLAY.
7381 The value is a list of three integers: the major and minor
7382 version numbers, and the vendor-specific release
7383 number. See also the function `x-server-vendor'.
7385 The optional argument DISPLAY specifies which display to ask about.
7386 DISPLAY should be either a frame or a display name (a string).
7387 If omitted or nil, that stands for the selected frame's display. */)
7389 Lisp_Object display
;
7391 return Fcons (make_number (w32_major_version
),
7392 Fcons (make_number (w32_minor_version
),
7393 Fcons (make_number (w32_build_number
), Qnil
)));
7396 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
7397 doc
: /* Returns the number of screens on the server of DISPLAY.
7398 The optional argument DISPLAY specifies which display to ask about.
7399 DISPLAY should be either a frame or a display name (a string).
7400 If omitted or nil, that stands for the selected frame's display. */)
7402 Lisp_Object display
;
7404 return make_number (1);
7407 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
7408 Sx_display_mm_height
, 0, 1, 0,
7409 doc
: /* Returns the height in millimeters of DISPLAY.
7410 The optional argument DISPLAY specifies which display to ask about.
7411 DISPLAY should be either a frame or a display name (a string).
7412 If omitted or nil, that stands for the selected frame's display. */)
7414 Lisp_Object display
;
7416 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7420 hdc
= GetDC (dpyinfo
->root_window
);
7422 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
7424 ReleaseDC (dpyinfo
->root_window
, hdc
);
7426 return make_number (cap
);
7429 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
7430 doc
: /* Returns the width in millimeters of DISPLAY.
7431 The optional argument DISPLAY specifies which display to ask about.
7432 DISPLAY should be either a frame or a display name (a string).
7433 If omitted or nil, that stands for the selected frame's display. */)
7435 Lisp_Object display
;
7437 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7442 hdc
= GetDC (dpyinfo
->root_window
);
7444 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
7446 ReleaseDC (dpyinfo
->root_window
, hdc
);
7448 return make_number (cap
);
7451 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
7452 Sx_display_backing_store
, 0, 1, 0,
7453 doc
: /* Returns an indication of whether DISPLAY does backing store.
7454 The value may be `always', `when-mapped', or `not-useful'.
7455 The optional argument DISPLAY specifies which display to ask about.
7456 DISPLAY should be either a frame or a display name (a string).
7457 If omitted or nil, that stands for the selected frame's display. */)
7459 Lisp_Object display
;
7461 return intern ("not-useful");
7464 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
7465 Sx_display_visual_class
, 0, 1, 0,
7466 doc
: /* Returns the visual class of DISPLAY.
7467 The value is one of the symbols `static-gray', `gray-scale',
7468 `static-color', `pseudo-color', `true-color', or `direct-color'.
7470 The optional argument DISPLAY specifies which display to ask about.
7471 DISPLAY should be either a frame or a display name (a string).
7472 If omitted or nil, that stands for the selected frame's display. */)
7474 Lisp_Object display
;
7476 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7477 Lisp_Object result
= Qnil
;
7479 if (dpyinfo
->has_palette
)
7480 result
= intern ("pseudo-color");
7481 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
7482 result
= intern ("static-grey");
7483 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
7484 result
= intern ("static-color");
7485 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
7486 result
= intern ("true-color");
7491 DEFUN ("x-display-save-under", Fx_display_save_under
,
7492 Sx_display_save_under
, 0, 1, 0,
7493 doc
: /* Returns t if DISPLAY supports the save-under feature.
7494 The optional argument DISPLAY specifies which display to ask about.
7495 DISPLAY should be either a frame or a display name (a string).
7496 If omitted or nil, that stands for the selected frame's display. */)
7498 Lisp_Object display
;
7505 register struct frame
*f
;
7507 return PIXEL_WIDTH (f
);
7512 register struct frame
*f
;
7514 return PIXEL_HEIGHT (f
);
7519 register struct frame
*f
;
7521 return FONT_WIDTH (f
->output_data
.w32
->font
);
7526 register struct frame
*f
;
7528 return f
->output_data
.w32
->line_height
;
7533 register struct frame
*f
;
7535 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
7538 /* Return the display structure for the display named NAME.
7539 Open a new connection if necessary. */
7541 struct w32_display_info
*
7542 x_display_info_for_name (name
)
7546 struct w32_display_info
*dpyinfo
;
7548 CHECK_STRING (name
);
7550 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
7552 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
7555 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
7560 /* Use this general default value to start with. */
7561 Vx_resource_name
= Vinvocation_name
;
7563 validate_x_resource_name ();
7565 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
7566 (char *) XSTRING (Vx_resource_name
)->data
);
7569 error ("Cannot connect to server %s", XSTRING (name
)->data
);
7572 XSETFASTINT (Vwindow_system_version
, 3);
7577 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
7578 1, 3, 0, doc
: /* Open a connection to a server.
7579 DISPLAY is the name of the display to connect to.
7580 Optional second arg XRM-STRING is a string of resources in xrdb format.
7581 If the optional third arg MUST-SUCCEED is non-nil,
7582 terminate Emacs if we can't open the connection. */)
7583 (display
, xrm_string
, must_succeed
)
7584 Lisp_Object display
, xrm_string
, must_succeed
;
7586 unsigned char *xrm_option
;
7587 struct w32_display_info
*dpyinfo
;
7589 /* If initialization has already been done, return now to avoid
7590 overwriting critical parts of one_w32_display_info. */
7594 CHECK_STRING (display
);
7595 if (! NILP (xrm_string
))
7596 CHECK_STRING (xrm_string
);
7598 if (! EQ (Vwindow_system
, intern ("w32")))
7599 error ("Not using Microsoft Windows");
7601 /* Allow color mapping to be defined externally; first look in user's
7602 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
7604 Lisp_Object color_file
;
7605 struct gcpro gcpro1
;
7607 color_file
= build_string("~/rgb.txt");
7609 GCPRO1 (color_file
);
7611 if (NILP (Ffile_readable_p (color_file
)))
7613 Fexpand_file_name (build_string ("rgb.txt"),
7614 Fsymbol_value (intern ("data-directory")));
7616 Vw32_color_map
= Fw32_load_color_file (color_file
);
7620 if (NILP (Vw32_color_map
))
7621 Vw32_color_map
= Fw32_default_color_map ();
7623 if (! NILP (xrm_string
))
7624 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
7626 xrm_option
= (unsigned char *) 0;
7628 /* Use this general default value to start with. */
7629 /* First remove .exe suffix from invocation-name - it looks ugly. */
7631 char basename
[ MAX_PATH
], *str
;
7633 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
7634 str
= strrchr (basename
, '.');
7636 Vinvocation_name
= build_string (basename
);
7638 Vx_resource_name
= Vinvocation_name
;
7640 validate_x_resource_name ();
7642 /* This is what opens the connection and sets x_current_display.
7643 This also initializes many symbols, such as those used for input. */
7644 dpyinfo
= w32_term_init (display
, xrm_option
,
7645 (char *) XSTRING (Vx_resource_name
)->data
);
7649 if (!NILP (must_succeed
))
7650 fatal ("Cannot connect to server %s.\n",
7651 XSTRING (display
)->data
);
7653 error ("Cannot connect to server %s", XSTRING (display
)->data
);
7658 XSETFASTINT (Vwindow_system_version
, 3);
7662 DEFUN ("x-close-connection", Fx_close_connection
,
7663 Sx_close_connection
, 1, 1, 0,
7664 doc
: /* Close the connection to DISPLAY's server.
7665 For DISPLAY, specify either a frame or a display name (a string).
7666 If DISPLAY is nil, that stands for the selected frame's display. */)
7668 Lisp_Object display
;
7670 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7673 if (dpyinfo
->reference_count
> 0)
7674 error ("Display still has frames on it");
7677 /* Free the fonts in the font table. */
7678 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
7679 if (dpyinfo
->font_table
[i
].name
)
7681 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
7682 xfree (dpyinfo
->font_table
[i
].full_name
);
7683 xfree (dpyinfo
->font_table
[i
].name
);
7684 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
7686 x_destroy_all_bitmaps (dpyinfo
);
7688 x_delete_display (dpyinfo
);
7694 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
7695 doc
: /* Return the list of display names that Emacs has connections to. */)
7698 Lisp_Object tail
, result
;
7701 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
7702 result
= Fcons (XCAR (XCAR (tail
)), result
);
7707 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
7708 doc
: /* This is a noop on W32 systems. */)
7710 Lisp_Object display
, on
;
7717 /***********************************************************************
7719 ***********************************************************************/
7721 /* Value is the number of elements of vector VECTOR. */
7723 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
7725 /* List of supported image types. Use define_image_type to add new
7726 types. Use lookup_image_type to find a type for a given symbol. */
7728 static struct image_type
*image_types
;
7730 /* The symbol `image' which is the car of the lists used to represent
7733 extern Lisp_Object Qimage
;
7735 /* The symbol `xbm' which is used as the type symbol for XBM images. */
7741 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
7742 extern Lisp_Object QCdata
;
7743 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
7744 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
7745 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
7747 /* Other symbols. */
7749 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
7751 /* Time in seconds after which images should be removed from the cache
7752 if not displayed. */
7754 Lisp_Object Vimage_cache_eviction_delay
;
7756 /* Function prototypes. */
7758 static void define_image_type
P_ ((struct image_type
*type
));
7759 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
7760 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
7761 static void x_laplace
P_ ((struct frame
*, struct image
*));
7762 static void x_emboss
P_ ((struct frame
*, struct image
*));
7763 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
7767 /* Define a new image type from TYPE. This adds a copy of TYPE to
7768 image_types and adds the symbol *TYPE->type to Vimage_types. */
7771 define_image_type (type
)
7772 struct image_type
*type
;
7774 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7775 The initialized data segment is read-only. */
7776 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
7777 bcopy (type
, p
, sizeof *p
);
7778 p
->next
= image_types
;
7780 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
7784 /* Look up image type SYMBOL, and return a pointer to its image_type
7785 structure. Value is null if SYMBOL is not a known image type. */
7787 static INLINE
struct image_type
*
7788 lookup_image_type (symbol
)
7791 struct image_type
*type
;
7793 for (type
= image_types
; type
; type
= type
->next
)
7794 if (EQ (symbol
, *type
->type
))
7801 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
7802 valid image specification is a list whose car is the symbol
7803 `image', and whose rest is a property list. The property list must
7804 contain a value for key `:type'. That value must be the name of a
7805 supported image type. The rest of the property list depends on the
7809 valid_image_p (object
)
7814 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
7818 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
7819 if (EQ (XCAR (tem
), QCtype
))
7822 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
7824 struct image_type
*type
;
7825 type
= lookup_image_type (XCAR (tem
));
7827 valid_p
= type
->valid_p (object
);
7838 /* Log error message with format string FORMAT and argument ARG.
7839 Signaling an error, e.g. when an image cannot be loaded, is not a
7840 good idea because this would interrupt redisplay, and the error
7841 message display would lead to another redisplay. This function
7842 therefore simply displays a message. */
7845 image_error (format
, arg1
, arg2
)
7847 Lisp_Object arg1
, arg2
;
7849 add_to_log (format
, arg1
, arg2
);
7854 /***********************************************************************
7855 Image specifications
7856 ***********************************************************************/
7858 enum image_value_type
7860 IMAGE_DONT_CHECK_VALUE_TYPE
,
7862 IMAGE_STRING_OR_NIL_VALUE
,
7864 IMAGE_POSITIVE_INTEGER_VALUE
,
7865 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
7866 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
7868 IMAGE_INTEGER_VALUE
,
7869 IMAGE_FUNCTION_VALUE
,
7874 /* Structure used when parsing image specifications. */
7876 struct image_keyword
7878 /* Name of keyword. */
7881 /* The type of value allowed. */
7882 enum image_value_type type
;
7884 /* Non-zero means key must be present. */
7887 /* Used to recognize duplicate keywords in a property list. */
7890 /* The value that was found. */
7895 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
7897 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
7900 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
7901 has the format (image KEYWORD VALUE ...). One of the keyword/
7902 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7903 image_keywords structures of size NKEYWORDS describing other
7904 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7907 parse_image_spec (spec
, keywords
, nkeywords
, type
)
7909 struct image_keyword
*keywords
;
7916 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
7919 plist
= XCDR (spec
);
7920 while (CONSP (plist
))
7922 Lisp_Object key
, value
;
7924 /* First element of a pair must be a symbol. */
7926 plist
= XCDR (plist
);
7930 /* There must follow a value. */
7933 value
= XCAR (plist
);
7934 plist
= XCDR (plist
);
7936 /* Find key in KEYWORDS. Error if not found. */
7937 for (i
= 0; i
< nkeywords
; ++i
)
7938 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
7944 /* Record that we recognized the keyword. If a keywords
7945 was found more than once, it's an error. */
7946 keywords
[i
].value
= value
;
7947 ++keywords
[i
].count
;
7949 if (keywords
[i
].count
> 1)
7952 /* Check type of value against allowed type. */
7953 switch (keywords
[i
].type
)
7955 case IMAGE_STRING_VALUE
:
7956 if (!STRINGP (value
))
7960 case IMAGE_STRING_OR_NIL_VALUE
:
7961 if (!STRINGP (value
) && !NILP (value
))
7965 case IMAGE_SYMBOL_VALUE
:
7966 if (!SYMBOLP (value
))
7970 case IMAGE_POSITIVE_INTEGER_VALUE
:
7971 if (!INTEGERP (value
) || XINT (value
) <= 0)
7975 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
7976 if (INTEGERP (value
) && XINT (value
) >= 0)
7979 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
7980 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
7984 case IMAGE_ASCENT_VALUE
:
7985 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
7987 else if (INTEGERP (value
)
7988 && XINT (value
) >= 0
7989 && XINT (value
) <= 100)
7993 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
7994 if (!INTEGERP (value
) || XINT (value
) < 0)
7998 case IMAGE_DONT_CHECK_VALUE_TYPE
:
8001 case IMAGE_FUNCTION_VALUE
:
8002 value
= indirect_function (value
);
8004 || COMPILEDP (value
)
8005 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
8009 case IMAGE_NUMBER_VALUE
:
8010 if (!INTEGERP (value
) && !FLOATP (value
))
8014 case IMAGE_INTEGER_VALUE
:
8015 if (!INTEGERP (value
))
8019 case IMAGE_BOOL_VALUE
:
8020 if (!NILP (value
) && !EQ (value
, Qt
))
8029 if (EQ (key
, QCtype
) && !EQ (type
, value
))
8033 /* Check that all mandatory fields are present. */
8034 for (i
= 0; i
< nkeywords
; ++i
)
8035 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
8038 return NILP (plist
);
8042 /* Return the value of KEY in image specification SPEC. Value is nil
8043 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8044 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8047 image_spec_value (spec
, key
, found
)
8048 Lisp_Object spec
, key
;
8053 xassert (valid_image_p (spec
));
8055 for (tail
= XCDR (spec
);
8056 CONSP (tail
) && CONSP (XCDR (tail
));
8057 tail
= XCDR (XCDR (tail
)))
8059 if (EQ (XCAR (tail
), key
))
8063 return XCAR (XCDR (tail
));
8075 /***********************************************************************
8076 Image type independent image structures
8077 ***********************************************************************/
8079 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
8080 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
8083 /* Allocate and return a new image structure for image specification
8084 SPEC. SPEC has a hash value of HASH. */
8086 static struct image
*
8087 make_image (spec
, hash
)
8091 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
8093 xassert (valid_image_p (spec
));
8094 bzero (img
, sizeof *img
);
8095 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
8096 xassert (img
->type
!= NULL
);
8098 img
->data
.lisp_val
= Qnil
;
8099 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
8105 /* Free image IMG which was used on frame F, including its resources. */
8114 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8116 /* Remove IMG from the hash table of its cache. */
8118 img
->prev
->next
= img
->next
;
8120 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
8123 img
->next
->prev
= img
->prev
;
8125 c
->images
[img
->id
] = NULL
;
8127 /* Free resources, then free IMG. */
8128 img
->type
->free (f
, img
);
8134 /* Prepare image IMG for display on frame F. Must be called before
8135 drawing an image. */
8138 prepare_image_for_display (f
, img
)
8144 /* We're about to display IMG, so set its timestamp to `now'. */
8146 img
->timestamp
= EMACS_SECS (t
);
8148 /* If IMG doesn't have a pixmap yet, load it now, using the image
8149 type dependent loader function. */
8150 if (img
->pixmap
== 0 && !img
->load_failed_p
)
8151 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8155 /* Value is the number of pixels for the ascent of image IMG when
8156 drawn in face FACE. */
8159 image_ascent (img
, face
)
8163 int height
= img
->height
+ img
->vmargin
;
8166 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
8169 ascent
= height
/ 2 - (FONT_DESCENT(face
->font
)
8170 - FONT_BASE(face
->font
)) / 2;
8172 ascent
= height
/ 2;
8175 ascent
= height
* img
->ascent
/ 100.0;
8182 /***********************************************************************
8183 Helper functions for X image types
8184 ***********************************************************************/
8186 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8187 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
8189 Lisp_Object color_name
,
8190 unsigned long dflt
));
8192 /* Free X resources of image IMG which is used on frame F. */
8195 x_clear_image (f
, img
)
8199 #if 0 /* TODO: W32 image support */
8204 XFreePixmap (NULL
, img
->pixmap
);
8211 int class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
8213 /* If display has an immutable color map, freeing colors is not
8214 necessary and some servers don't allow it. So don't do it. */
8215 if (class != StaticColor
8216 && class != StaticGray
8217 && class != TrueColor
)
8221 cmap
= DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f
)->screen
);
8222 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
, img
->colors
,
8227 xfree (img
->colors
);
8235 /* Allocate color COLOR_NAME for image IMG on frame F. If color
8236 cannot be allocated, use DFLT. Add a newly allocated color to
8237 IMG->colors, so that it can be freed again. Value is the pixel
8240 static unsigned long
8241 x_alloc_image_color (f
, img
, color_name
, dflt
)
8244 Lisp_Object color_name
;
8247 #if 0 /* TODO: allocing colors. */
8249 unsigned long result
;
8251 xassert (STRINGP (color_name
));
8253 if (w32_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
8255 /* This isn't called frequently so we get away with simply
8256 reallocating the color vector to the needed size, here. */
8259 (unsigned long *) xrealloc (img
->colors
,
8260 img
->ncolors
* sizeof *img
->colors
);
8261 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
8262 result
= color
.pixel
;
8273 /***********************************************************************
8275 ***********************************************************************/
8277 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
8278 static void postprocess_image
P_ ((struct frame
*, struct image
*));
8281 /* Return a new, initialized image cache that is allocated from the
8282 heap. Call free_image_cache to free an image cache. */
8284 struct image_cache
*
8287 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
8290 bzero (c
, sizeof *c
);
8292 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
8293 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
8294 c
->buckets
= (struct image
**) xmalloc (size
);
8295 bzero (c
->buckets
, size
);
8300 /* Free image cache of frame F. Be aware that X frames share images
8304 free_image_cache (f
)
8307 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8312 /* Cache should not be referenced by any frame when freed. */
8313 xassert (c
->refcount
== 0);
8315 for (i
= 0; i
< c
->used
; ++i
)
8316 free_image (f
, c
->images
[i
]);
8320 FRAME_X_IMAGE_CACHE (f
) = NULL
;
8325 /* Clear image cache of frame F. FORCE_P non-zero means free all
8326 images. FORCE_P zero means clear only images that haven't been
8327 displayed for some time. Should be called from time to time to
8328 reduce the number of loaded images. If image-eviction-seconds is
8329 non-nil, this frees images in the cache which weren't displayed for
8330 at least that many seconds. */
8333 clear_image_cache (f
, force_p
)
8337 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8339 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
8343 int i
, any_freed_p
= 0;
8346 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
8348 for (i
= 0; i
< c
->used
; ++i
)
8350 struct image
*img
= c
->images
[i
];
8353 || (img
->timestamp
> old
)))
8355 free_image (f
, img
);
8360 /* We may be clearing the image cache because, for example,
8361 Emacs was iconified for a longer period of time. In that
8362 case, current matrices may still contain references to
8363 images freed above. So, clear these matrices. */
8366 clear_current_matrices (f
);
8367 ++windows_or_buffers_changed
;
8373 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
8375 doc
: /* Clear the image cache of FRAME.
8376 FRAME nil or omitted means use the selected frame.
8377 FRAME t means clear the image caches of all frames. */)
8385 FOR_EACH_FRAME (tail
, frame
)
8386 if (FRAME_W32_P (XFRAME (frame
)))
8387 clear_image_cache (XFRAME (frame
), 1);
8390 clear_image_cache (check_x_frame (frame
), 1);
8396 /* Compute masks and transform image IMG on frame F, as specified
8397 by the image's specification, */
8400 postprocess_image (f
, img
)
8404 #if 0 /* TODO: image support. */
8405 /* Manipulation of the image's mask. */
8408 Lisp_Object conversion
, spec
;
8413 /* `:heuristic-mask t'
8415 means build a mask heuristically.
8416 `:heuristic-mask (R G B)'
8417 `:mask (heuristic (R G B))'
8418 means build a mask from color (R G B) in the
8421 means remove a mask, if any. */
8423 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
8425 x_build_heuristic_mask (f
, img
, mask
);
8430 mask
= image_spec_value (spec
, QCmask
, &found_p
);
8432 if (EQ (mask
, Qheuristic
))
8433 x_build_heuristic_mask (f
, img
, Qt
);
8434 else if (CONSP (mask
)
8435 && EQ (XCAR (mask
), Qheuristic
))
8437 if (CONSP (XCDR (mask
)))
8438 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
8440 x_build_heuristic_mask (f
, img
, XCDR (mask
));
8442 else if (NILP (mask
) && found_p
&& img
->mask
)
8444 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8450 /* Should we apply an image transformation algorithm? */
8451 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
8452 if (EQ (conversion
, Qdisabled
))
8453 x_disable_image (f
, img
);
8454 else if (EQ (conversion
, Qlaplace
))
8456 else if (EQ (conversion
, Qemboss
))
8458 else if (CONSP (conversion
)
8459 && EQ (XCAR (conversion
), Qedge_detection
))
8462 tem
= XCDR (conversion
);
8464 x_edge_detection (f
, img
,
8465 Fplist_get (tem
, QCmatrix
),
8466 Fplist_get (tem
, QCcolor_adjustment
));
8473 /* Return the id of image with Lisp specification SPEC on frame F.
8474 SPEC must be a valid Lisp image specification (see valid_image_p). */
8477 lookup_image (f
, spec
)
8481 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8485 struct gcpro gcpro1
;
8488 /* F must be a window-system frame, and SPEC must be a valid image
8490 xassert (FRAME_WINDOW_P (f
));
8491 xassert (valid_image_p (spec
));
8495 /* Look up SPEC in the hash table of the image cache. */
8496 hash
= sxhash (spec
, 0);
8497 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8499 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
8500 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
8503 /* If not found, create a new image and cache it. */
8506 extern Lisp_Object Qpostscript
;
8509 img
= make_image (spec
, hash
);
8510 cache_image (f
, img
);
8511 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8513 /* If we can't load the image, and we don't have a width and
8514 height, use some arbitrary width and height so that we can
8515 draw a rectangle for it. */
8516 if (img
->load_failed_p
)
8520 value
= image_spec_value (spec
, QCwidth
, NULL
);
8521 img
->width
= (INTEGERP (value
)
8522 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
8523 value
= image_spec_value (spec
, QCheight
, NULL
);
8524 img
->height
= (INTEGERP (value
)
8525 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
8529 /* Handle image type independent image attributes
8530 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
8531 Lisp_Object ascent
, margin
, relief
;
8533 ascent
= image_spec_value (spec
, QCascent
, NULL
);
8534 if (INTEGERP (ascent
))
8535 img
->ascent
= XFASTINT (ascent
);
8536 else if (EQ (ascent
, Qcenter
))
8537 img
->ascent
= CENTERED_IMAGE_ASCENT
;
8539 margin
= image_spec_value (spec
, QCmargin
, NULL
);
8540 if (INTEGERP (margin
) && XINT (margin
) >= 0)
8541 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
8542 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
8543 && INTEGERP (XCDR (margin
)))
8545 if (XINT (XCAR (margin
)) > 0)
8546 img
->hmargin
= XFASTINT (XCAR (margin
));
8547 if (XINT (XCDR (margin
)) > 0)
8548 img
->vmargin
= XFASTINT (XCDR (margin
));
8551 relief
= image_spec_value (spec
, QCrelief
, NULL
);
8552 if (INTEGERP (relief
))
8554 img
->relief
= XINT (relief
);
8555 img
->hmargin
+= abs (img
->relief
);
8556 img
->vmargin
+= abs (img
->relief
);
8559 /* Do image transformations and compute masks, unless we
8560 don't have the image yet. */
8561 if (!EQ (*img
->type
->type
, Qpostscript
))
8562 postprocess_image (f
, img
);
8566 xassert (!interrupt_input_blocked
);
8569 /* We're using IMG, so set its timestamp to `now'. */
8570 EMACS_GET_TIME (now
);
8571 img
->timestamp
= EMACS_SECS (now
);
8575 /* Value is the image id. */
8580 /* Cache image IMG in the image cache of frame F. */
8583 cache_image (f
, img
)
8587 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8590 /* Find a free slot in c->images. */
8591 for (i
= 0; i
< c
->used
; ++i
)
8592 if (c
->images
[i
] == NULL
)
8595 /* If no free slot found, maybe enlarge c->images. */
8596 if (i
== c
->used
&& c
->used
== c
->size
)
8599 c
->images
= (struct image
**) xrealloc (c
->images
,
8600 c
->size
* sizeof *c
->images
);
8603 /* Add IMG to c->images, and assign IMG an id. */
8609 /* Add IMG to the cache's hash table. */
8610 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8611 img
->next
= c
->buckets
[i
];
8613 img
->next
->prev
= img
;
8615 c
->buckets
[i
] = img
;
8619 /* Call FN on every image in the image cache of frame F. Used to mark
8620 Lisp Objects in the image cache. */
8623 forall_images_in_image_cache (f
, fn
)
8625 void (*fn
) P_ ((struct image
*img
));
8627 if (FRAME_LIVE_P (f
) && FRAME_W32_P (f
))
8629 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8633 for (i
= 0; i
< c
->used
; ++i
)
8642 /***********************************************************************
8644 ***********************************************************************/
8646 #if 0 /* TODO: W32 specific image code. */
8648 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
8649 XImage
**, Pixmap
*));
8650 static void x_destroy_x_image
P_ ((XImage
*));
8651 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
8654 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
8655 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
8656 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
8657 via xmalloc. Print error messages via image_error if an error
8658 occurs. Value is non-zero if successful. */
8661 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
8663 int width
, height
, depth
;
8667 #if 0 /* TODO: Image support for W32 */
8668 Display
*display
= FRAME_W32_DISPLAY (f
);
8669 Screen
*screen
= FRAME_X_SCREEN (f
);
8670 Window window
= FRAME_W32_WINDOW (f
);
8672 xassert (interrupt_input_blocked
);
8675 depth
= DefaultDepthOfScreen (screen
);
8676 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
8677 depth
, ZPixmap
, 0, NULL
, width
, height
,
8678 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
8681 image_error ("Unable to allocate X image", Qnil
, Qnil
);
8685 /* Allocate image raster. */
8686 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
8688 /* Allocate a pixmap of the same size. */
8689 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
8692 x_destroy_x_image (*ximg
);
8694 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
8702 /* Destroy XImage XIMG. Free XIMG->data. */
8705 x_destroy_x_image (ximg
)
8708 xassert (interrupt_input_blocked
);
8713 XDestroyImage (ximg
);
8718 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
8719 are width and height of both the image and pixmap. */
8722 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
8729 xassert (interrupt_input_blocked
);
8730 gc
= XCreateGC (NULL
, pixmap
, 0, NULL
);
8731 XPutImage (NULL
, pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
8738 /***********************************************************************
8740 ***********************************************************************/
8742 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
8743 static char *slurp_file
P_ ((char *, int *));
8746 /* Find image file FILE. Look in data-directory, then
8747 x-bitmap-file-path. Value is the full name of the file found, or
8748 nil if not found. */
8751 x_find_image_file (file
)
8754 Lisp_Object file_found
, search_path
;
8755 struct gcpro gcpro1
, gcpro2
;
8759 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
8760 GCPRO2 (file_found
, search_path
);
8762 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
8763 fd
= openp (search_path
, file
, Qnil
, &file_found
, 0);
8775 /* Read FILE into memory. Value is a pointer to a buffer allocated
8776 with xmalloc holding FILE's contents. Value is null if an error
8777 occurred. *SIZE is set to the size of the file. */
8780 slurp_file (file
, size
)
8788 if (stat (file
, &st
) == 0
8789 && (fp
= fopen (file
, "r")) != NULL
8790 && (buf
= (char *) xmalloc (st
.st_size
),
8791 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
8812 /***********************************************************************
8814 ***********************************************************************/
8816 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
8817 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
8819 static int xbm_image_p
P_ ((Lisp_Object object
));
8820 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
8824 /* Indices of image specification fields in xbm_format, below. */
8826 enum xbm_keyword_index
8843 /* Vector of image_keyword structures describing the format
8844 of valid XBM image specifications. */
8846 static struct image_keyword xbm_format
[XBM_LAST
] =
8848 {":type", IMAGE_SYMBOL_VALUE
, 1},
8849 {":file", IMAGE_STRING_VALUE
, 0},
8850 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8851 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8852 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8853 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8854 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
8855 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8856 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8857 {":relief", IMAGE_INTEGER_VALUE
, 0},
8858 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8859 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8862 /* Structure describing the image type XBM. */
8864 static struct image_type xbm_type
=
8873 /* Tokens returned from xbm_scan. */
8882 /* Return non-zero if OBJECT is a valid XBM-type image specification.
8883 A valid specification is a list starting with the symbol `image'
8884 The rest of the list is a property list which must contain an
8887 If the specification specifies a file to load, it must contain
8888 an entry `:file FILENAME' where FILENAME is a string.
8890 If the specification is for a bitmap loaded from memory it must
8891 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
8892 WIDTH and HEIGHT are integers > 0. DATA may be:
8894 1. a string large enough to hold the bitmap data, i.e. it must
8895 have a size >= (WIDTH + 7) / 8 * HEIGHT
8897 2. a bool-vector of size >= WIDTH * HEIGHT
8899 3. a vector of strings or bool-vectors, one for each line of the
8902 Both the file and data forms may contain the additional entries
8903 `:background COLOR' and `:foreground COLOR'. If not present,
8904 foreground and background of the frame on which the image is
8905 displayed, is used. */
8908 xbm_image_p (object
)
8911 struct image_keyword kw
[XBM_LAST
];
8913 bcopy (xbm_format
, kw
, sizeof kw
);
8914 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
8917 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
8919 if (kw
[XBM_FILE
].count
)
8921 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
8929 /* Entries for `:width', `:height' and `:data' must be present. */
8930 if (!kw
[XBM_WIDTH
].count
8931 || !kw
[XBM_HEIGHT
].count
8932 || !kw
[XBM_DATA
].count
)
8935 data
= kw
[XBM_DATA
].value
;
8936 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
8937 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
8939 /* Check type of data, and width and height against contents of
8945 /* Number of elements of the vector must be >= height. */
8946 if (XVECTOR (data
)->size
< height
)
8949 /* Each string or bool-vector in data must be large enough
8950 for one line of the image. */
8951 for (i
= 0; i
< height
; ++i
)
8953 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
8957 if (XSTRING (elt
)->size
8958 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
8961 else if (BOOL_VECTOR_P (elt
))
8963 if (XBOOL_VECTOR (elt
)->size
< width
)
8970 else if (STRINGP (data
))
8972 if (XSTRING (data
)->size
8973 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
8976 else if (BOOL_VECTOR_P (data
))
8978 if (XBOOL_VECTOR (data
)->size
< width
* height
)
8985 /* Baseline must be a value between 0 and 100 (a percentage). */
8986 if (kw
[XBM_ASCENT
].count
8987 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
8994 /* Scan a bitmap file. FP is the stream to read from. Value is
8995 either an enumerator from enum xbm_token, or a character for a
8996 single-character token, or 0 at end of file. If scanning an
8997 identifier, store the lexeme of the identifier in SVAL. If
8998 scanning a number, store its value in *IVAL. */
9001 xbm_scan (s
, end
, sval
, ival
)
9010 /* Skip white space. */
9011 while (*s
< end
&&(c
= *(*s
)++, isspace (c
)))
9016 else if (isdigit (c
))
9018 int value
= 0, digit
;
9020 if (c
== '0' && *s
< end
)
9023 if (c
== 'x' || c
== 'X')
9030 else if (c
>= 'a' && c
<= 'f')
9031 digit
= c
- 'a' + 10;
9032 else if (c
>= 'A' && c
<= 'F')
9033 digit
= c
- 'A' + 10;
9036 value
= 16 * value
+ digit
;
9039 else if (isdigit (c
))
9043 && (c
= *(*s
)++, isdigit (c
)))
9044 value
= 8 * value
+ c
- '0';
9051 && (c
= *(*s
)++, isdigit (c
)))
9052 value
= 10 * value
+ c
- '0';
9060 else if (isalpha (c
) || c
== '_')
9064 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
9071 else if (c
== '/' && **s
== '*')
9073 /* C-style comment. */
9075 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
9088 /* Replacement for XReadBitmapFileData which isn't available under old
9089 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9090 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9091 the image. Return in *DATA the bitmap data allocated with xmalloc.
9092 Value is non-zero if successful. DATA null means just test if
9093 CONTENTS looks like an in-memory XBM file. */
9096 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
9097 char *contents
, *end
;
9098 int *width
, *height
;
9099 unsigned char **data
;
9102 char buffer
[BUFSIZ
];
9105 int bytes_per_line
, i
, nbytes
;
9111 LA1 = xbm_scan (contents, end, buffer, &value)
9113 #define expect(TOKEN) \
9114 if (LA1 != (TOKEN)) \
9119 #define expect_ident(IDENT) \
9120 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9125 *width
= *height
= -1;
9128 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
9130 /* Parse defines for width, height and hot-spots. */
9134 expect_ident ("define");
9135 expect (XBM_TK_IDENT
);
9137 if (LA1
== XBM_TK_NUMBER
);
9139 char *p
= strrchr (buffer
, '_');
9140 p
= p
? p
+ 1 : buffer
;
9141 if (strcmp (p
, "width") == 0)
9143 else if (strcmp (p
, "height") == 0)
9146 expect (XBM_TK_NUMBER
);
9149 if (*width
< 0 || *height
< 0)
9151 else if (data
== NULL
)
9154 /* Parse bits. Must start with `static'. */
9155 expect_ident ("static");
9156 if (LA1
== XBM_TK_IDENT
)
9158 if (strcmp (buffer
, "unsigned") == 0)
9161 expect_ident ("char");
9163 else if (strcmp (buffer
, "short") == 0)
9167 if (*width
% 16 && *width
% 16 < 9)
9170 else if (strcmp (buffer
, "char") == 0)
9178 expect (XBM_TK_IDENT
);
9184 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
9185 nbytes
= bytes_per_line
* *height
;
9186 p
= *data
= (char *) xmalloc (nbytes
);
9191 for (i
= 0; i
< nbytes
; i
+= 2)
9194 expect (XBM_TK_NUMBER
);
9197 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
9200 if (LA1
== ',' || LA1
== '}')
9208 for (i
= 0; i
< nbytes
; ++i
)
9211 expect (XBM_TK_NUMBER
);
9215 if (LA1
== ',' || LA1
== '}')
9240 /* Load XBM image IMG which will be displayed on frame F from buffer
9241 CONTENTS. END is the end of the buffer. Value is non-zero if
9245 xbm_load_image (f
, img
, contents
, end
)
9248 char *contents
, *end
;
9251 unsigned char *data
;
9254 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
9257 int depth
= one_w32_display_info
.n_cbits
;
9258 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
9259 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
9262 xassert (img
->width
> 0 && img
->height
> 0);
9264 /* Get foreground and background colors, maybe allocate colors. */
9265 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
9267 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
9269 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
9271 background
= x_alloc_image_color (f
, img
, value
, background
);
9273 #if 0 /* TODO : Port image display to W32 */
9275 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f
),
9276 FRAME_W32_WINDOW (f
),
9278 img
->width
, img
->height
,
9279 foreground
, background
,
9283 if (img
->pixmap
== 0)
9285 x_clear_image (f
, img
);
9286 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
9293 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
9299 /* Value is non-zero if DATA looks like an in-memory XBM file. */
9306 return (STRINGP (data
)
9307 && xbm_read_bitmap_data (XSTRING (data
)->data
,
9308 (XSTRING (data
)->data
9309 + STRING_BYTES (XSTRING (data
))),
9314 /* Fill image IMG which is used on frame F with pixmap data. Value is
9315 non-zero if successful. */
9323 Lisp_Object file_name
;
9325 xassert (xbm_image_p (img
->spec
));
9327 /* If IMG->spec specifies a file name, create a non-file spec from it. */
9328 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
9329 if (STRINGP (file_name
))
9334 struct gcpro gcpro1
;
9336 file
= x_find_image_file (file_name
);
9338 if (!STRINGP (file
))
9340 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
9345 contents
= slurp_file (XSTRING (file
)->data
, &size
);
9346 if (contents
== NULL
)
9348 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
9353 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
9358 struct image_keyword fmt
[XBM_LAST
];
9361 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
9362 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
9365 int in_memory_file_p
= 0;
9367 /* See if data looks like an in-memory XBM file. */
9368 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9369 in_memory_file_p
= xbm_file_p (data
);
9371 /* Parse the list specification. */
9372 bcopy (xbm_format
, fmt
, sizeof fmt
);
9373 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
9376 /* Get specified width, and height. */
9377 if (!in_memory_file_p
)
9379 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
9380 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
9381 xassert (img
->width
> 0 && img
->height
> 0);
9383 /* Get foreground and background colors, maybe allocate colors. */
9384 if (fmt
[XBM_FOREGROUND
].count
9385 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
9386 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
9388 if (fmt
[XBM_BACKGROUND
].count
9389 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
9390 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
9393 if (in_memory_file_p
)
9394 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
9395 (XSTRING (data
)->data
9396 + STRING_BYTES (XSTRING (data
))));
9403 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
9405 p
= bits
= (char *) alloca (nbytes
* img
->height
);
9406 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
9408 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
9410 bcopy (XSTRING (line
)->data
, p
, nbytes
);
9412 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
9415 else if (STRINGP (data
))
9416 bits
= XSTRING (data
)->data
;
9418 bits
= XBOOL_VECTOR (data
)->data
;
9419 #ifdef TODO /* image support. */
9420 /* Create the pixmap. */
9421 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
9423 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
9426 img
->width
, img
->height
,
9427 foreground
, background
,
9434 image_error ("Unable to create pixmap for XBM image `%s'",
9436 x_clear_image (f
, img
);
9446 /***********************************************************************
9448 ***********************************************************************/
9452 static int xpm_image_p
P_ ((Lisp_Object object
));
9453 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
9454 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
9456 #include "X11/xpm.h"
9458 /* The symbol `xpm' identifying XPM-format images. */
9462 /* Indices of image specification fields in xpm_format, below. */
9464 enum xpm_keyword_index
9478 /* Vector of image_keyword structures describing the format
9479 of valid XPM image specifications. */
9481 static struct image_keyword xpm_format
[XPM_LAST
] =
9483 {":type", IMAGE_SYMBOL_VALUE
, 1},
9484 {":file", IMAGE_STRING_VALUE
, 0},
9485 {":data", IMAGE_STRING_VALUE
, 0},
9486 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9487 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9488 {":relief", IMAGE_INTEGER_VALUE
, 0},
9489 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9490 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9491 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9494 /* Structure describing the image type XBM. */
9496 static struct image_type xpm_type
=
9506 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
9507 for XPM images. Such a list must consist of conses whose car and
9511 xpm_valid_color_symbols_p (color_symbols
)
9512 Lisp_Object color_symbols
;
9514 while (CONSP (color_symbols
))
9516 Lisp_Object sym
= XCAR (color_symbols
);
9518 || !STRINGP (XCAR (sym
))
9519 || !STRINGP (XCDR (sym
)))
9521 color_symbols
= XCDR (color_symbols
);
9524 return NILP (color_symbols
);
9528 /* Value is non-zero if OBJECT is a valid XPM image specification. */
9531 xpm_image_p (object
)
9534 struct image_keyword fmt
[XPM_LAST
];
9535 bcopy (xpm_format
, fmt
, sizeof fmt
);
9536 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
9537 /* Either `:file' or `:data' must be present. */
9538 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
9539 /* Either no `:color-symbols' or it's a list of conses
9540 whose car and cdr are strings. */
9541 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
9542 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
9543 && (fmt
[XPM_ASCENT
].count
== 0
9544 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
9548 /* Load image IMG which will be displayed on frame F. Value is
9549 non-zero if successful. */
9557 XpmAttributes attrs
;
9558 Lisp_Object specified_file
, color_symbols
;
9560 /* Configure the XPM lib. Use the visual of frame F. Allocate
9561 close colors. Return colors allocated. */
9562 bzero (&attrs
, sizeof attrs
);
9563 attrs
.visual
= FRAME_X_VISUAL (f
);
9564 attrs
.colormap
= FRAME_X_COLORMAP (f
);
9565 attrs
.valuemask
|= XpmVisual
;
9566 attrs
.valuemask
|= XpmColormap
;
9567 attrs
.valuemask
|= XpmReturnAllocPixels
;
9568 #ifdef XpmAllocCloseColors
9569 attrs
.alloc_close_colors
= 1;
9570 attrs
.valuemask
|= XpmAllocCloseColors
;
9572 attrs
.closeness
= 600;
9573 attrs
.valuemask
|= XpmCloseness
;
9576 /* If image specification contains symbolic color definitions, add
9577 these to `attrs'. */
9578 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
9579 if (CONSP (color_symbols
))
9582 XpmColorSymbol
*xpm_syms
;
9585 attrs
.valuemask
|= XpmColorSymbols
;
9587 /* Count number of symbols. */
9588 attrs
.numsymbols
= 0;
9589 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
9592 /* Allocate an XpmColorSymbol array. */
9593 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
9594 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
9595 bzero (xpm_syms
, size
);
9596 attrs
.colorsymbols
= xpm_syms
;
9598 /* Fill the color symbol array. */
9599 for (tail
= color_symbols
, i
= 0;
9601 ++i
, tail
= XCDR (tail
))
9603 Lisp_Object name
= XCAR (XCAR (tail
));
9604 Lisp_Object color
= XCDR (XCAR (tail
));
9605 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
9606 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
9607 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
9608 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
9612 /* Create a pixmap for the image, either from a file, or from a
9613 string buffer containing data in the same format as an XPM file. */
9615 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9616 if (STRINGP (specified_file
))
9618 Lisp_Object file
= x_find_image_file (specified_file
);
9619 if (!STRINGP (file
))
9621 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9626 rc
= XpmReadFileToPixmap (NULL
, FRAME_W32_WINDOW (f
),
9627 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
9632 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
9633 rc
= XpmCreatePixmapFromBuffer (NULL
, FRAME_W32_WINDOW (f
),
9634 XSTRING (buffer
)->data
,
9635 &img
->pixmap
, &img
->mask
,
9640 if (rc
== XpmSuccess
)
9642 /* Remember allocated colors. */
9643 img
->ncolors
= attrs
.nalloc_pixels
;
9644 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
9645 * sizeof *img
->colors
);
9646 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
9647 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
9649 img
->width
= attrs
.width
;
9650 img
->height
= attrs
.height
;
9651 xassert (img
->width
> 0 && img
->height
> 0);
9653 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
9655 XpmFreeAttributes (&attrs
);
9663 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
9666 case XpmFileInvalid
:
9667 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
9671 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
9674 case XpmColorFailed
:
9675 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
9679 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
9684 return rc
== XpmSuccess
;
9687 #endif /* HAVE_XPM != 0 */
9690 #if 0 /* TODO : Color tables on W32. */
9691 /***********************************************************************
9693 ***********************************************************************/
9695 /* An entry in the color table mapping an RGB color to a pixel color. */
9700 unsigned long pixel
;
9702 /* Next in color table collision list. */
9703 struct ct_color
*next
;
9706 /* The bucket vector size to use. Must be prime. */
9710 /* Value is a hash of the RGB color given by R, G, and B. */
9712 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
9714 /* The color hash table. */
9716 struct ct_color
**ct_table
;
9718 /* Number of entries in the color table. */
9720 int ct_colors_allocated
;
9722 /* Function prototypes. */
9724 static void init_color_table
P_ ((void));
9725 static void free_color_table
P_ ((void));
9726 static unsigned long *colors_in_color_table
P_ ((int *n
));
9727 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
9728 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
9731 /* Initialize the color table. */
9736 int size
= CT_SIZE
* sizeof (*ct_table
);
9737 ct_table
= (struct ct_color
**) xmalloc (size
);
9738 bzero (ct_table
, size
);
9739 ct_colors_allocated
= 0;
9743 /* Free memory associated with the color table. */
9749 struct ct_color
*p
, *next
;
9751 for (i
= 0; i
< CT_SIZE
; ++i
)
9752 for (p
= ct_table
[i
]; p
; p
= next
)
9763 /* Value is a pixel color for RGB color R, G, B on frame F. If an
9764 entry for that color already is in the color table, return the
9765 pixel color of that entry. Otherwise, allocate a new color for R,
9766 G, B, and make an entry in the color table. */
9768 static unsigned long
9769 lookup_rgb_color (f
, r
, g
, b
)
9773 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
9774 int i
= hash
% CT_SIZE
;
9777 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9778 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
9787 color
= PALETTERGB (r
, g
, b
);
9789 ++ct_colors_allocated
;
9791 p
= (struct ct_color
*) xmalloc (sizeof *p
);
9796 p
->next
= ct_table
[i
];
9804 /* Look up pixel color PIXEL which is used on frame F in the color
9805 table. If not already present, allocate it. Value is PIXEL. */
9807 static unsigned long
9808 lookup_pixel_color (f
, pixel
)
9810 unsigned long pixel
;
9812 int i
= pixel
% CT_SIZE
;
9815 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9816 if (p
->pixel
== pixel
)
9827 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9828 color
.pixel
= pixel
;
9829 XQueryColor (NULL
, cmap
, &color
);
9830 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
9835 ++ct_colors_allocated
;
9837 p
= (struct ct_color
*) xmalloc (sizeof *p
);
9842 p
->next
= ct_table
[i
];
9846 return FRAME_FOREGROUND_PIXEL (f
);
9852 /* Value is a vector of all pixel colors contained in the color table,
9853 allocated via xmalloc. Set *N to the number of colors. */
9855 static unsigned long *
9856 colors_in_color_table (n
)
9861 unsigned long *colors
;
9863 if (ct_colors_allocated
== 0)
9870 colors
= (unsigned long *) xmalloc (ct_colors_allocated
9872 *n
= ct_colors_allocated
;
9874 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
9875 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9876 colors
[j
++] = p
->pixel
;
9885 /***********************************************************************
9887 ***********************************************************************/
9888 #if 0 /* TODO: image support. */
9889 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
9890 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
9891 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
9893 /* Non-zero means draw a cross on images having `:conversion
9896 int cross_disabled_images
;
9898 /* Edge detection matrices for different edge-detection
9901 static int emboss_matrix
[9] = {
9903 2, -1, 0, /* y - 1 */
9905 0, 1, -2 /* y + 1 */
9908 static int laplace_matrix
[9] = {
9910 1, 0, 0, /* y - 1 */
9912 0, 0, -1 /* y + 1 */
9915 /* Value is the intensity of the color whose red/green/blue values
9918 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
9921 /* On frame F, return an array of XColor structures describing image
9922 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
9923 non-zero means also fill the red/green/blue members of the XColor
9924 structures. Value is a pointer to the array of XColors structures,
9925 allocated with xmalloc; it must be freed by the caller. */
9928 x_to_xcolors (f
, img
, rgb_p
)
9937 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
9939 /* Get the X image IMG->pixmap. */
9940 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9941 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9943 /* Fill the `pixel' members of the XColor array. I wished there
9944 were an easy and portable way to circumvent XGetPixel. */
9946 for (y
= 0; y
< img
->height
; ++y
)
9950 for (x
= 0; x
< img
->width
; ++x
, ++p
)
9951 p
->pixel
= XGetPixel (ximg
, x
, y
);
9954 x_query_colors (f
, row
, img
->width
);
9957 XDestroyImage (ximg
);
9962 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
9963 RGB members are set. F is the frame on which this all happens.
9964 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
9967 x_from_xcolors (f
, img
, colors
)
9977 init_color_table ();
9979 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
9982 for (y
= 0; y
< img
->height
; ++y
)
9983 for (x
= 0; x
< img
->width
; ++x
, ++p
)
9985 unsigned long pixel
;
9986 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
9987 XPutPixel (oimg
, x
, y
, pixel
);
9991 x_clear_image_1 (f
, img
, 1, 0, 1);
9993 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
9994 x_destroy_x_image (oimg
);
9995 img
->pixmap
= pixmap
;
9996 img
->colors
= colors_in_color_table (&img
->ncolors
);
9997 free_color_table ();
10001 /* On frame F, perform edge-detection on image IMG.
10003 MATRIX is a nine-element array specifying the transformation
10004 matrix. See emboss_matrix for an example.
10006 COLOR_ADJUST is a color adjustment added to each pixel of the
10010 x_detect_edges (f
, img
, matrix
, color_adjust
)
10013 int matrix
[9], color_adjust
;
10015 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10019 for (i
= sum
= 0; i
< 9; ++i
)
10020 sum
+= abs (matrix
[i
]);
10022 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
10024 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
10026 for (y
= 0; y
< img
->height
; ++y
)
10028 p
= COLOR (new, 0, y
);
10029 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10030 p
= COLOR (new, img
->width
- 1, y
);
10031 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10034 for (x
= 1; x
< img
->width
- 1; ++x
)
10036 p
= COLOR (new, x
, 0);
10037 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10038 p
= COLOR (new, x
, img
->height
- 1);
10039 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10042 for (y
= 1; y
< img
->height
- 1; ++y
)
10044 p
= COLOR (new, 1, y
);
10046 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
10048 int r
, g
, b
, y1
, x1
;
10051 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
10052 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
10055 XColor
*t
= COLOR (colors
, x1
, y1
);
10056 r
+= matrix
[i
] * t
->red
;
10057 g
+= matrix
[i
] * t
->green
;
10058 b
+= matrix
[i
] * t
->blue
;
10061 r
= (r
/ sum
+ color_adjust
) & 0xffff;
10062 g
= (g
/ sum
+ color_adjust
) & 0xffff;
10063 b
= (b
/ sum
+ color_adjust
) & 0xffff;
10064 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
10069 x_from_xcolors (f
, img
, new);
10075 /* Perform the pre-defined `emboss' edge-detection on image IMG
10083 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
10087 /* Transform image IMG which is used on frame F with a Laplace
10088 edge-detection algorithm. The result is an image that can be used
10089 to draw disabled buttons, for example. */
10096 x_detect_edges (f
, img
, laplace_matrix
, 45000);
10100 /* Perform edge-detection on image IMG on frame F, with specified
10101 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
10103 MATRIX must be either
10105 - a list of at least 9 numbers in row-major form
10106 - a vector of at least 9 numbers
10108 COLOR_ADJUST nil means use a default; otherwise it must be a
10112 x_edge_detection (f
, img
, matrix
, color_adjust
)
10115 Lisp_Object matrix
, color_adjust
;
10120 if (CONSP (matrix
))
10123 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
10124 ++i
, matrix
= XCDR (matrix
))
10125 trans
[i
] = XFLOATINT (XCAR (matrix
));
10127 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
10129 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
10130 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
10133 if (NILP (color_adjust
))
10134 color_adjust
= make_number (0xffff / 2);
10136 if (i
== 9 && NUMBERP (color_adjust
))
10137 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
10141 /* Transform image IMG on frame F so that it looks disabled. */
10144 x_disable_image (f
, img
)
10148 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
10150 if (dpyinfo
->n_planes
>= 2)
10152 /* Color (or grayscale). Convert to gray, and equalize. Just
10153 drawing such images with a stipple can look very odd, so
10154 we're using this method instead. */
10155 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10157 const int h
= 15000;
10158 const int l
= 30000;
10160 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
10164 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
10165 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
10166 p
->red
= p
->green
= p
->blue
= i2
;
10169 x_from_xcolors (f
, img
, colors
);
10172 /* Draw a cross over the disabled image, if we must or if we
10174 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
10176 Display
*dpy
= FRAME_X_DISPLAY (f
);
10179 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
10180 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
10181 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
10182 img
->width
- 1, img
->height
- 1);
10183 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
10184 img
->width
- 1, 0);
10189 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
10190 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
10191 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
10192 img
->width
- 1, img
->height
- 1);
10193 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
10194 img
->width
- 1, 0);
10201 /* Build a mask for image IMG which is used on frame F. FILE is the
10202 name of an image file, for error messages. HOW determines how to
10203 determine the background color of IMG. If it is a list '(R G B)',
10204 with R, G, and B being integers >= 0, take that as the color of the
10205 background. Otherwise, determine the background color of IMG
10206 heuristically. Value is non-zero if successful. */
10209 x_build_heuristic_mask (f
, img
, how
)
10214 Display
*dpy
= FRAME_W32_DISPLAY (f
);
10215 XImage
*ximg
, *mask_img
;
10216 int x
, y
, rc
, look_at_corners_p
;
10221 /* Create an image and pixmap serving as mask. */
10222 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
10223 &mask_img
, &img
->mask
);
10230 /* Get the X image of IMG->pixmap. */
10231 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
10234 /* Determine the background color of ximg. If HOW is `(R G B)'
10235 take that as color. Otherwise, try to determine the color
10237 look_at_corners_p
= 1;
10245 && NATNUMP (XCAR (how
)))
10247 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
10251 if (i
== 3 && NILP (how
))
10253 char color_name
[30];
10254 XColor exact
, color
;
10257 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
10259 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
10260 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
10263 look_at_corners_p
= 0;
10268 if (look_at_corners_p
)
10270 unsigned long corners
[4];
10273 /* Get the colors at the corners of ximg. */
10274 corners
[0] = XGetPixel (ximg
, 0, 0);
10275 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
10276 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
10277 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
10279 /* Choose the most frequently found color as background. */
10280 for (i
= best_count
= 0; i
< 4; ++i
)
10284 for (j
= n
= 0; j
< 4; ++j
)
10285 if (corners
[i
] == corners
[j
])
10288 if (n
> best_count
)
10289 bg
= corners
[i
], best_count
= n
;
10293 /* Set all bits in mask_img to 1 whose color in ximg is different
10294 from the background color bg. */
10295 for (y
= 0; y
< img
->height
; ++y
)
10296 for (x
= 0; x
< img
->width
; ++x
)
10297 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
10299 /* Put mask_img into img->mask. */
10300 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
10301 x_destroy_x_image (mask_img
);
10302 XDestroyImage (ximg
);
10311 /***********************************************************************
10312 PBM (mono, gray, color)
10313 ***********************************************************************/
10316 static int pbm_image_p
P_ ((Lisp_Object object
));
10317 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
10318 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
10320 /* The symbol `pbm' identifying images of this type. */
10324 /* Indices of image specification fields in gs_format, below. */
10326 enum pbm_keyword_index
10335 PBM_HEURISTIC_MASK
,
10339 /* Vector of image_keyword structures describing the format
10340 of valid user-defined image specifications. */
10342 static struct image_keyword pbm_format
[PBM_LAST
] =
10344 {":type", IMAGE_SYMBOL_VALUE
, 1},
10345 {":file", IMAGE_STRING_VALUE
, 0},
10346 {":data", IMAGE_STRING_VALUE
, 0},
10347 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10348 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10349 {":relief", IMAGE_INTEGER_VALUE
, 0},
10350 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10351 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10352 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10353 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
10354 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10357 /* Structure describing the image type `pbm'. */
10359 static struct image_type pbm_type
=
10369 /* Return non-zero if OBJECT is a valid PBM image specification. */
10372 pbm_image_p (object
)
10373 Lisp_Object object
;
10375 struct image_keyword fmt
[PBM_LAST
];
10377 bcopy (pbm_format
, fmt
, sizeof fmt
);
10379 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
10380 || (fmt
[PBM_ASCENT
].count
10381 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
10384 /* Must specify either :data or :file. */
10385 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
10389 /* Scan a decimal number from *S and return it. Advance *S while
10390 reading the number. END is the end of the string. Value is -1 at
10394 pbm_scan_number (s
, end
)
10395 unsigned char **s
, *end
;
10401 /* Skip white-space. */
10402 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
10407 /* Skip comment to end of line. */
10408 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
10411 else if (isdigit (c
))
10413 /* Read decimal number. */
10415 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
10416 val
= 10 * val
+ c
- '0';
10427 /* Read FILE into memory. Value is a pointer to a buffer allocated
10428 with xmalloc holding FILE's contents. Value is null if an error
10429 occured. *SIZE is set to the size of the file. */
10432 pbm_read_file (file
, size
)
10440 if (stat (XSTRING (file
)->data
, &st
) == 0
10441 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
10442 && (buf
= (char *) xmalloc (st
.st_size
),
10443 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
10445 *size
= st
.st_size
;
10463 /* Load PBM image IMG for use on frame F. */
10471 int width
, height
, max_color_idx
= 0;
10473 Lisp_Object file
, specified_file
;
10474 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
10475 struct gcpro gcpro1
;
10476 unsigned char *contents
= NULL
;
10477 unsigned char *end
, *p
;
10480 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10484 if (STRINGP (specified_file
))
10486 file
= x_find_image_file (specified_file
);
10487 if (!STRINGP (file
))
10489 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10494 contents
= slurp_file (XSTRING (file
)->data
, &size
);
10495 if (contents
== NULL
)
10497 image_error ("Error reading `%s'", file
, Qnil
);
10503 end
= contents
+ size
;
10508 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10509 p
= XSTRING (data
)->data
;
10510 end
= p
+ STRING_BYTES (XSTRING (data
));
10513 /* Check magic number. */
10514 if (end
- p
< 2 || *p
++ != 'P')
10516 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10526 raw_p
= 0, type
= PBM_MONO
;
10530 raw_p
= 0, type
= PBM_GRAY
;
10534 raw_p
= 0, type
= PBM_COLOR
;
10538 raw_p
= 1, type
= PBM_MONO
;
10542 raw_p
= 1, type
= PBM_GRAY
;
10546 raw_p
= 1, type
= PBM_COLOR
;
10550 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10554 /* Read width, height, maximum color-component. Characters
10555 starting with `#' up to the end of a line are ignored. */
10556 width
= pbm_scan_number (&p
, end
);
10557 height
= pbm_scan_number (&p
, end
);
10559 if (type
!= PBM_MONO
)
10561 max_color_idx
= pbm_scan_number (&p
, end
);
10562 if (raw_p
&& max_color_idx
> 255)
10563 max_color_idx
= 255;
10568 || (type
!= PBM_MONO
&& max_color_idx
< 0))
10571 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
10572 &ximg
, &img
->pixmap
))
10575 /* Initialize the color hash table. */
10576 init_color_table ();
10578 if (type
== PBM_MONO
)
10581 struct image_keyword fmt
[PBM_LAST
];
10582 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
10583 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
10585 /* Parse the image specification. */
10586 bcopy (pbm_format
, fmt
, sizeof fmt
);
10587 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
10589 /* Get foreground and background colors, maybe allocate colors. */
10590 if (fmt
[PBM_FOREGROUND
].count
10591 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
10592 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
10593 if (fmt
[PBM_BACKGROUND
].count
10594 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
10595 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
10597 for (y
= 0; y
< height
; ++y
)
10598 for (x
= 0; x
< width
; ++x
)
10608 g
= pbm_scan_number (&p
, end
);
10610 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
10615 for (y
= 0; y
< height
; ++y
)
10616 for (x
= 0; x
< width
; ++x
)
10620 if (type
== PBM_GRAY
)
10621 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
10630 r
= pbm_scan_number (&p
, end
);
10631 g
= pbm_scan_number (&p
, end
);
10632 b
= pbm_scan_number (&p
, end
);
10635 if (r
< 0 || g
< 0 || b
< 0)
10637 xfree (ximg
->data
);
10639 XDestroyImage (ximg
);
10640 image_error ("Invalid pixel value in image `%s'",
10645 /* RGB values are now in the range 0..max_color_idx.
10646 Scale this to the range 0..0xffff supported by X. */
10647 r
= (double) r
* 65535 / max_color_idx
;
10648 g
= (double) g
* 65535 / max_color_idx
;
10649 b
= (double) b
* 65535 / max_color_idx
;
10650 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
10654 /* Store in IMG->colors the colors allocated for the image, and
10655 free the color table. */
10656 img
->colors
= colors_in_color_table (&img
->ncolors
);
10657 free_color_table ();
10659 /* Put the image into a pixmap. */
10660 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10661 x_destroy_x_image (ximg
);
10663 img
->width
= width
;
10664 img
->height
= height
;
10670 #endif /* HAVE_PBM */
10673 /***********************************************************************
10675 ***********************************************************************/
10681 /* Function prototypes. */
10683 static int png_image_p
P_ ((Lisp_Object object
));
10684 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
10686 /* The symbol `png' identifying images of this type. */
10690 /* Indices of image specification fields in png_format, below. */
10692 enum png_keyword_index
10701 PNG_HEURISTIC_MASK
,
10705 /* Vector of image_keyword structures describing the format
10706 of valid user-defined image specifications. */
10708 static struct image_keyword png_format
[PNG_LAST
] =
10710 {":type", IMAGE_SYMBOL_VALUE
, 1},
10711 {":data", IMAGE_STRING_VALUE
, 0},
10712 {":file", IMAGE_STRING_VALUE
, 0},
10713 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10714 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10715 {":relief", IMAGE_INTEGER_VALUE
, 0},
10716 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10717 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
10720 /* Structure describing the image type `png'. */
10722 static struct image_type png_type
=
10732 /* Return non-zero if OBJECT is a valid PNG image specification. */
10735 png_image_p (object
)
10736 Lisp_Object object
;
10738 struct image_keyword fmt
[PNG_LAST
];
10739 bcopy (png_format
, fmt
, sizeof fmt
);
10741 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
10742 || (fmt
[PNG_ASCENT
].count
10743 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
10746 /* Must specify either the :data or :file keyword. */
10747 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
10751 /* Error and warning handlers installed when the PNG library
10755 my_png_error (png_ptr
, msg
)
10756 png_struct
*png_ptr
;
10759 xassert (png_ptr
!= NULL
);
10760 image_error ("PNG error: %s", build_string (msg
), Qnil
);
10761 longjmp (png_ptr
->jmpbuf
, 1);
10766 my_png_warning (png_ptr
, msg
)
10767 png_struct
*png_ptr
;
10770 xassert (png_ptr
!= NULL
);
10771 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
10774 /* Memory source for PNG decoding. */
10776 struct png_memory_storage
10778 unsigned char *bytes
; /* The data */
10779 size_t len
; /* How big is it? */
10780 int index
; /* Where are we? */
10784 /* Function set as reader function when reading PNG image from memory.
10785 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
10786 bytes from the input to DATA. */
10789 png_read_from_memory (png_ptr
, data
, length
)
10790 png_structp png_ptr
;
10794 struct png_memory_storage
*tbr
10795 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
10797 if (length
> tbr
->len
- tbr
->index
)
10798 png_error (png_ptr
, "Read error");
10800 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
10801 tbr
->index
= tbr
->index
+ length
;
10804 /* Load PNG image IMG for use on frame F. Value is non-zero if
10812 Lisp_Object file
, specified_file
;
10813 Lisp_Object specified_data
;
10815 XImage
*ximg
, *mask_img
= NULL
;
10816 struct gcpro gcpro1
;
10817 png_struct
*png_ptr
= NULL
;
10818 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
10821 png_byte
*pixels
= NULL
;
10822 png_byte
**rows
= NULL
;
10823 png_uint_32 width
, height
;
10824 int bit_depth
, color_type
, interlace_type
;
10826 png_uint_32 row_bytes
;
10829 double screen_gamma
, image_gamma
;
10831 struct png_memory_storage tbr
; /* Data to be read */
10833 /* Find out what file to load. */
10834 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10835 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10839 if (NILP (specified_data
))
10841 file
= x_find_image_file (specified_file
);
10842 if (!STRINGP (file
))
10844 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10849 /* Open the image file. */
10850 fp
= fopen (XSTRING (file
)->data
, "rb");
10853 image_error ("Cannot open image file `%s'", file
, Qnil
);
10859 /* Check PNG signature. */
10860 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
10861 || !png_check_sig (sig
, sizeof sig
))
10863 image_error ("Not a PNG file:` %s'", file
, Qnil
);
10871 /* Read from memory. */
10872 tbr
.bytes
= XSTRING (specified_data
)->data
;
10873 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
10876 /* Check PNG signature. */
10877 if (tbr
.len
< sizeof sig
10878 || !png_check_sig (tbr
.bytes
, sizeof sig
))
10880 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
10885 /* Need to skip past the signature. */
10886 tbr
.bytes
+= sizeof (sig
);
10889 /* Initialize read and info structs for PNG lib. */
10890 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
10891 my_png_error
, my_png_warning
);
10894 if (fp
) fclose (fp
);
10899 info_ptr
= png_create_info_struct (png_ptr
);
10902 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
10903 if (fp
) fclose (fp
);
10908 end_info
= png_create_info_struct (png_ptr
);
10911 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
10912 if (fp
) fclose (fp
);
10917 /* Set error jump-back. We come back here when the PNG library
10918 detects an error. */
10919 if (setjmp (png_ptr
->jmpbuf
))
10923 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
10926 if (fp
) fclose (fp
);
10931 /* Read image info. */
10932 if (!NILP (specified_data
))
10933 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
10935 png_init_io (png_ptr
, fp
);
10937 png_set_sig_bytes (png_ptr
, sizeof sig
);
10938 png_read_info (png_ptr
, info_ptr
);
10939 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
10940 &interlace_type
, NULL
, NULL
);
10942 /* If image contains simply transparency data, we prefer to
10943 construct a clipping mask. */
10944 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
10949 /* This function is easier to write if we only have to handle
10950 one data format: RGB or RGBA with 8 bits per channel. Let's
10951 transform other formats into that format. */
10953 /* Strip more than 8 bits per channel. */
10954 if (bit_depth
== 16)
10955 png_set_strip_16 (png_ptr
);
10957 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
10959 png_set_expand (png_ptr
);
10961 /* Convert grayscale images to RGB. */
10962 if (color_type
== PNG_COLOR_TYPE_GRAY
10963 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
10964 png_set_gray_to_rgb (png_ptr
);
10966 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
10967 gamma_str
= getenv ("SCREEN_GAMMA");
10968 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
10970 /* Tell the PNG lib to handle gamma correction for us. */
10972 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
10973 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
10974 /* There is a special chunk in the image specifying the gamma. */
10975 png_set_sRGB (png_ptr
, info_ptr
, intent
);
10978 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
10979 /* Image contains gamma information. */
10980 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
10982 /* Use a default of 0.5 for the image gamma. */
10983 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
10985 /* Handle alpha channel by combining the image with a background
10986 color. Do this only if a real alpha channel is supplied. For
10987 simple transparency, we prefer a clipping mask. */
10988 if (!transparent_p
)
10990 png_color_16
*image_background
;
10992 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
10993 /* Image contains a background color with which to
10994 combine the image. */
10995 png_set_background (png_ptr
, image_background
,
10996 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
10999 /* Image does not contain a background color with which
11000 to combine the image data via an alpha channel. Use
11001 the frame's background instead. */
11004 png_color_16 frame_background
;
11007 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
11008 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
11009 XQueryColor (FRAME_W32_DISPLAY (f
), cmap
, &color
);
11012 bzero (&frame_background
, sizeof frame_background
);
11013 frame_background
.red
= color
.red
;
11014 frame_background
.green
= color
.green
;
11015 frame_background
.blue
= color
.blue
;
11017 png_set_background (png_ptr
, &frame_background
,
11018 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
11022 /* Update info structure. */
11023 png_read_update_info (png_ptr
, info_ptr
);
11025 /* Get number of channels. Valid values are 1 for grayscale images
11026 and images with a palette, 2 for grayscale images with transparency
11027 information (alpha channel), 3 for RGB images, and 4 for RGB
11028 images with alpha channel, i.e. RGBA. If conversions above were
11029 sufficient we should only have 3 or 4 channels here. */
11030 channels
= png_get_channels (png_ptr
, info_ptr
);
11031 xassert (channels
== 3 || channels
== 4);
11033 /* Number of bytes needed for one row of the image. */
11034 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
11036 /* Allocate memory for the image. */
11037 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
11038 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
11039 for (i
= 0; i
< height
; ++i
)
11040 rows
[i
] = pixels
+ i
* row_bytes
;
11042 /* Read the entire image. */
11043 png_read_image (png_ptr
, rows
);
11044 png_read_end (png_ptr
, info_ptr
);
11053 /* Create the X image and pixmap. */
11054 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
11061 /* Create an image and pixmap serving as mask if the PNG image
11062 contains an alpha channel. */
11065 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
11066 &mask_img
, &img
->mask
))
11068 x_destroy_x_image (ximg
);
11069 XFreePixmap (FRAME_W32_DISPLAY (f
), img
->pixmap
);
11075 /* Fill the X image and mask from PNG data. */
11076 init_color_table ();
11078 for (y
= 0; y
< height
; ++y
)
11080 png_byte
*p
= rows
[y
];
11082 for (x
= 0; x
< width
; ++x
)
11089 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
11091 /* An alpha channel, aka mask channel, associates variable
11092 transparency with an image. Where other image formats
11093 support binary transparency---fully transparent or fully
11094 opaque---PNG allows up to 254 levels of partial transparency.
11095 The PNG library implements partial transparency by combining
11096 the image with a specified background color.
11098 I'm not sure how to handle this here nicely: because the
11099 background on which the image is displayed may change, for
11100 real alpha channel support, it would be necessary to create
11101 a new image for each possible background.
11103 What I'm doing now is that a mask is created if we have
11104 boolean transparency information. Otherwise I'm using
11105 the frame's background color to combine the image with. */
11110 XPutPixel (mask_img
, x
, y
, *p
> 0);
11116 /* Remember colors allocated for this image. */
11117 img
->colors
= colors_in_color_table (&img
->ncolors
);
11118 free_color_table ();
11121 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
11125 img
->width
= width
;
11126 img
->height
= height
;
11128 /* Put the image into the pixmap, then free the X image and its buffer. */
11129 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11130 x_destroy_x_image (ximg
);
11132 /* Same for the mask. */
11135 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
11136 x_destroy_x_image (mask_img
);
11144 #endif /* HAVE_PNG != 0 */
11148 /***********************************************************************
11150 ***********************************************************************/
11154 /* Work around a warning about HAVE_STDLIB_H being redefined in
11156 #ifdef HAVE_STDLIB_H
11157 #define HAVE_STDLIB_H_1
11158 #undef HAVE_STDLIB_H
11159 #endif /* HAVE_STLIB_H */
11161 #include <jpeglib.h>
11162 #include <jerror.h>
11163 #include <setjmp.h>
11165 #ifdef HAVE_STLIB_H_1
11166 #define HAVE_STDLIB_H 1
11169 static int jpeg_image_p
P_ ((Lisp_Object object
));
11170 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
11172 /* The symbol `jpeg' identifying images of this type. */
11176 /* Indices of image specification fields in gs_format, below. */
11178 enum jpeg_keyword_index
11187 JPEG_HEURISTIC_MASK
,
11191 /* Vector of image_keyword structures describing the format
11192 of valid user-defined image specifications. */
11194 static struct image_keyword jpeg_format
[JPEG_LAST
] =
11196 {":type", IMAGE_SYMBOL_VALUE
, 1},
11197 {":data", IMAGE_STRING_VALUE
, 0},
11198 {":file", IMAGE_STRING_VALUE
, 0},
11199 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11200 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11201 {":relief", IMAGE_INTEGER_VALUE
, 0},
11202 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11203 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
11206 /* Structure describing the image type `jpeg'. */
11208 static struct image_type jpeg_type
=
11218 /* Return non-zero if OBJECT is a valid JPEG image specification. */
11221 jpeg_image_p (object
)
11222 Lisp_Object object
;
11224 struct image_keyword fmt
[JPEG_LAST
];
11226 bcopy (jpeg_format
, fmt
, sizeof fmt
);
11228 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
11229 || (fmt
[JPEG_ASCENT
].count
11230 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
11233 /* Must specify either the :data or :file keyword. */
11234 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
11238 struct my_jpeg_error_mgr
11240 struct jpeg_error_mgr pub
;
11241 jmp_buf setjmp_buffer
;
11245 my_error_exit (cinfo
)
11246 j_common_ptr cinfo
;
11248 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
11249 longjmp (mgr
->setjmp_buffer
, 1);
11252 /* Init source method for JPEG data source manager. Called by
11253 jpeg_read_header() before any data is actually read. See
11254 libjpeg.doc from the JPEG lib distribution. */
11257 our_init_source (cinfo
)
11258 j_decompress_ptr cinfo
;
11263 /* Fill input buffer method for JPEG data source manager. Called
11264 whenever more data is needed. We read the whole image in one step,
11265 so this only adds a fake end of input marker at the end. */
11268 our_fill_input_buffer (cinfo
)
11269 j_decompress_ptr cinfo
;
11271 /* Insert a fake EOI marker. */
11272 struct jpeg_source_mgr
*src
= cinfo
->src
;
11273 static JOCTET buffer
[2];
11275 buffer
[0] = (JOCTET
) 0xFF;
11276 buffer
[1] = (JOCTET
) JPEG_EOI
;
11278 src
->next_input_byte
= buffer
;
11279 src
->bytes_in_buffer
= 2;
11284 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
11285 is the JPEG data source manager. */
11288 our_skip_input_data (cinfo
, num_bytes
)
11289 j_decompress_ptr cinfo
;
11292 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11296 if (num_bytes
> src
->bytes_in_buffer
)
11297 ERREXIT (cinfo
, JERR_INPUT_EOF
);
11299 src
->bytes_in_buffer
-= num_bytes
;
11300 src
->next_input_byte
+= num_bytes
;
11305 /* Method to terminate data source. Called by
11306 jpeg_finish_decompress() after all data has been processed. */
11309 our_term_source (cinfo
)
11310 j_decompress_ptr cinfo
;
11315 /* Set up the JPEG lib for reading an image from DATA which contains
11316 LEN bytes. CINFO is the decompression info structure created for
11317 reading the image. */
11320 jpeg_memory_src (cinfo
, data
, len
)
11321 j_decompress_ptr cinfo
;
11325 struct jpeg_source_mgr
*src
;
11327 if (cinfo
->src
== NULL
)
11329 /* First time for this JPEG object? */
11330 cinfo
->src
= (struct jpeg_source_mgr
*)
11331 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
11332 sizeof (struct jpeg_source_mgr
));
11333 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11334 src
->next_input_byte
= data
;
11337 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11338 src
->init_source
= our_init_source
;
11339 src
->fill_input_buffer
= our_fill_input_buffer
;
11340 src
->skip_input_data
= our_skip_input_data
;
11341 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
11342 src
->term_source
= our_term_source
;
11343 src
->bytes_in_buffer
= len
;
11344 src
->next_input_byte
= data
;
11348 /* Load image IMG for use on frame F. Patterned after example.c
11349 from the JPEG lib. */
11356 struct jpeg_decompress_struct cinfo
;
11357 struct my_jpeg_error_mgr mgr
;
11358 Lisp_Object file
, specified_file
;
11359 Lisp_Object specified_data
;
11362 int row_stride
, x
, y
;
11363 XImage
*ximg
= NULL
;
11365 unsigned long *colors
;
11367 struct gcpro gcpro1
;
11369 /* Open the JPEG file. */
11370 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11371 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11375 if (NILP (specified_data
))
11377 file
= x_find_image_file (specified_file
);
11378 if (!STRINGP (file
))
11380 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11385 fp
= fopen (XSTRING (file
)->data
, "r");
11388 image_error ("Cannot open `%s'", file
, Qnil
);
11394 /* Customize libjpeg's error handling to call my_error_exit when an
11395 error is detected. This function will perform a longjmp. */
11396 mgr
.pub
.error_exit
= my_error_exit
;
11397 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
11399 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
11403 /* Called from my_error_exit. Display a JPEG error. */
11404 char buffer
[JMSG_LENGTH_MAX
];
11405 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
11406 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
11407 build_string (buffer
));
11410 /* Close the input file and destroy the JPEG object. */
11413 jpeg_destroy_decompress (&cinfo
);
11417 /* If we already have an XImage, free that. */
11418 x_destroy_x_image (ximg
);
11420 /* Free pixmap and colors. */
11421 x_clear_image (f
, img
);
11428 /* Create the JPEG decompression object. Let it read from fp.
11429 Read the JPEG image header. */
11430 jpeg_create_decompress (&cinfo
);
11432 if (NILP (specified_data
))
11433 jpeg_stdio_src (&cinfo
, fp
);
11435 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
11436 STRING_BYTES (XSTRING (specified_data
)));
11438 jpeg_read_header (&cinfo
, TRUE
);
11440 /* Customize decompression so that color quantization will be used.
11441 Start decompression. */
11442 cinfo
.quantize_colors
= TRUE
;
11443 jpeg_start_decompress (&cinfo
);
11444 width
= img
->width
= cinfo
.output_width
;
11445 height
= img
->height
= cinfo
.output_height
;
11449 /* Create X image and pixmap. */
11450 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
11454 longjmp (mgr
.setjmp_buffer
, 2);
11457 /* Allocate colors. When color quantization is used,
11458 cinfo.actual_number_of_colors has been set with the number of
11459 colors generated, and cinfo.colormap is a two-dimensional array
11460 of color indices in the range 0..cinfo.actual_number_of_colors.
11461 No more than 255 colors will be generated. */
11465 if (cinfo
.out_color_components
> 2)
11466 ir
= 0, ig
= 1, ib
= 2;
11467 else if (cinfo
.out_color_components
> 1)
11468 ir
= 0, ig
= 1, ib
= 0;
11470 ir
= 0, ig
= 0, ib
= 0;
11472 /* Use the color table mechanism because it handles colors that
11473 cannot be allocated nicely. Such colors will be replaced with
11474 a default color, and we don't have to care about which colors
11475 can be freed safely, and which can't. */
11476 init_color_table ();
11477 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
11480 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
11482 /* Multiply RGB values with 255 because X expects RGB values
11483 in the range 0..0xffff. */
11484 int r
= cinfo
.colormap
[ir
][i
] << 8;
11485 int g
= cinfo
.colormap
[ig
][i
] << 8;
11486 int b
= cinfo
.colormap
[ib
][i
] << 8;
11487 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
11490 /* Remember those colors actually allocated. */
11491 img
->colors
= colors_in_color_table (&img
->ncolors
);
11492 free_color_table ();
11496 row_stride
= width
* cinfo
.output_components
;
11497 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
11499 for (y
= 0; y
< height
; ++y
)
11501 jpeg_read_scanlines (&cinfo
, buffer
, 1);
11502 for (x
= 0; x
< cinfo
.output_width
; ++x
)
11503 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
11507 jpeg_finish_decompress (&cinfo
);
11508 jpeg_destroy_decompress (&cinfo
);
11512 /* Put the image into the pixmap. */
11513 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11514 x_destroy_x_image (ximg
);
11520 #endif /* HAVE_JPEG */
11524 /***********************************************************************
11526 ***********************************************************************/
11530 #include <tiffio.h>
11532 static int tiff_image_p
P_ ((Lisp_Object object
));
11533 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
11535 /* The symbol `tiff' identifying images of this type. */
11539 /* Indices of image specification fields in tiff_format, below. */
11541 enum tiff_keyword_index
11550 TIFF_HEURISTIC_MASK
,
11554 /* Vector of image_keyword structures describing the format
11555 of valid user-defined image specifications. */
11557 static struct image_keyword tiff_format
[TIFF_LAST
] =
11559 {":type", IMAGE_SYMBOL_VALUE
, 1},
11560 {":data", IMAGE_STRING_VALUE
, 0},
11561 {":file", IMAGE_STRING_VALUE
, 0},
11562 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11563 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11564 {":relief", IMAGE_INTEGER_VALUE
, 0},
11565 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11566 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
11569 /* Structure describing the image type `tiff'. */
11571 static struct image_type tiff_type
=
11581 /* Return non-zero if OBJECT is a valid TIFF image specification. */
11584 tiff_image_p (object
)
11585 Lisp_Object object
;
11587 struct image_keyword fmt
[TIFF_LAST
];
11588 bcopy (tiff_format
, fmt
, sizeof fmt
);
11590 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
11591 || (fmt
[TIFF_ASCENT
].count
11592 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
11595 /* Must specify either the :data or :file keyword. */
11596 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
11600 /* Reading from a memory buffer for TIFF images Based on the PNG
11601 memory source, but we have to provide a lot of extra functions.
11604 We really only need to implement read and seek, but I am not
11605 convinced that the TIFF library is smart enough not to destroy
11606 itself if we only hand it the function pointers we need to
11611 unsigned char *bytes
;
11615 tiff_memory_source
;
11618 tiff_read_from_memory (data
, buf
, size
)
11623 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11625 if (size
> src
->len
- src
->index
)
11626 return (size_t) -1;
11627 bcopy (src
->bytes
+ src
->index
, buf
, size
);
11628 src
->index
+= size
;
11633 tiff_write_from_memory (data
, buf
, size
)
11638 return (size_t) -1;
11642 tiff_seek_in_memory (data
, off
, whence
)
11647 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11652 case SEEK_SET
: /* Go from beginning of source. */
11656 case SEEK_END
: /* Go from end of source. */
11657 idx
= src
->len
+ off
;
11660 case SEEK_CUR
: /* Go from current position. */
11661 idx
= src
->index
+ off
;
11664 default: /* Invalid `whence'. */
11668 if (idx
> src
->len
|| idx
< 0)
11676 tiff_close_memory (data
)
11684 tiff_mmap_memory (data
, pbase
, psize
)
11689 /* It is already _IN_ memory. */
11694 tiff_unmap_memory (data
, base
, size
)
11699 /* We don't need to do this. */
11703 tiff_size_of_memory (data
)
11706 return ((tiff_memory_source
*) data
)->len
;
11711 tiff_error_handler (title
, format
, ap
)
11712 const char *title
, *format
;
11718 len
= sprintf (buf
, "TIFF error: %s ", title
);
11719 vsprintf (buf
+ len
, format
, ap
);
11720 add_to_log (buf
, Qnil
, Qnil
);
11725 tiff_warning_handler (title
, format
, ap
)
11726 const char *title
, *format
;
11732 len
= sprintf (buf
, "TIFF warning: %s ", title
);
11733 vsprintf (buf
+ len
, format
, ap
);
11734 add_to_log (buf
, Qnil
, Qnil
);
11738 /* Load TIFF image IMG for use on frame F. Value is non-zero if
11746 Lisp_Object file
, specified_file
;
11747 Lisp_Object specified_data
;
11749 int width
, height
, x
, y
;
11753 struct gcpro gcpro1
;
11754 tiff_memory_source memsrc
;
11756 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11757 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11761 TIFFSetErrorHandler (tiff_error_handler
);
11762 TIFFSetWarningHandler (tiff_warning_handler
);
11764 if (NILP (specified_data
))
11766 /* Read from a file */
11767 file
= x_find_image_file (specified_file
);
11768 if (!STRINGP (file
))
11770 image_error ("Cannot find image file `%s'", file
, Qnil
);
11775 /* Try to open the image file. */
11776 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
11779 image_error ("Cannot open `%s'", file
, Qnil
);
11786 /* Memory source! */
11787 memsrc
.bytes
= XSTRING (specified_data
)->data
;
11788 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
11791 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
11792 (TIFFReadWriteProc
) tiff_read_from_memory
,
11793 (TIFFReadWriteProc
) tiff_write_from_memory
,
11794 tiff_seek_in_memory
,
11796 tiff_size_of_memory
,
11798 tiff_unmap_memory
);
11802 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
11808 /* Get width and height of the image, and allocate a raster buffer
11809 of width x height 32-bit values. */
11810 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
11811 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
11812 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
11814 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
11818 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
11824 /* Create the X image and pixmap. */
11825 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11832 /* Initialize the color table. */
11833 init_color_table ();
11835 /* Process the pixel raster. Origin is in the lower-left corner. */
11836 for (y
= 0; y
< height
; ++y
)
11838 uint32
*row
= buf
+ y
* width
;
11840 for (x
= 0; x
< width
; ++x
)
11842 uint32 abgr
= row
[x
];
11843 int r
= TIFFGetR (abgr
) << 8;
11844 int g
= TIFFGetG (abgr
) << 8;
11845 int b
= TIFFGetB (abgr
) << 8;
11846 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
11850 /* Remember the colors allocated for the image. Free the color table. */
11851 img
->colors
= colors_in_color_table (&img
->ncolors
);
11852 free_color_table ();
11854 /* Put the image into the pixmap, then free the X image and its buffer. */
11855 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11856 x_destroy_x_image (ximg
);
11859 img
->width
= width
;
11860 img
->height
= height
;
11866 #endif /* HAVE_TIFF != 0 */
11870 /***********************************************************************
11872 ***********************************************************************/
11876 #include <gif_lib.h>
11878 static int gif_image_p
P_ ((Lisp_Object object
));
11879 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
11881 /* The symbol `gif' identifying images of this type. */
11885 /* Indices of image specification fields in gif_format, below. */
11887 enum gif_keyword_index
11896 GIF_HEURISTIC_MASK
,
11901 /* Vector of image_keyword structures describing the format
11902 of valid user-defined image specifications. */
11904 static struct image_keyword gif_format
[GIF_LAST
] =
11906 {":type", IMAGE_SYMBOL_VALUE
, 1},
11907 {":data", IMAGE_STRING_VALUE
, 0},
11908 {":file", IMAGE_STRING_VALUE
, 0},
11909 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11910 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11911 {":relief", IMAGE_INTEGER_VALUE
, 0},
11912 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11913 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11914 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
11917 /* Structure describing the image type `gif'. */
11919 static struct image_type gif_type
=
11928 /* Return non-zero if OBJECT is a valid GIF image specification. */
11931 gif_image_p (object
)
11932 Lisp_Object object
;
11934 struct image_keyword fmt
[GIF_LAST
];
11935 bcopy (gif_format
, fmt
, sizeof fmt
);
11937 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
11938 || (fmt
[GIF_ASCENT
].count
11939 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
11942 /* Must specify either the :data or :file keyword. */
11943 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
11946 /* Reading a GIF image from memory
11947 Based on the PNG memory stuff to a certain extent. */
11951 unsigned char *bytes
;
11957 /* Make the current memory source available to gif_read_from_memory.
11958 It's done this way because not all versions of libungif support
11959 a UserData field in the GifFileType structure. */
11960 static gif_memory_source
*current_gif_memory_src
;
11963 gif_read_from_memory (file
, buf
, len
)
11968 gif_memory_source
*src
= current_gif_memory_src
;
11970 if (len
> src
->len
- src
->index
)
11973 bcopy (src
->bytes
+ src
->index
, buf
, len
);
11979 /* Load GIF image IMG for use on frame F. Value is non-zero if
11987 Lisp_Object file
, specified_file
;
11988 Lisp_Object specified_data
;
11989 int rc
, width
, height
, x
, y
, i
;
11991 ColorMapObject
*gif_color_map
;
11992 unsigned long pixel_colors
[256];
11994 struct gcpro gcpro1
;
11996 int ino
, image_left
, image_top
, image_width
, image_height
;
11997 gif_memory_source memsrc
;
11998 unsigned char *raster
;
12000 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12001 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12005 if (NILP (specified_data
))
12007 file
= x_find_image_file (specified_file
);
12008 if (!STRINGP (file
))
12010 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
12015 /* Open the GIF file. */
12016 gif
= DGifOpenFileName (XSTRING (file
)->data
);
12019 image_error ("Cannot open `%s'", file
, Qnil
);
12026 /* Read from memory! */
12027 current_gif_memory_src
= &memsrc
;
12028 memsrc
.bytes
= XSTRING (specified_data
)->data
;
12029 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
12032 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
12035 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
12041 /* Read entire contents. */
12042 rc
= DGifSlurp (gif
);
12043 if (rc
== GIF_ERROR
)
12045 image_error ("Error reading `%s'", img
->spec
, Qnil
);
12046 DGifCloseFile (gif
);
12051 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
12052 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
12053 if (ino
>= gif
->ImageCount
)
12055 image_error ("Invalid image number `%s' in image `%s'",
12057 DGifCloseFile (gif
);
12062 width
= img
->width
= gif
->SWidth
;
12063 height
= img
->height
= gif
->SHeight
;
12067 /* Create the X image and pixmap. */
12068 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12071 DGifCloseFile (gif
);
12076 /* Allocate colors. */
12077 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
12078 if (!gif_color_map
)
12079 gif_color_map
= gif
->SColorMap
;
12080 init_color_table ();
12081 bzero (pixel_colors
, sizeof pixel_colors
);
12083 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
12085 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
12086 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
12087 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
12088 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
12091 img
->colors
= colors_in_color_table (&img
->ncolors
);
12092 free_color_table ();
12094 /* Clear the part of the screen image that are not covered by
12095 the image from the GIF file. Full animated GIF support
12096 requires more than can be done here (see the gif89 spec,
12097 disposal methods). Let's simply assume that the part
12098 not covered by a sub-image is in the frame's background color. */
12099 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
12100 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
12101 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
12102 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
12104 for (y
= 0; y
< image_top
; ++y
)
12105 for (x
= 0; x
< width
; ++x
)
12106 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12108 for (y
= image_top
+ image_height
; y
< height
; ++y
)
12109 for (x
= 0; x
< width
; ++x
)
12110 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12112 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
12114 for (x
= 0; x
< image_left
; ++x
)
12115 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12116 for (x
= image_left
+ image_width
; x
< width
; ++x
)
12117 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12120 /* Read the GIF image into the X image. We use a local variable
12121 `raster' here because RasterBits below is a char *, and invites
12122 problems with bytes >= 0x80. */
12123 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
12125 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
12127 static int interlace_start
[] = {0, 4, 2, 1};
12128 static int interlace_increment
[] = {8, 8, 4, 2};
12130 int row
= interlace_start
[0];
12134 for (y
= 0; y
< image_height
; y
++)
12136 if (row
>= image_height
)
12138 row
= interlace_start
[++pass
];
12139 while (row
>= image_height
)
12140 row
= interlace_start
[++pass
];
12143 for (x
= 0; x
< image_width
; x
++)
12145 int i
= raster
[(y
* image_width
) + x
];
12146 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
12150 row
+= interlace_increment
[pass
];
12155 for (y
= 0; y
< image_height
; ++y
)
12156 for (x
= 0; x
< image_width
; ++x
)
12158 int i
= raster
[y
* image_width
+ x
];
12159 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
12163 DGifCloseFile (gif
);
12165 /* Put the image into the pixmap, then free the X image and its buffer. */
12166 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12167 x_destroy_x_image (ximg
);
12174 #endif /* HAVE_GIF != 0 */
12178 /***********************************************************************
12180 ***********************************************************************/
12182 Lisp_Object Qpostscript
;
12184 #ifdef HAVE_GHOSTSCRIPT
12185 static int gs_image_p
P_ ((Lisp_Object object
));
12186 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
12187 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
12189 /* The symbol `postscript' identifying images of this type. */
12191 /* Keyword symbols. */
12193 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
12195 /* Indices of image specification fields in gs_format, below. */
12197 enum gs_keyword_index
12213 /* Vector of image_keyword structures describing the format
12214 of valid user-defined image specifications. */
12216 static struct image_keyword gs_format
[GS_LAST
] =
12218 {":type", IMAGE_SYMBOL_VALUE
, 1},
12219 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12220 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12221 {":file", IMAGE_STRING_VALUE
, 1},
12222 {":loader", IMAGE_FUNCTION_VALUE
, 0},
12223 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
12224 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
12225 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12226 {":relief", IMAGE_INTEGER_VALUE
, 0},
12227 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12228 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
12231 /* Structure describing the image type `ghostscript'. */
12233 static struct image_type gs_type
=
12243 /* Free X resources of Ghostscript image IMG which is used on frame F. */
12246 gs_clear_image (f
, img
)
12250 /* IMG->data.ptr_val may contain a recorded colormap. */
12251 xfree (img
->data
.ptr_val
);
12252 x_clear_image (f
, img
);
12256 /* Return non-zero if OBJECT is a valid Ghostscript image
12260 gs_image_p (object
)
12261 Lisp_Object object
;
12263 struct image_keyword fmt
[GS_LAST
];
12267 bcopy (gs_format
, fmt
, sizeof fmt
);
12269 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
12270 || (fmt
[GS_ASCENT
].count
12271 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
12274 /* Bounding box must be a list or vector containing 4 integers. */
12275 tem
= fmt
[GS_BOUNDING_BOX
].value
;
12278 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
12279 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
12284 else if (VECTORP (tem
))
12286 if (XVECTOR (tem
)->size
!= 4)
12288 for (i
= 0; i
< 4; ++i
)
12289 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
12299 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
12308 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
12309 struct gcpro gcpro1
, gcpro2
;
12311 double in_width
, in_height
;
12312 Lisp_Object pixel_colors
= Qnil
;
12314 /* Compute pixel size of pixmap needed from the given size in the
12315 image specification. Sizes in the specification are in pt. 1 pt
12316 = 1/72 in, xdpi and ydpi are stored in the frame's X display
12318 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
12319 in_width
= XFASTINT (pt_width
) / 72.0;
12320 img
->width
= in_width
* FRAME_W32_DISPLAY_INFO (f
)->resx
;
12321 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
12322 in_height
= XFASTINT (pt_height
) / 72.0;
12323 img
->height
= in_height
* FRAME_W32_DISPLAY_INFO (f
)->resy
;
12325 /* Create the pixmap. */
12327 xassert (img
->pixmap
== 0);
12328 img
->pixmap
= XCreatePixmap (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12329 img
->width
, img
->height
,
12330 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
12335 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
12339 /* Call the loader to fill the pixmap. It returns a process object
12340 if successful. We do not record_unwind_protect here because
12341 other places in redisplay like calling window scroll functions
12342 don't either. Let the Lisp loader use `unwind-protect' instead. */
12343 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
12345 sprintf (buffer
, "%lu %lu",
12346 (unsigned long) FRAME_W32_WINDOW (f
),
12347 (unsigned long) img
->pixmap
);
12348 window_and_pixmap_id
= build_string (buffer
);
12350 sprintf (buffer
, "%lu %lu",
12351 FRAME_FOREGROUND_PIXEL (f
),
12352 FRAME_BACKGROUND_PIXEL (f
));
12353 pixel_colors
= build_string (buffer
);
12355 XSETFRAME (frame
, f
);
12356 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
12358 loader
= intern ("gs-load-image");
12360 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
12361 make_number (img
->width
),
12362 make_number (img
->height
),
12363 window_and_pixmap_id
,
12366 return PROCESSP (img
->data
.lisp_val
);
12370 /* Kill the Ghostscript process that was started to fill PIXMAP on
12371 frame F. Called from XTread_socket when receiving an event
12372 telling Emacs that Ghostscript has finished drawing. */
12375 x_kill_gs_process (pixmap
, f
)
12379 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
12383 /* Find the image containing PIXMAP. */
12384 for (i
= 0; i
< c
->used
; ++i
)
12385 if (c
->images
[i
]->pixmap
== pixmap
)
12388 /* Should someone in between have cleared the image cache, for
12389 instance, give up. */
12393 /* Kill the GS process. We should have found PIXMAP in the image
12394 cache and its image should contain a process object. */
12395 img
= c
->images
[i
];
12396 xassert (PROCESSP (img
->data
.lisp_val
));
12397 Fkill_process (img
->data
.lisp_val
, Qnil
);
12398 img
->data
.lisp_val
= Qnil
;
12400 /* On displays with a mutable colormap, figure out the colors
12401 allocated for the image by looking at the pixels of an XImage for
12403 class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
12404 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
12410 /* Try to get an XImage for img->pixmep. */
12411 ximg
= XGetImage (FRAME_W32_DISPLAY (f
), img
->pixmap
,
12412 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
12417 /* Initialize the color table. */
12418 init_color_table ();
12420 /* For each pixel of the image, look its color up in the
12421 color table. After having done so, the color table will
12422 contain an entry for each color used by the image. */
12423 for (y
= 0; y
< img
->height
; ++y
)
12424 for (x
= 0; x
< img
->width
; ++x
)
12426 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
12427 lookup_pixel_color (f
, pixel
);
12430 /* Record colors in the image. Free color table and XImage. */
12431 img
->colors
= colors_in_color_table (&img
->ncolors
);
12432 free_color_table ();
12433 XDestroyImage (ximg
);
12435 #if 0 /* This doesn't seem to be the case. If we free the colors
12436 here, we get a BadAccess later in x_clear_image when
12437 freeing the colors. */
12438 /* We have allocated colors once, but Ghostscript has also
12439 allocated colors on behalf of us. So, to get the
12440 reference counts right, free them once. */
12442 x_free_colors (FRAME_W32_DISPLAY (f
), cmap
,
12443 img
->colors
, img
->ncolors
, 0);
12447 image_error ("Cannot get X image of `%s'; colors will not be freed",
12453 /* Now that we have the pixmap, compute mask and transform the
12454 image if requested. */
12456 postprocess_image (f
, img
);
12460 #endif /* HAVE_GHOSTSCRIPT */
12463 /***********************************************************************
12465 ***********************************************************************/
12467 DEFUN ("x-change-window-property", Fx_change_window_property
,
12468 Sx_change_window_property
, 2, 3, 0,
12469 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
12470 PROP and VALUE must be strings. FRAME nil or omitted means use the
12471 selected frame. Value is VALUE. */)
12472 (prop
, value
, frame
)
12473 Lisp_Object frame
, prop
, value
;
12475 #if 0 /* TODO : port window properties to W32 */
12476 struct frame
*f
= check_x_frame (frame
);
12479 CHECK_STRING (prop
);
12480 CHECK_STRING (value
);
12483 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12484 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12485 prop_atom
, XA_STRING
, 8, PropModeReplace
,
12486 XSTRING (value
)->data
, XSTRING (value
)->size
);
12488 /* Make sure the property is set when we return. */
12489 XFlush (FRAME_W32_DISPLAY (f
));
12498 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
12499 Sx_delete_window_property
, 1, 2, 0,
12500 doc
: /* Remove window property PROP from X window of FRAME.
12501 FRAME nil or omitted means use the selected frame. Value is PROP. */)
12503 Lisp_Object prop
, frame
;
12505 #if 0 /* TODO : port window properties to W32 */
12507 struct frame
*f
= check_x_frame (frame
);
12510 CHECK_STRING (prop
);
12512 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12513 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
12515 /* Make sure the property is removed when we return. */
12516 XFlush (FRAME_W32_DISPLAY (f
));
12524 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
12526 doc
: /* Value is the value of window property PROP on FRAME.
12527 If FRAME is nil or omitted, use the selected frame. Value is nil
12528 if FRAME hasn't a property with name PROP or if PROP has no string
12531 Lisp_Object prop
, frame
;
12533 #if 0 /* TODO : port window properties to W32 */
12535 struct frame
*f
= check_x_frame (frame
);
12538 Lisp_Object prop_value
= Qnil
;
12539 char *tmp_data
= NULL
;
12542 unsigned long actual_size
, bytes_remaining
;
12544 CHECK_STRING (prop
);
12546 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12547 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12548 prop_atom
, 0, 0, False
, XA_STRING
,
12549 &actual_type
, &actual_format
, &actual_size
,
12550 &bytes_remaining
, (unsigned char **) &tmp_data
);
12553 int size
= bytes_remaining
;
12558 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12559 prop_atom
, 0, bytes_remaining
,
12561 &actual_type
, &actual_format
,
12562 &actual_size
, &bytes_remaining
,
12563 (unsigned char **) &tmp_data
);
12565 prop_value
= make_string (tmp_data
, size
);
12580 /***********************************************************************
12582 ***********************************************************************/
12584 /* If non-null, an asynchronous timer that, when it expires, displays
12585 an hourglass cursor on all frames. */
12587 static struct atimer
*hourglass_atimer
;
12589 /* Non-zero means an hourglass cursor is currently shown. */
12591 static int hourglass_shown_p
;
12593 /* Number of seconds to wait before displaying an hourglass cursor. */
12595 static Lisp_Object Vhourglass_delay
;
12597 /* Default number of seconds to wait before displaying an hourglass
12600 #define DEFAULT_HOURGLASS_DELAY 1
12602 /* Function prototypes. */
12604 static void show_hourglass
P_ ((struct atimer
*));
12605 static void hide_hourglass
P_ ((void));
12608 /* Cancel a currently active hourglass timer, and start a new one. */
12613 #if 0 /* TODO: cursor shape changes. */
12615 int secs
, usecs
= 0;
12617 cancel_hourglass ();
12619 if (INTEGERP (Vhourglass_delay
)
12620 && XINT (Vhourglass_delay
) > 0)
12621 secs
= XFASTINT (Vhourglass_delay
);
12622 else if (FLOATP (Vhourglass_delay
)
12623 && XFLOAT_DATA (Vhourglass_delay
) > 0)
12626 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
12627 secs
= XFASTINT (tem
);
12628 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
12631 secs
= DEFAULT_HOURGLASS_DELAY
;
12633 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
12634 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
12635 show_hourglass
, NULL
);
12640 /* Cancel the hourglass cursor timer if active, hide an hourglass
12641 cursor if shown. */
12644 cancel_hourglass ()
12646 if (hourglass_atimer
)
12648 cancel_atimer (hourglass_atimer
);
12649 hourglass_atimer
= NULL
;
12652 if (hourglass_shown_p
)
12657 /* Timer function of hourglass_atimer. TIMER is equal to
12660 Display an hourglass cursor on all frames by mapping the frames'
12661 hourglass_window. Set the hourglass_p flag in the frames'
12662 output_data.x structure to indicate that an hourglass cursor is
12663 shown on the frames. */
12666 show_hourglass (timer
)
12667 struct atimer
*timer
;
12669 #if 0 /* TODO: cursor shape changes. */
12670 /* The timer implementation will cancel this timer automatically
12671 after this function has run. Set hourglass_atimer to null
12672 so that we know the timer doesn't have to be canceled. */
12673 hourglass_atimer
= NULL
;
12675 if (!hourglass_shown_p
)
12677 Lisp_Object rest
, frame
;
12681 FOR_EACH_FRAME (rest
, frame
)
12682 if (FRAME_W32_P (XFRAME (frame
)))
12684 struct frame
*f
= XFRAME (frame
);
12686 f
->output_data
.w32
->hourglass_p
= 1;
12688 if (!f
->output_data
.w32
->hourglass_window
)
12690 unsigned long mask
= CWCursor
;
12691 XSetWindowAttributes attrs
;
12693 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
12695 f
->output_data
.w32
->hourglass_window
12696 = XCreateWindow (FRAME_X_DISPLAY (f
),
12697 FRAME_OUTER_WINDOW (f
),
12698 0, 0, 32000, 32000, 0, 0,
12704 XMapRaised (FRAME_X_DISPLAY (f
),
12705 f
->output_data
.w32
->hourglass_window
);
12706 XFlush (FRAME_X_DISPLAY (f
));
12709 hourglass_shown_p
= 1;
12716 /* Hide the hourglass cursor on all frames, if it is currently shown. */
12721 #if 0 /* TODO: cursor shape changes. */
12722 if (hourglass_shown_p
)
12724 Lisp_Object rest
, frame
;
12727 FOR_EACH_FRAME (rest
, frame
)
12729 struct frame
*f
= XFRAME (frame
);
12731 if (FRAME_W32_P (f
)
12732 /* Watch out for newly created frames. */
12733 && f
->output_data
.x
->hourglass_window
)
12735 XUnmapWindow (FRAME_X_DISPLAY (f
),
12736 f
->output_data
.x
->hourglass_window
);
12737 /* Sync here because XTread_socket looks at the
12738 hourglass_p flag that is reset to zero below. */
12739 XSync (FRAME_X_DISPLAY (f
), False
);
12740 f
->output_data
.x
->hourglass_p
= 0;
12744 hourglass_shown_p
= 0;
12752 /***********************************************************************
12754 ***********************************************************************/
12756 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
12757 Lisp_Object
, Lisp_Object
));
12758 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
12759 Lisp_Object
, int, int, int *, int *));
12761 /* The frame of a currently visible tooltip. */
12763 Lisp_Object tip_frame
;
12765 /* If non-nil, a timer started that hides the last tooltip when it
12768 Lisp_Object tip_timer
;
12771 /* If non-nil, a vector of 3 elements containing the last args
12772 with which x-show-tip was called. See there. */
12774 Lisp_Object last_show_tip_args
;
12776 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
12778 Lisp_Object Vx_max_tooltip_size
;
12782 unwind_create_tip_frame (frame
)
12785 Lisp_Object deleted
;
12787 deleted
= unwind_create_frame (frame
);
12788 if (EQ (deleted
, Qt
))
12798 /* Create a frame for a tooltip on the display described by DPYINFO.
12799 PARMS is a list of frame parameters. TEXT is the string to
12800 display in the tip frame. Value is the frame.
12802 Note that functions called here, esp. x_default_parameter can
12803 signal errors, for instance when a specified color name is
12804 undefined. We have to make sure that we're in a consistent state
12805 when this happens. */
12808 x_create_tip_frame (dpyinfo
, parms
, text
)
12809 struct w32_display_info
*dpyinfo
;
12810 Lisp_Object parms
, text
;
12812 #if 0 /* TODO : w32 version */
12814 Lisp_Object frame
, tem
;
12816 long window_prompting
= 0;
12818 int count
= BINDING_STACK_SIZE ();
12819 struct gcpro gcpro1
, gcpro2
, gcpro3
;
12821 int face_change_count_before
= face_change_count
;
12822 Lisp_Object buffer
;
12823 struct buffer
*old_buffer
;
12827 /* Use this general default value to start with until we know if
12828 this frame has a specified name. */
12829 Vx_resource_name
= Vinvocation_name
;
12831 #ifdef MULTI_KBOARD
12832 kb
= dpyinfo
->kboard
;
12834 kb
= &the_only_kboard
;
12837 /* Get the name of the frame to use for resource lookup. */
12838 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
12839 if (!STRINGP (name
)
12840 && !EQ (name
, Qunbound
)
12842 error ("Invalid frame name--not a string or nil");
12843 Vx_resource_name
= name
;
12846 GCPRO3 (parms
, name
, frame
);
12847 f
= make_frame (1);
12848 XSETFRAME (frame
, f
);
12850 buffer
= Fget_buffer_create (build_string (" *tip*"));
12851 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
12852 old_buffer
= current_buffer
;
12853 set_buffer_internal_1 (XBUFFER (buffer
));
12854 current_buffer
->truncate_lines
= Qnil
;
12856 Finsert (1, &text
);
12857 set_buffer_internal_1 (old_buffer
);
12859 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
12860 record_unwind_protect (unwind_create_tip_frame
, frame
);
12862 /* By setting the output method, we're essentially saying that
12863 the frame is live, as per FRAME_LIVE_P. If we get a signal
12864 from this point on, x_destroy_window might screw up reference
12866 f
->output_method
= output_w32
;
12867 f
->output_data
.w32
=
12868 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
12869 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
12871 f
->output_data
.w32
->icon_bitmap
= -1;
12873 f
->output_data
.w32
->fontset
= -1;
12874 f
->icon_name
= Qnil
;
12877 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
12878 dpyinfo_refcount
= dpyinfo
->reference_count
;
12879 #endif /* GLYPH_DEBUG */
12880 #ifdef MULTI_KBOARD
12881 FRAME_KBOARD (f
) = kb
;
12883 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
12884 f
->output_data
.w32
->explicit_parent
= 0;
12886 /* Set the name; the functions to which we pass f expect the name to
12888 if (EQ (name
, Qunbound
) || NILP (name
))
12890 f
->name
= build_string (dpyinfo
->x_id_name
);
12891 f
->explicit_name
= 0;
12896 f
->explicit_name
= 1;
12897 /* use the frame's title when getting resources for this frame. */
12898 specbind (Qx_resource_name
, name
);
12901 /* Extract the window parameters from the supplied values
12902 that are needed to determine window geometry. */
12906 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
12909 /* First, try whatever font the caller has specified. */
12910 if (STRINGP (font
))
12912 tem
= Fquery_fontset (font
, Qnil
);
12914 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
12916 font
= x_new_font (f
, XSTRING (font
)->data
);
12919 /* Try out a font which we hope has bold and italic variations. */
12920 if (!STRINGP (font
))
12921 font
= x_new_font (f
, "-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
12922 if (!STRINGP (font
))
12923 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12924 if (! STRINGP (font
))
12925 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12926 if (! STRINGP (font
))
12927 /* This was formerly the first thing tried, but it finds too many fonts
12928 and takes too long. */
12929 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
12930 /* If those didn't work, look for something which will at least work. */
12931 if (! STRINGP (font
))
12932 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
12934 if (! STRINGP (font
))
12935 font
= build_string ("fixed");
12937 x_default_parameter (f
, parms
, Qfont
, font
,
12938 "font", "Font", RES_TYPE_STRING
);
12941 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
12942 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
12944 /* This defaults to 2 in order to match xterm. We recognize either
12945 internalBorderWidth or internalBorder (which is what xterm calls
12947 if (NILP (Fassq (Qinternal_border_width
, parms
)))
12951 value
= w32_get_arg (parms
, Qinternal_border_width
,
12952 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
12953 if (! EQ (value
, Qunbound
))
12954 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
12958 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
12959 "internalBorderWidth", "internalBorderWidth",
12962 /* Also do the stuff which must be set before the window exists. */
12963 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
12964 "foreground", "Foreground", RES_TYPE_STRING
);
12965 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
12966 "background", "Background", RES_TYPE_STRING
);
12967 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
12968 "pointerColor", "Foreground", RES_TYPE_STRING
);
12969 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
12970 "cursorColor", "Foreground", RES_TYPE_STRING
);
12971 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
12972 "borderColor", "BorderColor", RES_TYPE_STRING
);
12974 /* Init faces before x_default_parameter is called for scroll-bar
12975 parameters because that function calls x_set_scroll_bar_width,
12976 which calls change_frame_size, which calls Fset_window_buffer,
12977 which runs hooks, which call Fvertical_motion. At the end, we
12978 end up in init_iterator with a null face cache, which should not
12980 init_frame_faces (f
);
12982 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
12983 window_prompting
= x_figure_window_size (f
, parms
);
12985 if (window_prompting
& XNegative
)
12987 if (window_prompting
& YNegative
)
12988 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
12990 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
12994 if (window_prompting
& YNegative
)
12995 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
12997 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
13000 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
13002 XSetWindowAttributes attrs
;
13003 unsigned long mask
;
13006 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
13007 if (DoesSaveUnders (dpyinfo
->screen
))
13008 mask
|= CWSaveUnder
;
13010 /* Window managers looks at the override-redirect flag to
13011 determine whether or net to give windows a decoration (Xlib
13013 attrs
.override_redirect
= True
;
13014 attrs
.save_under
= True
;
13015 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
13016 /* Arrange for getting MapNotify and UnmapNotify events. */
13017 attrs
.event_mask
= StructureNotifyMask
;
13019 = FRAME_W32_WINDOW (f
)
13020 = XCreateWindow (FRAME_W32_DISPLAY (f
),
13021 FRAME_W32_DISPLAY_INFO (f
)->root_window
,
13022 /* x, y, width, height */
13026 CopyFromParent
, InputOutput
, CopyFromParent
,
13033 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
13034 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
13035 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
13036 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
13037 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
13038 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
13040 /* Dimensions, especially f->height, must be done via change_frame_size.
13041 Change will not be effected unless different from the current
13044 height
= f
->height
;
13046 SET_FRAME_WIDTH (f
, 0);
13047 change_frame_size (f
, height
, width
, 1, 0, 0);
13049 /* Set up faces after all frame parameters are known. This call
13050 also merges in face attributes specified for new frames.
13052 Frame parameters may be changed if .Xdefaults contains
13053 specifications for the default font. For example, if there is an
13054 `Emacs.default.attributeBackground: pink', the `background-color'
13055 attribute of the frame get's set, which let's the internal border
13056 of the tooltip frame appear in pink. Prevent this. */
13058 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
13060 /* Set tip_frame here, so that */
13062 call1 (Qface_set_after_frame_default
, frame
);
13064 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
13065 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
13073 /* It is now ok to make the frame official even if we get an error
13074 below. And the frame needs to be on Vframe_list or making it
13075 visible won't work. */
13076 Vframe_list
= Fcons (frame
, Vframe_list
);
13078 /* Now that the frame is official, it counts as a reference to
13080 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
13082 /* Setting attributes of faces of the tooltip frame from resources
13083 and similar will increment face_change_count, which leads to the
13084 clearing of all current matrices. Since this isn't necessary
13085 here, avoid it by resetting face_change_count to the value it
13086 had before we created the tip frame. */
13087 face_change_count
= face_change_count_before
;
13089 /* Discard the unwind_protect. */
13090 return unbind_to (count
, frame
);
13096 /* Compute where to display tip frame F. PARMS is the list of frame
13097 parameters for F. DX and DY are specified offsets from the current
13098 location of the mouse. WIDTH and HEIGHT are the width and height
13099 of the tooltip. Return coordinates relative to the root window of
13100 the display in *ROOT_X, and *ROOT_Y. */
13103 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
13105 Lisp_Object parms
, dx
, dy
;
13107 int *root_x
, *root_y
;
13109 #ifdef TODO /* Tool tips not supported. */
13110 Lisp_Object left
, top
;
13112 Window root
, child
;
13115 /* User-specified position? */
13116 left
= Fcdr (Fassq (Qleft
, parms
));
13117 top
= Fcdr (Fassq (Qtop
, parms
));
13119 /* Move the tooltip window where the mouse pointer is. Resize and
13121 if (!INTEGERP (left
) && !INTEGERP (top
))
13124 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
13125 &root
, &child
, root_x
, root_y
, &win_x
, &win_y
, &pmask
);
13129 if (INTEGERP (top
))
13130 *root_y
= XINT (top
);
13131 else if (*root_y
+ XINT (dy
) - height
< 0)
13132 *root_y
-= XINT (dy
);
13136 *root_y
+= XINT (dy
);
13139 if (INTEGERP (left
))
13140 *root_x
= XINT (left
);
13141 else if (*root_x
+ XINT (dx
) + width
> FRAME_X_DISPLAY_INFO (f
)->width
)
13142 *root_x
-= width
+ XINT (dx
);
13144 *root_x
+= XINT (dx
);
13146 #endif /* Tooltip support. */
13150 #ifdef TODO /* Tooltip support not complete. */
13151 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
13152 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
13153 A tooltip window is a small window displaying a string.
13155 FRAME nil or omitted means use the selected frame.
13157 PARMS is an optional list of frame parameters which can be
13158 used to change the tooltip's appearance.
13160 Automatically hide the tooltip after TIMEOUT seconds.
13161 TIMEOUT nil means use the default timeout of 5 seconds.
13163 If the list of frame parameters PARAMS contains a `left' parameters,
13164 the tooltip is displayed at that x-position. Otherwise it is
13165 displayed at the mouse position, with offset DX added (default is 5 if
13166 DX isn't specified). Likewise for the y-position; if a `top' frame
13167 parameter is specified, it determines the y-position of the tooltip
13168 window, otherwise it is displayed at the mouse position, with offset
13169 DY added (default is -10).
13171 A tooltip's maximum size is specified by `x-max-tooltip-size'.
13172 Text larger than the specified size is clipped. */)
13173 (string
, frame
, parms
, timeout
, dx
, dy
)
13174 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
13178 Lisp_Object buffer
, top
, left
, max_width
, max_height
;
13179 int root_x
, root_y
;
13180 struct buffer
*old_buffer
;
13181 struct text_pos pos
;
13182 int i
, width
, height
;
13183 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
13184 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
13185 int count
= specpdl_ptr
- specpdl
;
13187 specbind (Qinhibit_redisplay
, Qt
);
13189 GCPRO4 (string
, parms
, frame
, timeout
);
13191 CHECK_STRING (string
);
13192 f
= check_x_frame (frame
);
13193 if (NILP (timeout
))
13194 timeout
= make_number (5);
13196 CHECK_NATNUM (timeout
);
13199 dx
= make_number (5);
13204 dy
= make_number (-10);
13208 if (NILP (last_show_tip_args
))
13209 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
13211 if (!NILP (tip_frame
))
13213 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
13214 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
13215 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
13217 if (EQ (frame
, last_frame
)
13218 && !NILP (Fequal (last_string
, string
))
13219 && !NILP (Fequal (last_parms
, parms
)))
13221 struct frame
*f
= XFRAME (tip_frame
);
13223 /* Only DX and DY have changed. */
13224 if (!NILP (tip_timer
))
13226 Lisp_Object timer
= tip_timer
;
13228 call1 (Qcancel_timer
, timer
);
13232 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
13233 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
13234 root_x
, root_y
- PIXEL_HEIGHT (f
));
13240 /* Hide a previous tip, if any. */
13243 ASET (last_show_tip_args
, 0, string
);
13244 ASET (last_show_tip_args
, 1, frame
);
13245 ASET (last_show_tip_args
, 2, parms
);
13247 /* Add default values to frame parameters. */
13248 if (NILP (Fassq (Qname
, parms
)))
13249 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
13250 if (NILP (Fassq (Qinternal_border_width
, parms
)))
13251 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
13252 if (NILP (Fassq (Qborder_width
, parms
)))
13253 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
13254 if (NILP (Fassq (Qborder_color
, parms
)))
13255 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
13256 if (NILP (Fassq (Qbackground_color
, parms
)))
13257 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
13260 /* Create a frame for the tooltip, and record it in the global
13261 variable tip_frame. */
13262 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
);
13263 f
= XFRAME (frame
);
13265 /* Set up the frame's root window. */
13266 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
13267 w
->left
= w
->top
= make_number (0);
13269 if (CONSP (Vx_max_tooltip_size
)
13270 && INTEGERP (XCAR (Vx_max_tooltip_size
))
13271 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
13272 && INTEGERP (XCDR (Vx_max_tooltip_size
))
13273 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
13275 w
->width
= XCAR (Vx_max_tooltip_size
);
13276 w
->height
= XCDR (Vx_max_tooltip_size
);
13280 w
->width
= make_number (80);
13281 w
->height
= make_number (40);
13284 f
->window_width
= XINT (w
->width
);
13286 w
->pseudo_window_p
= 1;
13288 /* Display the tooltip text in a temporary buffer. */
13289 old_buffer
= current_buffer
;
13290 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
13291 current_buffer
->truncate_lines
= Qnil
;
13292 clear_glyph_matrix (w
->desired_matrix
);
13293 clear_glyph_matrix (w
->current_matrix
);
13294 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
13295 try_window (FRAME_ROOT_WINDOW (f
), pos
);
13297 /* Compute width and height of the tooltip. */
13298 width
= height
= 0;
13299 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
13301 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
13302 struct glyph
*last
;
13305 /* Stop at the first empty row at the end. */
13306 if (!row
->enabled_p
|| !row
->displays_text_p
)
13309 /* Let the row go over the full width of the frame. */
13310 row
->full_width_p
= 1;
13312 /* There's a glyph at the end of rows that is use to place
13313 the cursor there. Don't include the width of this glyph. */
13314 if (row
->used
[TEXT_AREA
])
13316 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
13317 row_width
= row
->pixel_width
- last
->pixel_width
;
13320 row_width
= row
->pixel_width
;
13322 height
+= row
->height
;
13323 width
= max (width
, row_width
);
13326 /* Add the frame's internal border to the width and height the X
13327 window should have. */
13328 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13329 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13331 /* Move the tooltip window where the mouse pointer is. Resize and
13333 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
13336 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
13337 root_x
, root_y
- height
, width
, height
);
13338 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
13341 /* Draw into the window. */
13342 w
->must_be_updated_p
= 1;
13343 update_single_window (w
, 1);
13345 /* Restore original current buffer. */
13346 set_buffer_internal_1 (old_buffer
);
13347 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
13350 /* Let the tip disappear after timeout seconds. */
13351 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
13352 intern ("x-hide-tip"));
13355 return unbind_to (count
, Qnil
);
13359 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
13360 doc
: /* Hide the current tooltip window, if there is any.
13361 Value is t if tooltip was open, nil otherwise. */)
13365 Lisp_Object deleted
, frame
, timer
;
13366 struct gcpro gcpro1
, gcpro2
;
13368 /* Return quickly if nothing to do. */
13369 if (NILP (tip_timer
) && NILP (tip_frame
))
13374 GCPRO2 (frame
, timer
);
13375 tip_frame
= tip_timer
= deleted
= Qnil
;
13377 count
= BINDING_STACK_SIZE ();
13378 specbind (Qinhibit_redisplay
, Qt
);
13379 specbind (Qinhibit_quit
, Qt
);
13382 call1 (Qcancel_timer
, timer
);
13384 if (FRAMEP (frame
))
13386 Fdelete_frame (frame
, Qnil
);
13391 return unbind_to (count
, deleted
);
13397 /***********************************************************************
13398 File selection dialog
13399 ***********************************************************************/
13401 extern Lisp_Object Qfile_name_history
;
13403 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
13404 doc
: /* Read file name, prompting with PROMPT in directory DIR.
13405 Use a file selection dialog.
13406 Select DEFAULT-FILENAME in the dialog's file selection box, if
13407 specified. Ensure that file exists if MUSTMATCH is non-nil. */)
13408 (prompt
, dir
, default_filename
, mustmatch
)
13409 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
13411 struct frame
*f
= SELECTED_FRAME ();
13412 Lisp_Object file
= Qnil
;
13413 int count
= specpdl_ptr
- specpdl
;
13414 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
13415 char filename
[MAX_PATH
+ 1];
13416 char init_dir
[MAX_PATH
+ 1];
13417 int use_dialog_p
= 1;
13419 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
13420 CHECK_STRING (prompt
);
13421 CHECK_STRING (dir
);
13423 /* Create the dialog with PROMPT as title, using DIR as initial
13424 directory and using "*" as pattern. */
13425 dir
= Fexpand_file_name (dir
, Qnil
);
13426 strncpy (init_dir
, XSTRING (dir
)->data
, MAX_PATH
);
13427 init_dir
[MAX_PATH
] = '\0';
13428 unixtodos_filename (init_dir
);
13430 if (STRINGP (default_filename
))
13432 char *file_name_only
;
13433 char *full_path_name
= XSTRING (default_filename
)->data
;
13435 unixtodos_filename (full_path_name
);
13437 file_name_only
= strrchr (full_path_name
, '\\');
13438 if (!file_name_only
)
13439 file_name_only
= full_path_name
;
13444 /* If default_file_name is a directory, don't use the open
13445 file dialog, as it does not support selecting
13447 if (!(*file_name_only
))
13451 strncpy (filename
, file_name_only
, MAX_PATH
);
13452 filename
[MAX_PATH
] = '\0';
13455 filename
[0] = '\0';
13459 OPENFILENAME file_details
;
13461 /* Prevent redisplay. */
13462 specbind (Qinhibit_redisplay
, Qt
);
13465 bzero (&file_details
, sizeof (file_details
));
13466 file_details
.lStructSize
= sizeof (file_details
);
13467 file_details
.hwndOwner
= FRAME_W32_WINDOW (f
);
13468 /* Undocumented Bug in Common File Dialog:
13469 If a filter is not specified, shell links are not resolved. */
13470 file_details
.lpstrFilter
= "ALL Files (*.*)\0*.*\0\0";
13471 file_details
.lpstrFile
= filename
;
13472 file_details
.nMaxFile
= sizeof (filename
);
13473 file_details
.lpstrInitialDir
= init_dir
;
13474 file_details
.lpstrTitle
= XSTRING (prompt
)->data
;
13475 file_details
.Flags
= OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
;
13477 if (!NILP (mustmatch
))
13478 file_details
.Flags
|= OFN_FILEMUSTEXIST
| OFN_PATHMUSTEXIST
;
13480 if (GetOpenFileName (&file_details
))
13482 dostounix_filename (filename
);
13483 file
= build_string (filename
);
13489 file
= unbind_to (count
, file
);
13491 /* Open File dialog will not allow folders to be selected, so resort
13492 to minibuffer completing reads for directories. */
13494 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
13495 dir
, mustmatch
, dir
, Qfile_name_history
,
13496 default_filename
, Qnil
);
13500 /* Make "Cancel" equivalent to C-g. */
13502 Fsignal (Qquit
, Qnil
);
13504 return unbind_to (count
, file
);
13509 /***********************************************************************
13510 w32 specialized functions
13511 ***********************************************************************/
13513 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
13514 doc
: /* Select a font using the W32 font dialog.
13515 Returns an X font string corresponding to the selection. */)
13519 FRAME_PTR f
= check_x_frame (frame
);
13527 bzero (&cf
, sizeof (cf
));
13528 bzero (&lf
, sizeof (lf
));
13530 cf
.lStructSize
= sizeof (cf
);
13531 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
13532 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
13533 cf
.lpLogFont
= &lf
;
13535 /* Initialize as much of the font details as we can from the current
13537 hdc
= GetDC (FRAME_W32_WINDOW (f
));
13538 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
13539 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
13540 if (GetTextMetrics (hdc
, &tm
))
13542 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
13543 lf
.lfWeight
= tm
.tmWeight
;
13544 lf
.lfItalic
= tm
.tmItalic
;
13545 lf
.lfUnderline
= tm
.tmUnderlined
;
13546 lf
.lfStrikeOut
= tm
.tmStruckOut
;
13547 lf
.lfCharSet
= tm
.tmCharSet
;
13548 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
13550 SelectObject (hdc
, oldobj
);
13551 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
13553 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
13556 return build_string (buf
);
13559 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
13560 Sw32_send_sys_command
, 1, 2, 0,
13561 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
13562 Some useful values for command are 0xf030 to maximise frame (0xf020
13563 to minimize), 0xf120 to restore frame to original size, and 0xf100
13564 to activate the menubar for keyboard access. 0xf140 activates the
13565 screen saver if defined.
13567 If optional parameter FRAME is not specified, use selected frame. */)
13569 Lisp_Object command
, frame
;
13571 FRAME_PTR f
= check_x_frame (frame
);
13573 CHECK_NUMBER (command
);
13575 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
13580 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
13581 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
13582 This is a wrapper around the ShellExecute system function, which
13583 invokes the application registered to handle OPERATION for DOCUMENT.
13584 OPERATION is typically \"open\", \"print\" or \"explore\" (but can be
13585 nil for the default action), and DOCUMENT is typically the name of a
13586 document file or URL, but can also be a program executable to run or
13587 a directory to open in the Windows Explorer.
13589 If DOCUMENT is a program executable, PARAMETERS can be a string
13590 containing command line parameters, but otherwise should be nil.
13592 SHOW-FLAG can be used to control whether the invoked application is hidden
13593 or minimized. If SHOW-FLAG is nil, the application is displayed normally,
13594 otherwise it is an integer representing a ShowWindow flag:
13598 3 - start maximized
13599 6 - start minimized */)
13600 (operation
, document
, parameters
, show_flag
)
13601 Lisp_Object operation
, document
, parameters
, show_flag
;
13603 Lisp_Object current_dir
;
13605 CHECK_STRING (document
);
13607 /* Encode filename and current directory. */
13608 current_dir
= ENCODE_FILE (current_buffer
->directory
);
13609 document
= ENCODE_FILE (document
);
13610 if ((int) ShellExecute (NULL
,
13611 (STRINGP (operation
) ?
13612 XSTRING (operation
)->data
: NULL
),
13613 XSTRING (document
)->data
,
13614 (STRINGP (parameters
) ?
13615 XSTRING (parameters
)->data
: NULL
),
13616 XSTRING (current_dir
)->data
,
13617 (INTEGERP (show_flag
) ?
13618 XINT (show_flag
) : SW_SHOWDEFAULT
))
13621 error ("ShellExecute failed: %s", w32_strerror (0));
13624 /* Lookup virtual keycode from string representing the name of a
13625 non-ascii keystroke into the corresponding virtual key, using
13626 lispy_function_keys. */
13628 lookup_vk_code (char *key
)
13632 for (i
= 0; i
< 256; i
++)
13633 if (lispy_function_keys
[i
] != 0
13634 && strcmp (lispy_function_keys
[i
], key
) == 0)
13640 /* Convert a one-element vector style key sequence to a hot key
13643 w32_parse_hot_key (key
)
13646 /* Copied from Fdefine_key and store_in_keymap. */
13647 register Lisp_Object c
;
13649 int lisp_modifiers
;
13651 struct gcpro gcpro1
;
13653 CHECK_VECTOR (key
);
13655 if (XFASTINT (Flength (key
)) != 1)
13660 c
= Faref (key
, make_number (0));
13662 if (CONSP (c
) && lucid_event_type_list_p (c
))
13663 c
= Fevent_convert_list (c
);
13667 if (! INTEGERP (c
) && ! SYMBOLP (c
))
13668 error ("Key definition is invalid");
13670 /* Work out the base key and the modifiers. */
13673 c
= parse_modifiers (c
);
13674 lisp_modifiers
= Fcar (Fcdr (c
));
13678 vk_code
= lookup_vk_code (XSYMBOL (c
)->name
->data
);
13680 else if (INTEGERP (c
))
13682 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
13683 /* Many ascii characters are their own virtual key code. */
13684 vk_code
= XINT (c
) & CHARACTERBITS
;
13687 if (vk_code
< 0 || vk_code
> 255)
13690 if ((lisp_modifiers
& meta_modifier
) != 0
13691 && !NILP (Vw32_alt_is_meta
))
13692 lisp_modifiers
|= alt_modifier
;
13694 /* Supply defs missing from mingw32. */
13696 #define MOD_ALT 0x0001
13697 #define MOD_CONTROL 0x0002
13698 #define MOD_SHIFT 0x0004
13699 #define MOD_WIN 0x0008
13702 /* Convert lisp modifiers to Windows hot-key form. */
13703 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
13704 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
13705 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
13706 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
13708 return HOTKEY (vk_code
, w32_modifiers
);
13711 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
13712 Sw32_register_hot_key
, 1, 1, 0,
13713 doc
: /* Register KEY as a hot-key combination.
13714 Certain key combinations like Alt-Tab are reserved for system use on
13715 Windows, and therefore are normally intercepted by the system. However,
13716 most of these key combinations can be received by registering them as
13717 hot-keys, overriding their special meaning.
13719 KEY must be a one element key definition in vector form that would be
13720 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
13721 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
13722 is always interpreted as the Windows modifier keys.
13724 The return value is the hotkey-id if registered, otherwise nil. */)
13728 key
= w32_parse_hot_key (key
);
13730 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
13732 /* Reuse an empty slot if possible. */
13733 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
13735 /* Safe to add new key to list, even if we have focus. */
13737 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
13739 XSETCAR (item
, key
);
13741 /* Notify input thread about new hot-key definition, so that it
13742 takes effect without needing to switch focus. */
13743 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
13750 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
13751 Sw32_unregister_hot_key
, 1, 1, 0,
13752 doc
: /* Unregister HOTKEY as a hot-key combination. */)
13758 if (!INTEGERP (key
))
13759 key
= w32_parse_hot_key (key
);
13761 item
= Fmemq (key
, w32_grabbed_keys
);
13765 /* Notify input thread about hot-key definition being removed, so
13766 that it takes effect without needing focus switch. */
13767 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
13768 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
13771 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
13778 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
13779 Sw32_registered_hot_keys
, 0, 0, 0,
13780 doc
: /* Return list of registered hot-key IDs. */)
13783 return Fcopy_sequence (w32_grabbed_keys
);
13786 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
13787 Sw32_reconstruct_hot_key
, 1, 1, 0,
13788 doc
: /* Convert hot-key ID to a lisp key combination. */)
13790 Lisp_Object hotkeyid
;
13792 int vk_code
, w32_modifiers
;
13795 CHECK_NUMBER (hotkeyid
);
13797 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
13798 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
13800 if (lispy_function_keys
[vk_code
])
13801 key
= intern (lispy_function_keys
[vk_code
]);
13803 key
= make_number (vk_code
);
13805 key
= Fcons (key
, Qnil
);
13806 if (w32_modifiers
& MOD_SHIFT
)
13807 key
= Fcons (Qshift
, key
);
13808 if (w32_modifiers
& MOD_CONTROL
)
13809 key
= Fcons (Qctrl
, key
);
13810 if (w32_modifiers
& MOD_ALT
)
13811 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
13812 if (w32_modifiers
& MOD_WIN
)
13813 key
= Fcons (Qhyper
, key
);
13818 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
13819 Sw32_toggle_lock_key
, 1, 2, 0,
13820 doc
: /* Toggle the state of the lock key KEY.
13821 KEY can be `capslock', `kp-numlock', or `scroll'.
13822 If the optional parameter NEW-STATE is a number, then the state of KEY
13823 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
13825 Lisp_Object key
, new_state
;
13829 if (EQ (key
, intern ("capslock")))
13830 vk_code
= VK_CAPITAL
;
13831 else if (EQ (key
, intern ("kp-numlock")))
13832 vk_code
= VK_NUMLOCK
;
13833 else if (EQ (key
, intern ("scroll")))
13834 vk_code
= VK_SCROLL
;
13838 if (!dwWindowsThreadId
)
13839 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
13841 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
13842 (WPARAM
) vk_code
, (LPARAM
) new_state
))
13845 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
13846 return make_number (msg
.wParam
);
13851 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
13852 doc
: /* Return storage information about the file system FILENAME is on.
13853 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
13854 storage of the file system, FREE is the free storage, and AVAIL is the
13855 storage available to a non-superuser. All 3 numbers are in bytes.
13856 If the underlying system call fails, value is nil. */)
13858 Lisp_Object filename
;
13860 Lisp_Object encoded
, value
;
13862 CHECK_STRING (filename
);
13863 filename
= Fexpand_file_name (filename
, Qnil
);
13864 encoded
= ENCODE_FILE (filename
);
13868 /* Determining the required information on Windows turns out, sadly,
13869 to be more involved than one would hope. The original Win32 api
13870 call for this will return bogus information on some systems, but we
13871 must dynamically probe for the replacement api, since that was
13872 added rather late on. */
13874 HMODULE hKernel
= GetModuleHandle ("kernel32");
13875 BOOL (*pfn_GetDiskFreeSpaceEx
)
13876 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
13877 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
13879 /* On Windows, we may need to specify the root directory of the
13880 volume holding FILENAME. */
13881 char rootname
[MAX_PATH
];
13882 char *name
= XSTRING (encoded
)->data
;
13884 /* find the root name of the volume if given */
13885 if (isalpha (name
[0]) && name
[1] == ':')
13887 rootname
[0] = name
[0];
13888 rootname
[1] = name
[1];
13889 rootname
[2] = '\\';
13892 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
13894 char *str
= rootname
;
13898 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
13908 if (pfn_GetDiskFreeSpaceEx
)
13910 LARGE_INTEGER availbytes
;
13911 LARGE_INTEGER freebytes
;
13912 LARGE_INTEGER totalbytes
;
13914 if (pfn_GetDiskFreeSpaceEx(rootname
,
13918 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
13919 make_float ((double) freebytes
.QuadPart
),
13920 make_float ((double) availbytes
.QuadPart
));
13924 DWORD sectors_per_cluster
;
13925 DWORD bytes_per_sector
;
13926 DWORD free_clusters
;
13927 DWORD total_clusters
;
13929 if (GetDiskFreeSpace(rootname
,
13930 §ors_per_cluster
,
13934 value
= list3 (make_float ((double) total_clusters
13935 * sectors_per_cluster
* bytes_per_sector
),
13936 make_float ((double) free_clusters
13937 * sectors_per_cluster
* bytes_per_sector
),
13938 make_float ((double) free_clusters
13939 * sectors_per_cluster
* bytes_per_sector
));
13948 /* This is zero if not using MS-Windows. */
13951 /* The section below is built by the lisp expression at the top of the file,
13952 just above where these variables are declared. */
13953 /*&&& init symbols here &&&*/
13954 Qauto_raise
= intern ("auto-raise");
13955 staticpro (&Qauto_raise
);
13956 Qauto_lower
= intern ("auto-lower");
13957 staticpro (&Qauto_lower
);
13958 Qbar
= intern ("bar");
13960 Qborder_color
= intern ("border-color");
13961 staticpro (&Qborder_color
);
13962 Qborder_width
= intern ("border-width");
13963 staticpro (&Qborder_width
);
13964 Qbox
= intern ("box");
13966 Qcursor_color
= intern ("cursor-color");
13967 staticpro (&Qcursor_color
);
13968 Qcursor_type
= intern ("cursor-type");
13969 staticpro (&Qcursor_type
);
13970 Qgeometry
= intern ("geometry");
13971 staticpro (&Qgeometry
);
13972 Qicon_left
= intern ("icon-left");
13973 staticpro (&Qicon_left
);
13974 Qicon_top
= intern ("icon-top");
13975 staticpro (&Qicon_top
);
13976 Qicon_type
= intern ("icon-type");
13977 staticpro (&Qicon_type
);
13978 Qicon_name
= intern ("icon-name");
13979 staticpro (&Qicon_name
);
13980 Qinternal_border_width
= intern ("internal-border-width");
13981 staticpro (&Qinternal_border_width
);
13982 Qleft
= intern ("left");
13983 staticpro (&Qleft
);
13984 Qright
= intern ("right");
13985 staticpro (&Qright
);
13986 Qmouse_color
= intern ("mouse-color");
13987 staticpro (&Qmouse_color
);
13988 Qnone
= intern ("none");
13989 staticpro (&Qnone
);
13990 Qparent_id
= intern ("parent-id");
13991 staticpro (&Qparent_id
);
13992 Qscroll_bar_width
= intern ("scroll-bar-width");
13993 staticpro (&Qscroll_bar_width
);
13994 Qsuppress_icon
= intern ("suppress-icon");
13995 staticpro (&Qsuppress_icon
);
13996 Qundefined_color
= intern ("undefined-color");
13997 staticpro (&Qundefined_color
);
13998 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
13999 staticpro (&Qvertical_scroll_bars
);
14000 Qvisibility
= intern ("visibility");
14001 staticpro (&Qvisibility
);
14002 Qwindow_id
= intern ("window-id");
14003 staticpro (&Qwindow_id
);
14004 Qx_frame_parameter
= intern ("x-frame-parameter");
14005 staticpro (&Qx_frame_parameter
);
14006 Qx_resource_name
= intern ("x-resource-name");
14007 staticpro (&Qx_resource_name
);
14008 Quser_position
= intern ("user-position");
14009 staticpro (&Quser_position
);
14010 Quser_size
= intern ("user-size");
14011 staticpro (&Quser_size
);
14012 Qscreen_gamma
= intern ("screen-gamma");
14013 staticpro (&Qscreen_gamma
);
14014 Qline_spacing
= intern ("line-spacing");
14015 staticpro (&Qline_spacing
);
14016 Qcenter
= intern ("center");
14017 staticpro (&Qcenter
);
14018 Qcancel_timer
= intern ("cancel-timer");
14019 staticpro (&Qcancel_timer
);
14020 /* This is the end of symbol initialization. */
14022 Qhyper
= intern ("hyper");
14023 staticpro (&Qhyper
);
14024 Qsuper
= intern ("super");
14025 staticpro (&Qsuper
);
14026 Qmeta
= intern ("meta");
14027 staticpro (&Qmeta
);
14028 Qalt
= intern ("alt");
14030 Qctrl
= intern ("ctrl");
14031 staticpro (&Qctrl
);
14032 Qcontrol
= intern ("control");
14033 staticpro (&Qcontrol
);
14034 Qshift
= intern ("shift");
14035 staticpro (&Qshift
);
14037 /* Text property `display' should be nonsticky by default. */
14038 Vtext_property_default_nonsticky
14039 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
14042 Qlaplace
= intern ("laplace");
14043 staticpro (&Qlaplace
);
14044 Qemboss
= intern ("emboss");
14045 staticpro (&Qemboss
);
14046 Qedge_detection
= intern ("edge-detection");
14047 staticpro (&Qedge_detection
);
14048 Qheuristic
= intern ("heuristic");
14049 staticpro (&Qheuristic
);
14050 QCmatrix
= intern (":matrix");
14051 staticpro (&QCmatrix
);
14052 QCcolor_adjustment
= intern (":color-adjustment");
14053 staticpro (&QCcolor_adjustment
);
14054 QCmask
= intern (":mask");
14055 staticpro (&QCmask
);
14057 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
14058 staticpro (&Qface_set_after_frame_default
);
14060 Fput (Qundefined_color
, Qerror_conditions
,
14061 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
14062 Fput (Qundefined_color
, Qerror_message
,
14063 build_string ("Undefined color"));
14065 staticpro (&w32_grabbed_keys
);
14066 w32_grabbed_keys
= Qnil
;
14068 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
14069 doc
: /* An array of color name mappings for windows. */);
14070 Vw32_color_map
= Qnil
;
14072 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
14073 doc
: /* Non-nil if alt key presses are passed on to Windows.
14074 When non-nil, for example, alt pressed and released and then space will
14075 open the System menu. When nil, Emacs silently swallows alt key events. */);
14076 Vw32_pass_alt_to_system
= Qnil
;
14078 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
14079 doc
: /* Non-nil if the alt key is to be considered the same as the meta key.
14080 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta. */);
14081 Vw32_alt_is_meta
= Qt
;
14083 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
14084 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
14085 XSETINT (Vw32_quit_key
, 0);
14087 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14088 &Vw32_pass_lwindow_to_system
,
14089 doc
: /* Non-nil if the left \"Windows\" key is passed on to Windows.
14090 When non-nil, the Start menu is opened by tapping the key. */);
14091 Vw32_pass_lwindow_to_system
= Qt
;
14093 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14094 &Vw32_pass_rwindow_to_system
,
14095 doc
: /* Non-nil if the right \"Windows\" key is passed on to Windows.
14096 When non-nil, the Start menu is opened by tapping the key. */);
14097 Vw32_pass_rwindow_to_system
= Qt
;
14099 DEFVAR_INT ("w32-phantom-key-code",
14100 &Vw32_phantom_key_code
,
14101 doc
: /* Virtual key code used to generate \"phantom\" key presses.
14102 Value is a number between 0 and 255.
14104 Phantom key presses are generated in order to stop the system from
14105 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
14106 `w32-pass-rwindow-to-system' is nil. */);
14107 /* Although 255 is technically not a valid key code, it works and
14108 means that this hack won't interfere with any real key code. */
14109 Vw32_phantom_key_code
= 255;
14111 DEFVAR_LISP ("w32-enable-num-lock",
14112 &Vw32_enable_num_lock
,
14113 doc
: /* Non-nil if Num Lock should act normally.
14114 Set to nil to see Num Lock as the key `kp-numlock'. */);
14115 Vw32_enable_num_lock
= Qt
;
14117 DEFVAR_LISP ("w32-enable-caps-lock",
14118 &Vw32_enable_caps_lock
,
14119 doc
: /* Non-nil if Caps Lock should act normally.
14120 Set to nil to see Caps Lock as the key `capslock'. */);
14121 Vw32_enable_caps_lock
= Qt
;
14123 DEFVAR_LISP ("w32-scroll-lock-modifier",
14124 &Vw32_scroll_lock_modifier
,
14125 doc
: /* Modifier to use for the Scroll Lock on state.
14126 The value can be hyper, super, meta, alt, control or shift for the
14127 respective modifier, or nil to see Scroll Lock as the key `scroll'.
14128 Any other value will cause the key to be ignored. */);
14129 Vw32_scroll_lock_modifier
= Qt
;
14131 DEFVAR_LISP ("w32-lwindow-modifier",
14132 &Vw32_lwindow_modifier
,
14133 doc
: /* Modifier to use for the left \"Windows\" key.
14134 The value can be hyper, super, meta, alt, control or shift for the
14135 respective modifier, or nil to appear as the key `lwindow'.
14136 Any other value will cause the key to be ignored. */);
14137 Vw32_lwindow_modifier
= Qnil
;
14139 DEFVAR_LISP ("w32-rwindow-modifier",
14140 &Vw32_rwindow_modifier
,
14141 doc
: /* Modifier to use for the right \"Windows\" key.
14142 The value can be hyper, super, meta, alt, control or shift for the
14143 respective modifier, or nil to appear as the key `rwindow'.
14144 Any other value will cause the key to be ignored. */);
14145 Vw32_rwindow_modifier
= Qnil
;
14147 DEFVAR_LISP ("w32-apps-modifier",
14148 &Vw32_apps_modifier
,
14149 doc
: /* Modifier to use for the \"Apps\" key.
14150 The value can be hyper, super, meta, alt, control or shift for the
14151 respective modifier, or nil to appear as the key `apps'.
14152 Any other value will cause the key to be ignored. */);
14153 Vw32_apps_modifier
= Qnil
;
14155 DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts
,
14156 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
14157 Vw32_enable_synthesized_fonts
= Qnil
;
14159 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
14160 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
14161 Vw32_enable_palette
= Qt
;
14163 DEFVAR_INT ("w32-mouse-button-tolerance",
14164 &Vw32_mouse_button_tolerance
,
14165 doc
: /* Analogue of double click interval for faking middle mouse events.
14166 The value is the minimum time in milliseconds that must elapse between
14167 left/right button down events before they are considered distinct events.
14168 If both mouse buttons are depressed within this interval, a middle mouse
14169 button down event is generated instead. */);
14170 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
14172 DEFVAR_INT ("w32-mouse-move-interval",
14173 &Vw32_mouse_move_interval
,
14174 doc
: /* Minimum interval between mouse move events.
14175 The value is the minimum time in milliseconds that must elapse between
14176 successive mouse move (or scroll bar drag) events before they are
14177 reported as lisp events. */);
14178 XSETINT (Vw32_mouse_move_interval
, 0);
14180 init_x_parm_symbols ();
14182 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
14183 doc
: /* List of directories to search for bitmap files for w32. */);
14184 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
14186 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
14187 doc
: /* The shape of the pointer when over text.
14188 Changing the value does not affect existing frames
14189 unless you set the mouse color. */);
14190 Vx_pointer_shape
= Qnil
;
14192 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
14193 doc
: /* The name Emacs uses to look up resources; for internal use only.
14194 `x-get-resource' uses this as the first component of the instance name
14195 when requesting resource values.
14196 Emacs initially sets `x-resource-name' to the name under which Emacs
14197 was invoked, or to the value specified with the `-name' or `-rn'
14198 switches, if present. */);
14199 Vx_resource_name
= Qnil
;
14201 Vx_nontext_pointer_shape
= Qnil
;
14203 Vx_mode_pointer_shape
= Qnil
;
14205 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
14206 doc
: /* The shape of the pointer when Emacs is busy.
14207 This variable takes effect when you create a new frame
14208 or when you set the mouse color. */);
14209 Vx_hourglass_pointer_shape
= Qnil
;
14211 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
14212 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
14213 display_hourglass_p
= 1;
14215 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
14216 doc
: /* *Seconds to wait before displaying an hourglass pointer.
14217 Value must be an integer or float. */);
14218 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
14220 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
14221 &Vx_sensitive_text_pointer_shape
,
14222 doc
: /* The shape of the pointer when over mouse-sensitive text.
14223 This variable takes effect when you create a new frame
14224 or when you set the mouse color. */);
14225 Vx_sensitive_text_pointer_shape
= Qnil
;
14227 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
14228 &Vx_window_horizontal_drag_shape
,
14229 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
14230 This variable takes effect when you create a new frame
14231 or when you set the mouse color. */);
14232 Vx_window_horizontal_drag_shape
= Qnil
;
14234 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
14235 doc
: /* A string indicating the foreground color of the cursor box. */);
14236 Vx_cursor_fore_pixel
= Qnil
;
14238 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
14239 doc
: /* Maximum size for tooltips.
14240 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
14241 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
14243 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
14244 doc
: /* Non-nil if no window manager is in use.
14245 Emacs doesn't try to figure this out; this is always nil
14246 unless you set it to something else. */);
14247 /* We don't have any way to find this out, so set it to nil
14248 and maybe the user would like to set it to t. */
14249 Vx_no_window_manager
= Qnil
;
14251 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
14252 &Vx_pixel_size_width_font_regexp
,
14253 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
14255 Since Emacs gets width of a font matching with this regexp from
14256 PIXEL_SIZE field of the name, font finding mechanism gets faster for
14257 such a font. This is especially effective for such large fonts as
14258 Chinese, Japanese, and Korean. */);
14259 Vx_pixel_size_width_font_regexp
= Qnil
;
14261 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
14262 doc
: /* Time after which cached images are removed from the cache.
14263 When an image has not been displayed this many seconds, remove it
14264 from the image cache. Value must be an integer or nil with nil
14265 meaning don't clear the cache. */);
14266 Vimage_cache_eviction_delay
= make_number (30 * 60);
14268 DEFVAR_LISP ("w32-bdf-filename-alist",
14269 &Vw32_bdf_filename_alist
,
14270 doc
: /* List of bdf fonts and their corresponding filenames. */);
14271 Vw32_bdf_filename_alist
= Qnil
;
14273 DEFVAR_BOOL ("w32-strict-fontnames",
14274 &w32_strict_fontnames
,
14275 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
14276 Default is nil, which allows old fontnames that are not XLFD compliant,
14277 and allows third-party CJK display to work by specifying false charset
14278 fields to trick Emacs into translating to Big5, SJIS etc.
14279 Setting this to t will prevent wrong fonts being selected when
14280 fontsets are automatically created. */);
14281 w32_strict_fontnames
= 0;
14283 DEFVAR_BOOL ("w32-strict-painting",
14284 &w32_strict_painting
,
14285 doc
: /* Non-nil means use strict rules for repainting frames.
14286 Set this to nil to get the old behaviour for repainting; this should
14287 only be necessary if the default setting causes problems. */);
14288 w32_strict_painting
= 1;
14290 DEFVAR_LISP ("w32-system-coding-system",
14291 &Vw32_system_coding_system
,
14292 doc
: /* Coding system used by Windows system functions, such as for font names. */);
14293 Vw32_system_coding_system
= Qnil
;
14295 DEFVAR_LISP ("w32-charset-info-alist",
14296 &Vw32_charset_info_alist
,
14297 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
14298 Each entry should be of the form:
14300 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
14302 where CHARSET_NAME is a string used in font names to identify the charset,
14303 WINDOWS_CHARSET is a symbol that can be one of:
14304 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
14305 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
14306 w32-charset-chinesebig5,
14307 #ifdef JOHAB_CHARSET
14308 w32-charset-johab, w32-charset-hebrew,
14309 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
14310 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
14311 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
14313 #ifdef UNICODE_CHARSET
14314 w32-charset-unicode,
14316 or w32-charset-oem.
14317 CODEPAGE should be an integer specifying the codepage that should be used
14318 to display the character set, t to do no translation and output as Unicode,
14319 or nil to do no translation and output as 8 bit (or multibyte on far-east
14320 versions of Windows) characters. */);
14321 Vw32_charset_info_alist
= Qnil
;
14323 staticpro (&Qw32_charset_ansi
);
14324 Qw32_charset_ansi
= intern ("w32-charset-ansi");
14325 staticpro (&Qw32_charset_symbol
);
14326 Qw32_charset_symbol
= intern ("w32-charset-symbol");
14327 staticpro (&Qw32_charset_shiftjis
);
14328 Qw32_charset_shiftjis
= intern ("w32-charset-shiftjis");
14329 staticpro (&Qw32_charset_hangeul
);
14330 Qw32_charset_hangeul
= intern ("w32-charset-hangeul");
14331 staticpro (&Qw32_charset_chinesebig5
);
14332 Qw32_charset_chinesebig5
= intern ("w32-charset-chinesebig5");
14333 staticpro (&Qw32_charset_gb2312
);
14334 Qw32_charset_gb2312
= intern ("w32-charset-gb2312");
14335 staticpro (&Qw32_charset_oem
);
14336 Qw32_charset_oem
= intern ("w32-charset-oem");
14338 #ifdef JOHAB_CHARSET
14340 static int w32_extra_charsets_defined
= 1;
14341 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
14342 doc
: /* Internal variable. */);
14344 staticpro (&Qw32_charset_johab
);
14345 Qw32_charset_johab
= intern ("w32-charset-johab");
14346 staticpro (&Qw32_charset_easteurope
);
14347 Qw32_charset_easteurope
= intern ("w32-charset-easteurope");
14348 staticpro (&Qw32_charset_turkish
);
14349 Qw32_charset_turkish
= intern ("w32-charset-turkish");
14350 staticpro (&Qw32_charset_baltic
);
14351 Qw32_charset_baltic
= intern ("w32-charset-baltic");
14352 staticpro (&Qw32_charset_russian
);
14353 Qw32_charset_russian
= intern ("w32-charset-russian");
14354 staticpro (&Qw32_charset_arabic
);
14355 Qw32_charset_arabic
= intern ("w32-charset-arabic");
14356 staticpro (&Qw32_charset_greek
);
14357 Qw32_charset_greek
= intern ("w32-charset-greek");
14358 staticpro (&Qw32_charset_hebrew
);
14359 Qw32_charset_hebrew
= intern ("w32-charset-hebrew");
14360 staticpro (&Qw32_charset_vietnamese
);
14361 Qw32_charset_vietnamese
= intern ("w32-charset-vietnamese");
14362 staticpro (&Qw32_charset_thai
);
14363 Qw32_charset_thai
= intern ("w32-charset-thai");
14364 staticpro (&Qw32_charset_mac
);
14365 Qw32_charset_mac
= intern ("w32-charset-mac");
14369 #ifdef UNICODE_CHARSET
14371 static int w32_unicode_charset_defined
= 1;
14372 DEFVAR_BOOL ("w32-unicode-charset-defined",
14373 &w32_unicode_charset_defined
,
14374 doc
: /* Internal variable. */);
14376 staticpro (&Qw32_charset_unicode
);
14377 Qw32_charset_unicode
= intern ("w32-charset-unicode");
14380 defsubr (&Sx_get_resource
);
14381 #if 0 /* TODO: Port to W32 */
14382 defsubr (&Sx_change_window_property
);
14383 defsubr (&Sx_delete_window_property
);
14384 defsubr (&Sx_window_property
);
14386 defsubr (&Sxw_display_color_p
);
14387 defsubr (&Sx_display_grayscale_p
);
14388 defsubr (&Sxw_color_defined_p
);
14389 defsubr (&Sxw_color_values
);
14390 defsubr (&Sx_server_max_request_size
);
14391 defsubr (&Sx_server_vendor
);
14392 defsubr (&Sx_server_version
);
14393 defsubr (&Sx_display_pixel_width
);
14394 defsubr (&Sx_display_pixel_height
);
14395 defsubr (&Sx_display_mm_width
);
14396 defsubr (&Sx_display_mm_height
);
14397 defsubr (&Sx_display_screens
);
14398 defsubr (&Sx_display_planes
);
14399 defsubr (&Sx_display_color_cells
);
14400 defsubr (&Sx_display_visual_class
);
14401 defsubr (&Sx_display_backing_store
);
14402 defsubr (&Sx_display_save_under
);
14403 defsubr (&Sx_parse_geometry
);
14404 defsubr (&Sx_create_frame
);
14405 defsubr (&Sx_open_connection
);
14406 defsubr (&Sx_close_connection
);
14407 defsubr (&Sx_display_list
);
14408 defsubr (&Sx_synchronize
);
14410 /* W32 specific functions */
14412 defsubr (&Sw32_focus_frame
);
14413 defsubr (&Sw32_select_font
);
14414 defsubr (&Sw32_define_rgb_color
);
14415 defsubr (&Sw32_default_color_map
);
14416 defsubr (&Sw32_load_color_file
);
14417 defsubr (&Sw32_send_sys_command
);
14418 defsubr (&Sw32_shell_execute
);
14419 defsubr (&Sw32_register_hot_key
);
14420 defsubr (&Sw32_unregister_hot_key
);
14421 defsubr (&Sw32_registered_hot_keys
);
14422 defsubr (&Sw32_reconstruct_hot_key
);
14423 defsubr (&Sw32_toggle_lock_key
);
14424 defsubr (&Sw32_find_bdf_fonts
);
14426 defsubr (&Sfile_system_info
);
14428 /* Setting callback functions for fontset handler. */
14429 get_font_info_func
= w32_get_font_info
;
14431 #if 0 /* This function pointer doesn't seem to be used anywhere.
14432 And the pointer assigned has the wrong type, anyway. */
14433 list_fonts_func
= w32_list_fonts
;
14436 load_font_func
= w32_load_font
;
14437 find_ccl_program_func
= w32_find_ccl_program
;
14438 query_font_func
= w32_query_font
;
14439 set_frame_fontset_func
= x_set_font
;
14440 check_window_system_func
= check_w32
;
14442 #if 0 /* TODO Image support for W32 */
14444 Qxbm
= intern ("xbm");
14446 QCtype
= intern (":type");
14447 staticpro (&QCtype
);
14448 QCconversion
= intern (":conversion");
14449 staticpro (&QCconversion
);
14450 QCheuristic_mask
= intern (":heuristic-mask");
14451 staticpro (&QCheuristic_mask
);
14452 QCcolor_symbols
= intern (":color-symbols");
14453 staticpro (&QCcolor_symbols
);
14454 QCascent
= intern (":ascent");
14455 staticpro (&QCascent
);
14456 QCmargin
= intern (":margin");
14457 staticpro (&QCmargin
);
14458 QCrelief
= intern (":relief");
14459 staticpro (&QCrelief
);
14460 Qpostscript
= intern ("postscript");
14461 staticpro (&Qpostscript
);
14462 QCloader
= intern (":loader");
14463 staticpro (&QCloader
);
14464 QCbounding_box
= intern (":bounding-box");
14465 staticpro (&QCbounding_box
);
14466 QCpt_width
= intern (":pt-width");
14467 staticpro (&QCpt_width
);
14468 QCpt_height
= intern (":pt-height");
14469 staticpro (&QCpt_height
);
14470 QCindex
= intern (":index");
14471 staticpro (&QCindex
);
14472 Qpbm
= intern ("pbm");
14476 Qxpm
= intern ("xpm");
14481 Qjpeg
= intern ("jpeg");
14482 staticpro (&Qjpeg
);
14486 Qtiff
= intern ("tiff");
14487 staticpro (&Qtiff
);
14491 Qgif
= intern ("gif");
14496 Qpng
= intern ("png");
14500 defsubr (&Sclear_image_cache
);
14503 defsubr (&Simagep
);
14504 defsubr (&Slookup_image
);
14508 hourglass_atimer
= NULL
;
14509 hourglass_shown_p
= 0;
14510 #ifdef TODO /* Tooltip support not complete. */
14511 defsubr (&Sx_show_tip
);
14512 defsubr (&Sx_hide_tip
);
14515 staticpro (&tip_timer
);
14517 staticpro (&tip_frame
);
14519 defsubr (&Sx_file_dialog
);
14526 image_types
= NULL
;
14527 Vimage_types
= Qnil
;
14529 #if 0 /* TODO : Image support for W32 */
14530 define_image_type (&xbm_type
);
14531 define_image_type (&gs_type
);
14532 define_image_type (&pbm_type
);
14535 define_image_type (&xpm_type
);
14539 define_image_type (&jpeg_type
);
14543 define_image_type (&tiff_type
);
14547 define_image_type (&gif_type
);
14551 define_image_type (&png_type
);
14562 button
= MessageBox (NULL
,
14563 "A fatal error has occurred!\n\n"
14564 "Select Abort to exit, Retry to debug, Ignore to continue",
14565 "Emacs Abort Dialog",
14566 MB_ICONEXCLAMATION
| MB_TASKMODAL
14567 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
14582 /* For convenience when debugging. */
14586 return GetLastError ();