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 void x_compute_fringe_widths (struct frame
*, int);
57 extern double atof ();
58 extern int w32_console_toggle_lock_key (int vk_code
, Lisp_Object new_state
);
59 extern void w32_menu_display_help (HWND owner
, HMENU menu
, UINT menu_item
, UINT flags
);
62 /* A definition of XColor for non-X frames. */
63 #ifndef HAVE_X_WINDOWS
66 unsigned short red
, green
, blue
;
72 extern char *lispy_function_keys
[];
74 /* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
75 it, and including `bitmaps/gray' more than once is a problem when
76 config.h defines `static' as an empty replacement string. */
78 int gray_bitmap_width
= gray_width
;
79 int gray_bitmap_height
= gray_height
;
80 unsigned char *gray_bitmap_bits
= gray_bits
;
82 /* The colormap for converting color names to RGB values */
83 Lisp_Object Vw32_color_map
;
85 /* Non nil if alt key presses are passed on to Windows. */
86 Lisp_Object Vw32_pass_alt_to_system
;
88 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
90 Lisp_Object Vw32_alt_is_meta
;
92 /* If non-zero, the windows virtual key code for an alternative quit key. */
93 Lisp_Object Vw32_quit_key
;
95 /* Non nil if left window key events are passed on to Windows (this only
96 affects whether "tapping" the key opens the Start menu). */
97 Lisp_Object Vw32_pass_lwindow_to_system
;
99 /* Non nil if right window key events are passed on to Windows (this
100 only affects whether "tapping" the key opens the Start menu). */
101 Lisp_Object Vw32_pass_rwindow_to_system
;
103 /* Virtual key code used to generate "phantom" key presses in order
104 to stop system from acting on Windows key events. */
105 Lisp_Object Vw32_phantom_key_code
;
107 /* Modifier associated with the left "Windows" key, or nil to act as a
109 Lisp_Object Vw32_lwindow_modifier
;
111 /* Modifier associated with the right "Windows" key, or nil to act as a
113 Lisp_Object Vw32_rwindow_modifier
;
115 /* Modifier associated with the "Apps" key, or nil to act as a normal
117 Lisp_Object Vw32_apps_modifier
;
119 /* Value is nil if Num Lock acts as a function key. */
120 Lisp_Object Vw32_enable_num_lock
;
122 /* Value is nil if Caps Lock acts as a function key. */
123 Lisp_Object Vw32_enable_caps_lock
;
125 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
126 Lisp_Object Vw32_scroll_lock_modifier
;
128 /* Switch to control whether we inhibit requests for synthesized bold
129 and italic versions of fonts. */
130 Lisp_Object Vw32_enable_synthesized_fonts
;
132 /* Enable palette management. */
133 Lisp_Object Vw32_enable_palette
;
135 /* Control how close left/right button down events must be to
136 be converted to a middle button down event. */
137 Lisp_Object Vw32_mouse_button_tolerance
;
139 /* Minimum interval between mouse movement (and scroll bar drag)
140 events that are passed on to the event loop. */
141 Lisp_Object Vw32_mouse_move_interval
;
143 /* The name we're using in resource queries. */
144 Lisp_Object Vx_resource_name
;
146 /* Non nil if no window manager is in use. */
147 Lisp_Object Vx_no_window_manager
;
149 /* Non-zero means we're allowed to display a hourglass pointer. */
151 int display_hourglass_p
;
153 /* The background and shape of the mouse pointer, and shape when not
154 over text or in the modeline. */
156 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
157 Lisp_Object Vx_hourglass_pointer_shape
, Vx_window_horizontal_drag_shape
;
159 /* The shape when over mouse-sensitive text. */
161 Lisp_Object Vx_sensitive_text_pointer_shape
;
163 /* Color of chars displayed in cursor box. */
165 Lisp_Object Vx_cursor_fore_pixel
;
167 /* Nonzero if using Windows. */
169 static int w32_in_use
;
171 /* Search path for bitmap files. */
173 Lisp_Object Vx_bitmap_file_path
;
175 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
177 Lisp_Object Vx_pixel_size_width_font_regexp
;
179 /* Alist of bdf fonts and the files that define them. */
180 Lisp_Object Vw32_bdf_filename_alist
;
182 /* 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 if (FRAME_W32_WINDOW (f
) == wdesc
)
413 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
414 id, which is just an int that this section returns. Bitmaps are
415 reference counted so they can be shared among frames.
417 Bitmap indices are guaranteed to be > 0, so a negative number can
418 be used to indicate no bitmap.
420 If you use x_create_bitmap_from_data, then you must keep track of
421 the bitmaps yourself. That is, creating a bitmap from the same
422 data more than once will not be caught. */
425 /* Functions to access the contents of a bitmap, given an id. */
428 x_bitmap_height (f
, id
)
432 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
436 x_bitmap_width (f
, id
)
440 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
444 x_bitmap_pixmap (f
, id
)
448 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
452 /* Allocate a new bitmap record. Returns index of new record. */
455 x_allocate_bitmap_record (f
)
458 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
461 if (dpyinfo
->bitmaps
== NULL
)
463 dpyinfo
->bitmaps_size
= 10;
465 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
466 dpyinfo
->bitmaps_last
= 1;
470 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
471 return ++dpyinfo
->bitmaps_last
;
473 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
474 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
477 dpyinfo
->bitmaps_size
*= 2;
479 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
480 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
481 return ++dpyinfo
->bitmaps_last
;
484 /* Add one reference to the reference count of the bitmap with id ID. */
487 x_reference_bitmap (f
, id
)
491 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
494 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
497 x_create_bitmap_from_data (f
, bits
, width
, height
)
500 unsigned int width
, height
;
502 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
506 bitmap
= CreateBitmap (width
, height
,
507 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
508 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
514 id
= x_allocate_bitmap_record (f
);
515 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
516 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
517 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
518 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
519 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
520 dpyinfo
->bitmaps
[id
- 1].height
= height
;
521 dpyinfo
->bitmaps
[id
- 1].width
= width
;
526 /* Create bitmap from file FILE for frame F. */
529 x_create_bitmap_from_file (f
, file
)
534 #if 0 /* TODO : bitmap support */
535 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
536 unsigned int width
, height
;
538 int xhot
, yhot
, result
, id
;
544 /* Look for an existing bitmap with the same name. */
545 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
547 if (dpyinfo
->bitmaps
[id
].refcount
548 && dpyinfo
->bitmaps
[id
].file
549 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
551 ++dpyinfo
->bitmaps
[id
].refcount
;
556 /* Search bitmap-file-path for the file, if appropriate. */
557 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, 0);
562 filename
= (char *) XSTRING (found
)->data
;
564 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
570 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
571 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
572 if (result
!= BitmapSuccess
)
575 id
= x_allocate_bitmap_record (f
);
576 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
577 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
578 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
579 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
580 dpyinfo
->bitmaps
[id
- 1].height
= height
;
581 dpyinfo
->bitmaps
[id
- 1].width
= width
;
582 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
588 /* Remove reference to bitmap with id number ID. */
591 x_destroy_bitmap (f
, id
)
595 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
599 --dpyinfo
->bitmaps
[id
- 1].refcount
;
600 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
603 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
604 if (dpyinfo
->bitmaps
[id
- 1].file
)
606 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
607 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
614 /* Free all the bitmaps for the display specified by DPYINFO. */
617 x_destroy_all_bitmaps (dpyinfo
)
618 struct w32_display_info
*dpyinfo
;
621 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
622 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
624 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
625 if (dpyinfo
->bitmaps
[i
].file
)
626 xfree (dpyinfo
->bitmaps
[i
].file
);
628 dpyinfo
->bitmaps_last
= 0;
631 /* Connect the frame-parameter names for W32 frames
632 to the ways of passing the parameter values to the window system.
634 The name of a parameter, as a Lisp symbol,
635 has an `x-frame-parameter' property which is an integer in Lisp
636 but can be interpreted as an `enum x_frame_parm' in C. */
640 X_PARM_FOREGROUND_COLOR
,
641 X_PARM_BACKGROUND_COLOR
,
648 X_PARM_INTERNAL_BORDER_WIDTH
,
652 X_PARM_VERT_SCROLL_BAR
,
654 X_PARM_MENU_BAR_LINES
658 struct x_frame_parm_table
661 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
664 BOOL my_show_window
P_ ((struct frame
*, HWND
, int));
665 void my_set_window_pos
P_ ((HWND
, HWND
, int, int, int, int, UINT
));
666 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
667 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
668 static void x_change_window_heights
P_ ((Lisp_Object
, int));
669 /* TODO: Native Input Method support; see x_create_im. */
670 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
671 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
672 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
673 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
674 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
675 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
676 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
677 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
678 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
679 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
680 static void x_set_fringe_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
681 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
682 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
684 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
685 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
686 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
687 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
689 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
690 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
691 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
692 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
693 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
694 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
695 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
696 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
699 static struct x_frame_parm_table x_frame_parms
[] =
701 "auto-raise", x_set_autoraise
,
702 "auto-lower", x_set_autolower
,
703 "background-color", x_set_background_color
,
704 "border-color", x_set_border_color
,
705 "border-width", x_set_border_width
,
706 "cursor-color", x_set_cursor_color
,
707 "cursor-type", x_set_cursor_type
,
709 "foreground-color", x_set_foreground_color
,
710 "icon-name", x_set_icon_name
,
711 "icon-type", x_set_icon_type
,
712 "internal-border-width", x_set_internal_border_width
,
713 "menu-bar-lines", x_set_menu_bar_lines
,
714 "mouse-color", x_set_mouse_color
,
715 "name", x_explicitly_set_name
,
716 "scroll-bar-width", x_set_scroll_bar_width
,
717 "title", x_set_title
,
718 "unsplittable", x_set_unsplittable
,
719 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
720 "visibility", x_set_visibility
,
721 "tool-bar-lines", x_set_tool_bar_lines
,
722 "screen-gamma", x_set_screen_gamma
,
723 "line-spacing", x_set_line_spacing
,
724 "left-fringe", x_set_fringe_width
,
725 "right-fringe", x_set_fringe_width
729 /* Attach the `x-frame-parameter' properties to
730 the Lisp symbol names of parameters relevant to W32. */
733 init_x_parm_symbols ()
737 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
738 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
742 /* Change the parameters of frame F as specified by ALIST.
743 If a parameter is not specially recognized, do nothing;
744 otherwise call the `x_set_...' function for that parameter. */
747 x_set_frame_parameters (f
, alist
)
753 /* If both of these parameters are present, it's more efficient to
754 set them both at once. So we wait until we've looked at the
755 entire list before we set them. */
759 Lisp_Object left
, top
;
761 /* Same with these. */
762 Lisp_Object icon_left
, icon_top
;
764 /* Record in these vectors all the parms specified. */
768 int left_no_change
= 0, top_no_change
= 0;
769 int icon_left_no_change
= 0, icon_top_no_change
= 0;
771 struct gcpro gcpro1
, gcpro2
;
774 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
777 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
778 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
780 /* Extract parm names and values into those vectors. */
783 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
788 parms
[i
] = Fcar (elt
);
789 values
[i
] = Fcdr (elt
);
792 /* TAIL and ALIST are not used again below here. */
795 GCPRO2 (*parms
, *values
);
799 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
800 because their values appear in VALUES and strings are not valid. */
801 top
= left
= Qunbound
;
802 icon_left
= icon_top
= Qunbound
;
804 /* Provide default values for HEIGHT and WIDTH. */
805 if (FRAME_NEW_WIDTH (f
))
806 width
= FRAME_NEW_WIDTH (f
);
808 width
= FRAME_WIDTH (f
);
810 if (FRAME_NEW_HEIGHT (f
))
811 height
= FRAME_NEW_HEIGHT (f
);
813 height
= FRAME_HEIGHT (f
);
815 /* Process foreground_color and background_color before anything else.
816 They are independent of other properties, but other properties (e.g.,
817 cursor_color) are dependent upon them. */
818 /* Process default font as well, since fringe widths depends on it. */
819 for (p
= 0; p
< i
; p
++)
821 Lisp_Object prop
, val
;
825 if (EQ (prop
, Qforeground_color
)
826 || EQ (prop
, Qbackground_color
)
829 register Lisp_Object param_index
, old_value
;
831 old_value
= get_frame_param (f
, prop
);
833 if (NILP (Fequal (val
, old_value
)))
835 store_frame_param (f
, prop
, val
);
837 param_index
= Fget (prop
, Qx_frame_parameter
);
838 if (NATNUMP (param_index
)
839 && (XFASTINT (param_index
)
840 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
841 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
846 /* Now process them in reverse of specified order. */
847 for (i
--; i
>= 0; i
--)
849 Lisp_Object prop
, val
;
854 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
855 width
= XFASTINT (val
);
856 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
857 height
= XFASTINT (val
);
858 else if (EQ (prop
, Qtop
))
860 else if (EQ (prop
, Qleft
))
862 else if (EQ (prop
, Qicon_top
))
864 else if (EQ (prop
, Qicon_left
))
866 else if (EQ (prop
, Qforeground_color
)
867 || EQ (prop
, Qbackground_color
)
869 /* Processed above. */
873 register Lisp_Object param_index
, old_value
;
875 old_value
= get_frame_param (f
, prop
);
877 store_frame_param (f
, prop
, val
);
879 param_index
= Fget (prop
, Qx_frame_parameter
);
880 if (NATNUMP (param_index
)
881 && (XFASTINT (param_index
)
882 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
883 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
887 /* Don't die if just one of these was set. */
888 if (EQ (left
, Qunbound
))
891 if (f
->output_data
.w32
->left_pos
< 0)
892 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
894 XSETINT (left
, f
->output_data
.w32
->left_pos
);
896 if (EQ (top
, Qunbound
))
899 if (f
->output_data
.w32
->top_pos
< 0)
900 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
902 XSETINT (top
, f
->output_data
.w32
->top_pos
);
905 /* If one of the icon positions was not set, preserve or default it. */
906 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
908 icon_left_no_change
= 1;
909 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
910 if (NILP (icon_left
))
911 XSETINT (icon_left
, 0);
913 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
915 icon_top_no_change
= 1;
916 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
918 XSETINT (icon_top
, 0);
921 /* Don't set these parameters unless they've been explicitly
922 specified. The window might be mapped or resized while we're in
923 this function, and we don't want to override that unless the lisp
924 code has asked for it.
926 Don't set these parameters unless they actually differ from the
927 window's current parameters; the window may not actually exist
932 check_frame_size (f
, &height
, &width
);
934 XSETFRAME (frame
, f
);
936 if (width
!= FRAME_WIDTH (f
)
937 || height
!= FRAME_HEIGHT (f
)
938 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
939 Fset_frame_size (frame
, make_number (width
), make_number (height
));
941 if ((!NILP (left
) || !NILP (top
))
942 && ! (left_no_change
&& top_no_change
)
943 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
944 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
949 /* Record the signs. */
950 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
951 if (EQ (left
, Qminus
))
952 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
953 else if (INTEGERP (left
))
955 leftpos
= XINT (left
);
957 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
959 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
960 && CONSP (XCDR (left
))
961 && INTEGERP (XCAR (XCDR (left
))))
963 leftpos
= - XINT (XCAR (XCDR (left
)));
964 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
966 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
967 && CONSP (XCDR (left
))
968 && INTEGERP (XCAR (XCDR (left
))))
970 leftpos
= XINT (XCAR (XCDR (left
)));
973 if (EQ (top
, Qminus
))
974 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
975 else if (INTEGERP (top
))
979 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
981 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
982 && CONSP (XCDR (top
))
983 && INTEGERP (XCAR (XCDR (top
))))
985 toppos
= - XINT (XCAR (XCDR (top
)));
986 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
988 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
989 && CONSP (XCDR (top
))
990 && INTEGERP (XCAR (XCDR (top
))))
992 toppos
= XINT (XCAR (XCDR (top
)));
996 /* Store the numeric value of the position. */
997 f
->output_data
.w32
->top_pos
= toppos
;
998 f
->output_data
.w32
->left_pos
= leftpos
;
1000 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
1002 /* Actually set that position, and convert to absolute. */
1003 x_set_offset (f
, leftpos
, toppos
, -1);
1006 if ((!NILP (icon_left
) || !NILP (icon_top
))
1007 && ! (icon_left_no_change
&& icon_top_no_change
))
1008 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1014 /* Store the screen positions of frame F into XPTR and YPTR.
1015 These are the positions of the containing window manager window,
1016 not Emacs's own window. */
1019 x_real_positions (f
, xptr
, yptr
)
1028 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
1029 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
1035 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
1041 /* Insert a description of internally-recorded parameters of frame X
1042 into the parameter alist *ALISTPTR that is to be given to the user.
1043 Only parameters that are specific to W32
1044 and whose values are not correctly recorded in the frame's
1045 param_alist need to be considered here. */
1048 x_report_frame_params (f
, alistptr
)
1050 Lisp_Object
*alistptr
;
1055 /* Represent negative positions (off the top or left screen edge)
1056 in a way that Fmodify_frame_parameters will understand correctly. */
1057 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
1058 if (f
->output_data
.w32
->left_pos
>= 0)
1059 store_in_alist (alistptr
, Qleft
, tem
);
1061 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1063 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
1064 if (f
->output_data
.w32
->top_pos
>= 0)
1065 store_in_alist (alistptr
, Qtop
, tem
);
1067 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1069 store_in_alist (alistptr
, Qborder_width
,
1070 make_number (f
->output_data
.w32
->border_width
));
1071 store_in_alist (alistptr
, Qinternal_border_width
,
1072 make_number (f
->output_data
.w32
->internal_border_width
));
1073 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
1074 store_in_alist (alistptr
, Qwindow_id
,
1075 build_string (buf
));
1076 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1077 FRAME_SAMPLE_VISIBILITY (f
);
1078 store_in_alist (alistptr
, Qvisibility
,
1079 (FRAME_VISIBLE_P (f
) ? Qt
1080 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1081 store_in_alist (alistptr
, Qdisplay
,
1082 XCAR (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
));
1086 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
,
1087 Sw32_define_rgb_color
, 4, 4, 0,
1088 doc
: /* Convert RGB numbers to a windows color reference and associate with NAME.
1089 This adds or updates a named color to w32-color-map, making it
1090 available for use. The original entry's RGB ref is returned, or nil
1091 if the entry is new. */)
1092 (red
, green
, blue
, name
)
1093 Lisp_Object red
, green
, blue
, name
;
1096 Lisp_Object oldrgb
= Qnil
;
1100 CHECK_NUMBER (green
);
1101 CHECK_NUMBER (blue
);
1102 CHECK_STRING (name
);
1104 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
1108 /* replace existing entry in w32-color-map or add new entry. */
1109 entry
= Fassoc (name
, Vw32_color_map
);
1112 entry
= Fcons (name
, rgb
);
1113 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
1117 oldrgb
= Fcdr (entry
);
1118 Fsetcdr (entry
, rgb
);
1126 DEFUN ("w32-load-color-file", Fw32_load_color_file
,
1127 Sw32_load_color_file
, 1, 1, 0,
1128 doc
: /* Create an alist of color entries from an external file.
1129 Assign this value to w32-color-map to replace the existing color map.
1131 The file should define one named RGB color per line like so:
1133 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
1135 Lisp_Object filename
;
1138 Lisp_Object cmap
= Qnil
;
1139 Lisp_Object abspath
;
1141 CHECK_STRING (filename
);
1142 abspath
= Fexpand_file_name (filename
, Qnil
);
1144 fp
= fopen (XSTRING (filename
)->data
, "rt");
1148 int red
, green
, blue
;
1153 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
1154 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
1156 char *name
= buf
+ num
;
1157 num
= strlen (name
) - 1;
1158 if (name
[num
] == '\n')
1160 cmap
= Fcons (Fcons (build_string (name
),
1161 make_number (RGB (red
, green
, blue
))),
1173 /* The default colors for the w32 color map */
1174 typedef struct colormap_t
1180 colormap_t w32_color_map
[] =
1182 {"snow" , PALETTERGB (255,250,250)},
1183 {"ghost white" , PALETTERGB (248,248,255)},
1184 {"GhostWhite" , PALETTERGB (248,248,255)},
1185 {"white smoke" , PALETTERGB (245,245,245)},
1186 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1187 {"gainsboro" , PALETTERGB (220,220,220)},
1188 {"floral white" , PALETTERGB (255,250,240)},
1189 {"FloralWhite" , PALETTERGB (255,250,240)},
1190 {"old lace" , PALETTERGB (253,245,230)},
1191 {"OldLace" , PALETTERGB (253,245,230)},
1192 {"linen" , PALETTERGB (250,240,230)},
1193 {"antique white" , PALETTERGB (250,235,215)},
1194 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1195 {"papaya whip" , PALETTERGB (255,239,213)},
1196 {"PapayaWhip" , PALETTERGB (255,239,213)},
1197 {"blanched almond" , PALETTERGB (255,235,205)},
1198 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1199 {"bisque" , PALETTERGB (255,228,196)},
1200 {"peach puff" , PALETTERGB (255,218,185)},
1201 {"PeachPuff" , PALETTERGB (255,218,185)},
1202 {"navajo white" , PALETTERGB (255,222,173)},
1203 {"NavajoWhite" , PALETTERGB (255,222,173)},
1204 {"moccasin" , PALETTERGB (255,228,181)},
1205 {"cornsilk" , PALETTERGB (255,248,220)},
1206 {"ivory" , PALETTERGB (255,255,240)},
1207 {"lemon chiffon" , PALETTERGB (255,250,205)},
1208 {"LemonChiffon" , PALETTERGB (255,250,205)},
1209 {"seashell" , PALETTERGB (255,245,238)},
1210 {"honeydew" , PALETTERGB (240,255,240)},
1211 {"mint cream" , PALETTERGB (245,255,250)},
1212 {"MintCream" , PALETTERGB (245,255,250)},
1213 {"azure" , PALETTERGB (240,255,255)},
1214 {"alice blue" , PALETTERGB (240,248,255)},
1215 {"AliceBlue" , PALETTERGB (240,248,255)},
1216 {"lavender" , PALETTERGB (230,230,250)},
1217 {"lavender blush" , PALETTERGB (255,240,245)},
1218 {"LavenderBlush" , PALETTERGB (255,240,245)},
1219 {"misty rose" , PALETTERGB (255,228,225)},
1220 {"MistyRose" , PALETTERGB (255,228,225)},
1221 {"white" , PALETTERGB (255,255,255)},
1222 {"black" , PALETTERGB ( 0, 0, 0)},
1223 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1224 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1225 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1226 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1227 {"dim gray" , PALETTERGB (105,105,105)},
1228 {"DimGray" , PALETTERGB (105,105,105)},
1229 {"dim grey" , PALETTERGB (105,105,105)},
1230 {"DimGrey" , PALETTERGB (105,105,105)},
1231 {"slate gray" , PALETTERGB (112,128,144)},
1232 {"SlateGray" , PALETTERGB (112,128,144)},
1233 {"slate grey" , PALETTERGB (112,128,144)},
1234 {"SlateGrey" , PALETTERGB (112,128,144)},
1235 {"light slate gray" , PALETTERGB (119,136,153)},
1236 {"LightSlateGray" , PALETTERGB (119,136,153)},
1237 {"light slate grey" , PALETTERGB (119,136,153)},
1238 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1239 {"gray" , PALETTERGB (190,190,190)},
1240 {"grey" , PALETTERGB (190,190,190)},
1241 {"light grey" , PALETTERGB (211,211,211)},
1242 {"LightGrey" , PALETTERGB (211,211,211)},
1243 {"light gray" , PALETTERGB (211,211,211)},
1244 {"LightGray" , PALETTERGB (211,211,211)},
1245 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1246 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1247 {"navy" , PALETTERGB ( 0, 0,128)},
1248 {"navy blue" , PALETTERGB ( 0, 0,128)},
1249 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1250 {"cornflower blue" , PALETTERGB (100,149,237)},
1251 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1252 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1253 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1254 {"slate blue" , PALETTERGB (106, 90,205)},
1255 {"SlateBlue" , PALETTERGB (106, 90,205)},
1256 {"medium slate blue" , PALETTERGB (123,104,238)},
1257 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1258 {"light slate blue" , PALETTERGB (132,112,255)},
1259 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1260 {"medium blue" , PALETTERGB ( 0, 0,205)},
1261 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1262 {"royal blue" , PALETTERGB ( 65,105,225)},
1263 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1264 {"blue" , PALETTERGB ( 0, 0,255)},
1265 {"dodger blue" , PALETTERGB ( 30,144,255)},
1266 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1267 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1268 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1269 {"sky blue" , PALETTERGB (135,206,235)},
1270 {"SkyBlue" , PALETTERGB (135,206,235)},
1271 {"light sky blue" , PALETTERGB (135,206,250)},
1272 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1273 {"steel blue" , PALETTERGB ( 70,130,180)},
1274 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1275 {"light steel blue" , PALETTERGB (176,196,222)},
1276 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1277 {"light blue" , PALETTERGB (173,216,230)},
1278 {"LightBlue" , PALETTERGB (173,216,230)},
1279 {"powder blue" , PALETTERGB (176,224,230)},
1280 {"PowderBlue" , PALETTERGB (176,224,230)},
1281 {"pale turquoise" , PALETTERGB (175,238,238)},
1282 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1283 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1284 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1285 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1286 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1287 {"turquoise" , PALETTERGB ( 64,224,208)},
1288 {"cyan" , PALETTERGB ( 0,255,255)},
1289 {"light cyan" , PALETTERGB (224,255,255)},
1290 {"LightCyan" , PALETTERGB (224,255,255)},
1291 {"cadet blue" , PALETTERGB ( 95,158,160)},
1292 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1293 {"medium aquamarine" , PALETTERGB (102,205,170)},
1294 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1295 {"aquamarine" , PALETTERGB (127,255,212)},
1296 {"dark green" , PALETTERGB ( 0,100, 0)},
1297 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1298 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1299 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1300 {"dark sea green" , PALETTERGB (143,188,143)},
1301 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1302 {"sea green" , PALETTERGB ( 46,139, 87)},
1303 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1304 {"medium sea green" , PALETTERGB ( 60,179,113)},
1305 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1306 {"light sea green" , PALETTERGB ( 32,178,170)},
1307 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1308 {"pale green" , PALETTERGB (152,251,152)},
1309 {"PaleGreen" , PALETTERGB (152,251,152)},
1310 {"spring green" , PALETTERGB ( 0,255,127)},
1311 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1312 {"lawn green" , PALETTERGB (124,252, 0)},
1313 {"LawnGreen" , PALETTERGB (124,252, 0)},
1314 {"green" , PALETTERGB ( 0,255, 0)},
1315 {"chartreuse" , PALETTERGB (127,255, 0)},
1316 {"medium spring green" , PALETTERGB ( 0,250,154)},
1317 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1318 {"green yellow" , PALETTERGB (173,255, 47)},
1319 {"GreenYellow" , PALETTERGB (173,255, 47)},
1320 {"lime green" , PALETTERGB ( 50,205, 50)},
1321 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1322 {"yellow green" , PALETTERGB (154,205, 50)},
1323 {"YellowGreen" , PALETTERGB (154,205, 50)},
1324 {"forest green" , PALETTERGB ( 34,139, 34)},
1325 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1326 {"olive drab" , PALETTERGB (107,142, 35)},
1327 {"OliveDrab" , PALETTERGB (107,142, 35)},
1328 {"dark khaki" , PALETTERGB (189,183,107)},
1329 {"DarkKhaki" , PALETTERGB (189,183,107)},
1330 {"khaki" , PALETTERGB (240,230,140)},
1331 {"pale goldenrod" , PALETTERGB (238,232,170)},
1332 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1333 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1334 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1335 {"light yellow" , PALETTERGB (255,255,224)},
1336 {"LightYellow" , PALETTERGB (255,255,224)},
1337 {"yellow" , PALETTERGB (255,255, 0)},
1338 {"gold" , PALETTERGB (255,215, 0)},
1339 {"light goldenrod" , PALETTERGB (238,221,130)},
1340 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1341 {"goldenrod" , PALETTERGB (218,165, 32)},
1342 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1343 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1344 {"rosy brown" , PALETTERGB (188,143,143)},
1345 {"RosyBrown" , PALETTERGB (188,143,143)},
1346 {"indian red" , PALETTERGB (205, 92, 92)},
1347 {"IndianRed" , PALETTERGB (205, 92, 92)},
1348 {"saddle brown" , PALETTERGB (139, 69, 19)},
1349 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1350 {"sienna" , PALETTERGB (160, 82, 45)},
1351 {"peru" , PALETTERGB (205,133, 63)},
1352 {"burlywood" , PALETTERGB (222,184,135)},
1353 {"beige" , PALETTERGB (245,245,220)},
1354 {"wheat" , PALETTERGB (245,222,179)},
1355 {"sandy brown" , PALETTERGB (244,164, 96)},
1356 {"SandyBrown" , PALETTERGB (244,164, 96)},
1357 {"tan" , PALETTERGB (210,180,140)},
1358 {"chocolate" , PALETTERGB (210,105, 30)},
1359 {"firebrick" , PALETTERGB (178,34, 34)},
1360 {"brown" , PALETTERGB (165,42, 42)},
1361 {"dark salmon" , PALETTERGB (233,150,122)},
1362 {"DarkSalmon" , PALETTERGB (233,150,122)},
1363 {"salmon" , PALETTERGB (250,128,114)},
1364 {"light salmon" , PALETTERGB (255,160,122)},
1365 {"LightSalmon" , PALETTERGB (255,160,122)},
1366 {"orange" , PALETTERGB (255,165, 0)},
1367 {"dark orange" , PALETTERGB (255,140, 0)},
1368 {"DarkOrange" , PALETTERGB (255,140, 0)},
1369 {"coral" , PALETTERGB (255,127, 80)},
1370 {"light coral" , PALETTERGB (240,128,128)},
1371 {"LightCoral" , PALETTERGB (240,128,128)},
1372 {"tomato" , PALETTERGB (255, 99, 71)},
1373 {"orange red" , PALETTERGB (255, 69, 0)},
1374 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1375 {"red" , PALETTERGB (255, 0, 0)},
1376 {"hot pink" , PALETTERGB (255,105,180)},
1377 {"HotPink" , PALETTERGB (255,105,180)},
1378 {"deep pink" , PALETTERGB (255, 20,147)},
1379 {"DeepPink" , PALETTERGB (255, 20,147)},
1380 {"pink" , PALETTERGB (255,192,203)},
1381 {"light pink" , PALETTERGB (255,182,193)},
1382 {"LightPink" , PALETTERGB (255,182,193)},
1383 {"pale violet red" , PALETTERGB (219,112,147)},
1384 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1385 {"maroon" , PALETTERGB (176, 48, 96)},
1386 {"medium violet red" , PALETTERGB (199, 21,133)},
1387 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1388 {"violet red" , PALETTERGB (208, 32,144)},
1389 {"VioletRed" , PALETTERGB (208, 32,144)},
1390 {"magenta" , PALETTERGB (255, 0,255)},
1391 {"violet" , PALETTERGB (238,130,238)},
1392 {"plum" , PALETTERGB (221,160,221)},
1393 {"orchid" , PALETTERGB (218,112,214)},
1394 {"medium orchid" , PALETTERGB (186, 85,211)},
1395 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1396 {"dark orchid" , PALETTERGB (153, 50,204)},
1397 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1398 {"dark violet" , PALETTERGB (148, 0,211)},
1399 {"DarkViolet" , PALETTERGB (148, 0,211)},
1400 {"blue violet" , PALETTERGB (138, 43,226)},
1401 {"BlueViolet" , PALETTERGB (138, 43,226)},
1402 {"purple" , PALETTERGB (160, 32,240)},
1403 {"medium purple" , PALETTERGB (147,112,219)},
1404 {"MediumPurple" , PALETTERGB (147,112,219)},
1405 {"thistle" , PALETTERGB (216,191,216)},
1406 {"gray0" , PALETTERGB ( 0, 0, 0)},
1407 {"grey0" , PALETTERGB ( 0, 0, 0)},
1408 {"dark grey" , PALETTERGB (169,169,169)},
1409 {"DarkGrey" , PALETTERGB (169,169,169)},
1410 {"dark gray" , PALETTERGB (169,169,169)},
1411 {"DarkGray" , PALETTERGB (169,169,169)},
1412 {"dark blue" , PALETTERGB ( 0, 0,139)},
1413 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1414 {"dark cyan" , PALETTERGB ( 0,139,139)},
1415 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1416 {"dark magenta" , PALETTERGB (139, 0,139)},
1417 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1418 {"dark red" , PALETTERGB (139, 0, 0)},
1419 {"DarkRed" , PALETTERGB (139, 0, 0)},
1420 {"light green" , PALETTERGB (144,238,144)},
1421 {"LightGreen" , PALETTERGB (144,238,144)},
1424 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1425 0, 0, 0, doc
: /* Return the default color map. */)
1429 colormap_t
*pc
= w32_color_map
;
1436 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1438 cmap
= Fcons (Fcons (build_string (pc
->name
),
1439 make_number (pc
->colorref
)),
1448 w32_to_x_color (rgb
)
1457 color
= Frassq (rgb
, Vw32_color_map
);
1462 return (Fcar (color
));
1468 w32_color_map_lookup (colorname
)
1471 Lisp_Object tail
, ret
= Qnil
;
1475 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1477 register Lisp_Object elt
, tem
;
1480 if (!CONSP (elt
)) continue;
1484 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1486 ret
= XUINT (Fcdr (elt
));
1500 x_to_w32_color (colorname
)
1503 register Lisp_Object ret
= Qnil
;
1507 if (colorname
[0] == '#')
1509 /* Could be an old-style RGB Device specification. */
1512 color
= colorname
+ 1;
1514 size
= strlen(color
);
1515 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1523 for (i
= 0; i
< 3; i
++)
1527 unsigned long value
;
1529 /* The check for 'x' in the following conditional takes into
1530 account the fact that strtol allows a "0x" in front of
1531 our numbers, and we don't. */
1532 if (!isxdigit(color
[0]) || color
[1] == 'x')
1536 value
= strtoul(color
, &end
, 16);
1538 if (errno
== ERANGE
|| end
- color
!= size
)
1543 value
= value
* 0x10;
1554 colorval
|= (value
<< pos
);
1565 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1573 color
= colorname
+ 4;
1574 for (i
= 0; i
< 3; i
++)
1577 unsigned long value
;
1579 /* The check for 'x' in the following conditional takes into
1580 account the fact that strtol allows a "0x" in front of
1581 our numbers, and we don't. */
1582 if (!isxdigit(color
[0]) || color
[1] == 'x')
1584 value
= strtoul(color
, &end
, 16);
1585 if (errno
== ERANGE
)
1587 switch (end
- color
)
1590 value
= value
* 0x10 + value
;
1603 if (value
== ULONG_MAX
)
1605 colorval
|= (value
<< pos
);
1619 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1621 /* This is an RGB Intensity specification. */
1628 color
= colorname
+ 5;
1629 for (i
= 0; i
< 3; i
++)
1635 value
= strtod(color
, &end
);
1636 if (errno
== ERANGE
)
1638 if (value
< 0.0 || value
> 1.0)
1640 val
= (UINT
)(0x100 * value
);
1641 /* We used 0x100 instead of 0xFF to give an continuous
1642 range between 0.0 and 1.0 inclusive. The next statement
1643 fixes the 1.0 case. */
1646 colorval
|= (val
<< pos
);
1660 /* I am not going to attempt to handle any of the CIE color schemes
1661 or TekHVC, since I don't know the algorithms for conversion to
1664 /* If we fail to lookup the color name in w32_color_map, then check the
1665 colorname to see if it can be crudely approximated: If the X color
1666 ends in a number (e.g., "darkseagreen2"), strip the number and
1667 return the result of looking up the base color name. */
1668 ret
= w32_color_map_lookup (colorname
);
1671 int len
= strlen (colorname
);
1673 if (isdigit (colorname
[len
- 1]))
1675 char *ptr
, *approx
= alloca (len
+ 1);
1677 strcpy (approx
, colorname
);
1678 ptr
= &approx
[len
- 1];
1679 while (ptr
> approx
&& isdigit (*ptr
))
1682 ret
= w32_color_map_lookup (approx
);
1692 w32_regenerate_palette (FRAME_PTR f
)
1694 struct w32_palette_entry
* list
;
1695 LOGPALETTE
* log_palette
;
1696 HPALETTE new_palette
;
1699 /* don't bother trying to create palette if not supported */
1700 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1703 log_palette
= (LOGPALETTE
*)
1704 alloca (sizeof (LOGPALETTE
) +
1705 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1706 log_palette
->palVersion
= 0x300;
1707 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1709 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1711 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1712 i
++, list
= list
->next
)
1713 log_palette
->palPalEntry
[i
] = list
->entry
;
1715 new_palette
= CreatePalette (log_palette
);
1719 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1720 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1721 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1723 /* Realize display palette and garbage all frames. */
1724 release_frame_dc (f
, get_frame_dc (f
));
1729 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1730 #define SET_W32_COLOR(pe, color) \
1733 pe.peRed = GetRValue (color); \
1734 pe.peGreen = GetGValue (color); \
1735 pe.peBlue = GetBValue (color); \
1740 /* Keep these around in case we ever want to track color usage. */
1742 w32_map_color (FRAME_PTR f
, COLORREF color
)
1744 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1746 if (NILP (Vw32_enable_palette
))
1749 /* check if color is already mapped */
1752 if (W32_COLOR (list
->entry
) == color
)
1760 /* not already mapped, so add to list and recreate Windows palette */
1761 list
= (struct w32_palette_entry
*)
1762 xmalloc (sizeof (struct w32_palette_entry
));
1763 SET_W32_COLOR (list
->entry
, color
);
1765 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1766 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1767 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1769 /* set flag that palette must be regenerated */
1770 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1774 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1776 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1777 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1779 if (NILP (Vw32_enable_palette
))
1782 /* check if color is already mapped */
1785 if (W32_COLOR (list
->entry
) == color
)
1787 if (--list
->refcount
== 0)
1791 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1801 /* set flag that palette must be regenerated */
1802 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1807 /* Gamma-correct COLOR on frame F. */
1810 gamma_correct (f
, color
)
1816 *color
= PALETTERGB (
1817 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1818 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1819 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1824 /* Decide if color named COLOR is valid for the display associated with
1825 the selected frame; if so, return the rgb values in COLOR_DEF.
1826 If ALLOC is nonzero, allocate a new colormap cell. */
1829 w32_defined_color (f
, color
, color_def
, alloc
)
1835 register Lisp_Object tem
;
1836 COLORREF w32_color_ref
;
1838 tem
= x_to_w32_color (color
);
1844 /* Apply gamma correction. */
1845 w32_color_ref
= XUINT (tem
);
1846 gamma_correct (f
, &w32_color_ref
);
1847 XSETINT (tem
, w32_color_ref
);
1850 /* Map this color to the palette if it is enabled. */
1851 if (!NILP (Vw32_enable_palette
))
1853 struct w32_palette_entry
* entry
=
1854 one_w32_display_info
.color_list
;
1855 struct w32_palette_entry
** prev
=
1856 &one_w32_display_info
.color_list
;
1858 /* check if color is already mapped */
1861 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1863 prev
= &entry
->next
;
1864 entry
= entry
->next
;
1867 if (entry
== NULL
&& alloc
)
1869 /* not already mapped, so add to list */
1870 entry
= (struct w32_palette_entry
*)
1871 xmalloc (sizeof (struct w32_palette_entry
));
1872 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1875 one_w32_display_info
.num_colors
++;
1877 /* set flag that palette must be regenerated */
1878 one_w32_display_info
.regen_palette
= TRUE
;
1881 /* Ensure COLORREF value is snapped to nearest color in (default)
1882 palette by simulating the PALETTERGB macro. This works whether
1883 or not the display device has a palette. */
1884 w32_color_ref
= XUINT (tem
) | 0x2000000;
1886 color_def
->pixel
= w32_color_ref
;
1887 color_def
->red
= GetRValue (w32_color_ref
);
1888 color_def
->green
= GetGValue (w32_color_ref
);
1889 color_def
->blue
= GetBValue (w32_color_ref
);
1899 /* Given a string ARG naming a color, compute a pixel value from it
1900 suitable for screen F.
1901 If F is not a color screen, return DEF (default) regardless of what
1905 x_decode_color (f
, arg
, def
)
1914 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1915 return BLACK_PIX_DEFAULT (f
);
1916 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1917 return WHITE_PIX_DEFAULT (f
);
1919 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1922 /* w32_defined_color is responsible for coping with failures
1923 by looking for a near-miss. */
1924 if (w32_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1927 /* defined_color failed; return an ultimate default. */
1931 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1932 the previous value of that parameter, NEW_VALUE is the new value. */
1935 x_set_line_spacing (f
, new_value
, old_value
)
1937 Lisp_Object new_value
, old_value
;
1939 if (NILP (new_value
))
1940 f
->extra_line_spacing
= 0;
1941 else if (NATNUMP (new_value
))
1942 f
->extra_line_spacing
= XFASTINT (new_value
);
1944 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1945 Fcons (new_value
, Qnil
)));
1946 if (FRAME_VISIBLE_P (f
))
1951 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1952 the previous value of that parameter, NEW_VALUE is the new value. */
1955 x_set_screen_gamma (f
, new_value
, old_value
)
1957 Lisp_Object new_value
, old_value
;
1959 if (NILP (new_value
))
1961 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1962 /* The value 0.4545 is the normal viewing gamma. */
1963 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1965 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1966 Fcons (new_value
, Qnil
)));
1968 clear_face_cache (0);
1972 /* Functions called only from `x_set_frame_param'
1973 to set individual parameters.
1975 If FRAME_W32_WINDOW (f) is 0,
1976 the frame is being created and its window does not exist yet.
1977 In that case, just record the parameter's new value
1978 in the standard place; do not attempt to change the window. */
1981 x_set_foreground_color (f
, arg
, oldval
)
1983 Lisp_Object arg
, oldval
;
1985 struct w32_output
*x
= f
->output_data
.w32
;
1986 PIX_TYPE fg
, old_fg
;
1988 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1989 old_fg
= FRAME_FOREGROUND_PIXEL (f
);
1990 FRAME_FOREGROUND_PIXEL (f
) = fg
;
1992 if (FRAME_W32_WINDOW (f
) != 0)
1994 if (x
->cursor_pixel
== old_fg
)
1995 x
->cursor_pixel
= fg
;
1997 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1998 if (FRAME_VISIBLE_P (f
))
2004 x_set_background_color (f
, arg
, oldval
)
2006 Lisp_Object arg
, oldval
;
2008 FRAME_BACKGROUND_PIXEL (f
)
2009 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
2011 if (FRAME_W32_WINDOW (f
) != 0)
2013 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
2014 FRAME_BACKGROUND_PIXEL (f
));
2016 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
2018 if (FRAME_VISIBLE_P (f
))
2024 x_set_mouse_color (f
, arg
, oldval
)
2026 Lisp_Object arg
, oldval
;
2028 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
2032 if (!EQ (Qnil
, arg
))
2033 f
->output_data
.w32
->mouse_pixel
2034 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2035 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
2037 /* Don't let pointers be invisible. */
2038 if (mask_color
== f
->output_data
.w32
->mouse_pixel
2039 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
2040 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
2042 #if 0 /* TODO : cursor changes */
2045 /* It's not okay to crash if the user selects a screwy cursor. */
2046 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
2048 if (!EQ (Qnil
, Vx_pointer_shape
))
2050 CHECK_NUMBER (Vx_pointer_shape
);
2051 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
2054 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2055 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
2057 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
2059 CHECK_NUMBER (Vx_nontext_pointer_shape
);
2060 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2061 XINT (Vx_nontext_pointer_shape
));
2064 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
2065 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2067 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
2069 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
2070 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2071 XINT (Vx_hourglass_pointer_shape
));
2074 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
2075 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
2077 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2078 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
2080 CHECK_NUMBER (Vx_mode_pointer_shape
);
2081 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2082 XINT (Vx_mode_pointer_shape
));
2085 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2086 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
2088 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
2090 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
2092 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2093 XINT (Vx_sensitive_text_pointer_shape
));
2096 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
2098 if (!NILP (Vx_window_horizontal_drag_shape
))
2100 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
2101 horizontal_drag_cursor
2102 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
2103 XINT (Vx_window_horizontal_drag_shape
));
2106 horizontal_drag_cursor
2107 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
2109 /* Check and report errors with the above calls. */
2110 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
2111 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
2114 XColor fore_color
, back_color
;
2116 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
2117 back_color
.pixel
= mask_color
;
2118 XQueryColor (FRAME_W32_DISPLAY (f
),
2119 DefaultColormap (FRAME_W32_DISPLAY (f
),
2120 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2122 XQueryColor (FRAME_W32_DISPLAY (f
),
2123 DefaultColormap (FRAME_W32_DISPLAY (f
),
2124 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2126 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
2127 &fore_color
, &back_color
);
2128 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
2129 &fore_color
, &back_color
);
2130 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
2131 &fore_color
, &back_color
);
2132 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
2133 &fore_color
, &back_color
);
2134 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
2135 &fore_color
, &back_color
);
2138 if (FRAME_W32_WINDOW (f
) != 0)
2139 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
2141 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
2142 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
2143 f
->output_data
.w32
->text_cursor
= cursor
;
2145 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
2146 && f
->output_data
.w32
->nontext_cursor
!= 0)
2147 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
2148 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
2150 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
2151 && f
->output_data
.w32
->hourglass_cursor
!= 0)
2152 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
2153 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
2155 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
2156 && f
->output_data
.w32
->modeline_cursor
!= 0)
2157 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
2158 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
2160 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
2161 && f
->output_data
.w32
->cross_cursor
!= 0)
2162 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
2163 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
2165 XFlush (FRAME_W32_DISPLAY (f
));
2168 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
2172 /* Defined in w32term.c. */
2173 void x_update_cursor (struct frame
*f
, int on_p
);
2176 x_set_cursor_color (f
, arg
, oldval
)
2178 Lisp_Object arg
, oldval
;
2180 unsigned long fore_pixel
, pixel
;
2182 if (!NILP (Vx_cursor_fore_pixel
))
2183 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
2184 WHITE_PIX_DEFAULT (f
));
2186 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2188 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2190 /* Make sure that the cursor color differs from the background color. */
2191 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
2193 pixel
= f
->output_data
.w32
->mouse_pixel
;
2194 if (pixel
== fore_pixel
)
2195 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2198 FRAME_FOREGROUND_PIXEL (f
) = fore_pixel
;
2199 f
->output_data
.w32
->cursor_pixel
= pixel
;
2201 if (FRAME_W32_WINDOW (f
) != 0)
2203 if (FRAME_VISIBLE_P (f
))
2205 x_update_cursor (f
, 0);
2206 x_update_cursor (f
, 1);
2210 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
2213 /* Set the border-color of frame F to pixel value PIX.
2214 Note that this does not fully take effect if done before
2217 x_set_border_pixel (f
, pix
)
2221 f
->output_data
.w32
->border_pixel
= pix
;
2223 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
2225 if (FRAME_VISIBLE_P (f
))
2230 /* Set the border-color of frame F to value described by ARG.
2231 ARG can be a string naming a color.
2232 The border-color is used for the border that is drawn by the server.
2233 Note that this does not fully take effect if done before
2234 F has a window; it must be redone when the window is created. */
2237 x_set_border_color (f
, arg
, oldval
)
2239 Lisp_Object arg
, oldval
;
2244 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2245 x_set_border_pixel (f
, pix
);
2246 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
2249 /* Value is the internal representation of the specified cursor type
2250 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
2251 of the bar cursor. */
2253 enum text_cursor_kinds
2254 x_specified_cursor_type (arg
, width
)
2258 enum text_cursor_kinds type
;
2265 else if (CONSP (arg
)
2266 && EQ (XCAR (arg
), Qbar
)
2267 && INTEGERP (XCDR (arg
))
2268 && XINT (XCDR (arg
)) >= 0)
2271 *width
= XINT (XCDR (arg
));
2273 else if (NILP (arg
))
2276 /* Treat anything unknown as "box cursor".
2277 It was bad to signal an error; people have trouble fixing
2278 .Xdefaults with Emacs, when it has something bad in it. */
2279 type
= FILLED_BOX_CURSOR
;
2285 x_set_cursor_type (f
, arg
, oldval
)
2287 Lisp_Object arg
, oldval
;
2291 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
2292 f
->output_data
.w32
->cursor_width
= width
;
2294 /* Make sure the cursor gets redrawn. This is overkill, but how
2295 often do people change cursor types? */
2296 update_mode_lines
++;
2300 x_set_icon_type (f
, arg
, oldval
)
2302 Lisp_Object arg
, oldval
;
2306 if (NILP (arg
) && NILP (oldval
))
2309 if (STRINGP (arg
) && STRINGP (oldval
)
2310 && EQ (Fstring_equal (oldval
, arg
), Qt
))
2313 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
2318 result
= x_bitmap_icon (f
, arg
);
2322 error ("No icon window available");
2328 /* Return non-nil if frame F wants a bitmap icon. */
2336 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
2344 x_set_icon_name (f
, arg
, oldval
)
2346 Lisp_Object arg
, oldval
;
2350 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2353 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2359 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2364 result
= x_text_icon (f
,
2365 (char *) XSTRING ((!NILP (f
->icon_name
)
2374 error ("No icon window available");
2377 /* If the window was unmapped (and its icon was mapped),
2378 the new icon is not mapped, so map the window in its stead. */
2379 if (FRAME_VISIBLE_P (f
))
2381 #ifdef USE_X_TOOLKIT
2382 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2384 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2387 XFlush (FRAME_W32_DISPLAY (f
));
2392 extern Lisp_Object
x_new_font ();
2393 extern Lisp_Object
x_new_fontset();
2396 x_set_font (f
, arg
, oldval
)
2398 Lisp_Object arg
, oldval
;
2401 Lisp_Object fontset_name
;
2403 int old_fontset
= FRAME_FONTSET(f
);
2407 fontset_name
= Fquery_fontset (arg
, Qnil
);
2410 result
= (STRINGP (fontset_name
)
2411 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
2412 : x_new_font (f
, XSTRING (arg
)->data
));
2415 if (EQ (result
, Qnil
))
2416 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
2417 else if (EQ (result
, Qt
))
2418 error ("The characters of the given font have varying widths");
2419 else if (STRINGP (result
))
2421 if (STRINGP (fontset_name
))
2423 /* Fontset names are built from ASCII font names, so the
2424 names may be equal despite there was a change. */
2425 if (old_fontset
== FRAME_FONTSET (f
))
2428 else if (!NILP (Fequal (result
, oldval
)))
2431 store_frame_param (f
, Qfont
, result
);
2432 recompute_basic_faces (f
);
2437 do_pending_window_change (0);
2439 /* Don't call `face-set-after-frame-default' when faces haven't been
2440 initialized yet. This is the case when called from
2441 Fx_create_frame. In that case, the X widget or window doesn't
2442 exist either, and we can end up in x_report_frame_params with a
2443 null widget which gives a segfault. */
2444 if (FRAME_FACE_CACHE (f
))
2446 XSETFRAME (frame
, f
);
2447 call1 (Qface_set_after_frame_default
, frame
);
2452 x_set_fringe_width (f
, new_value
, old_value
)
2454 Lisp_Object new_value
, old_value
;
2456 x_compute_fringe_widths (f
, 1);
2460 x_set_border_width (f
, arg
, oldval
)
2462 Lisp_Object arg
, oldval
;
2466 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2469 if (FRAME_W32_WINDOW (f
) != 0)
2470 error ("Cannot change the border width of a window");
2472 f
->output_data
.w32
->border_width
= XINT (arg
);
2476 x_set_internal_border_width (f
, arg
, oldval
)
2478 Lisp_Object arg
, oldval
;
2480 int old
= f
->output_data
.w32
->internal_border_width
;
2483 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2484 if (f
->output_data
.w32
->internal_border_width
< 0)
2485 f
->output_data
.w32
->internal_border_width
= 0;
2487 if (f
->output_data
.w32
->internal_border_width
== old
)
2490 if (FRAME_W32_WINDOW (f
) != 0)
2492 x_set_window_size (f
, 0, f
->width
, f
->height
);
2493 SET_FRAME_GARBAGED (f
);
2494 do_pending_window_change (0);
2497 SET_FRAME_GARBAGED (f
);
2501 x_set_visibility (f
, value
, oldval
)
2503 Lisp_Object value
, oldval
;
2506 XSETFRAME (frame
, f
);
2509 Fmake_frame_invisible (frame
, Qt
);
2510 else if (EQ (value
, Qicon
))
2511 Ficonify_frame (frame
);
2513 Fmake_frame_visible (frame
);
2517 /* Change window heights in windows rooted in WINDOW by N lines. */
2520 x_change_window_heights (window
, n
)
2524 struct window
*w
= XWINDOW (window
);
2526 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2527 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2529 if (INTEGERP (w
->orig_top
))
2530 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2531 if (INTEGERP (w
->orig_height
))
2532 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2534 /* Handle just the top child in a vertical split. */
2535 if (!NILP (w
->vchild
))
2536 x_change_window_heights (w
->vchild
, n
);
2538 /* Adjust all children in a horizontal split. */
2539 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2541 w
= XWINDOW (window
);
2542 x_change_window_heights (window
, n
);
2547 x_set_menu_bar_lines (f
, value
, oldval
)
2549 Lisp_Object value
, oldval
;
2552 int olines
= FRAME_MENU_BAR_LINES (f
);
2554 /* Right now, menu bars don't work properly in minibuf-only frames;
2555 most of the commands try to apply themselves to the minibuffer
2556 frame itself, and get an error because you can't switch buffers
2557 in or split the minibuffer window. */
2558 if (FRAME_MINIBUF_ONLY_P (f
))
2561 if (INTEGERP (value
))
2562 nlines
= XINT (value
);
2566 FRAME_MENU_BAR_LINES (f
) = 0;
2568 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2571 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2572 free_frame_menubar (f
);
2573 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2575 /* Adjust the frame size so that the client (text) dimensions
2576 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2578 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2579 do_pending_window_change (0);
2585 /* Set the number of lines used for the tool bar of frame F to VALUE.
2586 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2587 is the old number of tool bar lines. This function changes the
2588 height of all windows on frame F to match the new tool bar height.
2589 The frame's height doesn't change. */
2592 x_set_tool_bar_lines (f
, value
, oldval
)
2594 Lisp_Object value
, oldval
;
2596 int delta
, nlines
, root_height
;
2597 Lisp_Object root_window
;
2599 /* Treat tool bars like menu bars. */
2600 if (FRAME_MINIBUF_ONLY_P (f
))
2603 /* Use VALUE only if an integer >= 0. */
2604 if (INTEGERP (value
) && XINT (value
) >= 0)
2605 nlines
= XFASTINT (value
);
2609 /* Make sure we redisplay all windows in this frame. */
2610 ++windows_or_buffers_changed
;
2612 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2614 /* Don't resize the tool-bar to more than we have room for. */
2615 root_window
= FRAME_ROOT_WINDOW (f
);
2616 root_height
= XINT (XWINDOW (root_window
)->height
);
2617 if (root_height
- delta
< 1)
2619 delta
= root_height
- 1;
2620 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2623 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2624 x_change_window_heights (root_window
, delta
);
2627 /* We also have to make sure that the internal border at the top of
2628 the frame, below the menu bar or tool bar, is redrawn when the
2629 tool bar disappears. This is so because the internal border is
2630 below the tool bar if one is displayed, but is below the menu bar
2631 if there isn't a tool bar. The tool bar draws into the area
2632 below the menu bar. */
2633 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2637 clear_current_matrices (f
);
2638 updating_frame
= NULL
;
2641 /* If the tool bar gets smaller, the internal border below it
2642 has to be cleared. It was formerly part of the display
2643 of the larger tool bar, and updating windows won't clear it. */
2646 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2647 int width
= PIXEL_WIDTH (f
);
2648 int y
= nlines
* CANON_Y_UNIT (f
);
2652 HDC hdc
= get_frame_dc (f
);
2653 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
2654 release_frame_dc (f
, hdc
);
2658 if (WINDOWP (f
->tool_bar_window
))
2659 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2664 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2667 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2668 name; if NAME is a string, set F's name to NAME and set
2669 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2671 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2672 suggesting a new name, which lisp code should override; if
2673 F->explicit_name is set, ignore the new name; otherwise, set it. */
2676 x_set_name (f
, name
, explicit)
2681 /* Make sure that requests from lisp code override requests from
2682 Emacs redisplay code. */
2685 /* If we're switching from explicit to implicit, we had better
2686 update the mode lines and thereby update the title. */
2687 if (f
->explicit_name
&& NILP (name
))
2688 update_mode_lines
= 1;
2690 f
->explicit_name
= ! NILP (name
);
2692 else if (f
->explicit_name
)
2695 /* If NAME is nil, set the name to the w32_id_name. */
2698 /* Check for no change needed in this very common case
2699 before we do any consing. */
2700 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2701 XSTRING (f
->name
)->data
))
2703 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2706 CHECK_STRING (name
);
2708 /* Don't change the name if it's already NAME. */
2709 if (! NILP (Fstring_equal (name
, f
->name
)))
2714 /* For setting the frame title, the title parameter should override
2715 the name parameter. */
2716 if (! NILP (f
->title
))
2719 if (FRAME_W32_WINDOW (f
))
2721 if (STRING_MULTIBYTE (name
))
2722 name
= ENCODE_SYSTEM (name
);
2725 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2730 /* This function should be called when the user's lisp code has
2731 specified a name for the frame; the name will override any set by the
2734 x_explicitly_set_name (f
, arg
, oldval
)
2736 Lisp_Object arg
, oldval
;
2738 x_set_name (f
, arg
, 1);
2741 /* This function should be called by Emacs redisplay code to set the
2742 name; names set this way will never override names set by the user's
2745 x_implicitly_set_name (f
, arg
, oldval
)
2747 Lisp_Object arg
, oldval
;
2749 x_set_name (f
, arg
, 0);
2752 /* Change the title of frame F to NAME.
2753 If NAME is nil, use the frame name as the title.
2755 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2756 name; if NAME is a string, set F's name to NAME and set
2757 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2759 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2760 suggesting a new name, which lisp code should override; if
2761 F->explicit_name is set, ignore the new name; otherwise, set it. */
2764 x_set_title (f
, name
, old_name
)
2766 Lisp_Object name
, old_name
;
2768 /* Don't change the title if it's already NAME. */
2769 if (EQ (name
, f
->title
))
2772 update_mode_lines
= 1;
2779 if (FRAME_W32_WINDOW (f
))
2781 if (STRING_MULTIBYTE (name
))
2782 name
= ENCODE_SYSTEM (name
);
2785 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2791 x_set_autoraise (f
, arg
, oldval
)
2793 Lisp_Object arg
, oldval
;
2795 f
->auto_raise
= !EQ (Qnil
, arg
);
2799 x_set_autolower (f
, arg
, oldval
)
2801 Lisp_Object arg
, oldval
;
2803 f
->auto_lower
= !EQ (Qnil
, arg
);
2807 x_set_unsplittable (f
, arg
, oldval
)
2809 Lisp_Object arg
, oldval
;
2811 f
->no_split
= !NILP (arg
);
2815 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2817 Lisp_Object arg
, oldval
;
2819 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2820 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2821 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2822 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2824 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2825 vertical_scroll_bar_none
:
2826 /* Put scroll bars on the right by default, as is conventional
2829 ? vertical_scroll_bar_left
2830 : vertical_scroll_bar_right
;
2832 /* We set this parameter before creating the window for the
2833 frame, so we can get the geometry right from the start.
2834 However, if the window hasn't been created yet, we shouldn't
2835 call x_set_window_size. */
2836 if (FRAME_W32_WINDOW (f
))
2837 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2838 do_pending_window_change (0);
2843 x_set_scroll_bar_width (f
, arg
, oldval
)
2845 Lisp_Object arg
, oldval
;
2847 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2851 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
2852 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) +
2854 if (FRAME_W32_WINDOW (f
))
2855 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2856 do_pending_window_change (0);
2858 else if (INTEGERP (arg
) && XINT (arg
) > 0
2859 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2861 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2862 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2864 if (FRAME_W32_WINDOW (f
))
2865 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2866 do_pending_window_change (0);
2868 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2869 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2870 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2873 /* Subroutines of creating an frame. */
2875 /* Make sure that Vx_resource_name is set to a reasonable value.
2876 Fix it up, or set it to `emacs' if it is too hopeless. */
2879 validate_x_resource_name ()
2882 /* Number of valid characters in the resource name. */
2884 /* Number of invalid characters in the resource name. */
2889 if (STRINGP (Vx_resource_name
))
2891 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2894 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2896 /* Only letters, digits, - and _ are valid in resource names.
2897 Count the valid characters and count the invalid ones. */
2898 for (i
= 0; i
< len
; i
++)
2901 if (! ((c
>= 'a' && c
<= 'z')
2902 || (c
>= 'A' && c
<= 'Z')
2903 || (c
>= '0' && c
<= '9')
2904 || c
== '-' || c
== '_'))
2911 /* Not a string => completely invalid. */
2912 bad_count
= 5, good_count
= 0;
2914 /* If name is valid already, return. */
2918 /* If name is entirely invalid, or nearly so, use `emacs'. */
2920 || (good_count
== 1 && bad_count
> 0))
2922 Vx_resource_name
= build_string ("emacs");
2926 /* Name is partly valid. Copy it and replace the invalid characters
2927 with underscores. */
2929 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2931 for (i
= 0; i
< len
; i
++)
2933 int c
= XSTRING (new)->data
[i
];
2934 if (! ((c
>= 'a' && c
<= 'z')
2935 || (c
>= 'A' && c
<= 'Z')
2936 || (c
>= '0' && c
<= '9')
2937 || c
== '-' || c
== '_'))
2938 XSTRING (new)->data
[i
] = '_';
2943 extern char *x_get_string_resource ();
2945 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2946 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2947 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2948 class, where INSTANCE is the name under which Emacs was invoked, or
2949 the name specified by the `-name' or `-rn' command-line arguments.
2951 The optional arguments COMPONENT and SUBCLASS add to the key and the
2952 class, respectively. You must specify both of them or neither.
2953 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2954 and the class is `Emacs.CLASS.SUBCLASS'. */)
2955 (attribute
, class, component
, subclass
)
2956 Lisp_Object attribute
, class, component
, subclass
;
2958 register char *value
;
2962 CHECK_STRING (attribute
);
2963 CHECK_STRING (class);
2965 if (!NILP (component
))
2966 CHECK_STRING (component
);
2967 if (!NILP (subclass
))
2968 CHECK_STRING (subclass
);
2969 if (NILP (component
) != NILP (subclass
))
2970 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2972 validate_x_resource_name ();
2974 /* Allocate space for the components, the dots which separate them,
2975 and the final '\0'. Make them big enough for the worst case. */
2976 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2977 + (STRINGP (component
)
2978 ? STRING_BYTES (XSTRING (component
)) : 0)
2979 + STRING_BYTES (XSTRING (attribute
))
2982 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2983 + STRING_BYTES (XSTRING (class))
2984 + (STRINGP (subclass
)
2985 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2988 /* Start with emacs.FRAMENAME for the name (the specific one)
2989 and with `Emacs' for the class key (the general one). */
2990 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2991 strcpy (class_key
, EMACS_CLASS
);
2993 strcat (class_key
, ".");
2994 strcat (class_key
, XSTRING (class)->data
);
2996 if (!NILP (component
))
2998 strcat (class_key
, ".");
2999 strcat (class_key
, XSTRING (subclass
)->data
);
3001 strcat (name_key
, ".");
3002 strcat (name_key
, XSTRING (component
)->data
);
3005 strcat (name_key
, ".");
3006 strcat (name_key
, XSTRING (attribute
)->data
);
3008 value
= x_get_string_resource (Qnil
,
3009 name_key
, class_key
);
3011 if (value
!= (char *) 0)
3012 return build_string (value
);
3017 /* Used when C code wants a resource value. */
3020 x_get_resource_string (attribute
, class)
3021 char *attribute
, *class;
3025 struct frame
*sf
= SELECTED_FRAME ();
3027 /* Allocate space for the components, the dots which separate them,
3028 and the final '\0'. */
3029 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
3030 + strlen (attribute
) + 2);
3031 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3032 + strlen (class) + 2);
3034 sprintf (name_key
, "%s.%s",
3035 XSTRING (Vinvocation_name
)->data
,
3037 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3039 return x_get_string_resource (sf
, name_key
, class_key
);
3042 /* Types we might convert a resource string into. */
3052 /* Return the value of parameter PARAM.
3054 First search ALIST, then Vdefault_frame_alist, then the X defaults
3055 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3057 Convert the resource to the type specified by desired_type.
3059 If no default is specified, return Qunbound. If you call
3060 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
3061 and don't let it get stored in any Lisp-visible variables! */
3064 w32_get_arg (alist
, param
, attribute
, class, type
)
3065 Lisp_Object alist
, param
;
3068 enum resource_types type
;
3070 register Lisp_Object tem
;
3072 tem
= Fassq (param
, alist
);
3074 tem
= Fassq (param
, Vdefault_frame_alist
);
3080 tem
= Fx_get_resource (build_string (attribute
),
3081 build_string (class),
3089 case RES_TYPE_NUMBER
:
3090 return make_number (atoi (XSTRING (tem
)->data
));
3092 case RES_TYPE_FLOAT
:
3093 return make_float (atof (XSTRING (tem
)->data
));
3095 case RES_TYPE_BOOLEAN
:
3096 tem
= Fdowncase (tem
);
3097 if (!strcmp (XSTRING (tem
)->data
, "on")
3098 || !strcmp (XSTRING (tem
)->data
, "true"))
3103 case RES_TYPE_STRING
:
3106 case RES_TYPE_SYMBOL
:
3107 /* As a special case, we map the values `true' and `on'
3108 to Qt, and `false' and `off' to Qnil. */
3111 lower
= Fdowncase (tem
);
3112 if (!strcmp (XSTRING (lower
)->data
, "on")
3113 || !strcmp (XSTRING (lower
)->data
, "true"))
3115 else if (!strcmp (XSTRING (lower
)->data
, "off")
3116 || !strcmp (XSTRING (lower
)->data
, "false"))
3119 return Fintern (tem
, Qnil
);
3132 /* Record in frame F the specified or default value according to ALIST
3133 of the parameter named PROP (a Lisp symbol).
3134 If no value is specified for PROP, look for an X default for XPROP
3135 on the frame named NAME.
3136 If that is not found either, use the value DEFLT. */
3139 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3146 enum resource_types type
;
3150 tem
= w32_get_arg (alist
, prop
, xprop
, xclass
, type
);
3151 if (EQ (tem
, Qunbound
))
3153 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3157 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3158 doc
: /* Parse an X-style geometry string STRING.
3159 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3160 The properties returned may include `top', `left', `height', and `width'.
3161 The value of `left' or `top' may be an integer,
3162 or a list (+ N) meaning N pixels relative to top/left corner,
3163 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3168 unsigned int width
, height
;
3171 CHECK_STRING (string
);
3173 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3174 &x
, &y
, &width
, &height
);
3177 if (geometry
& XValue
)
3179 Lisp_Object element
;
3181 if (x
>= 0 && (geometry
& XNegative
))
3182 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3183 else if (x
< 0 && ! (geometry
& XNegative
))
3184 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3186 element
= Fcons (Qleft
, make_number (x
));
3187 result
= Fcons (element
, result
);
3190 if (geometry
& YValue
)
3192 Lisp_Object element
;
3194 if (y
>= 0 && (geometry
& YNegative
))
3195 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3196 else if (y
< 0 && ! (geometry
& YNegative
))
3197 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3199 element
= Fcons (Qtop
, make_number (y
));
3200 result
= Fcons (element
, result
);
3203 if (geometry
& WidthValue
)
3204 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3205 if (geometry
& HeightValue
)
3206 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3211 /* Calculate the desired size and position of this window,
3212 and return the flags saying which aspects were specified.
3214 This function does not make the coordinates positive. */
3216 #define DEFAULT_ROWS 40
3217 #define DEFAULT_COLS 80
3220 x_figure_window_size (f
, parms
)
3224 register Lisp_Object tem0
, tem1
, tem2
;
3225 long window_prompting
= 0;
3227 /* Default values if we fall through.
3228 Actually, if that happens we should get
3229 window manager prompting. */
3230 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3231 f
->height
= DEFAULT_ROWS
;
3232 /* Window managers expect that if program-specified
3233 positions are not (0,0), they're intentional, not defaults. */
3234 f
->output_data
.w32
->top_pos
= 0;
3235 f
->output_data
.w32
->left_pos
= 0;
3237 /* Ensure that old new_width and new_height will not override the
3239 FRAME_NEW_WIDTH (f
) = 0;
3240 FRAME_NEW_HEIGHT (f
) = 0;
3242 tem0
= w32_get_arg (parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3243 tem1
= w32_get_arg (parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3244 tem2
= w32_get_arg (parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3245 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3247 if (!EQ (tem0
, Qunbound
))
3249 CHECK_NUMBER (tem0
);
3250 f
->height
= XINT (tem0
);
3252 if (!EQ (tem1
, Qunbound
))
3254 CHECK_NUMBER (tem1
);
3255 SET_FRAME_WIDTH (f
, XINT (tem1
));
3257 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3258 window_prompting
|= USSize
;
3260 window_prompting
|= PSize
;
3263 f
->output_data
.w32
->vertical_scroll_bar_extra
3264 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3266 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
3267 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
3268 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
3269 x_compute_fringe_widths (f
, 0);
3270 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3271 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3273 tem0
= w32_get_arg (parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3274 tem1
= w32_get_arg (parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3275 tem2
= w32_get_arg (parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3276 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3278 if (EQ (tem0
, Qminus
))
3280 f
->output_data
.w32
->top_pos
= 0;
3281 window_prompting
|= YNegative
;
3283 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3284 && CONSP (XCDR (tem0
))
3285 && INTEGERP (XCAR (XCDR (tem0
))))
3287 f
->output_data
.w32
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3288 window_prompting
|= YNegative
;
3290 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3291 && CONSP (XCDR (tem0
))
3292 && INTEGERP (XCAR (XCDR (tem0
))))
3294 f
->output_data
.w32
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3296 else if (EQ (tem0
, Qunbound
))
3297 f
->output_data
.w32
->top_pos
= 0;
3300 CHECK_NUMBER (tem0
);
3301 f
->output_data
.w32
->top_pos
= XINT (tem0
);
3302 if (f
->output_data
.w32
->top_pos
< 0)
3303 window_prompting
|= YNegative
;
3306 if (EQ (tem1
, Qminus
))
3308 f
->output_data
.w32
->left_pos
= 0;
3309 window_prompting
|= XNegative
;
3311 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3312 && CONSP (XCDR (tem1
))
3313 && INTEGERP (XCAR (XCDR (tem1
))))
3315 f
->output_data
.w32
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3316 window_prompting
|= XNegative
;
3318 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3319 && CONSP (XCDR (tem1
))
3320 && INTEGERP (XCAR (XCDR (tem1
))))
3322 f
->output_data
.w32
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3324 else if (EQ (tem1
, Qunbound
))
3325 f
->output_data
.w32
->left_pos
= 0;
3328 CHECK_NUMBER (tem1
);
3329 f
->output_data
.w32
->left_pos
= XINT (tem1
);
3330 if (f
->output_data
.w32
->left_pos
< 0)
3331 window_prompting
|= XNegative
;
3334 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3335 window_prompting
|= USPosition
;
3337 window_prompting
|= PPosition
;
3340 return window_prompting
;
3345 extern LRESULT CALLBACK
w32_wnd_proc ();
3348 w32_init_class (hinst
)
3353 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
3354 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
3356 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
3357 wc
.hInstance
= hinst
;
3358 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
3359 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
3360 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
3361 wc
.lpszMenuName
= NULL
;
3362 wc
.lpszClassName
= EMACS_CLASS
;
3364 return (RegisterClass (&wc
));
3368 w32_createscrollbar (f
, bar
)
3370 struct scroll_bar
* bar
;
3372 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
3373 /* Position and size of scroll bar. */
3374 XINT(bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
3376 XINT(bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
3378 FRAME_W32_WINDOW (f
),
3385 w32_createwindow (f
)
3391 rect
.left
= rect
.top
= 0;
3392 rect
.right
= PIXEL_WIDTH (f
);
3393 rect
.bottom
= PIXEL_HEIGHT (f
);
3395 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
3396 FRAME_EXTERNAL_MENU_BAR (f
));
3398 /* Do first time app init */
3402 w32_init_class (hinst
);
3405 FRAME_W32_WINDOW (f
) = hwnd
3406 = CreateWindow (EMACS_CLASS
,
3408 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
3409 f
->output_data
.w32
->left_pos
,
3410 f
->output_data
.w32
->top_pos
,
3411 rect
.right
- rect
.left
,
3412 rect
.bottom
- rect
.top
,
3420 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
3421 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
3422 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
3423 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
3424 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
3426 /* Enable drag-n-drop. */
3427 DragAcceptFiles (hwnd
, TRUE
);
3429 /* Do this to discard the default setting specified by our parent. */
3430 ShowWindow (hwnd
, SW_HIDE
);
3435 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
3442 wmsg
->msg
.hwnd
= hwnd
;
3443 wmsg
->msg
.message
= msg
;
3444 wmsg
->msg
.wParam
= wParam
;
3445 wmsg
->msg
.lParam
= lParam
;
3446 wmsg
->msg
.time
= GetMessageTime ();
3451 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
3452 between left and right keys as advertised. We test for this
3453 support dynamically, and set a flag when the support is absent. If
3454 absent, we keep track of the left and right control and alt keys
3455 ourselves. This is particularly necessary on keyboards that rely
3456 upon the AltGr key, which is represented as having the left control
3457 and right alt keys pressed. For these keyboards, we need to know
3458 when the left alt key has been pressed in addition to the AltGr key
3459 so that we can properly support M-AltGr-key sequences (such as M-@
3460 on Swedish keyboards). */
3462 #define EMACS_LCONTROL 0
3463 #define EMACS_RCONTROL 1
3464 #define EMACS_LMENU 2
3465 #define EMACS_RMENU 3
3467 static int modifiers
[4];
3468 static int modifiers_recorded
;
3469 static int modifier_key_support_tested
;
3472 test_modifier_support (unsigned int wparam
)
3476 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3478 if (wparam
== VK_CONTROL
)
3488 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
3489 modifiers_recorded
= 1;
3491 modifiers_recorded
= 0;
3492 modifier_key_support_tested
= 1;
3496 record_keydown (unsigned int wparam
, unsigned int lparam
)
3500 if (!modifier_key_support_tested
)
3501 test_modifier_support (wparam
);
3503 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3506 if (wparam
== VK_CONTROL
)
3507 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3509 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3515 record_keyup (unsigned int wparam
, unsigned int lparam
)
3519 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3522 if (wparam
== VK_CONTROL
)
3523 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3525 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3530 /* Emacs can lose focus while a modifier key has been pressed. When
3531 it regains focus, be conservative and clear all modifiers since
3532 we cannot reconstruct the left and right modifier state. */
3538 if (GetFocus () == NULL
)
3539 /* Emacs doesn't have keyboard focus. Do nothing. */
3542 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3543 alt
= GetAsyncKeyState (VK_MENU
);
3545 if (!(ctrl
& 0x08000))
3546 /* Clear any recorded control modifier state. */
3547 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3549 if (!(alt
& 0x08000))
3550 /* Clear any recorded alt modifier state. */
3551 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3553 /* Update the state of all modifier keys, because modifiers used in
3554 hot-key combinations can get stuck on if Emacs loses focus as a
3555 result of a hot-key being pressed. */
3559 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3561 GetKeyboardState (keystate
);
3562 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
3563 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
3564 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
3565 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
3566 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
3567 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
3568 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
3569 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
3570 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
3571 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
3572 SetKeyboardState (keystate
);
3576 /* Synchronize modifier state with what is reported with the current
3577 keystroke. Even if we cannot distinguish between left and right
3578 modifier keys, we know that, if no modifiers are set, then neither
3579 the left or right modifier should be set. */
3583 if (!modifiers_recorded
)
3586 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3587 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3589 if (!(GetKeyState (VK_MENU
) & 0x8000))
3590 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3594 modifier_set (int vkey
)
3596 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
3597 return (GetKeyState (vkey
) & 0x1);
3598 if (!modifiers_recorded
)
3599 return (GetKeyState (vkey
) & 0x8000);
3604 return modifiers
[EMACS_LCONTROL
];
3606 return modifiers
[EMACS_RCONTROL
];
3608 return modifiers
[EMACS_LMENU
];
3610 return modifiers
[EMACS_RMENU
];
3612 return (GetKeyState (vkey
) & 0x8000);
3615 /* Convert between the modifier bits W32 uses and the modifier bits
3619 w32_key_to_modifier (int key
)
3621 Lisp_Object key_mapping
;
3626 key_mapping
= Vw32_lwindow_modifier
;
3629 key_mapping
= Vw32_rwindow_modifier
;
3632 key_mapping
= Vw32_apps_modifier
;
3635 key_mapping
= Vw32_scroll_lock_modifier
;
3641 /* NB. This code runs in the input thread, asychronously to the lisp
3642 thread, so we must be careful to ensure access to lisp data is
3643 thread-safe. The following code is safe because the modifier
3644 variable values are updated atomically from lisp and symbols are
3645 not relocated by GC. Also, we don't have to worry about seeing GC
3647 if (EQ (key_mapping
, Qhyper
))
3648 return hyper_modifier
;
3649 if (EQ (key_mapping
, Qsuper
))
3650 return super_modifier
;
3651 if (EQ (key_mapping
, Qmeta
))
3652 return meta_modifier
;
3653 if (EQ (key_mapping
, Qalt
))
3654 return alt_modifier
;
3655 if (EQ (key_mapping
, Qctrl
))
3656 return ctrl_modifier
;
3657 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
3658 return ctrl_modifier
;
3659 if (EQ (key_mapping
, Qshift
))
3660 return shift_modifier
;
3662 /* Don't generate any modifier if not explicitly requested. */
3667 w32_get_modifiers ()
3669 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
3670 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
3671 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
3672 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
3673 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
3674 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
3675 (modifier_set (VK_MENU
) ?
3676 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
3679 /* We map the VK_* modifiers into console modifier constants
3680 so that we can use the same routines to handle both console
3681 and window input. */
3684 construct_console_modifiers ()
3689 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3690 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3691 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
3692 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
3693 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3694 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3695 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3696 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3697 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
3698 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
3699 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
3705 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
3709 /* Convert to emacs modifiers. */
3710 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
3716 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
3718 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
3721 if (virt_key
== VK_RETURN
)
3722 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3724 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
3725 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
3727 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
3728 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
3730 if (virt_key
== VK_CLEAR
)
3731 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
3736 /* List of special key combinations which w32 would normally capture,
3737 but emacs should grab instead. Not directly visible to lisp, to
3738 simplify synchronization. Each item is an integer encoding a virtual
3739 key code and modifier combination to capture. */
3740 Lisp_Object w32_grabbed_keys
;
3742 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3743 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3744 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3745 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3747 /* Register hot-keys for reserved key combinations when Emacs has
3748 keyboard focus, since this is the only way Emacs can receive key
3749 combinations like Alt-Tab which are used by the system. */
3752 register_hot_keys (hwnd
)
3755 Lisp_Object keylist
;
3757 /* Use GC_CONSP, since we are called asynchronously. */
3758 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3760 Lisp_Object key
= XCAR (keylist
);
3762 /* Deleted entries get set to nil. */
3763 if (!INTEGERP (key
))
3766 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
3767 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
3772 unregister_hot_keys (hwnd
)
3775 Lisp_Object keylist
;
3777 /* Use GC_CONSP, since we are called asynchronously. */
3778 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3780 Lisp_Object key
= XCAR (keylist
);
3782 if (!INTEGERP (key
))
3785 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
3789 /* Main message dispatch loop. */
3792 w32_msg_pump (deferred_msg
* msg_buf
)
3798 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3800 while (GetMessage (&msg
, NULL
, 0, 0))
3802 if (msg
.hwnd
== NULL
)
3804 switch (msg
.message
)
3807 /* Produced by complete_deferred_msg; just ignore. */
3809 case WM_EMACS_CREATEWINDOW
:
3810 w32_createwindow ((struct frame
*) msg
.wParam
);
3811 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3814 case WM_EMACS_SETLOCALE
:
3815 SetThreadLocale (msg
.wParam
);
3816 /* Reply is not expected. */
3818 case WM_EMACS_SETKEYBOARDLAYOUT
:
3819 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
3820 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3824 case WM_EMACS_REGISTER_HOT_KEY
:
3825 focus_window
= GetFocus ();
3826 if (focus_window
!= NULL
)
3827 RegisterHotKey (focus_window
,
3828 HOTKEY_ID (msg
.wParam
),
3829 HOTKEY_MODIFIERS (msg
.wParam
),
3830 HOTKEY_VK_CODE (msg
.wParam
));
3831 /* Reply is not expected. */
3833 case WM_EMACS_UNREGISTER_HOT_KEY
:
3834 focus_window
= GetFocus ();
3835 if (focus_window
!= NULL
)
3836 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
3837 /* Mark item as erased. NB: this code must be
3838 thread-safe. The next line is okay because the cons
3839 cell is never made into garbage and is not relocated by
3841 XSETCAR ((Lisp_Object
) msg
.lParam
, Qnil
);
3842 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3845 case WM_EMACS_TOGGLE_LOCK_KEY
:
3847 int vk_code
= (int) msg
.wParam
;
3848 int cur_state
= (GetKeyState (vk_code
) & 1);
3849 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
3851 /* NB: This code must be thread-safe. It is safe to
3852 call NILP because symbols are not relocated by GC,
3853 and pointer here is not touched by GC (so the markbit
3854 can't be set). Numbers are safe because they are
3855 immediate values. */
3856 if (NILP (new_state
)
3857 || (NUMBERP (new_state
)
3858 && ((XUINT (new_state
)) & 1) != cur_state
))
3860 one_w32_display_info
.faked_key
= vk_code
;
3862 keybd_event ((BYTE
) vk_code
,
3863 (BYTE
) MapVirtualKey (vk_code
, 0),
3864 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3865 keybd_event ((BYTE
) vk_code
,
3866 (BYTE
) MapVirtualKey (vk_code
, 0),
3867 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3868 keybd_event ((BYTE
) vk_code
,
3869 (BYTE
) MapVirtualKey (vk_code
, 0),
3870 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3871 cur_state
= !cur_state
;
3873 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3879 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3884 DispatchMessage (&msg
);
3887 /* Exit nested loop when our deferred message has completed. */
3888 if (msg_buf
->completed
)
3893 deferred_msg
* deferred_msg_head
;
3895 static deferred_msg
*
3896 find_deferred_msg (HWND hwnd
, UINT msg
)
3898 deferred_msg
* item
;
3900 /* Don't actually need synchronization for read access, since
3901 modification of single pointer is always atomic. */
3902 /* enter_crit (); */
3904 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3905 if (item
->w32msg
.msg
.hwnd
== hwnd
3906 && item
->w32msg
.msg
.message
== msg
)
3909 /* leave_crit (); */
3915 send_deferred_msg (deferred_msg
* msg_buf
,
3921 /* Only input thread can send deferred messages. */
3922 if (GetCurrentThreadId () != dwWindowsThreadId
)
3925 /* It is an error to send a message that is already deferred. */
3926 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3929 /* Enforced synchronization is not needed because this is the only
3930 function that alters deferred_msg_head, and the following critical
3931 section is guaranteed to only be serially reentered (since only the
3932 input thread can call us). */
3934 /* enter_crit (); */
3936 msg_buf
->completed
= 0;
3937 msg_buf
->next
= deferred_msg_head
;
3938 deferred_msg_head
= msg_buf
;
3939 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
3941 /* leave_crit (); */
3943 /* Start a new nested message loop to process other messages until
3944 this one is completed. */
3945 w32_msg_pump (msg_buf
);
3947 deferred_msg_head
= msg_buf
->next
;
3949 return msg_buf
->result
;
3953 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
3955 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
3957 if (msg_buf
== NULL
)
3958 /* Message may have been cancelled, so don't abort(). */
3961 msg_buf
->result
= result
;
3962 msg_buf
->completed
= 1;
3964 /* Ensure input thread is woken so it notices the completion. */
3965 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3969 cancel_all_deferred_msgs ()
3971 deferred_msg
* item
;
3973 /* Don't actually need synchronization for read access, since
3974 modification of single pointer is always atomic. */
3975 /* enter_crit (); */
3977 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3980 item
->completed
= 1;
3983 /* leave_crit (); */
3985 /* Ensure input thread is woken so it notices the completion. */
3986 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3994 deferred_msg dummy_buf
;
3996 /* Ensure our message queue is created */
3998 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
4000 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
4003 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
4004 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
4005 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
4007 /* This is the inital message loop which should only exit when the
4008 application quits. */
4009 w32_msg_pump (&dummy_buf
);
4015 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
4025 wmsg
.dwModifiers
= modifiers
;
4027 /* Detect quit_char and set quit-flag directly. Note that we
4028 still need to post a message to ensure the main thread will be
4029 woken up if blocked in sys_select(), but we do NOT want to post
4030 the quit_char message itself (because it will usually be as if
4031 the user had typed quit_char twice). Instead, we post a dummy
4032 message that has no particular effect. */
4035 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
4036 c
= make_ctrl_char (c
) & 0377;
4038 || (wmsg
.dwModifiers
== 0 &&
4039 XFASTINT (Vw32_quit_key
) && wParam
== XFASTINT (Vw32_quit_key
)))
4043 /* The choice of message is somewhat arbitrary, as long as
4044 the main thread handler just ignores it. */
4047 /* Interrupt any blocking system calls. */
4050 /* As a safety precaution, forcibly complete any deferred
4051 messages. This is a kludge, but I don't see any particularly
4052 clean way to handle the situation where a deferred message is
4053 "dropped" in the lisp thread, and will thus never be
4054 completed, eg. by the user trying to activate the menubar
4055 when the lisp thread is busy, and then typing C-g when the
4056 menubar doesn't open promptly (with the result that the
4057 menubar never responds at all because the deferred
4058 WM_INITMENU message is never completed). Another problem
4059 situation is when the lisp thread calls SendMessage (to send
4060 a window manager command) when a message has been deferred;
4061 the lisp thread gets blocked indefinitely waiting for the
4062 deferred message to be completed, which itself is waiting for
4063 the lisp thread to respond.
4065 Note that we don't want to block the input thread waiting for
4066 a reponse from the lisp thread (although that would at least
4067 solve the deadlock problem above), because we want to be able
4068 to receive C-g to interrupt the lisp thread. */
4069 cancel_all_deferred_msgs ();
4073 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4076 /* Main window procedure */
4079 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
4086 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
4088 int windows_translate
;
4091 /* Note that it is okay to call x_window_to_frame, even though we are
4092 not running in the main lisp thread, because frame deletion
4093 requires the lisp thread to synchronize with this thread. Thus, if
4094 a frame struct is returned, it can be used without concern that the
4095 lisp thread might make it disappear while we are using it.
4097 NB. Walking the frame list in this thread is safe (as long as
4098 writes of Lisp_Object slots are atomic, which they are on Windows).
4099 Although delete-frame can destructively modify the frame list while
4100 we are walking it, a garbage collection cannot occur until after
4101 delete-frame has synchronized with this thread.
4103 It is also safe to use functions that make GDI calls, such as
4104 w32_clear_rect, because these functions must obtain a DC handle
4105 from the frame struct using get_frame_dc which is thread-aware. */
4110 f
= x_window_to_frame (dpyinfo
, hwnd
);
4113 HDC hdc
= get_frame_dc (f
);
4114 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
4115 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
4116 release_frame_dc (f
, hdc
);
4118 #if defined (W32_DEBUG_DISPLAY)
4119 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4121 wmsg
.rect
.left
, wmsg
.rect
.top
,
4122 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4123 #endif /* W32_DEBUG_DISPLAY */
4126 case WM_PALETTECHANGED
:
4127 /* ignore our own changes */
4128 if ((HWND
)wParam
!= hwnd
)
4130 f
= x_window_to_frame (dpyinfo
, hwnd
);
4132 /* get_frame_dc will realize our palette and force all
4133 frames to be redrawn if needed. */
4134 release_frame_dc (f
, get_frame_dc (f
));
4139 PAINTSTRUCT paintStruct
;
4142 f
= x_window_to_frame (dpyinfo
, hwnd
);
4145 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
4149 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4150 fails. Apparently this can happen under some
4152 if (!w32_strict_painting
|| GetUpdateRect (hwnd
, &update_rect
, FALSE
))
4155 BeginPaint (hwnd
, &paintStruct
);
4157 if (w32_strict_painting
)
4158 /* The rectangles returned by GetUpdateRect and BeginPaint
4159 do not always match. GetUpdateRect seems to be the
4160 more reliable of the two. */
4161 wmsg
.rect
= update_rect
;
4163 wmsg
.rect
= paintStruct
.rcPaint
;
4165 #if defined (W32_DEBUG_DISPLAY)
4166 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4168 wmsg
.rect
.left
, wmsg
.rect
.top
,
4169 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4170 DebPrint ((" [update region is %d,%d-%d,%d]\n",
4171 update_rect
.left
, update_rect
.top
,
4172 update_rect
.right
, update_rect
.bottom
));
4174 EndPaint (hwnd
, &paintStruct
);
4177 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4182 /* If GetUpdateRect returns 0 (meaning there is no update
4183 region), assume the whole window needs to be repainted. */
4184 GetClientRect(hwnd
, &wmsg
.rect
);
4185 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4189 case WM_INPUTLANGCHANGE
:
4190 /* Inform lisp thread of keyboard layout changes. */
4191 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4193 /* Clear dead keys in the keyboard state; for simplicity only
4194 preserve modifier key states. */
4199 GetKeyboardState (keystate
);
4200 for (i
= 0; i
< 256; i
++)
4217 SetKeyboardState (keystate
);
4222 /* Synchronize hot keys with normal input. */
4223 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
4228 record_keyup (wParam
, lParam
);
4233 /* Ignore keystrokes we fake ourself; see below. */
4234 if (dpyinfo
->faked_key
== wParam
)
4236 dpyinfo
->faked_key
= 0;
4237 /* Make sure TranslateMessage sees them though (as long as
4238 they don't produce WM_CHAR messages). This ensures that
4239 indicator lights are toggled promptly on Windows 9x, for
4241 if (lispy_function_keys
[wParam
] != 0)
4243 windows_translate
= 1;
4249 /* Synchronize modifiers with current keystroke. */
4251 record_keydown (wParam
, lParam
);
4252 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
4254 windows_translate
= 0;
4259 if (NILP (Vw32_pass_lwindow_to_system
))
4261 /* Prevent system from acting on keyup (which opens the
4262 Start menu if no other key was pressed) by simulating a
4263 press of Space which we will ignore. */
4264 if (GetAsyncKeyState (wParam
) & 1)
4266 if (NUMBERP (Vw32_phantom_key_code
))
4267 key
= XUINT (Vw32_phantom_key_code
) & 255;
4270 dpyinfo
->faked_key
= key
;
4271 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4274 if (!NILP (Vw32_lwindow_modifier
))
4278 if (NILP (Vw32_pass_rwindow_to_system
))
4280 if (GetAsyncKeyState (wParam
) & 1)
4282 if (NUMBERP (Vw32_phantom_key_code
))
4283 key
= XUINT (Vw32_phantom_key_code
) & 255;
4286 dpyinfo
->faked_key
= key
;
4287 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4290 if (!NILP (Vw32_rwindow_modifier
))
4294 if (!NILP (Vw32_apps_modifier
))
4298 if (NILP (Vw32_pass_alt_to_system
))
4299 /* Prevent DefWindowProc from activating the menu bar if an
4300 Alt key is pressed and released by itself. */
4302 windows_translate
= 1;
4305 /* Decide whether to treat as modifier or function key. */
4306 if (NILP (Vw32_enable_caps_lock
))
4307 goto disable_lock_key
;
4308 windows_translate
= 1;
4311 /* Decide whether to treat as modifier or function key. */
4312 if (NILP (Vw32_enable_num_lock
))
4313 goto disable_lock_key
;
4314 windows_translate
= 1;
4317 /* Decide whether to treat as modifier or function key. */
4318 if (NILP (Vw32_scroll_lock_modifier
))
4319 goto disable_lock_key
;
4320 windows_translate
= 1;
4323 /* Ensure the appropriate lock key state (and indicator light)
4324 remains in the same state. We do this by faking another
4325 press of the relevant key. Apparently, this really is the
4326 only way to toggle the state of the indicator lights. */
4327 dpyinfo
->faked_key
= wParam
;
4328 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4329 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4330 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4331 KEYEVENTF_EXTENDEDKEY
| 0, 0);
4332 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4333 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4334 /* Ensure indicator lights are updated promptly on Windows 9x
4335 (TranslateMessage apparently does this), after forwarding
4337 post_character_message (hwnd
, msg
, wParam
, lParam
,
4338 w32_get_key_modifiers (wParam
, lParam
));
4339 windows_translate
= 1;
4343 case VK_PROCESSKEY
: /* Generated by IME. */
4344 windows_translate
= 1;
4347 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4348 which is confusing for purposes of key binding; convert
4349 VK_CANCEL events into VK_PAUSE events. */
4353 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4354 for purposes of key binding; convert these back into
4355 VK_NUMLOCK events, at least when we want to see NumLock key
4356 presses. (Note that there is never any possibility that
4357 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4358 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
4359 wParam
= VK_NUMLOCK
;
4362 /* If not defined as a function key, change it to a WM_CHAR message. */
4363 if (lispy_function_keys
[wParam
] == 0)
4365 DWORD modifiers
= construct_console_modifiers ();
4367 if (!NILP (Vw32_recognize_altgr
)
4368 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
4370 /* Always let TranslateMessage handle AltGr key chords;
4371 for some reason, ToAscii doesn't always process AltGr
4372 chords correctly. */
4373 windows_translate
= 1;
4375 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
4377 /* Handle key chords including any modifiers other
4378 than shift directly, in order to preserve as much
4379 modifier information as possible. */
4380 if ('A' <= wParam
&& wParam
<= 'Z')
4382 /* Don't translate modified alphabetic keystrokes,
4383 so the user doesn't need to constantly switch
4384 layout to type control or meta keystrokes when
4385 the normal layout translates alphabetic
4386 characters to non-ascii characters. */
4387 if (!modifier_set (VK_SHIFT
))
4388 wParam
+= ('a' - 'A');
4393 /* Try to handle other keystrokes by determining the
4394 base character (ie. translating the base key plus
4398 KEY_EVENT_RECORD key
;
4400 key
.bKeyDown
= TRUE
;
4401 key
.wRepeatCount
= 1;
4402 key
.wVirtualKeyCode
= wParam
;
4403 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
4404 key
.uChar
.AsciiChar
= 0;
4405 key
.dwControlKeyState
= modifiers
;
4407 add
= w32_kbd_patch_key (&key
);
4408 /* 0 means an unrecognised keycode, negative means
4409 dead key. Ignore both. */
4412 /* Forward asciified character sequence. */
4413 post_character_message
4414 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
4415 w32_get_key_modifiers (wParam
, lParam
));
4416 w32_kbd_patch_key (&key
);
4423 /* Let TranslateMessage handle everything else. */
4424 windows_translate
= 1;
4430 if (windows_translate
)
4432 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
4434 windows_msg
.time
= GetMessageTime ();
4435 TranslateMessage (&windows_msg
);
4443 post_character_message (hwnd
, msg
, wParam
, lParam
,
4444 w32_get_key_modifiers (wParam
, lParam
));
4447 /* Simulate middle mouse button events when left and right buttons
4448 are used together, but only if user has two button mouse. */
4449 case WM_LBUTTONDOWN
:
4450 case WM_RBUTTONDOWN
:
4451 if (XINT (Vw32_num_mouse_buttons
) > 2)
4452 goto handle_plain_button
;
4455 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
4456 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
4458 if (button_state
& this)
4461 if (button_state
== 0)
4464 button_state
|= this;
4466 if (button_state
& other
)
4468 if (mouse_button_timer
)
4470 KillTimer (hwnd
, mouse_button_timer
);
4471 mouse_button_timer
= 0;
4473 /* Generate middle mouse event instead. */
4474 msg
= WM_MBUTTONDOWN
;
4475 button_state
|= MMOUSE
;
4477 else if (button_state
& MMOUSE
)
4479 /* Ignore button event if we've already generated a
4480 middle mouse down event. This happens if the
4481 user releases and press one of the two buttons
4482 after we've faked a middle mouse event. */
4487 /* Flush out saved message. */
4488 post_msg (&saved_mouse_button_msg
);
4490 wmsg
.dwModifiers
= w32_get_modifiers ();
4491 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4493 /* Clear message buffer. */
4494 saved_mouse_button_msg
.msg
.hwnd
= 0;
4498 /* Hold onto message for now. */
4499 mouse_button_timer
=
4500 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
4501 XINT (Vw32_mouse_button_tolerance
), NULL
);
4502 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
4503 saved_mouse_button_msg
.msg
.message
= msg
;
4504 saved_mouse_button_msg
.msg
.wParam
= wParam
;
4505 saved_mouse_button_msg
.msg
.lParam
= lParam
;
4506 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
4507 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
4514 if (XINT (Vw32_num_mouse_buttons
) > 2)
4515 goto handle_plain_button
;
4518 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
4519 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
4521 if ((button_state
& this) == 0)
4524 button_state
&= ~this;
4526 if (button_state
& MMOUSE
)
4528 /* Only generate event when second button is released. */
4529 if ((button_state
& other
) == 0)
4532 button_state
&= ~MMOUSE
;
4534 if (button_state
) abort ();
4541 /* Flush out saved message if necessary. */
4542 if (saved_mouse_button_msg
.msg
.hwnd
)
4544 post_msg (&saved_mouse_button_msg
);
4547 wmsg
.dwModifiers
= w32_get_modifiers ();
4548 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4550 /* Always clear message buffer and cancel timer. */
4551 saved_mouse_button_msg
.msg
.hwnd
= 0;
4552 KillTimer (hwnd
, mouse_button_timer
);
4553 mouse_button_timer
= 0;
4555 if (button_state
== 0)
4560 case WM_MBUTTONDOWN
:
4562 handle_plain_button
:
4567 if (parse_button (msg
, &button
, &up
))
4569 if (up
) ReleaseCapture ();
4570 else SetCapture (hwnd
);
4571 button
= (button
== 0) ? LMOUSE
:
4572 ((button
== 1) ? MMOUSE
: RMOUSE
);
4574 button_state
&= ~button
;
4576 button_state
|= button
;
4580 wmsg
.dwModifiers
= w32_get_modifiers ();
4581 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4586 if (XINT (Vw32_mouse_move_interval
) <= 0
4587 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
4589 wmsg
.dwModifiers
= w32_get_modifiers ();
4590 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4594 /* Hang onto mouse move and scroll messages for a bit, to avoid
4595 sending such events to Emacs faster than it can process them.
4596 If we get more events before the timer from the first message
4597 expires, we just replace the first message. */
4599 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
4601 SetTimer (hwnd
, MOUSE_MOVE_ID
,
4602 XINT (Vw32_mouse_move_interval
), NULL
);
4604 /* Hold onto message for now. */
4605 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
4606 saved_mouse_move_msg
.msg
.message
= msg
;
4607 saved_mouse_move_msg
.msg
.wParam
= wParam
;
4608 saved_mouse_move_msg
.msg
.lParam
= lParam
;
4609 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
4610 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
4615 wmsg
.dwModifiers
= w32_get_modifiers ();
4616 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4620 wmsg
.dwModifiers
= w32_get_modifiers ();
4621 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4625 /* Flush out saved messages if necessary. */
4626 if (wParam
== mouse_button_timer
)
4628 if (saved_mouse_button_msg
.msg
.hwnd
)
4630 post_msg (&saved_mouse_button_msg
);
4631 saved_mouse_button_msg
.msg
.hwnd
= 0;
4633 KillTimer (hwnd
, mouse_button_timer
);
4634 mouse_button_timer
= 0;
4636 else if (wParam
== mouse_move_timer
)
4638 if (saved_mouse_move_msg
.msg
.hwnd
)
4640 post_msg (&saved_mouse_move_msg
);
4641 saved_mouse_move_msg
.msg
.hwnd
= 0;
4643 KillTimer (hwnd
, mouse_move_timer
);
4644 mouse_move_timer
= 0;
4649 /* Windows doesn't send us focus messages when putting up and
4650 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4651 The only indication we get that something happened is receiving
4652 this message afterwards. So this is a good time to reset our
4653 keyboard modifiers' state. */
4660 /* We must ensure menu bar is fully constructed and up to date
4661 before allowing user interaction with it. To achieve this
4662 we send this message to the lisp thread and wait for a
4663 reply (whose value is not actually needed) to indicate that
4664 the menu bar is now ready for use, so we can now return.
4666 To remain responsive in the meantime, we enter a nested message
4667 loop that can process all other messages.
4669 However, we skip all this if the message results from calling
4670 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4671 thread a message because it is blocked on us at this point. We
4672 set menubar_active before calling TrackPopupMenu to indicate
4673 this (there is no possibility of confusion with real menubar
4676 f
= x_window_to_frame (dpyinfo
, hwnd
);
4678 && (f
->output_data
.w32
->menubar_active
4679 /* We can receive this message even in the absence of a
4680 menubar (ie. when the system menu is activated) - in this
4681 case we do NOT want to forward the message, otherwise it
4682 will cause the menubar to suddenly appear when the user
4683 had requested it to be turned off! */
4684 || f
->output_data
.w32
->menubar_widget
== NULL
))
4688 deferred_msg msg_buf
;
4690 /* Detect if message has already been deferred; in this case
4691 we cannot return any sensible value to ignore this. */
4692 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4695 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
4698 case WM_EXITMENULOOP
:
4699 f
= x_window_to_frame (dpyinfo
, hwnd
);
4701 /* Indicate that menubar can be modified again. */
4703 f
->output_data
.w32
->menubar_active
= 0;
4707 /* Direct handling of help_echo in menus. Should be safe now
4708 that we generate the help_echo by placing a help event in the
4711 HMENU menu
= (HMENU
) lParam
;
4712 UINT menu_item
= (UINT
) LOWORD (wParam
);
4713 UINT flags
= (UINT
) HIWORD (wParam
);
4715 w32_menu_display_help (hwnd
, menu
, menu_item
, flags
);
4719 case WM_MEASUREITEM
:
4720 f
= x_window_to_frame (dpyinfo
, hwnd
);
4723 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
4725 if (pMis
->CtlType
== ODT_MENU
)
4727 /* Work out dimensions for popup menu titles. */
4728 char * title
= (char *) pMis
->itemData
;
4729 HDC hdc
= GetDC (hwnd
);
4730 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4731 LOGFONT menu_logfont
;
4735 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4736 menu_logfont
.lfWeight
= FW_BOLD
;
4737 menu_font
= CreateFontIndirect (&menu_logfont
);
4738 old_font
= SelectObject (hdc
, menu_font
);
4740 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
4743 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
4744 pMis
->itemWidth
= size
.cx
;
4745 if (pMis
->itemHeight
< size
.cy
)
4746 pMis
->itemHeight
= size
.cy
;
4749 pMis
->itemWidth
= 0;
4751 SelectObject (hdc
, old_font
);
4752 DeleteObject (menu_font
);
4753 ReleaseDC (hwnd
, hdc
);
4760 f
= x_window_to_frame (dpyinfo
, hwnd
);
4763 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
4765 if (pDis
->CtlType
== ODT_MENU
)
4767 /* Draw popup menu title. */
4768 char * title
= (char *) pDis
->itemData
;
4771 HDC hdc
= pDis
->hDC
;
4772 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4773 LOGFONT menu_logfont
;
4776 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4777 menu_logfont
.lfWeight
= FW_BOLD
;
4778 menu_font
= CreateFontIndirect (&menu_logfont
);
4779 old_font
= SelectObject (hdc
, menu_font
);
4781 /* Always draw title as if not selected. */
4784 + GetSystemMetrics (SM_CXMENUCHECK
),
4786 ETO_OPAQUE
, &pDis
->rcItem
,
4787 title
, strlen (title
), NULL
);
4789 SelectObject (hdc
, old_font
);
4790 DeleteObject (menu_font
);
4798 /* Still not right - can't distinguish between clicks in the
4799 client area of the frame from clicks forwarded from the scroll
4800 bars - may have to hook WM_NCHITTEST to remember the mouse
4801 position and then check if it is in the client area ourselves. */
4802 case WM_MOUSEACTIVATE
:
4803 /* Discard the mouse click that activates a frame, allowing the
4804 user to click anywhere without changing point (or worse!).
4805 Don't eat mouse clicks on scrollbars though!! */
4806 if (LOWORD (lParam
) == HTCLIENT
)
4807 return MA_ACTIVATEANDEAT
;
4811 case WM_ACTIVATEAPP
:
4813 case WM_WINDOWPOSCHANGED
:
4815 /* Inform lisp thread that a frame might have just been obscured
4816 or exposed, so should recheck visibility of all frames. */
4817 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4821 dpyinfo
->faked_key
= 0;
4823 register_hot_keys (hwnd
);
4826 unregister_hot_keys (hwnd
);
4829 /* Relinquish the system caret. */
4830 if (w32_system_caret_hwnd
)
4833 w32_system_caret_hwnd
= NULL
;
4839 wmsg
.dwModifiers
= w32_get_modifiers ();
4840 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4844 wmsg
.dwModifiers
= w32_get_modifiers ();
4845 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4848 case WM_WINDOWPOSCHANGING
:
4849 /* Don't restrict the sizing of tip frames. */
4850 if (hwnd
== tip_window
)
4854 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
4856 wp
.length
= sizeof (WINDOWPLACEMENT
);
4857 GetWindowPlacement (hwnd
, &wp
);
4859 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
4866 DWORD internal_border
;
4867 DWORD scrollbar_extra
;
4870 wp
.length
= sizeof(wp
);
4871 GetWindowRect (hwnd
, &wr
);
4875 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
4876 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
4877 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
4878 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
4882 memset (&rect
, 0, sizeof (rect
));
4883 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
4884 GetMenu (hwnd
) != NULL
);
4886 /* Force width and height of client area to be exact
4887 multiples of the character cell dimensions. */
4888 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
4889 - 2 * internal_border
- scrollbar_extra
)
4891 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
4892 - 2 * internal_border
)
4897 /* For right/bottom sizing we can just fix the sizes.
4898 However for top/left sizing we will need to fix the X
4899 and Y positions as well. */
4904 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
4905 && (lppos
->flags
& SWP_NOMOVE
) == 0)
4907 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
4914 lppos
->flags
|= SWP_NOMOVE
;
4925 case WM_GETMINMAXINFO
:
4926 /* Hack to correct bug that allows Emacs frames to be resized
4927 below the Minimum Tracking Size. */
4928 ((LPMINMAXINFO
) lParam
)->ptMinTrackSize
.y
++;
4929 /* Hack to allow resizing the Emacs frame above the screen size.
4930 Note that Windows 9x limits coordinates to 16-bits. */
4931 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
4932 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
4935 case WM_EMACS_CREATESCROLLBAR
:
4936 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
4937 (struct scroll_bar
*) lParam
);
4939 case WM_EMACS_SHOWWINDOW
:
4940 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
4942 case WM_EMACS_SETFOREGROUND
:
4944 HWND foreground_window
;
4945 DWORD foreground_thread
, retval
;
4947 /* On NT 5.0, and apparently Windows 98, it is necessary to
4948 attach to the thread that currently has focus in order to
4949 pull the focus away from it. */
4950 foreground_window
= GetForegroundWindow ();
4951 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
4952 if (!foreground_window
4953 || foreground_thread
== GetCurrentThreadId ()
4954 || !AttachThreadInput (GetCurrentThreadId (),
4955 foreground_thread
, TRUE
))
4956 foreground_thread
= 0;
4958 retval
= SetForegroundWindow ((HWND
) wParam
);
4960 /* Detach from the previous foreground thread. */
4961 if (foreground_thread
)
4962 AttachThreadInput (GetCurrentThreadId (),
4963 foreground_thread
, FALSE
);
4968 case WM_EMACS_SETWINDOWPOS
:
4970 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
4971 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
4972 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
4975 case WM_EMACS_DESTROYWINDOW
:
4976 DragAcceptFiles ((HWND
) wParam
, FALSE
);
4977 return DestroyWindow ((HWND
) wParam
);
4979 case WM_EMACS_DESTROY_CARET
:
4980 w32_system_caret_hwnd
= NULL
;
4981 return DestroyCaret ();
4983 case WM_EMACS_TRACK_CARET
:
4984 /* If there is currently no system caret, create one. */
4985 if (w32_system_caret_hwnd
== NULL
)
4987 w32_system_caret_hwnd
= hwnd
;
4988 CreateCaret (hwnd
, NULL
, w32_system_caret_width
,
4989 w32_system_caret_height
);
4991 return SetCaretPos (w32_system_caret_x
, w32_system_caret_y
);
4993 case WM_EMACS_TRACKPOPUPMENU
:
4998 pos
= (POINT
*)lParam
;
4999 flags
= TPM_CENTERALIGN
;
5000 if (button_state
& LMOUSE
)
5001 flags
|= TPM_LEFTBUTTON
;
5002 else if (button_state
& RMOUSE
)
5003 flags
|= TPM_RIGHTBUTTON
;
5005 /* Remember we did a SetCapture on the initial mouse down event,
5006 so for safety, we make sure the capture is cancelled now. */
5010 /* Use menubar_active to indicate that WM_INITMENU is from
5011 TrackPopupMenu below, and should be ignored. */
5012 f
= x_window_to_frame (dpyinfo
, hwnd
);
5014 f
->output_data
.w32
->menubar_active
= 1;
5016 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
5020 /* Eat any mouse messages during popupmenu */
5021 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
5023 /* Get the menu selection, if any */
5024 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
5026 retval
= LOWORD (amsg
.wParam
);
5042 /* Check for messages registered at runtime. */
5043 if (msg
== msh_mousewheel
)
5045 wmsg
.dwModifiers
= w32_get_modifiers ();
5046 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
5051 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
5055 /* The most common default return code for handled messages is 0. */
5060 my_create_window (f
)
5065 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
5067 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
5071 /* Create a tooltip window. Unlike my_create_window, we do not do this
5072 indirectly via the Window thread, as we do not need to process Window
5073 messages for the tooltip. Creating tooltips indirectly also creates
5074 deadlocks when tooltips are created for menu items. */
5076 my_create_tip_window (f
)
5081 rect
.left
= rect
.top
= 0;
5082 rect
.right
= PIXEL_WIDTH (f
);
5083 rect
.bottom
= PIXEL_HEIGHT (f
);
5085 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
5086 FRAME_EXTERNAL_MENU_BAR (f
));
5088 tip_window
= FRAME_W32_WINDOW (f
)
5089 = CreateWindow (EMACS_CLASS
,
5091 f
->output_data
.w32
->dwStyle
,
5092 f
->output_data
.w32
->left_pos
,
5093 f
->output_data
.w32
->top_pos
,
5094 rect
.right
- rect
.left
,
5095 rect
.bottom
- rect
.top
,
5096 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
5103 SetWindowLong (tip_window
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
5104 SetWindowLong (tip_window
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
5105 SetWindowLong (tip_window
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
5106 SetWindowLong (tip_window
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
5108 /* Tip frames have no scrollbars. */
5109 SetWindowLong (tip_window
, WND_SCROLLBAR_INDEX
, 0);
5111 /* Do this to discard the default setting specified by our parent. */
5112 ShowWindow (tip_window
, SW_HIDE
);
5117 /* Create and set up the w32 window for frame F. */
5120 w32_window (f
, window_prompting
, minibuffer_only
)
5122 long window_prompting
;
5123 int minibuffer_only
;
5127 /* Use the resource name as the top-level window name
5128 for looking up resources. Make a non-Lisp copy
5129 for the window manager, so GC relocation won't bother it.
5131 Elsewhere we specify the window name for the window manager. */
5134 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
5135 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
5136 strcpy (f
->namebuf
, str
);
5139 my_create_window (f
);
5141 validate_x_resource_name ();
5143 /* x_set_name normally ignores requests to set the name if the
5144 requested name is the same as the current name. This is the one
5145 place where that assumption isn't correct; f->name is set, but
5146 the server hasn't been told. */
5149 int explicit = f
->explicit_name
;
5151 f
->explicit_name
= 0;
5154 x_set_name (f
, name
, explicit);
5159 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
5160 initialize_frame_menubar (f
);
5162 if (FRAME_W32_WINDOW (f
) == 0)
5163 error ("Unable to create window");
5166 /* Handle the icon stuff for this window. Perhaps later we might
5167 want an x_set_icon_position which can be called interactively as
5175 Lisp_Object icon_x
, icon_y
;
5177 /* Set the position of the icon. Note that Windows 95 groups all
5178 icons in the tray. */
5179 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
5180 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
5181 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
5183 CHECK_NUMBER (icon_x
);
5184 CHECK_NUMBER (icon_y
);
5186 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
5187 error ("Both left and top icon corners of icon must be specified");
5191 if (! EQ (icon_x
, Qunbound
))
5192 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
5195 /* Start up iconic or window? */
5196 x_wm_set_window_state
5197 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
5201 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
5214 XGCValues gc_values
;
5218 /* Create the GC's of this frame.
5219 Note that many default values are used. */
5222 gc_values
.font
= f
->output_data
.w32
->font
;
5224 /* Cursor has cursor-color background, background-color foreground. */
5225 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
5226 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
5227 f
->output_data
.w32
->cursor_gc
5228 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
5229 (GCFont
| GCForeground
| GCBackground
),
5233 f
->output_data
.w32
->white_relief
.gc
= 0;
5234 f
->output_data
.w32
->black_relief
.gc
= 0;
5240 /* Handler for signals raised during x_create_frame and
5241 x_create_top_frame. FRAME is the frame which is partially
5245 unwind_create_frame (frame
)
5248 struct frame
*f
= XFRAME (frame
);
5250 /* If frame is ``official'', nothing to do. */
5251 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
5254 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5257 x_free_frame_resources (f
);
5259 /* Check that reference counts are indeed correct. */
5260 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
5261 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
5270 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
5272 doc
: /* Make a new window, which is called a \"frame\" in Emacs terms.
5273 Returns an Emacs frame object.
5274 ALIST is an alist of frame parameters.
5275 If the parameters specify that the frame should not have a minibuffer,
5276 and do not specify a specific minibuffer window to use,
5277 then `default-minibuffer-frame' must be a frame whose minibuffer can
5278 be shared by the new frame.
5280 This function is an internal primitive--use `make-frame' instead. */)
5285 Lisp_Object frame
, tem
;
5287 int minibuffer_only
= 0;
5288 long window_prompting
= 0;
5290 int count
= BINDING_STACK_SIZE ();
5291 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
5292 Lisp_Object display
;
5293 struct w32_display_info
*dpyinfo
= NULL
;
5299 /* Use this general default value to start with
5300 until we know if this frame has a specified name. */
5301 Vx_resource_name
= Vinvocation_name
;
5303 display
= w32_get_arg (parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
5304 if (EQ (display
, Qunbound
))
5306 dpyinfo
= check_x_display_info (display
);
5308 kb
= dpyinfo
->kboard
;
5310 kb
= &the_only_kboard
;
5313 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
5315 && ! EQ (name
, Qunbound
)
5317 error ("Invalid frame name--not a string or nil");
5320 Vx_resource_name
= name
;
5322 /* See if parent window is specified. */
5323 parent
= w32_get_arg (parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
5324 if (EQ (parent
, Qunbound
))
5326 if (! NILP (parent
))
5327 CHECK_NUMBER (parent
);
5329 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5330 /* No need to protect DISPLAY because that's not used after passing
5331 it to make_frame_without_minibuffer. */
5333 GCPRO4 (parms
, parent
, name
, frame
);
5334 tem
= w32_get_arg (parms
, Qminibuffer
, "minibuffer", "Minibuffer",
5336 if (EQ (tem
, Qnone
) || NILP (tem
))
5337 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
5338 else if (EQ (tem
, Qonly
))
5340 f
= make_minibuffer_frame ();
5341 minibuffer_only
= 1;
5343 else if (WINDOWP (tem
))
5344 f
= make_frame_without_minibuffer (tem
, kb
, display
);
5348 XSETFRAME (frame
, f
);
5350 /* Note that Windows does support scroll bars. */
5351 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
5352 /* By default, make scrollbars the system standard width. */
5353 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
5355 f
->output_method
= output_w32
;
5356 f
->output_data
.w32
=
5357 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
5358 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
5359 FRAME_FONTSET (f
) = -1;
5360 record_unwind_protect (unwind_create_frame
, frame
);
5363 = w32_get_arg (parms
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
5364 if (! STRINGP (f
->icon_name
))
5365 f
->icon_name
= Qnil
;
5367 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
5369 FRAME_KBOARD (f
) = kb
;
5372 /* Specify the parent under which to make this window. */
5376 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
5377 f
->output_data
.w32
->explicit_parent
= 1;
5381 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5382 f
->output_data
.w32
->explicit_parent
= 0;
5385 /* Set the name; the functions to which we pass f expect the name to
5387 if (EQ (name
, Qunbound
) || NILP (name
))
5389 f
->name
= build_string (dpyinfo
->w32_id_name
);
5390 f
->explicit_name
= 0;
5395 f
->explicit_name
= 1;
5396 /* use the frame's title when getting resources for this frame. */
5397 specbind (Qx_resource_name
, name
);
5400 /* Extract the window parameters from the supplied values
5401 that are needed to determine window geometry. */
5405 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
5408 /* First, try whatever font the caller has specified. */
5411 tem
= Fquery_fontset (font
, Qnil
);
5413 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
5415 font
= x_new_font (f
, XSTRING (font
)->data
);
5417 /* Try out a font which we hope has bold and italic variations. */
5418 if (!STRINGP (font
))
5419 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
5420 if (! STRINGP (font
))
5421 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
5422 /* If those didn't work, look for something which will at least work. */
5423 if (! STRINGP (font
))
5424 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
5426 if (! STRINGP (font
))
5427 font
= build_string ("Fixedsys");
5429 x_default_parameter (f
, parms
, Qfont
, font
,
5430 "font", "Font", RES_TYPE_STRING
);
5433 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
5434 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
5435 /* This defaults to 2 in order to match xterm. We recognize either
5436 internalBorderWidth or internalBorder (which is what xterm calls
5438 if (NILP (Fassq (Qinternal_border_width
, parms
)))
5442 value
= w32_get_arg (parms
, Qinternal_border_width
,
5443 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
5444 if (! EQ (value
, Qunbound
))
5445 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
5448 /* Default internalBorderWidth to 0 on Windows to match other programs. */
5449 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
5450 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
5451 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qright
,
5452 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
5454 /* Also do the stuff which must be set before the window exists. */
5455 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
5456 "foreground", "Foreground", RES_TYPE_STRING
);
5457 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
5458 "background", "Background", RES_TYPE_STRING
);
5459 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
5460 "pointerColor", "Foreground", RES_TYPE_STRING
);
5461 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
5462 "cursorColor", "Foreground", RES_TYPE_STRING
);
5463 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
5464 "borderColor", "BorderColor", RES_TYPE_STRING
);
5465 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
5466 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
5467 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
5468 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
5469 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
5470 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
5471 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
5472 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
5475 /* Init faces before x_default_parameter is called for scroll-bar
5476 parameters because that function calls x_set_scroll_bar_width,
5477 which calls change_frame_size, which calls Fset_window_buffer,
5478 which runs hooks, which call Fvertical_motion. At the end, we
5479 end up in init_iterator with a null face cache, which should not
5481 init_frame_faces (f
);
5483 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
5484 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
5485 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
5486 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
5487 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
5488 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
5489 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
5490 "title", "Title", RES_TYPE_STRING
);
5492 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
5493 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5495 /* Add the tool-bar height to the initial frame height so that the
5496 user gets a text display area of the size he specified with -g or
5497 via .Xdefaults. Later changes of the tool-bar height don't
5498 change the frame size. This is done so that users can create
5499 tall Emacs frames without having to guess how tall the tool-bar
5501 if (FRAME_TOOL_BAR_LINES (f
))
5503 int margin
, relief
, bar_height
;
5505 relief
= (tool_bar_button_relief
>= 0
5506 ? tool_bar_button_relief
5507 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
5509 if (INTEGERP (Vtool_bar_button_margin
)
5510 && XINT (Vtool_bar_button_margin
) > 0)
5511 margin
= XFASTINT (Vtool_bar_button_margin
);
5512 else if (CONSP (Vtool_bar_button_margin
)
5513 && INTEGERP (XCDR (Vtool_bar_button_margin
))
5514 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
5515 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
5519 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
5520 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
5523 window_prompting
= x_figure_window_size (f
, parms
);
5525 if (window_prompting
& XNegative
)
5527 if (window_prompting
& YNegative
)
5528 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
5530 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
5534 if (window_prompting
& YNegative
)
5535 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
5537 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
5540 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
5542 tem
= w32_get_arg (parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
5543 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
5545 w32_window (f
, window_prompting
, minibuffer_only
);
5550 /* Now consider the frame official. */
5551 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
5552 Vframe_list
= Fcons (frame
, Vframe_list
);
5554 /* We need to do this after creating the window, so that the
5555 icon-creation functions can say whose icon they're describing. */
5556 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
5557 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
5559 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
5560 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5561 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
5562 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5563 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
5564 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
5565 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
5566 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
5568 /* Dimensions, especially f->height, must be done via change_frame_size.
5569 Change will not be effected unless different from the current
5575 SET_FRAME_WIDTH (f
, 0);
5576 change_frame_size (f
, height
, width
, 1, 0, 0);
5578 /* Tell the server what size and position, etc, we want, and how
5579 badly we want them. This should be done after we have the menu
5580 bar so that its size can be taken into account. */
5582 x_wm_set_size_hint (f
, window_prompting
, 0);
5585 /* Set up faces after all frame parameters are known. This call
5586 also merges in face attributes specified for new frames. If we
5587 don't do this, the `menu' face for instance won't have the right
5588 colors, and the menu bar won't appear in the specified colors for
5590 call1 (Qface_set_after_frame_default
, frame
);
5592 /* Make the window appear on the frame and enable display, unless
5593 the caller says not to. However, with explicit parent, Emacs
5594 cannot control visibility, so don't try. */
5595 if (! f
->output_data
.w32
->explicit_parent
)
5597 Lisp_Object visibility
;
5599 visibility
= w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
5600 if (EQ (visibility
, Qunbound
))
5603 if (EQ (visibility
, Qicon
))
5604 x_iconify_frame (f
);
5605 else if (! NILP (visibility
))
5606 x_make_frame_visible (f
);
5608 /* Must have been Qnil. */
5613 /* Make sure windows on this frame appear in calls to next-window
5614 and similar functions. */
5615 Vwindow_list
= Qnil
;
5617 return unbind_to (count
, frame
);
5620 /* FRAME is used only to get a handle on the X display. We don't pass the
5621 display info directly because we're called from frame.c, which doesn't
5622 know about that structure. */
5624 x_get_focus_frame (frame
)
5625 struct frame
*frame
;
5627 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
5629 if (! dpyinfo
->w32_focus_frame
)
5632 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
5636 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
5637 doc
: /* Give FRAME input focus, raising to foreground if necessary. */)
5641 x_focus_on_frame (check_x_frame (frame
));
5646 /* Return the charset portion of a font name. */
5647 char * xlfd_charset_of_font (char * fontname
)
5649 char *charset
, *encoding
;
5651 encoding
= strrchr(fontname
, '-');
5652 if (!encoding
|| encoding
== fontname
)
5655 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
5656 if (*charset
== '-')
5659 if (charset
== fontname
|| strcmp(charset
, "-*-*") == 0)
5665 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
5666 int size
, char* filename
);
5667 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
5668 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
5670 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
5672 static struct font_info
*
5673 w32_load_system_font (f
,fontname
,size
)
5678 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5679 Lisp_Object font_names
;
5681 /* Get a list of all the fonts that match this name. Once we
5682 have a list of matching fonts, we compare them against the fonts
5683 we already have loaded by comparing names. */
5684 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
5686 if (!NILP (font_names
))
5691 /* First check if any are already loaded, as that is cheaper
5692 than loading another one. */
5693 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5694 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
5695 if (dpyinfo
->font_table
[i
].name
5696 && (!strcmp (dpyinfo
->font_table
[i
].name
,
5697 XSTRING (XCAR (tail
))->data
)
5698 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
5699 XSTRING (XCAR (tail
))->data
)))
5700 return (dpyinfo
->font_table
+ i
);
5702 fontname
= (char *) XSTRING (XCAR (font_names
))->data
;
5704 else if (w32_strict_fontnames
)
5706 /* If EnumFontFamiliesEx was available, we got a full list of
5707 fonts back so stop now to avoid the possibility of loading a
5708 random font. If we had to fall back to EnumFontFamilies, the
5709 list is incomplete, so continue whether the font we want was
5711 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5712 FARPROC enum_font_families_ex
5713 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
5714 if (enum_font_families_ex
)
5718 /* Load the font and add it to the table. */
5720 char *full_name
, *encoding
, *charset
;
5722 struct font_info
*fontp
;
5728 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
5731 if (!*lf
.lfFaceName
)
5732 /* If no name was specified for the font, we get a random font
5733 from CreateFontIndirect - this is not particularly
5734 desirable, especially since CreateFontIndirect does not
5735 fill out the missing name in lf, so we never know what we
5739 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
5740 bzero (font
, sizeof (*font
));
5742 /* Set bdf to NULL to indicate that this is a Windows font. */
5747 font
->hfont
= CreateFontIndirect (&lf
);
5749 if (font
->hfont
== NULL
)
5758 codepage
= w32_codepage_for_font (fontname
);
5760 hdc
= GetDC (dpyinfo
->root_window
);
5761 oldobj
= SelectObject (hdc
, font
->hfont
);
5763 ok
= GetTextMetrics (hdc
, &font
->tm
);
5764 if (codepage
== CP_UNICODE
)
5765 font
->double_byte_p
= 1;
5768 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5769 don't report themselves as double byte fonts, when
5770 patently they are. So instead of trusting
5771 GetFontLanguageInfo, we check the properties of the
5772 codepage directly, since that is ultimately what we are
5773 working from anyway. */
5774 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5776 GetCPInfo (codepage
, &cpi
);
5777 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
5780 SelectObject (hdc
, oldobj
);
5781 ReleaseDC (dpyinfo
->root_window
, hdc
);
5782 /* Fill out details in lf according to the font that was
5784 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
5785 lf
.lfWidth
= font
->tm
.tmAveCharWidth
;
5786 lf
.lfWeight
= font
->tm
.tmWeight
;
5787 lf
.lfItalic
= font
->tm
.tmItalic
;
5788 lf
.lfCharSet
= font
->tm
.tmCharSet
;
5789 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
5790 ? VARIABLE_PITCH
: FIXED_PITCH
);
5791 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
5792 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
5794 w32_cache_char_metrics (font
);
5801 w32_unload_font (dpyinfo
, font
);
5805 /* Find a free slot in the font table. */
5806 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
5807 if (dpyinfo
->font_table
[i
].name
== NULL
)
5810 /* If no free slot found, maybe enlarge the font table. */
5811 if (i
== dpyinfo
->n_fonts
5812 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
5815 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
5816 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
5818 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
5821 fontp
= dpyinfo
->font_table
+ i
;
5822 if (i
== dpyinfo
->n_fonts
)
5825 /* Now fill in the slots of *FONTP. */
5828 fontp
->font_idx
= i
;
5829 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
5830 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
5832 charset
= xlfd_charset_of_font (fontname
);
5834 /* Cache the W32 codepage for a font. This makes w32_encode_char
5835 (called for every glyph during redisplay) much faster. */
5836 fontp
->codepage
= codepage
;
5838 /* Work out the font's full name. */
5839 full_name
= (char *)xmalloc (100);
5840 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
5841 fontp
->full_name
= full_name
;
5844 /* If all else fails - just use the name we used to load it. */
5846 fontp
->full_name
= fontp
->name
;
5849 fontp
->size
= FONT_WIDTH (font
);
5850 fontp
->height
= FONT_HEIGHT (font
);
5852 /* The slot `encoding' specifies how to map a character
5853 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
5854 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
5855 (0:0x20..0x7F, 1:0xA0..0xFF,
5856 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
5857 2:0xA020..0xFF7F). For the moment, we don't know which charset
5858 uses this font. So, we set information in fontp->encoding[1]
5859 which is never used by any charset. If mapping can't be
5860 decided, set FONT_ENCODING_NOT_DECIDED. */
5862 /* SJIS fonts need to be set to type 4, all others seem to work as
5863 type FONT_ENCODING_NOT_DECIDED. */
5864 encoding
= strrchr (fontp
->name
, '-');
5865 if (encoding
&& stricmp (encoding
+1, "sjis") == 0)
5866 fontp
->encoding
[1] = 4;
5868 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
5870 /* The following three values are set to 0 under W32, which is
5871 what they get set to if XGetFontProperty fails under X. */
5872 fontp
->baseline_offset
= 0;
5873 fontp
->relative_compose
= 0;
5874 fontp
->default_ascent
= 0;
5876 /* Set global flag fonts_changed_p to non-zero if the font loaded
5877 has a character with a smaller width than any other character
5878 before, or if the font loaded has a smalle>r height than any
5879 other font loaded before. If this happens, it will make a
5880 glyph matrix reallocation necessary. */
5881 fonts_changed_p
= x_compute_min_glyph_bounds (f
);
5887 /* Load font named FONTNAME of size SIZE for frame F, and return a
5888 pointer to the structure font_info while allocating it dynamically.
5889 If loading fails, return NULL. */
5891 w32_load_font (f
,fontname
,size
)
5896 Lisp_Object bdf_fonts
;
5897 struct font_info
*retval
= NULL
;
5899 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
5901 while (!retval
&& CONSP (bdf_fonts
))
5903 char *bdf_name
, *bdf_file
;
5904 Lisp_Object bdf_pair
;
5906 bdf_name
= XSTRING (XCAR (bdf_fonts
))->data
;
5907 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
5908 bdf_file
= XSTRING (XCDR (bdf_pair
))->data
;
5910 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
5912 bdf_fonts
= XCDR (bdf_fonts
);
5918 return w32_load_system_font(f
, fontname
, size
);
5923 w32_unload_font (dpyinfo
, font
)
5924 struct w32_display_info
*dpyinfo
;
5929 if (font
->per_char
) xfree (font
->per_char
);
5930 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
5932 if (font
->hfont
) DeleteObject(font
->hfont
);
5937 /* The font conversion stuff between x and w32 */
5939 /* X font string is as follows (from faces.el)
5943 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5944 * (weight\? "\\([^-]*\\)") ; 1
5945 * (slant "\\([ior]\\)") ; 2
5946 * (slant\? "\\([^-]?\\)") ; 2
5947 * (swidth "\\([^-]*\\)") ; 3
5948 * (adstyle "[^-]*") ; 4
5949 * (pixelsize "[0-9]+")
5950 * (pointsize "[0-9][0-9]+")
5951 * (resx "[0-9][0-9]+")
5952 * (resy "[0-9][0-9]+")
5953 * (spacing "[cmp?*]")
5954 * (avgwidth "[0-9]+")
5955 * (registry "[^-]+")
5956 * (encoding "[^-]+")
5961 x_to_w32_weight (lpw
)
5964 if (!lpw
) return (FW_DONTCARE
);
5966 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
5967 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
5968 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
5969 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
5970 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
5971 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
5972 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
5973 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
5974 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
5975 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
5982 w32_to_x_weight (fnweight
)
5985 if (fnweight
>= FW_HEAVY
) return "heavy";
5986 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
5987 if (fnweight
>= FW_BOLD
) return "bold";
5988 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
5989 if (fnweight
>= FW_MEDIUM
) return "medium";
5990 if (fnweight
>= FW_NORMAL
) return "normal";
5991 if (fnweight
>= FW_LIGHT
) return "light";
5992 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
5993 if (fnweight
>= FW_THIN
) return "thin";
5999 x_to_w32_charset (lpcs
)
6002 Lisp_Object this_entry
, w32_charset
;
6004 int len
= strlen (lpcs
);
6006 /* Support "*-#nnn" format for unknown charsets. */
6007 if (strncmp (lpcs
, "*-#", 3) == 0)
6008 return atoi (lpcs
+ 3);
6010 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
6011 charset
= alloca (len
+ 1);
6012 strcpy (charset
, lpcs
);
6013 lpcs
= strchr (charset
, '*');
6017 /* Look through w32-charset-info-alist for the character set.
6018 Format of each entry is
6019 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6021 this_entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6023 if (NILP(this_entry
))
6025 /* At startup, we want iso8859-1 fonts to come up properly. */
6026 if (stricmp(charset
, "iso8859-1") == 0)
6027 return ANSI_CHARSET
;
6029 return DEFAULT_CHARSET
;
6032 w32_charset
= Fcar (Fcdr (this_entry
));
6034 // Translate Lisp symbol to number.
6035 if (w32_charset
== Qw32_charset_ansi
)
6036 return ANSI_CHARSET
;
6037 if (w32_charset
== Qw32_charset_symbol
)
6038 return SYMBOL_CHARSET
;
6039 if (w32_charset
== Qw32_charset_shiftjis
)
6040 return SHIFTJIS_CHARSET
;
6041 if (w32_charset
== Qw32_charset_hangeul
)
6042 return HANGEUL_CHARSET
;
6043 if (w32_charset
== Qw32_charset_chinesebig5
)
6044 return CHINESEBIG5_CHARSET
;
6045 if (w32_charset
== Qw32_charset_gb2312
)
6046 return GB2312_CHARSET
;
6047 if (w32_charset
== Qw32_charset_oem
)
6049 #ifdef JOHAB_CHARSET
6050 if (w32_charset
== Qw32_charset_johab
)
6051 return JOHAB_CHARSET
;
6052 if (w32_charset
== Qw32_charset_easteurope
)
6053 return EASTEUROPE_CHARSET
;
6054 if (w32_charset
== Qw32_charset_turkish
)
6055 return TURKISH_CHARSET
;
6056 if (w32_charset
== Qw32_charset_baltic
)
6057 return BALTIC_CHARSET
;
6058 if (w32_charset
== Qw32_charset_russian
)
6059 return RUSSIAN_CHARSET
;
6060 if (w32_charset
== Qw32_charset_arabic
)
6061 return ARABIC_CHARSET
;
6062 if (w32_charset
== Qw32_charset_greek
)
6063 return GREEK_CHARSET
;
6064 if (w32_charset
== Qw32_charset_hebrew
)
6065 return HEBREW_CHARSET
;
6066 if (w32_charset
== Qw32_charset_vietnamese
)
6067 return VIETNAMESE_CHARSET
;
6068 if (w32_charset
== Qw32_charset_thai
)
6069 return THAI_CHARSET
;
6070 if (w32_charset
== Qw32_charset_mac
)
6072 #endif /* JOHAB_CHARSET */
6073 #ifdef UNICODE_CHARSET
6074 if (w32_charset
== Qw32_charset_unicode
)
6075 return UNICODE_CHARSET
;
6078 return DEFAULT_CHARSET
;
6083 w32_to_x_charset (fncharset
)
6086 static char buf
[32];
6087 Lisp_Object charset_type
;
6092 /* Handle startup case of w32-charset-info-alist not
6093 being set up yet. */
6094 if (NILP(Vw32_charset_info_alist
))
6096 charset_type
= Qw32_charset_ansi
;
6098 case DEFAULT_CHARSET
:
6099 charset_type
= Qw32_charset_default
;
6101 case SYMBOL_CHARSET
:
6102 charset_type
= Qw32_charset_symbol
;
6104 case SHIFTJIS_CHARSET
:
6105 charset_type
= Qw32_charset_shiftjis
;
6107 case HANGEUL_CHARSET
:
6108 charset_type
= Qw32_charset_hangeul
;
6110 case GB2312_CHARSET
:
6111 charset_type
= Qw32_charset_gb2312
;
6113 case CHINESEBIG5_CHARSET
:
6114 charset_type
= Qw32_charset_chinesebig5
;
6117 charset_type
= Qw32_charset_oem
;
6120 /* More recent versions of Windows (95 and NT4.0) define more
6122 #ifdef EASTEUROPE_CHARSET
6123 case EASTEUROPE_CHARSET
:
6124 charset_type
= Qw32_charset_easteurope
;
6126 case TURKISH_CHARSET
:
6127 charset_type
= Qw32_charset_turkish
;
6129 case BALTIC_CHARSET
:
6130 charset_type
= Qw32_charset_baltic
;
6132 case RUSSIAN_CHARSET
:
6133 charset_type
= Qw32_charset_russian
;
6135 case ARABIC_CHARSET
:
6136 charset_type
= Qw32_charset_arabic
;
6139 charset_type
= Qw32_charset_greek
;
6141 case HEBREW_CHARSET
:
6142 charset_type
= Qw32_charset_hebrew
;
6144 case VIETNAMESE_CHARSET
:
6145 charset_type
= Qw32_charset_vietnamese
;
6148 charset_type
= Qw32_charset_thai
;
6151 charset_type
= Qw32_charset_mac
;
6154 charset_type
= Qw32_charset_johab
;
6158 #ifdef UNICODE_CHARSET
6159 case UNICODE_CHARSET
:
6160 charset_type
= Qw32_charset_unicode
;
6164 /* Encode numerical value of unknown charset. */
6165 sprintf (buf
, "*-#%u", fncharset
);
6171 char * best_match
= NULL
;
6173 /* Look through w32-charset-info-alist for the character set.
6174 Prefer ISO codepages, and prefer lower numbers in the ISO
6175 range. Only return charsets for codepages which are installed.
6177 Format of each entry is
6178 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6180 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
6183 Lisp_Object w32_charset
;
6184 Lisp_Object codepage
;
6186 Lisp_Object this_entry
= XCAR (rest
);
6188 /* Skip invalid entries in alist. */
6189 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
6190 || !CONSP (XCDR (this_entry
))
6191 || !SYMBOLP (XCAR (XCDR (this_entry
))))
6194 x_charset
= XSTRING (XCAR (this_entry
))->data
;
6195 w32_charset
= XCAR (XCDR (this_entry
));
6196 codepage
= XCDR (XCDR (this_entry
));
6198 /* Look for Same charset and a valid codepage (or non-int
6199 which means ignore). */
6200 if (w32_charset
== charset_type
6201 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
6202 || IsValidCodePage (XINT (codepage
))))
6204 /* If we don't have a match already, then this is the
6207 best_match
= x_charset
;
6208 /* If this is an ISO codepage, and the best so far isn't,
6209 then this is better. */
6210 else if (stricmp (best_match
, "iso") != 0
6211 && stricmp (x_charset
, "iso") == 0)
6212 best_match
= x_charset
;
6213 /* If both are ISO8859 codepages, choose the one with the
6214 lowest number in the encoding field. */
6215 else if (stricmp (best_match
, "iso8859-") == 0
6216 && stricmp (x_charset
, "iso8859-") == 0)
6218 int best_enc
= atoi (best_match
+ 8);
6219 int this_enc
= atoi (x_charset
+ 8);
6220 if (this_enc
> 0 && this_enc
< best_enc
)
6221 best_match
= x_charset
;
6226 /* If no match, encode the numeric value. */
6229 sprintf (buf
, "*-#%u", fncharset
);
6233 strncpy(buf
, best_match
, 31);
6240 /* Get the Windows codepage corresponding to the specified font. The
6241 charset info in the font name is used to look up
6242 w32-charset-to-codepage-alist. */
6244 w32_codepage_for_font (char *fontname
)
6246 Lisp_Object codepage
, entry
;
6247 char *charset_str
, *charset
, *end
;
6249 if (NILP (Vw32_charset_info_alist
))
6252 /* Extract charset part of font string. */
6253 charset
= xlfd_charset_of_font (fontname
);
6258 charset_str
= (char *) alloca (strlen (charset
) + 1);
6259 strcpy (charset_str
, charset
);
6262 /* Remove leading "*-". */
6263 if (strncmp ("*-", charset_str
, 2) == 0)
6264 charset
= charset_str
+ 2;
6267 charset
= charset_str
;
6269 /* Stop match at wildcard (including preceding '-'). */
6270 if (end
= strchr (charset
, '*'))
6272 if (end
> charset
&& *(end
-1) == '-')
6277 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6281 codepage
= Fcdr (Fcdr (entry
));
6283 if (NILP (codepage
))
6285 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
6287 else if (INTEGERP (codepage
))
6288 return XINT (codepage
);
6295 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
6296 LOGFONT
* lplogfont
;
6299 char * specific_charset
;
6303 char height_pixels
[8];
6305 char width_pixels
[8];
6306 char *fontname_dash
;
6307 int display_resy
= one_w32_display_info
.resy
;
6308 int display_resx
= one_w32_display_info
.resx
;
6310 struct coding_system coding
;
6312 if (!lpxstr
) abort ();
6317 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
6318 fonttype
= "raster";
6319 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
6320 fonttype
= "outline";
6322 fonttype
= "unknown";
6324 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system
),
6326 coding
.src_multibyte
= 0;
6327 coding
.dst_multibyte
= 1;
6328 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6329 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
6331 fontname
= alloca(sizeof(*fontname
) * bufsz
);
6332 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
6333 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
6334 *(fontname
+ coding
.produced
) = '\0';
6336 /* Replace dashes with underscores so the dashes are not
6338 fontname_dash
= fontname
;
6339 while (fontname_dash
= strchr (fontname_dash
, '-'))
6340 *fontname_dash
= '_';
6342 if (lplogfont
->lfHeight
)
6344 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
6345 sprintf (height_dpi
, "%u",
6346 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
6350 strcpy (height_pixels
, "*");
6351 strcpy (height_dpi
, "*");
6353 if (lplogfont
->lfWidth
)
6354 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
6356 strcpy (width_pixels
, "*");
6358 _snprintf (lpxstr
, len
- 1,
6359 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6360 fonttype
, /* foundry */
6361 fontname
, /* family */
6362 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
6363 lplogfont
->lfItalic
?'i':'r', /* slant */
6365 /* add style name */
6366 height_pixels
, /* pixel size */
6367 height_dpi
, /* point size */
6368 display_resx
, /* resx */
6369 display_resy
, /* resy */
6370 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
6371 ? 'p' : 'c', /* spacing */
6372 width_pixels
, /* avg width */
6373 specific_charset
? specific_charset
6374 : w32_to_x_charset (lplogfont
->lfCharSet
)
6375 /* charset registry and encoding */
6378 lpxstr
[len
- 1] = 0; /* just to be sure */
6383 x_to_w32_font (lpxstr
, lplogfont
)
6385 LOGFONT
* lplogfont
;
6387 struct coding_system coding
;
6389 if (!lplogfont
) return (FALSE
);
6391 memset (lplogfont
, 0, sizeof (*lplogfont
));
6393 /* Set default value for each field. */
6395 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
6396 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
6397 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
6399 /* go for maximum quality */
6400 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
6401 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
6402 lplogfont
->lfQuality
= PROOF_QUALITY
;
6405 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
6406 lplogfont
->lfWeight
= FW_DONTCARE
;
6407 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
6412 /* Provide a simple escape mechanism for specifying Windows font names
6413 * directly -- if font spec does not beginning with '-', assume this
6415 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6421 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
6422 width
[10], resy
[10], remainder
[50];
6424 int dpi
= one_w32_display_info
.resy
;
6426 fields
= sscanf (lpxstr
,
6427 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
6428 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
6432 /* In the general case when wildcards cover more than one field,
6433 we don't know which field is which, so don't fill any in.
6434 However, we need to cope with this particular form, which is
6435 generated by font_list_1 (invoked by try_font_list):
6436 "-raster-6x10-*-gb2312*-*"
6437 and make sure to correctly parse the charset field. */
6440 fields
= sscanf (lpxstr
,
6441 "-%*[^-]-%49[^-]-*-%49s",
6444 else if (fields
< 9)
6450 if (fields
> 0 && name
[0] != '*')
6456 (Fcheck_coding_system (Vlocale_coding_system
), &coding
);
6457 coding
.src_multibyte
= 1;
6458 coding
.dst_multibyte
= 1;
6459 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
6460 buf
= (unsigned char *) alloca (bufsize
);
6461 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6462 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
6463 if (coding
.produced
>= LF_FACESIZE
)
6464 coding
.produced
= LF_FACESIZE
- 1;
6465 buf
[coding
.produced
] = 0;
6466 strcpy (lplogfont
->lfFaceName
, buf
);
6470 lplogfont
->lfFaceName
[0] = '\0';
6475 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6479 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
6483 if (fields
> 0 && pixels
[0] != '*')
6484 lplogfont
->lfHeight
= atoi (pixels
);
6488 if (fields
> 0 && resy
[0] != '*')
6491 if (tem
> 0) dpi
= tem
;
6494 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
6495 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
6498 lplogfont
->lfPitchAndFamily
=
6499 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
6503 if (fields
> 0 && width
[0] != '*')
6504 lplogfont
->lfWidth
= atoi (width
) / 10;
6508 /* Strip the trailing '-' if present. (it shouldn't be, as it
6509 fails the test against xlfd-tight-regexp in fontset.el). */
6511 int len
= strlen (remainder
);
6512 if (len
> 0 && remainder
[len
-1] == '-')
6513 remainder
[len
-1] = 0;
6515 encoding
= remainder
;
6517 if (strncmp (encoding
, "*-", 2) == 0)
6520 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
6525 char name
[100], height
[10], width
[10], weight
[20];
6527 fields
= sscanf (lpxstr
,
6528 "%99[^:]:%9[^:]:%9[^:]:%19s",
6529 name
, height
, width
, weight
);
6531 if (fields
== EOF
) return (FALSE
);
6535 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
6536 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
6540 lplogfont
->lfFaceName
[0] = 0;
6546 lplogfont
->lfHeight
= atoi (height
);
6551 lplogfont
->lfWidth
= atoi (width
);
6555 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6558 /* This makes TrueType fonts work better. */
6559 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
6564 /* Strip the pixel height and point height from the given xlfd, and
6565 return the pixel height. If no pixel height is specified, calculate
6566 one from the point height, or if that isn't defined either, return
6567 0 (which usually signifies a scalable font).
6570 xlfd_strip_height (char *fontname
)
6572 int pixel_height
, field_number
;
6573 char *read_from
, *write_to
;
6577 pixel_height
= field_number
= 0;
6580 /* Look for height fields. */
6581 for (read_from
= fontname
; *read_from
; read_from
++)
6583 if (*read_from
== '-')
6586 if (field_number
== 7) /* Pixel height. */
6589 write_to
= read_from
;
6591 /* Find end of field. */
6592 for (;*read_from
&& *read_from
!= '-'; read_from
++)
6595 /* Split the fontname at end of field. */
6601 pixel_height
= atoi (write_to
);
6602 /* Blank out field. */
6603 if (read_from
> write_to
)
6608 /* If the pixel height field is at the end (partial xlfd),
6611 return pixel_height
;
6613 /* If we got a pixel height, the point height can be
6614 ignored. Just blank it out and break now. */
6617 /* Find end of point size field. */
6618 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6624 /* Blank out the point size field. */
6625 if (read_from
> write_to
)
6631 return pixel_height
;
6635 /* If the point height is already blank, break now. */
6636 if (*read_from
== '-')
6642 else if (field_number
== 8)
6644 /* If we didn't get a pixel height, try to get the point
6645 height and convert that. */
6647 char *point_size_start
= read_from
++;
6649 /* Find end of field. */
6650 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6659 point_size
= atoi (point_size_start
);
6661 /* Convert to pixel height. */
6662 pixel_height
= point_size
6663 * one_w32_display_info
.height_in
/ 720;
6665 /* Blank out this field and break. */
6673 /* Shift the rest of the font spec into place. */
6674 if (write_to
&& read_from
> write_to
)
6676 for (; *read_from
; read_from
++, write_to
++)
6677 *write_to
= *read_from
;
6681 return pixel_height
;
6684 /* Assume parameter 1 is fully qualified, no wildcards. */
6686 w32_font_match (fontname
, pattern
)
6690 char *regex
= alloca (strlen (pattern
) * 2 + 3);
6691 char *font_name_copy
= alloca (strlen (fontname
) + 1);
6694 /* Copy fontname so we can modify it during comparison. */
6695 strcpy (font_name_copy
, fontname
);
6700 /* Turn pattern into a regexp and do a regexp match. */
6701 for (; *pattern
; pattern
++)
6703 if (*pattern
== '?')
6705 else if (*pattern
== '*')
6716 /* Strip out font heights and compare them seperately, since
6717 rounding error can cause mismatches. This also allows a
6718 comparison between a font that declares only a pixel height and a
6719 pattern that declares the point height.
6722 int font_height
, pattern_height
;
6724 font_height
= xlfd_strip_height (font_name_copy
);
6725 pattern_height
= xlfd_strip_height (regex
);
6727 /* Compare now, and don't bother doing expensive regexp matching
6728 if the heights differ. */
6729 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
6733 return (fast_c_string_match_ignore_case (build_string (regex
),
6734 font_name_copy
) >= 0);
6737 /* Callback functions, and a structure holding info they need, for
6738 listing system fonts on W32. We need one set of functions to do the
6739 job properly, but these don't work on NT 3.51 and earlier, so we
6740 have a second set which don't handle character sets properly to
6743 In both cases, there are two passes made. The first pass gets one
6744 font from each family, the second pass lists all the fonts from
6747 typedef struct enumfont_t
6752 XFontStruct
*size_ref
;
6753 Lisp_Object
*pattern
;
6758 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
6760 NEWTEXTMETRIC
* lptm
;
6764 /* Ignore struck out and underlined versions of fonts. */
6765 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
6768 /* Only return fonts with names starting with @ if they were
6769 explicitly specified, since Microsoft uses an initial @ to
6770 denote fonts for vertical writing, without providing a more
6771 convenient way of identifying them. */
6772 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
6773 && lpef
->logfont
.lfFaceName
[0] != '@')
6776 /* Check that the character set matches if it was specified */
6777 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
6778 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
6783 Lisp_Object width
= Qnil
;
6784 char *charset
= NULL
;
6786 /* Truetype fonts do not report their true metrics until loaded */
6787 if (FontType
!= RASTER_FONTTYPE
)
6789 if (!NILP (*(lpef
->pattern
)))
6791 /* Scalable fonts are as big as you want them to be. */
6792 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
6793 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
6794 width
= make_number (lpef
->logfont
.lfWidth
);
6798 lplf
->elfLogFont
.lfHeight
= 0;
6799 lplf
->elfLogFont
.lfWidth
= 0;
6803 /* Make sure the height used here is the same as everywhere
6804 else (ie character height, not cell height). */
6805 if (lplf
->elfLogFont
.lfHeight
> 0)
6807 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6808 if (FontType
== RASTER_FONTTYPE
)
6809 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
6811 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
6814 if (!NILP (*(lpef
->pattern
)))
6816 charset
= xlfd_charset_of_font (XSTRING(*(lpef
->pattern
))->data
);
6818 /* Ensure that charset is valid for this font. */
6820 && (x_to_w32_charset (charset
) != lplf
->elfLogFont
.lfCharSet
))
6824 /* TODO: List all relevant charsets if charset not specified. */
6825 if (!w32_to_x_font (&(lplf
->elfLogFont
), buf
, 100, charset
))
6828 if (NILP (*(lpef
->pattern
))
6829 || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
6831 *lpef
->tail
= Fcons (Fcons (build_string (buf
), width
), Qnil
);
6832 lpef
->tail
= &(XCDR (*lpef
->tail
));
6841 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
6843 NEWTEXTMETRIC
* lptm
;
6847 return EnumFontFamilies (lpef
->hdc
,
6848 lplf
->elfLogFont
.lfFaceName
,
6849 (FONTENUMPROC
) enum_font_cb2
,
6855 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
6856 ENUMLOGFONTEX
* lplf
;
6857 NEWTEXTMETRICEX
* lptm
;
6861 /* We are not interested in the extra info we get back from the 'Ex
6862 version - only the fact that we get character set variations
6863 enumerated seperately. */
6864 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
6869 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
6870 ENUMLOGFONTEX
* lplf
;
6871 NEWTEXTMETRICEX
* lptm
;
6875 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6876 FARPROC enum_font_families_ex
6877 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6878 /* We don't really expect EnumFontFamiliesEx to disappear once we
6879 get here, so don't bother handling it gracefully. */
6880 if (enum_font_families_ex
== NULL
)
6881 error ("gdi32.dll has disappeared!");
6882 return enum_font_families_ex (lpef
->hdc
,
6884 (FONTENUMPROC
) enum_fontex_cb2
,
6888 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6889 and xterm.c in Emacs 20.3) */
6891 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
6893 char *fontname
, *ptnstr
;
6894 Lisp_Object list
, tem
, newlist
= Qnil
;
6897 list
= Vw32_bdf_filename_alist
;
6898 ptnstr
= XSTRING (pattern
)->data
;
6900 for ( ; CONSP (list
); list
= XCDR (list
))
6904 fontname
= XSTRING (XCAR (tem
))->data
;
6905 else if (STRINGP (tem
))
6906 fontname
= XSTRING (tem
)->data
;
6910 if (w32_font_match (fontname
, ptnstr
))
6912 newlist
= Fcons (XCAR (tem
), newlist
);
6914 if (n_fonts
>= max_names
)
6922 static Lisp_Object
w32_list_synthesized_fonts (FRAME_PTR f
,
6923 Lisp_Object pattern
,
6924 int size
, int max_names
);
6926 /* Return a list of names of available fonts matching PATTERN on frame
6927 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6928 to be listed. Frame F NULL means we have not yet created any
6929 frame, which means we can't get proper size info, as we don't have
6930 a device context to use for GetTextMetrics.
6931 MAXNAMES sets a limit on how many fonts to match. */
6934 w32_list_fonts (f
, pattern
, size
, maxnames
)
6936 Lisp_Object pattern
;
6940 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
6941 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
6942 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
6945 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
6946 if (NILP (patterns
))
6947 patterns
= Fcons (pattern
, Qnil
);
6949 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
6954 tpat
= XCAR (patterns
);
6956 if (!STRINGP (tpat
))
6959 /* Avoid expensive EnumFontFamilies functions if we are not
6960 going to be able to output one of these anyway. */
6961 codepage
= w32_codepage_for_font (XSTRING (tpat
)->data
);
6962 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
6963 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
6964 && !IsValidCodePage(codepage
))
6967 /* See if we cached the result for this particular query.
6968 The cache is an alist of the form:
6969 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6971 if (tem
= XCDR (dpyinfo
->name_list_element
),
6972 !NILP (list
= Fassoc (tpat
, tem
)))
6974 list
= Fcdr_safe (list
);
6975 /* We have a cached list. Don't have to get the list again. */
6980 /* At first, put PATTERN in the cache. */
6986 /* Use EnumFontFamiliesEx where it is available, as it knows
6987 about character sets. Fall back to EnumFontFamilies for
6988 older versions of NT that don't support the 'Ex function. */
6989 x_to_w32_font (XSTRING (tpat
)->data
, &ef
.logfont
);
6991 LOGFONT font_match_pattern
;
6992 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6993 FARPROC enum_font_families_ex
6994 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6996 /* We do our own pattern matching so we can handle wildcards. */
6997 font_match_pattern
.lfFaceName
[0] = 0;
6998 font_match_pattern
.lfPitchAndFamily
= 0;
6999 /* We can use the charset, because if it is a wildcard it will
7000 be DEFAULT_CHARSET anyway. */
7001 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
7003 ef
.hdc
= GetDC (dpyinfo
->root_window
);
7005 if (enum_font_families_ex
)
7006 enum_font_families_ex (ef
.hdc
,
7007 &font_match_pattern
,
7008 (FONTENUMPROC
) enum_fontex_cb1
,
7011 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
7014 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
7019 /* Make a list of the fonts we got back.
7020 Store that in the font cache for the display. */
7021 XSETCDR (dpyinfo
->name_list_element
,
7022 Fcons (Fcons (tpat
, list
),
7023 XCDR (dpyinfo
->name_list_element
)));
7026 if (NILP (list
)) continue; /* Try the remaining alternatives. */
7028 newlist
= second_best
= Qnil
;
7030 /* Make a list of the fonts that have the right width. */
7031 for (; CONSP (list
); list
= XCDR (list
))
7038 if (NILP (XCAR (tem
)))
7042 newlist
= Fcons (XCAR (tem
), newlist
);
7044 if (n_fonts
>= maxnames
)
7049 if (!INTEGERP (XCDR (tem
)))
7051 /* Since we don't yet know the size of the font, we must
7052 load it and try GetTextMetrics. */
7053 W32FontStruct thisinfo
;
7058 if (!x_to_w32_font (XSTRING (XCAR (tem
))->data
, &lf
))
7062 thisinfo
.bdf
= NULL
;
7063 thisinfo
.hfont
= CreateFontIndirect (&lf
);
7064 if (thisinfo
.hfont
== NULL
)
7067 hdc
= GetDC (dpyinfo
->root_window
);
7068 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
7069 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
7070 XSETCDR (tem
, make_number (FONT_WIDTH (&thisinfo
)));
7072 XSETCDR (tem
, make_number (0));
7073 SelectObject (hdc
, oldobj
);
7074 ReleaseDC (dpyinfo
->root_window
, hdc
);
7075 DeleteObject(thisinfo
.hfont
);
7078 found_size
= XINT (XCDR (tem
));
7079 if (found_size
== size
)
7081 newlist
= Fcons (XCAR (tem
), newlist
);
7083 if (n_fonts
>= maxnames
)
7086 /* keep track of the closest matching size in case
7087 no exact match is found. */
7088 else if (found_size
> 0)
7090 if (NILP (second_best
))
7093 else if (found_size
< size
)
7095 if (XINT (XCDR (second_best
)) > size
7096 || XINT (XCDR (second_best
)) < found_size
)
7101 if (XINT (XCDR (second_best
)) > size
7102 && XINT (XCDR (second_best
)) >
7109 if (!NILP (newlist
))
7111 else if (!NILP (second_best
))
7113 newlist
= Fcons (XCAR (second_best
), Qnil
);
7118 /* Include any bdf fonts. */
7119 if (n_fonts
< maxnames
)
7121 Lisp_Object combined
[2];
7122 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
7123 combined
[1] = newlist
;
7124 newlist
= Fnconc(2, combined
);
7127 /* If we can't find a font that matches, check if Windows would be
7128 able to synthesize it from a different style. */
7129 if (NILP (newlist
) && !NILP (Vw32_enable_synthesized_fonts
))
7130 newlist
= w32_list_synthesized_fonts (f
, pattern
, size
, maxnames
);
7136 w32_list_synthesized_fonts (f
, pattern
, size
, max_names
)
7138 Lisp_Object pattern
;
7143 char *full_pattn
, *new_pattn
, foundary
[50], family
[50], *pattn_part2
;
7144 char style
[20], slant
;
7145 Lisp_Object matches
, tem
, synthed_matches
= Qnil
;
7147 full_pattn
= XSTRING (pattern
)->data
;
7149 pattn_part2
= alloca (XSTRING (pattern
)->size
+ 1);
7150 /* Allow some space for wildcard expansion. */
7151 new_pattn
= alloca (XSTRING (pattern
)->size
+ 100);
7153 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
7154 foundary
, family
, style
, &slant
, pattn_part2
);
7155 if (fields
== EOF
|| fields
< 5)
7158 /* If the style and slant are wildcards already there is no point
7159 checking again (and we don't want to keep recursing). */
7160 if (*style
== '*' && slant
== '*')
7163 sprintf (new_pattn
, "-%s-%s-*-*-%s", foundary
, family
, pattn_part2
);
7165 matches
= w32_list_fonts (f
, build_string (new_pattn
), size
, max_names
);
7167 for ( ; CONSP (matches
); matches
= XCDR (matches
))
7169 tem
= XCAR (matches
);
7173 full_pattn
= XSTRING (tem
)->data
;
7174 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
7175 foundary
, family
, pattn_part2
);
7176 if (fields
== EOF
|| fields
< 3)
7179 sprintf (new_pattn
, "-%s-%s-%s-%c-%s", foundary
, family
, style
,
7180 slant
, pattn_part2
);
7182 synthed_matches
= Fcons (build_string (new_pattn
),
7186 return synthed_matches
;
7190 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7192 w32_get_font_info (f
, font_idx
)
7196 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
7201 w32_query_font (struct frame
*f
, char *fontname
)
7204 struct font_info
*pfi
;
7206 pfi
= FRAME_W32_FONT_TABLE (f
);
7208 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
7210 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
7216 /* Find a CCL program for a font specified by FONTP, and set the member
7217 `encoder' of the structure. */
7220 w32_find_ccl_program (fontp
)
7221 struct font_info
*fontp
;
7223 Lisp_Object list
, elt
;
7225 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
7229 && STRINGP (XCAR (elt
))
7230 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
7236 struct ccl_program
*ccl
7237 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
7239 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
7242 fontp
->font_encoder
= ccl
;
7247 /* Find BDF files in a specified directory. (use GCPRO when calling,
7248 as this calls lisp to get a directory listing). */
7250 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
7252 Lisp_Object filelist
, list
= Qnil
;
7255 if (!STRINGP(directory
))
7258 filelist
= Fdirectory_files (directory
, Qt
,
7259 build_string (".*\\.[bB][dD][fF]"), Qt
);
7261 for ( ; CONSP(filelist
); filelist
= XCDR (filelist
))
7263 Lisp_Object filename
= XCAR (filelist
);
7264 if (w32_BDF_to_x_font (XSTRING (filename
)->data
, fontname
, 100))
7265 store_in_alist (&list
, build_string (fontname
), filename
);
7270 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
7272 doc
: /* Return a list of BDF fonts in DIR.
7273 The list is suitable for appending to w32-bdf-filename-alist. Fonts
7274 which do not contain an xlfd description will not be included in the
7275 list. DIR may be a list of directories. */)
7277 Lisp_Object directory
;
7279 Lisp_Object list
= Qnil
;
7280 struct gcpro gcpro1
, gcpro2
;
7282 if (!CONSP (directory
))
7283 return w32_find_bdf_fonts_in_dir (directory
);
7285 for ( ; CONSP (directory
); directory
= XCDR (directory
))
7287 Lisp_Object pair
[2];
7290 GCPRO2 (directory
, list
);
7291 pair
[1] = w32_find_bdf_fonts_in_dir( XCAR (directory
) );
7292 list
= Fnconc( 2, pair
);
7299 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
7300 doc
: /* Internal function called by `color-defined-p', which see. */)
7302 Lisp_Object color
, frame
;
7305 FRAME_PTR f
= check_x_frame (frame
);
7307 CHECK_STRING (color
);
7309 if (w32_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
7315 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
7316 doc
: /* Internal function called by `color-values', which see. */)
7318 Lisp_Object color
, frame
;
7321 FRAME_PTR f
= check_x_frame (frame
);
7323 CHECK_STRING (color
);
7325 if (w32_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
7329 rgb
[0] = make_number ((GetRValue (foo
.pixel
) << 8)
7330 | GetRValue (foo
.pixel
));
7331 rgb
[1] = make_number ((GetGValue (foo
.pixel
) << 8)
7332 | GetGValue (foo
.pixel
));
7333 rgb
[2] = make_number ((GetBValue (foo
.pixel
) << 8)
7334 | GetBValue (foo
.pixel
));
7335 return Flist (3, rgb
);
7341 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
7342 doc
: /* Internal function called by `display-color-p', which see. */)
7344 Lisp_Object display
;
7346 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7348 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
7354 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
7355 Sx_display_grayscale_p
, 0, 1, 0,
7356 doc
: /* Return t if the X display supports shades of gray.
7357 Note that color displays do support shades of gray.
7358 The optional argument DISPLAY specifies which display to ask about.
7359 DISPLAY should be either a frame or a display name (a string).
7360 If omitted or nil, that stands for the selected frame's display. */)
7362 Lisp_Object display
;
7364 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7366 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
7372 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
7373 Sx_display_pixel_width
, 0, 1, 0,
7374 doc
: /* Returns the width in pixels of DISPLAY.
7375 The optional argument DISPLAY specifies which display to ask about.
7376 DISPLAY should be either a frame or a display name (a string).
7377 If omitted or nil, that stands for the selected frame's display. */)
7379 Lisp_Object display
;
7381 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7383 return make_number (dpyinfo
->width
);
7386 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
7387 Sx_display_pixel_height
, 0, 1, 0,
7388 doc
: /* Returns the height in pixels of DISPLAY.
7389 The optional argument DISPLAY specifies which display to ask about.
7390 DISPLAY should be either a frame or a display name (a string).
7391 If omitted or nil, that stands for the selected frame's display. */)
7393 Lisp_Object display
;
7395 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7397 return make_number (dpyinfo
->height
);
7400 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
7402 doc
: /* Returns the number of bitplanes of DISPLAY.
7403 The optional argument DISPLAY specifies which display to ask about.
7404 DISPLAY should be either a frame or a display name (a string).
7405 If omitted or nil, that stands for the selected frame's display. */)
7407 Lisp_Object display
;
7409 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7411 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7414 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
7416 doc
: /* Returns the number of color cells of DISPLAY.
7417 The optional argument DISPLAY specifies which display to ask about.
7418 DISPLAY should be either a frame or a display name (a string).
7419 If omitted or nil, that stands for the selected frame's display. */)
7421 Lisp_Object display
;
7423 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7427 hdc
= GetDC (dpyinfo
->root_window
);
7428 if (dpyinfo
->has_palette
)
7429 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
7431 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
7434 cap
= 1 << (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7436 ReleaseDC (dpyinfo
->root_window
, hdc
);
7438 return make_number (cap
);
7441 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
7442 Sx_server_max_request_size
,
7444 doc
: /* Returns the maximum request size of the server of DISPLAY.
7445 The optional argument DISPLAY specifies which display to ask about.
7446 DISPLAY should be either a frame or a display name (a string).
7447 If omitted or nil, that stands for the selected frame's display. */)
7449 Lisp_Object display
;
7451 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7453 return make_number (1);
7456 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
7457 doc
: /* Returns the vendor ID string of the W32 system (Microsoft).
7458 The optional argument DISPLAY specifies which display to ask about.
7459 DISPLAY should be either a frame or a display name (a string).
7460 If omitted or nil, that stands for the selected frame's display. */)
7462 Lisp_Object display
;
7464 return build_string ("Microsoft Corp.");
7467 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
7468 doc
: /* Returns the version numbers of the server of DISPLAY.
7469 The value is a list of three integers: the major and minor
7470 version numbers, and the vendor-specific release
7471 number. See also the function `x-server-vendor'.
7473 The optional argument DISPLAY specifies which display to ask about.
7474 DISPLAY should be either a frame or a display name (a string).
7475 If omitted or nil, that stands for the selected frame's display. */)
7477 Lisp_Object display
;
7479 return Fcons (make_number (w32_major_version
),
7480 Fcons (make_number (w32_minor_version
),
7481 Fcons (make_number (w32_build_number
), Qnil
)));
7484 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
7485 doc
: /* Returns the number of screens on the server of DISPLAY.
7486 The optional argument DISPLAY specifies which display to ask about.
7487 DISPLAY should be either a frame or a display name (a string).
7488 If omitted or nil, that stands for the selected frame's display. */)
7490 Lisp_Object display
;
7492 return make_number (1);
7495 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
7496 Sx_display_mm_height
, 0, 1, 0,
7497 doc
: /* Returns the height in millimeters of DISPLAY.
7498 The optional argument DISPLAY specifies which display to ask about.
7499 DISPLAY should be either a frame or a display name (a string).
7500 If omitted or nil, that stands for the selected frame's display. */)
7502 Lisp_Object display
;
7504 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7508 hdc
= GetDC (dpyinfo
->root_window
);
7510 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
7512 ReleaseDC (dpyinfo
->root_window
, hdc
);
7514 return make_number (cap
);
7517 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
7518 doc
: /* Returns the width in millimeters of DISPLAY.
7519 The optional argument DISPLAY specifies which display to ask about.
7520 DISPLAY should be either a frame or a display name (a string).
7521 If omitted or nil, that stands for the selected frame's display. */)
7523 Lisp_Object display
;
7525 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7530 hdc
= GetDC (dpyinfo
->root_window
);
7532 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
7534 ReleaseDC (dpyinfo
->root_window
, hdc
);
7536 return make_number (cap
);
7539 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
7540 Sx_display_backing_store
, 0, 1, 0,
7541 doc
: /* Returns an indication of whether DISPLAY does backing store.
7542 The value may be `always', `when-mapped', or `not-useful'.
7543 The optional argument DISPLAY specifies which display to ask about.
7544 DISPLAY should be either a frame or a display name (a string).
7545 If omitted or nil, that stands for the selected frame's display. */)
7547 Lisp_Object display
;
7549 return intern ("not-useful");
7552 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
7553 Sx_display_visual_class
, 0, 1, 0,
7554 doc
: /* Returns the visual class of DISPLAY.
7555 The value is one of the symbols `static-gray', `gray-scale',
7556 `static-color', `pseudo-color', `true-color', or `direct-color'.
7558 The optional argument DISPLAY specifies which display to ask about.
7559 DISPLAY should be either a frame or a display name (a string).
7560 If omitted or nil, that stands for the selected frame's display. */)
7562 Lisp_Object display
;
7564 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7565 Lisp_Object result
= Qnil
;
7567 if (dpyinfo
->has_palette
)
7568 result
= intern ("pseudo-color");
7569 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
7570 result
= intern ("static-grey");
7571 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
7572 result
= intern ("static-color");
7573 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
7574 result
= intern ("true-color");
7579 DEFUN ("x-display-save-under", Fx_display_save_under
,
7580 Sx_display_save_under
, 0, 1, 0,
7581 doc
: /* Returns t if DISPLAY supports the save-under feature.
7582 The optional argument DISPLAY specifies which display to ask about.
7583 DISPLAY should be either a frame or a display name (a string).
7584 If omitted or nil, that stands for the selected frame's display. */)
7586 Lisp_Object display
;
7593 register struct frame
*f
;
7595 return PIXEL_WIDTH (f
);
7600 register struct frame
*f
;
7602 return PIXEL_HEIGHT (f
);
7607 register struct frame
*f
;
7609 return FONT_WIDTH (f
->output_data
.w32
->font
);
7614 register struct frame
*f
;
7616 return f
->output_data
.w32
->line_height
;
7621 register struct frame
*f
;
7623 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
7626 /* Return the display structure for the display named NAME.
7627 Open a new connection if necessary. */
7629 struct w32_display_info
*
7630 x_display_info_for_name (name
)
7634 struct w32_display_info
*dpyinfo
;
7636 CHECK_STRING (name
);
7638 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
7640 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
7643 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
7648 /* Use this general default value to start with. */
7649 Vx_resource_name
= Vinvocation_name
;
7651 validate_x_resource_name ();
7653 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
7654 (char *) XSTRING (Vx_resource_name
)->data
);
7657 error ("Cannot connect to server %s", XSTRING (name
)->data
);
7660 XSETFASTINT (Vwindow_system_version
, 3);
7665 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
7666 1, 3, 0, doc
: /* Open a connection to a server.
7667 DISPLAY is the name of the display to connect to.
7668 Optional second arg XRM-STRING is a string of resources in xrdb format.
7669 If the optional third arg MUST-SUCCEED is non-nil,
7670 terminate Emacs if we can't open the connection. */)
7671 (display
, xrm_string
, must_succeed
)
7672 Lisp_Object display
, xrm_string
, must_succeed
;
7674 unsigned char *xrm_option
;
7675 struct w32_display_info
*dpyinfo
;
7677 /* If initialization has already been done, return now to avoid
7678 overwriting critical parts of one_w32_display_info. */
7682 CHECK_STRING (display
);
7683 if (! NILP (xrm_string
))
7684 CHECK_STRING (xrm_string
);
7686 if (! EQ (Vwindow_system
, intern ("w32")))
7687 error ("Not using Microsoft Windows");
7689 /* Allow color mapping to be defined externally; first look in user's
7690 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
7692 Lisp_Object color_file
;
7693 struct gcpro gcpro1
;
7695 color_file
= build_string("~/rgb.txt");
7697 GCPRO1 (color_file
);
7699 if (NILP (Ffile_readable_p (color_file
)))
7701 Fexpand_file_name (build_string ("rgb.txt"),
7702 Fsymbol_value (intern ("data-directory")));
7704 Vw32_color_map
= Fw32_load_color_file (color_file
);
7708 if (NILP (Vw32_color_map
))
7709 Vw32_color_map
= Fw32_default_color_map ();
7711 if (! NILP (xrm_string
))
7712 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
7714 xrm_option
= (unsigned char *) 0;
7716 /* Use this general default value to start with. */
7717 /* First remove .exe suffix from invocation-name - it looks ugly. */
7719 char basename
[ MAX_PATH
], *str
;
7721 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
7722 str
= strrchr (basename
, '.');
7724 Vinvocation_name
= build_string (basename
);
7726 Vx_resource_name
= Vinvocation_name
;
7728 validate_x_resource_name ();
7730 /* This is what opens the connection and sets x_current_display.
7731 This also initializes many symbols, such as those used for input. */
7732 dpyinfo
= w32_term_init (display
, xrm_option
,
7733 (char *) XSTRING (Vx_resource_name
)->data
);
7737 if (!NILP (must_succeed
))
7738 fatal ("Cannot connect to server %s.\n",
7739 XSTRING (display
)->data
);
7741 error ("Cannot connect to server %s", XSTRING (display
)->data
);
7746 XSETFASTINT (Vwindow_system_version
, 3);
7750 DEFUN ("x-close-connection", Fx_close_connection
,
7751 Sx_close_connection
, 1, 1, 0,
7752 doc
: /* Close the connection to DISPLAY's server.
7753 For DISPLAY, specify either a frame or a display name (a string).
7754 If DISPLAY is nil, that stands for the selected frame's display. */)
7756 Lisp_Object display
;
7758 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7761 if (dpyinfo
->reference_count
> 0)
7762 error ("Display still has frames on it");
7765 /* Free the fonts in the font table. */
7766 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
7767 if (dpyinfo
->font_table
[i
].name
)
7769 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
7770 xfree (dpyinfo
->font_table
[i
].full_name
);
7771 xfree (dpyinfo
->font_table
[i
].name
);
7772 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
7774 x_destroy_all_bitmaps (dpyinfo
);
7776 x_delete_display (dpyinfo
);
7782 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
7783 doc
: /* Return the list of display names that Emacs has connections to. */)
7786 Lisp_Object tail
, result
;
7789 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
7790 result
= Fcons (XCAR (XCAR (tail
)), result
);
7795 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
7796 doc
: /* This is a noop on W32 systems. */)
7798 Lisp_Object display
, on
;
7805 /***********************************************************************
7807 ***********************************************************************/
7809 /* Value is the number of elements of vector VECTOR. */
7811 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
7813 /* List of supported image types. Use define_image_type to add new
7814 types. Use lookup_image_type to find a type for a given symbol. */
7816 static struct image_type
*image_types
;
7818 /* The symbol `image' which is the car of the lists used to represent
7821 extern Lisp_Object Qimage
;
7823 /* The symbol `xbm' which is used as the type symbol for XBM images. */
7829 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
7830 extern Lisp_Object QCdata
;
7831 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
7832 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
7833 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
7835 /* Other symbols. */
7837 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
7839 /* Time in seconds after which images should be removed from the cache
7840 if not displayed. */
7842 Lisp_Object Vimage_cache_eviction_delay
;
7844 /* Function prototypes. */
7846 static void define_image_type
P_ ((struct image_type
*type
));
7847 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
7848 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
7849 static void x_laplace
P_ ((struct frame
*, struct image
*));
7850 static void x_emboss
P_ ((struct frame
*, struct image
*));
7851 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
7855 /* Define a new image type from TYPE. This adds a copy of TYPE to
7856 image_types and adds the symbol *TYPE->type to Vimage_types. */
7859 define_image_type (type
)
7860 struct image_type
*type
;
7862 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7863 The initialized data segment is read-only. */
7864 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
7865 bcopy (type
, p
, sizeof *p
);
7866 p
->next
= image_types
;
7868 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
7872 /* Look up image type SYMBOL, and return a pointer to its image_type
7873 structure. Value is null if SYMBOL is not a known image type. */
7875 static INLINE
struct image_type
*
7876 lookup_image_type (symbol
)
7879 struct image_type
*type
;
7881 for (type
= image_types
; type
; type
= type
->next
)
7882 if (EQ (symbol
, *type
->type
))
7889 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
7890 valid image specification is a list whose car is the symbol
7891 `image', and whose rest is a property list. The property list must
7892 contain a value for key `:type'. That value must be the name of a
7893 supported image type. The rest of the property list depends on the
7897 valid_image_p (object
)
7902 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
7906 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
7907 if (EQ (XCAR (tem
), QCtype
))
7910 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
7912 struct image_type
*type
;
7913 type
= lookup_image_type (XCAR (tem
));
7915 valid_p
= type
->valid_p (object
);
7926 /* Log error message with format string FORMAT and argument ARG.
7927 Signaling an error, e.g. when an image cannot be loaded, is not a
7928 good idea because this would interrupt redisplay, and the error
7929 message display would lead to another redisplay. This function
7930 therefore simply displays a message. */
7933 image_error (format
, arg1
, arg2
)
7935 Lisp_Object arg1
, arg2
;
7937 add_to_log (format
, arg1
, arg2
);
7942 /***********************************************************************
7943 Image specifications
7944 ***********************************************************************/
7946 enum image_value_type
7948 IMAGE_DONT_CHECK_VALUE_TYPE
,
7950 IMAGE_STRING_OR_NIL_VALUE
,
7952 IMAGE_POSITIVE_INTEGER_VALUE
,
7953 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
7954 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
7956 IMAGE_INTEGER_VALUE
,
7957 IMAGE_FUNCTION_VALUE
,
7962 /* Structure used when parsing image specifications. */
7964 struct image_keyword
7966 /* Name of keyword. */
7969 /* The type of value allowed. */
7970 enum image_value_type type
;
7972 /* Non-zero means key must be present. */
7975 /* Used to recognize duplicate keywords in a property list. */
7978 /* The value that was found. */
7983 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
7985 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
7988 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
7989 has the format (image KEYWORD VALUE ...). One of the keyword/
7990 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7991 image_keywords structures of size NKEYWORDS describing other
7992 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7995 parse_image_spec (spec
, keywords
, nkeywords
, type
)
7997 struct image_keyword
*keywords
;
8004 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
8007 plist
= XCDR (spec
);
8008 while (CONSP (plist
))
8010 Lisp_Object key
, value
;
8012 /* First element of a pair must be a symbol. */
8014 plist
= XCDR (plist
);
8018 /* There must follow a value. */
8021 value
= XCAR (plist
);
8022 plist
= XCDR (plist
);
8024 /* Find key in KEYWORDS. Error if not found. */
8025 for (i
= 0; i
< nkeywords
; ++i
)
8026 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
8032 /* Record that we recognized the keyword. If a keywords
8033 was found more than once, it's an error. */
8034 keywords
[i
].value
= value
;
8035 ++keywords
[i
].count
;
8037 if (keywords
[i
].count
> 1)
8040 /* Check type of value against allowed type. */
8041 switch (keywords
[i
].type
)
8043 case IMAGE_STRING_VALUE
:
8044 if (!STRINGP (value
))
8048 case IMAGE_STRING_OR_NIL_VALUE
:
8049 if (!STRINGP (value
) && !NILP (value
))
8053 case IMAGE_SYMBOL_VALUE
:
8054 if (!SYMBOLP (value
))
8058 case IMAGE_POSITIVE_INTEGER_VALUE
:
8059 if (!INTEGERP (value
) || XINT (value
) <= 0)
8063 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
8064 if (INTEGERP (value
) && XINT (value
) >= 0)
8067 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
8068 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
8072 case IMAGE_ASCENT_VALUE
:
8073 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
8075 else if (INTEGERP (value
)
8076 && XINT (value
) >= 0
8077 && XINT (value
) <= 100)
8081 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
8082 if (!INTEGERP (value
) || XINT (value
) < 0)
8086 case IMAGE_DONT_CHECK_VALUE_TYPE
:
8089 case IMAGE_FUNCTION_VALUE
:
8090 value
= indirect_function (value
);
8092 || COMPILEDP (value
)
8093 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
8097 case IMAGE_NUMBER_VALUE
:
8098 if (!INTEGERP (value
) && !FLOATP (value
))
8102 case IMAGE_INTEGER_VALUE
:
8103 if (!INTEGERP (value
))
8107 case IMAGE_BOOL_VALUE
:
8108 if (!NILP (value
) && !EQ (value
, Qt
))
8117 if (EQ (key
, QCtype
) && !EQ (type
, value
))
8121 /* Check that all mandatory fields are present. */
8122 for (i
= 0; i
< nkeywords
; ++i
)
8123 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
8126 return NILP (plist
);
8130 /* Return the value of KEY in image specification SPEC. Value is nil
8131 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8132 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8135 image_spec_value (spec
, key
, found
)
8136 Lisp_Object spec
, key
;
8141 xassert (valid_image_p (spec
));
8143 for (tail
= XCDR (spec
);
8144 CONSP (tail
) && CONSP (XCDR (tail
));
8145 tail
= XCDR (XCDR (tail
)))
8147 if (EQ (XCAR (tail
), key
))
8151 return XCAR (XCDR (tail
));
8163 /***********************************************************************
8164 Image type independent image structures
8165 ***********************************************************************/
8167 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
8168 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
8171 /* Allocate and return a new image structure for image specification
8172 SPEC. SPEC has a hash value of HASH. */
8174 static struct image
*
8175 make_image (spec
, hash
)
8179 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
8181 xassert (valid_image_p (spec
));
8182 bzero (img
, sizeof *img
);
8183 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
8184 xassert (img
->type
!= NULL
);
8186 img
->data
.lisp_val
= Qnil
;
8187 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
8193 /* Free image IMG which was used on frame F, including its resources. */
8202 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8204 /* Remove IMG from the hash table of its cache. */
8206 img
->prev
->next
= img
->next
;
8208 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
8211 img
->next
->prev
= img
->prev
;
8213 c
->images
[img
->id
] = NULL
;
8215 /* Free resources, then free IMG. */
8216 img
->type
->free (f
, img
);
8222 /* Prepare image IMG for display on frame F. Must be called before
8223 drawing an image. */
8226 prepare_image_for_display (f
, img
)
8232 /* We're about to display IMG, so set its timestamp to `now'. */
8234 img
->timestamp
= EMACS_SECS (t
);
8236 /* If IMG doesn't have a pixmap yet, load it now, using the image
8237 type dependent loader function. */
8238 if (img
->pixmap
== 0 && !img
->load_failed_p
)
8239 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8243 /* Value is the number of pixels for the ascent of image IMG when
8244 drawn in face FACE. */
8247 image_ascent (img
, face
)
8251 int height
= img
->height
+ img
->vmargin
;
8254 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
8257 ascent
= height
/ 2 - (FONT_DESCENT(face
->font
)
8258 - FONT_BASE(face
->font
)) / 2;
8260 ascent
= height
/ 2;
8263 ascent
= height
* img
->ascent
/ 100.0;
8270 /* Image background colors. */
8272 static unsigned long
8273 four_corners_best (ximg
, width
, height
)
8275 unsigned long width
, height
;
8277 #if 0 /* TODO: Image support. */
8278 unsigned long corners
[4], best
;
8281 /* Get the colors at the corners of ximg. */
8282 corners
[0] = XGetPixel (ximg
, 0, 0);
8283 corners
[1] = XGetPixel (ximg
, width
- 1, 0);
8284 corners
[2] = XGetPixel (ximg
, width
- 1, height
- 1);
8285 corners
[3] = XGetPixel (ximg
, 0, height
- 1);
8287 /* Choose the most frequently found color as background. */
8288 for (i
= best_count
= 0; i
< 4; ++i
)
8292 for (j
= n
= 0; j
< 4; ++j
)
8293 if (corners
[i
] == corners
[j
])
8297 best
= corners
[i
], best_count
= n
;
8306 /* Return the `background' field of IMG. If IMG doesn't have one yet,
8307 it is guessed heuristically. If non-zero, XIMG is an existing XImage
8308 object to use for the heuristic. */
8311 image_background (img
, f
, ximg
)
8316 if (! img
->background_valid
)
8317 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8319 #if 0 /* TODO: Image support. */
8320 int free_ximg
= !ximg
;
8323 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
8324 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8326 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
8329 XDestroyImage (ximg
);
8331 img
->background_valid
= 1;
8335 return img
->background
;
8338 /* Return the `background_transparent' field of IMG. If IMG doesn't
8339 have one yet, it is guessed heuristically. If non-zero, MASK is an
8340 existing XImage object to use for the heuristic. */
8343 image_background_transparent (img
, f
, mask
)
8348 if (! img
->background_transparent_valid
)
8349 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8351 #if 0 /* TODO: Image support. */
8354 int free_mask
= !mask
;
8357 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
8358 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8360 img
->background_transparent
8361 = !four_corners_best (mask
, img
->width
, img
->height
);
8364 XDestroyImage (mask
);
8368 img
->background_transparent
= 0;
8370 img
->background_transparent_valid
= 1;
8373 return img
->background_transparent
;
8377 /***********************************************************************
8378 Helper functions for X image types
8379 ***********************************************************************/
8381 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
8383 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8384 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
8386 Lisp_Object color_name
,
8387 unsigned long dflt
));
8390 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
8391 free the pixmap if any. MASK_P non-zero means clear the mask
8392 pixmap if any. COLORS_P non-zero means free colors allocated for
8393 the image, if any. */
8396 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
8399 int pixmap_p
, mask_p
, colors_p
;
8402 if (pixmap_p
&& img
->pixmap
)
8404 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8406 img
->background_valid
= 0;
8409 if (mask_p
&& img
->mask
)
8411 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8413 img
->background_transparent_valid
= 0;
8416 if (colors_p
&& img
->ncolors
)
8418 x_free_colors (f
, img
->colors
, img
->ncolors
);
8419 xfree (img
->colors
);
8426 /* Free X resources of image IMG which is used on frame F. */
8429 x_clear_image (f
, img
)
8433 #if 0 /* TODO: W32 image support */
8438 XFreePixmap (NULL
, img
->pixmap
);
8445 int class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
8447 /* If display has an immutable color map, freeing colors is not
8448 necessary and some servers don't allow it. So don't do it. */
8449 if (class != StaticColor
8450 && class != StaticGray
8451 && class != TrueColor
)
8455 cmap
= DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f
)->screen
);
8456 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
, img
->colors
,
8461 xfree (img
->colors
);
8469 /* Allocate color COLOR_NAME for image IMG on frame F. If color
8470 cannot be allocated, use DFLT. Add a newly allocated color to
8471 IMG->colors, so that it can be freed again. Value is the pixel
8474 static unsigned long
8475 x_alloc_image_color (f
, img
, color_name
, dflt
)
8478 Lisp_Object color_name
;
8481 #if 0 /* TODO: allocing colors. */
8483 unsigned long result
;
8485 xassert (STRINGP (color_name
));
8487 if (w32_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
8489 /* This isn't called frequently so we get away with simply
8490 reallocating the color vector to the needed size, here. */
8493 (unsigned long *) xrealloc (img
->colors
,
8494 img
->ncolors
* sizeof *img
->colors
);
8495 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
8496 result
= color
.pixel
;
8507 /***********************************************************************
8509 ***********************************************************************/
8511 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
8512 static void postprocess_image
P_ ((struct frame
*, struct image
*));
8515 /* Return a new, initialized image cache that is allocated from the
8516 heap. Call free_image_cache to free an image cache. */
8518 struct image_cache
*
8521 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
8524 bzero (c
, sizeof *c
);
8526 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
8527 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
8528 c
->buckets
= (struct image
**) xmalloc (size
);
8529 bzero (c
->buckets
, size
);
8534 /* Free image cache of frame F. Be aware that X frames share images
8538 free_image_cache (f
)
8541 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8546 /* Cache should not be referenced by any frame when freed. */
8547 xassert (c
->refcount
== 0);
8549 for (i
= 0; i
< c
->used
; ++i
)
8550 free_image (f
, c
->images
[i
]);
8554 FRAME_X_IMAGE_CACHE (f
) = NULL
;
8559 /* Clear image cache of frame F. FORCE_P non-zero means free all
8560 images. FORCE_P zero means clear only images that haven't been
8561 displayed for some time. Should be called from time to time to
8562 reduce the number of loaded images. If image-eviction-seconds is
8563 non-nil, this frees images in the cache which weren't displayed for
8564 at least that many seconds. */
8567 clear_image_cache (f
, force_p
)
8571 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8573 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
8577 int i
, any_freed_p
= 0;
8580 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
8582 for (i
= 0; i
< c
->used
; ++i
)
8584 struct image
*img
= c
->images
[i
];
8587 || (img
->timestamp
> old
)))
8589 free_image (f
, img
);
8594 /* We may be clearing the image cache because, for example,
8595 Emacs was iconified for a longer period of time. In that
8596 case, current matrices may still contain references to
8597 images freed above. So, clear these matrices. */
8600 clear_current_matrices (f
);
8601 ++windows_or_buffers_changed
;
8607 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
8609 doc
: /* Clear the image cache of FRAME.
8610 FRAME nil or omitted means use the selected frame.
8611 FRAME t means clear the image caches of all frames. */)
8619 FOR_EACH_FRAME (tail
, frame
)
8620 if (FRAME_W32_P (XFRAME (frame
)))
8621 clear_image_cache (XFRAME (frame
), 1);
8624 clear_image_cache (check_x_frame (frame
), 1);
8630 /* Compute masks and transform image IMG on frame F, as specified
8631 by the image's specification, */
8634 postprocess_image (f
, img
)
8638 #if 0 /* TODO: image support. */
8639 /* Manipulation of the image's mask. */
8642 Lisp_Object conversion
, spec
;
8647 /* `:heuristic-mask t'
8649 means build a mask heuristically.
8650 `:heuristic-mask (R G B)'
8651 `:mask (heuristic (R G B))'
8652 means build a mask from color (R G B) in the
8655 means remove a mask, if any. */
8657 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
8659 x_build_heuristic_mask (f
, img
, mask
);
8664 mask
= image_spec_value (spec
, QCmask
, &found_p
);
8666 if (EQ (mask
, Qheuristic
))
8667 x_build_heuristic_mask (f
, img
, Qt
);
8668 else if (CONSP (mask
)
8669 && EQ (XCAR (mask
), Qheuristic
))
8671 if (CONSP (XCDR (mask
)))
8672 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
8674 x_build_heuristic_mask (f
, img
, XCDR (mask
));
8676 else if (NILP (mask
) && found_p
&& img
->mask
)
8678 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8684 /* Should we apply an image transformation algorithm? */
8685 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
8686 if (EQ (conversion
, Qdisabled
))
8687 x_disable_image (f
, img
);
8688 else if (EQ (conversion
, Qlaplace
))
8690 else if (EQ (conversion
, Qemboss
))
8692 else if (CONSP (conversion
)
8693 && EQ (XCAR (conversion
), Qedge_detection
))
8696 tem
= XCDR (conversion
);
8698 x_edge_detection (f
, img
,
8699 Fplist_get (tem
, QCmatrix
),
8700 Fplist_get (tem
, QCcolor_adjustment
));
8707 /* Return the id of image with Lisp specification SPEC on frame F.
8708 SPEC must be a valid Lisp image specification (see valid_image_p). */
8711 lookup_image (f
, spec
)
8715 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8719 struct gcpro gcpro1
;
8722 /* F must be a window-system frame, and SPEC must be a valid image
8724 xassert (FRAME_WINDOW_P (f
));
8725 xassert (valid_image_p (spec
));
8729 /* Look up SPEC in the hash table of the image cache. */
8730 hash
= sxhash (spec
, 0);
8731 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8733 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
8734 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
8737 /* If not found, create a new image and cache it. */
8740 extern Lisp_Object Qpostscript
;
8743 img
= make_image (spec
, hash
);
8744 cache_image (f
, img
);
8745 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8747 /* If we can't load the image, and we don't have a width and
8748 height, use some arbitrary width and height so that we can
8749 draw a rectangle for it. */
8750 if (img
->load_failed_p
)
8754 value
= image_spec_value (spec
, QCwidth
, NULL
);
8755 img
->width
= (INTEGERP (value
)
8756 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
8757 value
= image_spec_value (spec
, QCheight
, NULL
);
8758 img
->height
= (INTEGERP (value
)
8759 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
8763 /* Handle image type independent image attributes
8764 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF',
8765 `:background COLOR'. */
8766 Lisp_Object ascent
, margin
, relief
, bg
;
8768 ascent
= image_spec_value (spec
, QCascent
, NULL
);
8769 if (INTEGERP (ascent
))
8770 img
->ascent
= XFASTINT (ascent
);
8771 else if (EQ (ascent
, Qcenter
))
8772 img
->ascent
= CENTERED_IMAGE_ASCENT
;
8774 margin
= image_spec_value (spec
, QCmargin
, NULL
);
8775 if (INTEGERP (margin
) && XINT (margin
) >= 0)
8776 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
8777 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
8778 && INTEGERP (XCDR (margin
)))
8780 if (XINT (XCAR (margin
)) > 0)
8781 img
->hmargin
= XFASTINT (XCAR (margin
));
8782 if (XINT (XCDR (margin
)) > 0)
8783 img
->vmargin
= XFASTINT (XCDR (margin
));
8786 relief
= image_spec_value (spec
, QCrelief
, NULL
);
8787 if (INTEGERP (relief
))
8789 img
->relief
= XINT (relief
);
8790 img
->hmargin
+= abs (img
->relief
);
8791 img
->vmargin
+= abs (img
->relief
);
8794 if (! img
->background_valid
)
8796 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
8800 = x_alloc_image_color (f
, img
, bg
,
8801 FRAME_BACKGROUND_PIXEL (f
));
8802 img
->background_valid
= 1;
8806 /* Do image transformations and compute masks, unless we
8807 don't have the image yet. */
8808 if (!EQ (*img
->type
->type
, Qpostscript
))
8809 postprocess_image (f
, img
);
8813 xassert (!interrupt_input_blocked
);
8816 /* We're using IMG, so set its timestamp to `now'. */
8817 EMACS_GET_TIME (now
);
8818 img
->timestamp
= EMACS_SECS (now
);
8822 /* Value is the image id. */
8827 /* Cache image IMG in the image cache of frame F. */
8830 cache_image (f
, img
)
8834 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8837 /* Find a free slot in c->images. */
8838 for (i
= 0; i
< c
->used
; ++i
)
8839 if (c
->images
[i
] == NULL
)
8842 /* If no free slot found, maybe enlarge c->images. */
8843 if (i
== c
->used
&& c
->used
== c
->size
)
8846 c
->images
= (struct image
**) xrealloc (c
->images
,
8847 c
->size
* sizeof *c
->images
);
8850 /* Add IMG to c->images, and assign IMG an id. */
8856 /* Add IMG to the cache's hash table. */
8857 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8858 img
->next
= c
->buckets
[i
];
8860 img
->next
->prev
= img
;
8862 c
->buckets
[i
] = img
;
8866 /* Call FN on every image in the image cache of frame F. Used to mark
8867 Lisp Objects in the image cache. */
8870 forall_images_in_image_cache (f
, fn
)
8872 void (*fn
) P_ ((struct image
*img
));
8874 if (FRAME_LIVE_P (f
) && FRAME_W32_P (f
))
8876 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8880 for (i
= 0; i
< c
->used
; ++i
)
8889 /***********************************************************************
8891 ***********************************************************************/
8893 #if 0 /* TODO: W32 specific image code. */
8895 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
8896 XImage
**, Pixmap
*));
8897 static void x_destroy_x_image
P_ ((XImage
*));
8898 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
8901 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
8902 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
8903 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
8904 via xmalloc. Print error messages via image_error if an error
8905 occurs. Value is non-zero if successful. */
8908 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
8910 int width
, height
, depth
;
8914 #if 0 /* TODO: Image support for W32 */
8915 Display
*display
= FRAME_W32_DISPLAY (f
);
8916 Screen
*screen
= FRAME_X_SCREEN (f
);
8917 Window window
= FRAME_W32_WINDOW (f
);
8919 xassert (interrupt_input_blocked
);
8922 depth
= one_w32_display_info
.n_cbits
;
8923 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
8924 depth
, ZPixmap
, 0, NULL
, width
, height
,
8925 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
8928 image_error ("Unable to allocate X image", Qnil
, Qnil
);
8932 /* Allocate image raster. */
8933 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
8935 /* Allocate a pixmap of the same size. */
8936 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
8939 x_destroy_x_image (*ximg
);
8941 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
8949 /* Destroy XImage XIMG. Free XIMG->data. */
8952 x_destroy_x_image (ximg
)
8955 xassert (interrupt_input_blocked
);
8960 XDestroyImage (ximg
);
8965 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
8966 are width and height of both the image and pixmap. */
8969 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
8976 xassert (interrupt_input_blocked
);
8977 gc
= XCreateGC (NULL
, pixmap
, 0, NULL
);
8978 XPutImage (NULL
, pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
8985 /***********************************************************************
8987 ***********************************************************************/
8989 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
8990 static char *slurp_file
P_ ((char *, int *));
8993 /* Find image file FILE. Look in data-directory, then
8994 x-bitmap-file-path. Value is the full name of the file found, or
8995 nil if not found. */
8998 x_find_image_file (file
)
9001 Lisp_Object file_found
, search_path
;
9002 struct gcpro gcpro1
, gcpro2
;
9006 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
9007 GCPRO2 (file_found
, search_path
);
9009 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
9010 fd
= openp (search_path
, file
, Qnil
, &file_found
, 0);
9022 /* Read FILE into memory. Value is a pointer to a buffer allocated
9023 with xmalloc holding FILE's contents. Value is null if an error
9024 occurred. *SIZE is set to the size of the file. */
9027 slurp_file (file
, size
)
9035 if (stat (file
, &st
) == 0
9036 && (fp
= fopen (file
, "r")) != NULL
9037 && (buf
= (char *) xmalloc (st
.st_size
),
9038 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
9059 /***********************************************************************
9061 ***********************************************************************/
9063 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
9064 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
9066 static int xbm_image_p
P_ ((Lisp_Object object
));
9067 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
9071 /* Indices of image specification fields in xbm_format, below. */
9073 enum xbm_keyword_index
9091 /* Vector of image_keyword structures describing the format
9092 of valid XBM image specifications. */
9094 static struct image_keyword xbm_format
[XBM_LAST
] =
9096 {":type", IMAGE_SYMBOL_VALUE
, 1},
9097 {":file", IMAGE_STRING_VALUE
, 0},
9098 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9099 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9100 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9101 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
9102 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
9103 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9104 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9105 {":relief", IMAGE_INTEGER_VALUE
, 0},
9106 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9107 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9110 /* Structure describing the image type XBM. */
9112 static struct image_type xbm_type
=
9121 /* Tokens returned from xbm_scan. */
9130 /* Return non-zero if OBJECT is a valid XBM-type image specification.
9131 A valid specification is a list starting with the symbol `image'
9132 The rest of the list is a property list which must contain an
9135 If the specification specifies a file to load, it must contain
9136 an entry `:file FILENAME' where FILENAME is a string.
9138 If the specification is for a bitmap loaded from memory it must
9139 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
9140 WIDTH and HEIGHT are integers > 0. DATA may be:
9142 1. a string large enough to hold the bitmap data, i.e. it must
9143 have a size >= (WIDTH + 7) / 8 * HEIGHT
9145 2. a bool-vector of size >= WIDTH * HEIGHT
9147 3. a vector of strings or bool-vectors, one for each line of the
9150 Both the file and data forms may contain the additional entries
9151 `:background COLOR' and `:foreground COLOR'. If not present,
9152 foreground and background of the frame on which the image is
9153 displayed, is used. */
9156 xbm_image_p (object
)
9159 struct image_keyword kw
[XBM_LAST
];
9161 bcopy (xbm_format
, kw
, sizeof kw
);
9162 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
9165 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
9167 if (kw
[XBM_FILE
].count
)
9169 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
9177 /* Entries for `:width', `:height' and `:data' must be present. */
9178 if (!kw
[XBM_WIDTH
].count
9179 || !kw
[XBM_HEIGHT
].count
9180 || !kw
[XBM_DATA
].count
)
9183 data
= kw
[XBM_DATA
].value
;
9184 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
9185 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
9187 /* Check type of data, and width and height against contents of
9193 /* Number of elements of the vector must be >= height. */
9194 if (XVECTOR (data
)->size
< height
)
9197 /* Each string or bool-vector in data must be large enough
9198 for one line of the image. */
9199 for (i
= 0; i
< height
; ++i
)
9201 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
9205 if (XSTRING (elt
)->size
9206 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
9209 else if (BOOL_VECTOR_P (elt
))
9211 if (XBOOL_VECTOR (elt
)->size
< width
)
9218 else if (STRINGP (data
))
9220 if (XSTRING (data
)->size
9221 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
9224 else if (BOOL_VECTOR_P (data
))
9226 if (XBOOL_VECTOR (data
)->size
< width
* height
)
9233 /* Baseline must be a value between 0 and 100 (a percentage). */
9234 if (kw
[XBM_ASCENT
].count
9235 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
9242 /* Scan a bitmap file. FP is the stream to read from. Value is
9243 either an enumerator from enum xbm_token, or a character for a
9244 single-character token, or 0 at end of file. If scanning an
9245 identifier, store the lexeme of the identifier in SVAL. If
9246 scanning a number, store its value in *IVAL. */
9249 xbm_scan (s
, end
, sval
, ival
)
9258 /* Skip white space. */
9259 while (*s
< end
&&(c
= *(*s
)++, isspace (c
)))
9264 else if (isdigit (c
))
9266 int value
= 0, digit
;
9268 if (c
== '0' && *s
< end
)
9271 if (c
== 'x' || c
== 'X')
9278 else if (c
>= 'a' && c
<= 'f')
9279 digit
= c
- 'a' + 10;
9280 else if (c
>= 'A' && c
<= 'F')
9281 digit
= c
- 'A' + 10;
9284 value
= 16 * value
+ digit
;
9287 else if (isdigit (c
))
9291 && (c
= *(*s
)++, isdigit (c
)))
9292 value
= 8 * value
+ c
- '0';
9299 && (c
= *(*s
)++, isdigit (c
)))
9300 value
= 10 * value
+ c
- '0';
9308 else if (isalpha (c
) || c
== '_')
9312 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
9319 else if (c
== '/' && **s
== '*')
9321 /* C-style comment. */
9323 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
9336 /* Replacement for XReadBitmapFileData which isn't available under old
9337 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9338 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9339 the image. Return in *DATA the bitmap data allocated with xmalloc.
9340 Value is non-zero if successful. DATA null means just test if
9341 CONTENTS looks like an in-memory XBM file. */
9344 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
9345 char *contents
, *end
;
9346 int *width
, *height
;
9347 unsigned char **data
;
9350 char buffer
[BUFSIZ
];
9353 int bytes_per_line
, i
, nbytes
;
9359 LA1 = xbm_scan (contents, end, buffer, &value)
9361 #define expect(TOKEN) \
9362 if (LA1 != (TOKEN)) \
9367 #define expect_ident(IDENT) \
9368 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9373 *width
= *height
= -1;
9376 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
9378 /* Parse defines for width, height and hot-spots. */
9382 expect_ident ("define");
9383 expect (XBM_TK_IDENT
);
9385 if (LA1
== XBM_TK_NUMBER
);
9387 char *p
= strrchr (buffer
, '_');
9388 p
= p
? p
+ 1 : buffer
;
9389 if (strcmp (p
, "width") == 0)
9391 else if (strcmp (p
, "height") == 0)
9394 expect (XBM_TK_NUMBER
);
9397 if (*width
< 0 || *height
< 0)
9399 else if (data
== NULL
)
9402 /* Parse bits. Must start with `static'. */
9403 expect_ident ("static");
9404 if (LA1
== XBM_TK_IDENT
)
9406 if (strcmp (buffer
, "unsigned") == 0)
9409 expect_ident ("char");
9411 else if (strcmp (buffer
, "short") == 0)
9415 if (*width
% 16 && *width
% 16 < 9)
9418 else if (strcmp (buffer
, "char") == 0)
9426 expect (XBM_TK_IDENT
);
9432 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
9433 nbytes
= bytes_per_line
* *height
;
9434 p
= *data
= (char *) xmalloc (nbytes
);
9439 for (i
= 0; i
< nbytes
; i
+= 2)
9442 expect (XBM_TK_NUMBER
);
9445 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
9448 if (LA1
== ',' || LA1
== '}')
9456 for (i
= 0; i
< nbytes
; ++i
)
9459 expect (XBM_TK_NUMBER
);
9463 if (LA1
== ',' || LA1
== '}')
9488 /* Load XBM image IMG which will be displayed on frame F from buffer
9489 CONTENTS. END is the end of the buffer. Value is non-zero if
9493 xbm_load_image (f
, img
, contents
, end
)
9496 char *contents
, *end
;
9499 unsigned char *data
;
9502 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
9505 int depth
= one_w32_display_info
.n_cbits
;
9506 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
9507 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
9510 xassert (img
->width
> 0 && img
->height
> 0);
9512 /* Get foreground and background colors, maybe allocate colors. */
9513 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
9515 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
9516 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
9519 background
= x_alloc_image_color (f
, img
, value
, background
);
9520 img
->background
= background
;
9521 img
->background_valid
= 1;
9524 #if 0 /* TODO : Port image display to W32 */
9526 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f
),
9527 FRAME_W32_WINDOW (f
),
9529 img
->width
, img
->height
,
9530 foreground
, background
,
9535 if (img
->pixmap
== 0)
9537 x_clear_image (f
, img
);
9538 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
9544 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
9550 /* Value is non-zero if DATA looks like an in-memory XBM file. */
9557 return (STRINGP (data
)
9558 && xbm_read_bitmap_data (XSTRING (data
)->data
,
9559 (XSTRING (data
)->data
9560 + STRING_BYTES (XSTRING (data
))),
9565 /* Fill image IMG which is used on frame F with pixmap data. Value is
9566 non-zero if successful. */
9574 Lisp_Object file_name
;
9576 xassert (xbm_image_p (img
->spec
));
9578 /* If IMG->spec specifies a file name, create a non-file spec from it. */
9579 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
9580 if (STRINGP (file_name
))
9585 struct gcpro gcpro1
;
9587 file
= x_find_image_file (file_name
);
9589 if (!STRINGP (file
))
9591 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
9596 contents
= slurp_file (XSTRING (file
)->data
, &size
);
9597 if (contents
== NULL
)
9599 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
9604 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
9609 struct image_keyword fmt
[XBM_LAST
];
9612 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
9613 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
9616 int in_memory_file_p
= 0;
9618 /* See if data looks like an in-memory XBM file. */
9619 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9620 in_memory_file_p
= xbm_file_p (data
);
9622 /* Parse the list specification. */
9623 bcopy (xbm_format
, fmt
, sizeof fmt
);
9624 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
9627 /* Get specified width, and height. */
9628 if (!in_memory_file_p
)
9630 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
9631 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
9632 xassert (img
->width
> 0 && img
->height
> 0);
9634 /* Get foreground and background colors, maybe allocate colors. */
9635 if (fmt
[XBM_FOREGROUND
].count
9636 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
9637 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
9639 if (fmt
[XBM_BACKGROUND
].count
9640 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
9641 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
9644 if (in_memory_file_p
)
9645 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
9646 (XSTRING (data
)->data
9647 + STRING_BYTES (XSTRING (data
))));
9654 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
9656 p
= bits
= (char *) alloca (nbytes
* img
->height
);
9657 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
9659 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
9661 bcopy (XSTRING (line
)->data
, p
, nbytes
);
9663 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
9666 else if (STRINGP (data
))
9667 bits
= XSTRING (data
)->data
;
9669 bits
= XBOOL_VECTOR (data
)->data
;
9670 #ifdef TODO /* image support. */
9671 /* Create the pixmap. */
9672 depth
= one_w32_display_info
.n_cbits
;
9674 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
9677 img
->width
, img
->height
,
9678 foreground
, background
,
9685 image_error ("Unable to create pixmap for XBM image `%s'",
9687 x_clear_image (f
, img
);
9697 /***********************************************************************
9699 ***********************************************************************/
9703 static int xpm_image_p
P_ ((Lisp_Object object
));
9704 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
9705 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
9707 #include "X11/xpm.h"
9709 /* The symbol `xpm' identifying XPM-format images. */
9713 /* Indices of image specification fields in xpm_format, below. */
9715 enum xpm_keyword_index
9731 /* Vector of image_keyword structures describing the format
9732 of valid XPM image specifications. */
9734 static struct image_keyword xpm_format
[XPM_LAST
] =
9736 {":type", IMAGE_SYMBOL_VALUE
, 1},
9737 {":file", IMAGE_STRING_VALUE
, 0},
9738 {":data", IMAGE_STRING_VALUE
, 0},
9739 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9740 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9741 {":relief", IMAGE_INTEGER_VALUE
, 0},
9742 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9743 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9744 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9745 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9746 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9749 /* Structure describing the image type XBM. */
9751 static struct image_type xpm_type
=
9761 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
9762 for XPM images. Such a list must consist of conses whose car and
9766 xpm_valid_color_symbols_p (color_symbols
)
9767 Lisp_Object color_symbols
;
9769 while (CONSP (color_symbols
))
9771 Lisp_Object sym
= XCAR (color_symbols
);
9773 || !STRINGP (XCAR (sym
))
9774 || !STRINGP (XCDR (sym
)))
9776 color_symbols
= XCDR (color_symbols
);
9779 return NILP (color_symbols
);
9783 /* Value is non-zero if OBJECT is a valid XPM image specification. */
9786 xpm_image_p (object
)
9789 struct image_keyword fmt
[XPM_LAST
];
9790 bcopy (xpm_format
, fmt
, sizeof fmt
);
9791 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
9792 /* Either `:file' or `:data' must be present. */
9793 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
9794 /* Either no `:color-symbols' or it's a list of conses
9795 whose car and cdr are strings. */
9796 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
9797 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
9798 && (fmt
[XPM_ASCENT
].count
== 0
9799 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
9803 /* Load image IMG which will be displayed on frame F. Value is
9804 non-zero if successful. */
9812 XpmAttributes attrs
;
9813 Lisp_Object specified_file
, color_symbols
;
9815 /* Configure the XPM lib. Use the visual of frame F. Allocate
9816 close colors. Return colors allocated. */
9817 bzero (&attrs
, sizeof attrs
);
9818 attrs
.visual
= FRAME_X_VISUAL (f
);
9819 attrs
.colormap
= FRAME_X_COLORMAP (f
);
9820 attrs
.valuemask
|= XpmVisual
;
9821 attrs
.valuemask
|= XpmColormap
;
9822 attrs
.valuemask
|= XpmReturnAllocPixels
;
9823 #ifdef XpmAllocCloseColors
9824 attrs
.alloc_close_colors
= 1;
9825 attrs
.valuemask
|= XpmAllocCloseColors
;
9827 attrs
.closeness
= 600;
9828 attrs
.valuemask
|= XpmCloseness
;
9831 /* If image specification contains symbolic color definitions, add
9832 these to `attrs'. */
9833 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
9834 if (CONSP (color_symbols
))
9837 XpmColorSymbol
*xpm_syms
;
9840 attrs
.valuemask
|= XpmColorSymbols
;
9842 /* Count number of symbols. */
9843 attrs
.numsymbols
= 0;
9844 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
9847 /* Allocate an XpmColorSymbol array. */
9848 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
9849 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
9850 bzero (xpm_syms
, size
);
9851 attrs
.colorsymbols
= xpm_syms
;
9853 /* Fill the color symbol array. */
9854 for (tail
= color_symbols
, i
= 0;
9856 ++i
, tail
= XCDR (tail
))
9858 Lisp_Object name
= XCAR (XCAR (tail
));
9859 Lisp_Object color
= XCDR (XCAR (tail
));
9860 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
9861 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
9862 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
9863 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
9867 /* Create a pixmap for the image, either from a file, or from a
9868 string buffer containing data in the same format as an XPM file. */
9870 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9871 if (STRINGP (specified_file
))
9873 Lisp_Object file
= x_find_image_file (specified_file
);
9874 if (!STRINGP (file
))
9876 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9881 rc
= XpmReadFileToPixmap (NULL
, FRAME_W32_WINDOW (f
),
9882 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
9887 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
9888 rc
= XpmCreatePixmapFromBuffer (NULL
, FRAME_W32_WINDOW (f
),
9889 XSTRING (buffer
)->data
,
9890 &img
->pixmap
, &img
->mask
,
9895 if (rc
== XpmSuccess
)
9897 /* Remember allocated colors. */
9898 img
->ncolors
= attrs
.nalloc_pixels
;
9899 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
9900 * sizeof *img
->colors
);
9901 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
9902 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
9904 img
->width
= attrs
.width
;
9905 img
->height
= attrs
.height
;
9906 xassert (img
->width
> 0 && img
->height
> 0);
9908 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
9910 XpmFreeAttributes (&attrs
);
9918 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
9921 case XpmFileInvalid
:
9922 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
9926 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
9929 case XpmColorFailed
:
9930 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
9934 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
9939 return rc
== XpmSuccess
;
9942 #endif /* HAVE_XPM != 0 */
9945 #if 0 /* TODO : Color tables on W32. */
9946 /***********************************************************************
9948 ***********************************************************************/
9950 /* An entry in the color table mapping an RGB color to a pixel color. */
9955 unsigned long pixel
;
9957 /* Next in color table collision list. */
9958 struct ct_color
*next
;
9961 /* The bucket vector size to use. Must be prime. */
9965 /* Value is a hash of the RGB color given by R, G, and B. */
9967 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
9969 /* The color hash table. */
9971 struct ct_color
**ct_table
;
9973 /* Number of entries in the color table. */
9975 int ct_colors_allocated
;
9977 /* Function prototypes. */
9979 static void init_color_table
P_ ((void));
9980 static void free_color_table
P_ ((void));
9981 static unsigned long *colors_in_color_table
P_ ((int *n
));
9982 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
9983 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
9986 /* Initialize the color table. */
9991 int size
= CT_SIZE
* sizeof (*ct_table
);
9992 ct_table
= (struct ct_color
**) xmalloc (size
);
9993 bzero (ct_table
, size
);
9994 ct_colors_allocated
= 0;
9998 /* Free memory associated with the color table. */
10001 free_color_table ()
10004 struct ct_color
*p
, *next
;
10006 for (i
= 0; i
< CT_SIZE
; ++i
)
10007 for (p
= ct_table
[i
]; p
; p
= next
)
10018 /* Value is a pixel color for RGB color R, G, B on frame F. If an
10019 entry for that color already is in the color table, return the
10020 pixel color of that entry. Otherwise, allocate a new color for R,
10021 G, B, and make an entry in the color table. */
10023 static unsigned long
10024 lookup_rgb_color (f
, r
, g
, b
)
10028 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
10029 int i
= hash
% CT_SIZE
;
10030 struct ct_color
*p
;
10032 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10033 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
10042 color
= PALETTERGB (r
, g
, b
);
10044 ++ct_colors_allocated
;
10046 p
= (struct ct_color
*) xmalloc (sizeof *p
);
10051 p
->next
= ct_table
[i
];
10059 /* Look up pixel color PIXEL which is used on frame F in the color
10060 table. If not already present, allocate it. Value is PIXEL. */
10062 static unsigned long
10063 lookup_pixel_color (f
, pixel
)
10065 unsigned long pixel
;
10067 int i
= pixel
% CT_SIZE
;
10068 struct ct_color
*p
;
10070 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10071 if (p
->pixel
== pixel
)
10082 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
10083 color
.pixel
= pixel
;
10084 XQueryColor (NULL
, cmap
, &color
);
10085 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
10090 ++ct_colors_allocated
;
10092 p
= (struct ct_color
*) xmalloc (sizeof *p
);
10094 p
->g
= color
.green
;
10097 p
->next
= ct_table
[i
];
10101 return FRAME_FOREGROUND_PIXEL (f
);
10107 /* Value is a vector of all pixel colors contained in the color table,
10108 allocated via xmalloc. Set *N to the number of colors. */
10110 static unsigned long *
10111 colors_in_color_table (n
)
10115 struct ct_color
*p
;
10116 unsigned long *colors
;
10118 if (ct_colors_allocated
== 0)
10125 colors
= (unsigned long *) xmalloc (ct_colors_allocated
10127 *n
= ct_colors_allocated
;
10129 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
10130 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10131 colors
[j
++] = p
->pixel
;
10140 /***********************************************************************
10142 ***********************************************************************/
10143 #if 0 /* TODO: image support. */
10144 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
10145 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
10146 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
10148 /* Non-zero means draw a cross on images having `:conversion
10151 int cross_disabled_images
;
10153 /* Edge detection matrices for different edge-detection
10156 static int emboss_matrix
[9] = {
10157 /* x - 1 x x + 1 */
10158 2, -1, 0, /* y - 1 */
10160 0, 1, -2 /* y + 1 */
10163 static int laplace_matrix
[9] = {
10164 /* x - 1 x x + 1 */
10165 1, 0, 0, /* y - 1 */
10167 0, 0, -1 /* y + 1 */
10170 /* Value is the intensity of the color whose red/green/blue values
10171 are R, G, and B. */
10173 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
10176 /* On frame F, return an array of XColor structures describing image
10177 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
10178 non-zero means also fill the red/green/blue members of the XColor
10179 structures. Value is a pointer to the array of XColors structures,
10180 allocated with xmalloc; it must be freed by the caller. */
10183 x_to_xcolors (f
, img
, rgb_p
)
10189 XColor
*colors
, *p
;
10192 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
10194 /* Get the X image IMG->pixmap. */
10195 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10196 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10198 /* Fill the `pixel' members of the XColor array. I wished there
10199 were an easy and portable way to circumvent XGetPixel. */
10201 for (y
= 0; y
< img
->height
; ++y
)
10205 for (x
= 0; x
< img
->width
; ++x
, ++p
)
10206 p
->pixel
= XGetPixel (ximg
, x
, y
);
10209 x_query_colors (f
, row
, img
->width
);
10212 XDestroyImage (ximg
);
10217 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
10218 RGB members are set. F is the frame on which this all happens.
10219 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
10222 x_from_xcolors (f
, img
, colors
)
10232 init_color_table ();
10234 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
10237 for (y
= 0; y
< img
->height
; ++y
)
10238 for (x
= 0; x
< img
->width
; ++x
, ++p
)
10240 unsigned long pixel
;
10241 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
10242 XPutPixel (oimg
, x
, y
, pixel
);
10246 x_clear_image_1 (f
, img
, 1, 0, 1);
10248 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
10249 x_destroy_x_image (oimg
);
10250 img
->pixmap
= pixmap
;
10251 img
->colors
= colors_in_color_table (&img
->ncolors
);
10252 free_color_table ();
10256 /* On frame F, perform edge-detection on image IMG.
10258 MATRIX is a nine-element array specifying the transformation
10259 matrix. See emboss_matrix for an example.
10261 COLOR_ADJUST is a color adjustment added to each pixel of the
10265 x_detect_edges (f
, img
, matrix
, color_adjust
)
10268 int matrix
[9], color_adjust
;
10270 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10274 for (i
= sum
= 0; i
< 9; ++i
)
10275 sum
+= abs (matrix
[i
]);
10277 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
10279 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
10281 for (y
= 0; y
< img
->height
; ++y
)
10283 p
= COLOR (new, 0, y
);
10284 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10285 p
= COLOR (new, img
->width
- 1, y
);
10286 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10289 for (x
= 1; x
< img
->width
- 1; ++x
)
10291 p
= COLOR (new, x
, 0);
10292 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10293 p
= COLOR (new, x
, img
->height
- 1);
10294 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10297 for (y
= 1; y
< img
->height
- 1; ++y
)
10299 p
= COLOR (new, 1, y
);
10301 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
10303 int r
, g
, b
, y1
, x1
;
10306 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
10307 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
10310 XColor
*t
= COLOR (colors
, x1
, y1
);
10311 r
+= matrix
[i
] * t
->red
;
10312 g
+= matrix
[i
] * t
->green
;
10313 b
+= matrix
[i
] * t
->blue
;
10316 r
= (r
/ sum
+ color_adjust
) & 0xffff;
10317 g
= (g
/ sum
+ color_adjust
) & 0xffff;
10318 b
= (b
/ sum
+ color_adjust
) & 0xffff;
10319 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
10324 x_from_xcolors (f
, img
, new);
10330 /* Perform the pre-defined `emboss' edge-detection on image IMG
10338 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
10342 /* Transform image IMG which is used on frame F with a Laplace
10343 edge-detection algorithm. The result is an image that can be used
10344 to draw disabled buttons, for example. */
10351 x_detect_edges (f
, img
, laplace_matrix
, 45000);
10355 /* Perform edge-detection on image IMG on frame F, with specified
10356 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
10358 MATRIX must be either
10360 - a list of at least 9 numbers in row-major form
10361 - a vector of at least 9 numbers
10363 COLOR_ADJUST nil means use a default; otherwise it must be a
10367 x_edge_detection (f
, img
, matrix
, color_adjust
)
10370 Lisp_Object matrix
, color_adjust
;
10375 if (CONSP (matrix
))
10378 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
10379 ++i
, matrix
= XCDR (matrix
))
10380 trans
[i
] = XFLOATINT (XCAR (matrix
));
10382 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
10384 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
10385 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
10388 if (NILP (color_adjust
))
10389 color_adjust
= make_number (0xffff / 2);
10391 if (i
== 9 && NUMBERP (color_adjust
))
10392 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
10396 /* Transform image IMG on frame F so that it looks disabled. */
10399 x_disable_image (f
, img
)
10403 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
10405 if (dpyinfo
->n_planes
>= 2)
10407 /* Color (or grayscale). Convert to gray, and equalize. Just
10408 drawing such images with a stipple can look very odd, so
10409 we're using this method instead. */
10410 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10412 const int h
= 15000;
10413 const int l
= 30000;
10415 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
10419 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
10420 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
10421 p
->red
= p
->green
= p
->blue
= i2
;
10424 x_from_xcolors (f
, img
, colors
);
10427 /* Draw a cross over the disabled image, if we must or if we
10429 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
10431 Display
*dpy
= FRAME_X_DISPLAY (f
);
10434 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
10435 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
10436 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
10437 img
->width
- 1, img
->height
- 1);
10438 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
10439 img
->width
- 1, 0);
10444 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
10445 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
10446 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
10447 img
->width
- 1, img
->height
- 1);
10448 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
10449 img
->width
- 1, 0);
10456 /* Build a mask for image IMG which is used on frame F. FILE is the
10457 name of an image file, for error messages. HOW determines how to
10458 determine the background color of IMG. If it is a list '(R G B)',
10459 with R, G, and B being integers >= 0, take that as the color of the
10460 background. Otherwise, determine the background color of IMG
10461 heuristically. Value is non-zero if successful. */
10464 x_build_heuristic_mask (f
, img
, how
)
10469 Display
*dpy
= FRAME_W32_DISPLAY (f
);
10470 XImage
*ximg
, *mask_img
;
10471 int x
, y
, rc
, use_img_background
;
10472 unsigned long bg
= 0;
10476 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
10478 img
->background_transparent_valid
= 0;
10481 /* Create an image and pixmap serving as mask. */
10482 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
10483 &mask_img
, &img
->mask
);
10487 /* Get the X image of IMG->pixmap. */
10488 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
10491 /* Determine the background color of ximg. If HOW is `(R G B)'
10492 take that as color. Otherwise, use the image's background color. */
10493 use_img_background
= 1;
10499 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
10501 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
10505 if (i
== 3 && NILP (how
))
10507 char color_name
[30];
10508 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
10509 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
10510 use_img_background
= 0;
10514 if (use_img_background
)
10515 bg
= four_corners_best (ximg
, img
->width
, img
->height
);
10517 /* Set all bits in mask_img to 1 whose color in ximg is different
10518 from the background color bg. */
10519 for (y
= 0; y
< img
->height
; ++y
)
10520 for (x
= 0; x
< img
->width
; ++x
)
10521 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
10523 /* Fill in the background_transparent field while we have the mask handy. */
10524 image_background_transparent (img
, f
, mask_img
);
10526 /* Put mask_img into img->mask. */
10527 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
10528 x_destroy_x_image (mask_img
);
10529 XDestroyImage (ximg
);
10536 /***********************************************************************
10537 PBM (mono, gray, color)
10538 ***********************************************************************/
10541 static int pbm_image_p
P_ ((Lisp_Object object
));
10542 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
10543 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
10545 /* The symbol `pbm' identifying images of this type. */
10549 /* Indices of image specification fields in gs_format, below. */
10551 enum pbm_keyword_index
10560 PBM_HEURISTIC_MASK
,
10567 /* Vector of image_keyword structures describing the format
10568 of valid user-defined image specifications. */
10570 static struct image_keyword pbm_format
[PBM_LAST
] =
10572 {":type", IMAGE_SYMBOL_VALUE
, 1},
10573 {":file", IMAGE_STRING_VALUE
, 0},
10574 {":data", IMAGE_STRING_VALUE
, 0},
10575 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10576 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10577 {":relief", IMAGE_INTEGER_VALUE
, 0},
10578 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10579 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10580 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10581 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
10582 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10585 /* Structure describing the image type `pbm'. */
10587 static struct image_type pbm_type
=
10597 /* Return non-zero if OBJECT is a valid PBM image specification. */
10600 pbm_image_p (object
)
10601 Lisp_Object object
;
10603 struct image_keyword fmt
[PBM_LAST
];
10605 bcopy (pbm_format
, fmt
, sizeof fmt
);
10607 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
10608 || (fmt
[PBM_ASCENT
].count
10609 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
10612 /* Must specify either :data or :file. */
10613 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
10617 /* Scan a decimal number from *S and return it. Advance *S while
10618 reading the number. END is the end of the string. Value is -1 at
10622 pbm_scan_number (s
, end
)
10623 unsigned char **s
, *end
;
10629 /* Skip white-space. */
10630 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
10635 /* Skip comment to end of line. */
10636 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
10639 else if (isdigit (c
))
10641 /* Read decimal number. */
10643 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
10644 val
= 10 * val
+ c
- '0';
10655 /* Read FILE into memory. Value is a pointer to a buffer allocated
10656 with xmalloc holding FILE's contents. Value is null if an error
10657 occured. *SIZE is set to the size of the file. */
10660 pbm_read_file (file
, size
)
10668 if (stat (XSTRING (file
)->data
, &st
) == 0
10669 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
10670 && (buf
= (char *) xmalloc (st
.st_size
),
10671 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
10673 *size
= st
.st_size
;
10691 /* Load PBM image IMG for use on frame F. */
10699 int width
, height
, max_color_idx
= 0;
10701 Lisp_Object file
, specified_file
;
10702 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
10703 struct gcpro gcpro1
;
10704 unsigned char *contents
= NULL
;
10705 unsigned char *end
, *p
;
10708 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10712 if (STRINGP (specified_file
))
10714 file
= x_find_image_file (specified_file
);
10715 if (!STRINGP (file
))
10717 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10722 contents
= slurp_file (XSTRING (file
)->data
, &size
);
10723 if (contents
== NULL
)
10725 image_error ("Error reading `%s'", file
, Qnil
);
10731 end
= contents
+ size
;
10736 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10737 p
= XSTRING (data
)->data
;
10738 end
= p
+ STRING_BYTES (XSTRING (data
));
10741 /* Check magic number. */
10742 if (end
- p
< 2 || *p
++ != 'P')
10744 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10754 raw_p
= 0, type
= PBM_MONO
;
10758 raw_p
= 0, type
= PBM_GRAY
;
10762 raw_p
= 0, type
= PBM_COLOR
;
10766 raw_p
= 1, type
= PBM_MONO
;
10770 raw_p
= 1, type
= PBM_GRAY
;
10774 raw_p
= 1, type
= PBM_COLOR
;
10778 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10782 /* Read width, height, maximum color-component. Characters
10783 starting with `#' up to the end of a line are ignored. */
10784 width
= pbm_scan_number (&p
, end
);
10785 height
= pbm_scan_number (&p
, end
);
10787 if (type
!= PBM_MONO
)
10789 max_color_idx
= pbm_scan_number (&p
, end
);
10790 if (raw_p
&& max_color_idx
> 255)
10791 max_color_idx
= 255;
10796 || (type
!= PBM_MONO
&& max_color_idx
< 0))
10799 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
10800 &ximg
, &img
->pixmap
))
10803 /* Initialize the color hash table. */
10804 init_color_table ();
10806 if (type
== PBM_MONO
)
10809 struct image_keyword fmt
[PBM_LAST
];
10810 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
10811 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
10813 /* Parse the image specification. */
10814 bcopy (pbm_format
, fmt
, sizeof fmt
);
10815 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
10817 /* Get foreground and background colors, maybe allocate colors. */
10818 if (fmt
[PBM_FOREGROUND
].count
10819 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
10820 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
10821 if (fmt
[PBM_BACKGROUND
].count
10822 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
10824 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
10825 img
->background
= bg
;
10826 img
->background_valid
= 1;
10829 for (y
= 0; y
< height
; ++y
)
10830 for (x
= 0; x
< width
; ++x
)
10840 g
= pbm_scan_number (&p
, end
);
10842 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
10847 for (y
= 0; y
< height
; ++y
)
10848 for (x
= 0; x
< width
; ++x
)
10852 if (type
== PBM_GRAY
)
10853 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
10862 r
= pbm_scan_number (&p
, end
);
10863 g
= pbm_scan_number (&p
, end
);
10864 b
= pbm_scan_number (&p
, end
);
10867 if (r
< 0 || g
< 0 || b
< 0)
10869 xfree (ximg
->data
);
10871 XDestroyImage (ximg
);
10872 image_error ("Invalid pixel value in image `%s'",
10877 /* RGB values are now in the range 0..max_color_idx.
10878 Scale this to the range 0..0xffff supported by X. */
10879 r
= (double) r
* 65535 / max_color_idx
;
10880 g
= (double) g
* 65535 / max_color_idx
;
10881 b
= (double) b
* 65535 / max_color_idx
;
10882 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
10886 /* Store in IMG->colors the colors allocated for the image, and
10887 free the color table. */
10888 img
->colors
= colors_in_color_table (&img
->ncolors
);
10889 free_color_table ();
10891 /* Maybe fill in the background field while we have ximg handy. */
10892 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10893 IMAGE_BACKGROUND (img
, f
, ximg
);
10895 /* Put the image into a pixmap. */
10896 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10897 x_destroy_x_image (ximg
);
10899 img
->width
= width
;
10900 img
->height
= height
;
10906 #endif /* HAVE_PBM */
10909 /***********************************************************************
10911 ***********************************************************************/
10917 /* Function prototypes. */
10919 static int png_image_p
P_ ((Lisp_Object object
));
10920 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
10922 /* The symbol `png' identifying images of this type. */
10926 /* Indices of image specification fields in png_format, below. */
10928 enum png_keyword_index
10937 PNG_HEURISTIC_MASK
,
10943 /* Vector of image_keyword structures describing the format
10944 of valid user-defined image specifications. */
10946 static struct image_keyword png_format
[PNG_LAST
] =
10948 {":type", IMAGE_SYMBOL_VALUE
, 1},
10949 {":data", IMAGE_STRING_VALUE
, 0},
10950 {":file", IMAGE_STRING_VALUE
, 0},
10951 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10952 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10953 {":relief", IMAGE_INTEGER_VALUE
, 0},
10954 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10955 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10956 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10957 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10960 /* Structure describing the image type `png'. */
10962 static struct image_type png_type
=
10972 /* Return non-zero if OBJECT is a valid PNG image specification. */
10975 png_image_p (object
)
10976 Lisp_Object object
;
10978 struct image_keyword fmt
[PNG_LAST
];
10979 bcopy (png_format
, fmt
, sizeof fmt
);
10981 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
10982 || (fmt
[PNG_ASCENT
].count
10983 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
10986 /* Must specify either the :data or :file keyword. */
10987 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
10991 /* Error and warning handlers installed when the PNG library
10995 my_png_error (png_ptr
, msg
)
10996 png_struct
*png_ptr
;
10999 xassert (png_ptr
!= NULL
);
11000 image_error ("PNG error: %s", build_string (msg
), Qnil
);
11001 longjmp (png_ptr
->jmpbuf
, 1);
11006 my_png_warning (png_ptr
, msg
)
11007 png_struct
*png_ptr
;
11010 xassert (png_ptr
!= NULL
);
11011 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
11014 /* Memory source for PNG decoding. */
11016 struct png_memory_storage
11018 unsigned char *bytes
; /* The data */
11019 size_t len
; /* How big is it? */
11020 int index
; /* Where are we? */
11024 /* Function set as reader function when reading PNG image from memory.
11025 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
11026 bytes from the input to DATA. */
11029 png_read_from_memory (png_ptr
, data
, length
)
11030 png_structp png_ptr
;
11034 struct png_memory_storage
*tbr
11035 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
11037 if (length
> tbr
->len
- tbr
->index
)
11038 png_error (png_ptr
, "Read error");
11040 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
11041 tbr
->index
= tbr
->index
+ length
;
11044 /* Load PNG image IMG for use on frame F. Value is non-zero if
11052 Lisp_Object file
, specified_file
;
11053 Lisp_Object specified_data
;
11055 XImage
*ximg
, *mask_img
= NULL
;
11056 struct gcpro gcpro1
;
11057 png_struct
*png_ptr
= NULL
;
11058 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
11059 FILE *volatile fp
= NULL
;
11061 png_byte
*volatile pixels
= NULL
;
11062 png_byte
**volatile rows
= NULL
;
11063 png_uint_32 width
, height
;
11064 int bit_depth
, color_type
, interlace_type
;
11066 png_uint_32 row_bytes
;
11069 double screen_gamma
, image_gamma
;
11071 struct png_memory_storage tbr
; /* Data to be read */
11073 /* Find out what file to load. */
11074 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11075 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11079 if (NILP (specified_data
))
11081 file
= x_find_image_file (specified_file
);
11082 if (!STRINGP (file
))
11084 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11089 /* Open the image file. */
11090 fp
= fopen (XSTRING (file
)->data
, "rb");
11093 image_error ("Cannot open image file `%s'", file
, Qnil
);
11099 /* Check PNG signature. */
11100 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
11101 || !png_check_sig (sig
, sizeof sig
))
11103 image_error ("Not a PNG file:` %s'", file
, Qnil
);
11111 /* Read from memory. */
11112 tbr
.bytes
= XSTRING (specified_data
)->data
;
11113 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
11116 /* Check PNG signature. */
11117 if (tbr
.len
< sizeof sig
11118 || !png_check_sig (tbr
.bytes
, sizeof sig
))
11120 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
11125 /* Need to skip past the signature. */
11126 tbr
.bytes
+= sizeof (sig
);
11129 /* Initialize read and info structs for PNG lib. */
11130 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
11131 my_png_error
, my_png_warning
);
11134 if (fp
) fclose (fp
);
11139 info_ptr
= png_create_info_struct (png_ptr
);
11142 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
11143 if (fp
) fclose (fp
);
11148 end_info
= png_create_info_struct (png_ptr
);
11151 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
11152 if (fp
) fclose (fp
);
11157 /* Set error jump-back. We come back here when the PNG library
11158 detects an error. */
11159 if (setjmp (png_ptr
->jmpbuf
))
11163 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
11166 if (fp
) fclose (fp
);
11171 /* Read image info. */
11172 if (!NILP (specified_data
))
11173 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
11175 png_init_io (png_ptr
, fp
);
11177 png_set_sig_bytes (png_ptr
, sizeof sig
);
11178 png_read_info (png_ptr
, info_ptr
);
11179 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
11180 &interlace_type
, NULL
, NULL
);
11182 /* If image contains simply transparency data, we prefer to
11183 construct a clipping mask. */
11184 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
11189 /* This function is easier to write if we only have to handle
11190 one data format: RGB or RGBA with 8 bits per channel. Let's
11191 transform other formats into that format. */
11193 /* Strip more than 8 bits per channel. */
11194 if (bit_depth
== 16)
11195 png_set_strip_16 (png_ptr
);
11197 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
11199 png_set_expand (png_ptr
);
11201 /* Convert grayscale images to RGB. */
11202 if (color_type
== PNG_COLOR_TYPE_GRAY
11203 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
11204 png_set_gray_to_rgb (png_ptr
);
11206 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
11207 gamma_str
= getenv ("SCREEN_GAMMA");
11208 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
11210 /* Tell the PNG lib to handle gamma correction for us. */
11212 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
11213 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
11214 /* There is a special chunk in the image specifying the gamma. */
11215 png_set_sRGB (png_ptr
, info_ptr
, intent
);
11218 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
11219 /* Image contains gamma information. */
11220 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
11222 /* Use a default of 0.5 for the image gamma. */
11223 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
11225 /* Handle alpha channel by combining the image with a background
11226 color. Do this only if a real alpha channel is supplied. For
11227 simple transparency, we prefer a clipping mask. */
11228 if (!transparent_p
)
11230 png_color_16
*image_background
;
11231 Lisp_Object specified_bg
11232 = image_spec_value (img
->spec
, QCbackground
, NULL
);
11235 if (STRINGP (specified_bg
))
11236 /* The user specified `:background', use that. */
11239 if (w32_defined_color (f
, XSTRING (specified_bg
)->data
, &color
, 0))
11241 png_color_16 user_bg
;
11243 bzero (&user_bg
, sizeof user_bg
);
11244 user_bg
.red
= color
.red
;
11245 user_bg
.green
= color
.green
;
11246 user_bg
.blue
= color
.blue
;
11248 png_set_background (png_ptr
, &user_bg
,
11249 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
11252 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
11253 /* Image contains a background color with which to
11254 combine the image. */
11255 png_set_background (png_ptr
, image_background
,
11256 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
11259 /* Image does not contain a background color with which
11260 to combine the image data via an alpha channel. Use
11261 the frame's background instead. */
11264 png_color_16 frame_background
;
11266 cmap
= FRAME_X_COLORMAP (f
);
11267 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
11268 x_query_color (f
, &color
);
11270 bzero (&frame_background
, sizeof frame_background
);
11271 frame_background
.red
= color
.red
;
11272 frame_background
.green
= color
.green
;
11273 frame_background
.blue
= color
.blue
;
11275 png_set_background (png_ptr
, &frame_background
,
11276 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
11280 /* Update info structure. */
11281 png_read_update_info (png_ptr
, info_ptr
);
11283 /* Get number of channels. Valid values are 1 for grayscale images
11284 and images with a palette, 2 for grayscale images with transparency
11285 information (alpha channel), 3 for RGB images, and 4 for RGB
11286 images with alpha channel, i.e. RGBA. If conversions above were
11287 sufficient we should only have 3 or 4 channels here. */
11288 channels
= png_get_channels (png_ptr
, info_ptr
);
11289 xassert (channels
== 3 || channels
== 4);
11291 /* Number of bytes needed for one row of the image. */
11292 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
11294 /* Allocate memory for the image. */
11295 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
11296 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
11297 for (i
= 0; i
< height
; ++i
)
11298 rows
[i
] = pixels
+ i
* row_bytes
;
11300 /* Read the entire image. */
11301 png_read_image (png_ptr
, rows
);
11302 png_read_end (png_ptr
, info_ptr
);
11309 /* Create the X image and pixmap. */
11310 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
11314 /* Create an image and pixmap serving as mask if the PNG image
11315 contains an alpha channel. */
11318 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
11319 &mask_img
, &img
->mask
))
11321 x_destroy_x_image (ximg
);
11322 XFreePixmap (FRAME_W32_DISPLAY (f
), img
->pixmap
);
11327 /* Fill the X image and mask from PNG data. */
11328 init_color_table ();
11330 for (y
= 0; y
< height
; ++y
)
11332 png_byte
*p
= rows
[y
];
11334 for (x
= 0; x
< width
; ++x
)
11341 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
11343 /* An alpha channel, aka mask channel, associates variable
11344 transparency with an image. Where other image formats
11345 support binary transparency---fully transparent or fully
11346 opaque---PNG allows up to 254 levels of partial transparency.
11347 The PNG library implements partial transparency by combining
11348 the image with a specified background color.
11350 I'm not sure how to handle this here nicely: because the
11351 background on which the image is displayed may change, for
11352 real alpha channel support, it would be necessary to create
11353 a new image for each possible background.
11355 What I'm doing now is that a mask is created if we have
11356 boolean transparency information. Otherwise I'm using
11357 the frame's background color to combine the image with. */
11362 XPutPixel (mask_img
, x
, y
, *p
> 0);
11368 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11369 /* Set IMG's background color from the PNG image, unless the user
11373 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
11375 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
11376 img
->background_valid
= 1;
11380 /* Remember colors allocated for this image. */
11381 img
->colors
= colors_in_color_table (&img
->ncolors
);
11382 free_color_table ();
11385 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
11389 img
->width
= width
;
11390 img
->height
= height
;
11392 /* Maybe fill in the background field while we have ximg handy. */
11393 IMAGE_BACKGROUND (img
, f
, ximg
);
11395 /* Put the image into the pixmap, then free the X image and its buffer. */
11396 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11397 x_destroy_x_image (ximg
);
11399 /* Same for the mask. */
11402 /* Fill in the background_transparent field while we have the mask
11404 image_background_transparent (img
, f
, mask_img
);
11406 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
11407 x_destroy_x_image (mask_img
);
11414 #endif /* HAVE_PNG != 0 */
11418 /***********************************************************************
11420 ***********************************************************************/
11424 /* Work around a warning about HAVE_STDLIB_H being redefined in
11426 #ifdef HAVE_STDLIB_H
11427 #define HAVE_STDLIB_H_1
11428 #undef HAVE_STDLIB_H
11429 #endif /* HAVE_STLIB_H */
11431 #include <jpeglib.h>
11432 #include <jerror.h>
11433 #include <setjmp.h>
11435 #ifdef HAVE_STLIB_H_1
11436 #define HAVE_STDLIB_H 1
11439 static int jpeg_image_p
P_ ((Lisp_Object object
));
11440 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
11442 /* The symbol `jpeg' identifying images of this type. */
11446 /* Indices of image specification fields in gs_format, below. */
11448 enum jpeg_keyword_index
11457 JPEG_HEURISTIC_MASK
,
11463 /* Vector of image_keyword structures describing the format
11464 of valid user-defined image specifications. */
11466 static struct image_keyword jpeg_format
[JPEG_LAST
] =
11468 {":type", IMAGE_SYMBOL_VALUE
, 1},
11469 {":data", IMAGE_STRING_VALUE
, 0},
11470 {":file", IMAGE_STRING_VALUE
, 0},
11471 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11472 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11473 {":relief", IMAGE_INTEGER_VALUE
, 0},
11474 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11475 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11476 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11477 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11480 /* Structure describing the image type `jpeg'. */
11482 static struct image_type jpeg_type
=
11492 /* Return non-zero if OBJECT is a valid JPEG image specification. */
11495 jpeg_image_p (object
)
11496 Lisp_Object object
;
11498 struct image_keyword fmt
[JPEG_LAST
];
11500 bcopy (jpeg_format
, fmt
, sizeof fmt
);
11502 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
11503 || (fmt
[JPEG_ASCENT
].count
11504 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
11507 /* Must specify either the :data or :file keyword. */
11508 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
11512 struct my_jpeg_error_mgr
11514 struct jpeg_error_mgr pub
;
11515 jmp_buf setjmp_buffer
;
11519 my_error_exit (cinfo
)
11520 j_common_ptr cinfo
;
11522 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
11523 longjmp (mgr
->setjmp_buffer
, 1);
11526 /* Init source method for JPEG data source manager. Called by
11527 jpeg_read_header() before any data is actually read. See
11528 libjpeg.doc from the JPEG lib distribution. */
11531 our_init_source (cinfo
)
11532 j_decompress_ptr cinfo
;
11537 /* Fill input buffer method for JPEG data source manager. Called
11538 whenever more data is needed. We read the whole image in one step,
11539 so this only adds a fake end of input marker at the end. */
11542 our_fill_input_buffer (cinfo
)
11543 j_decompress_ptr cinfo
;
11545 /* Insert a fake EOI marker. */
11546 struct jpeg_source_mgr
*src
= cinfo
->src
;
11547 static JOCTET buffer
[2];
11549 buffer
[0] = (JOCTET
) 0xFF;
11550 buffer
[1] = (JOCTET
) JPEG_EOI
;
11552 src
->next_input_byte
= buffer
;
11553 src
->bytes_in_buffer
= 2;
11558 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
11559 is the JPEG data source manager. */
11562 our_skip_input_data (cinfo
, num_bytes
)
11563 j_decompress_ptr cinfo
;
11566 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11570 if (num_bytes
> src
->bytes_in_buffer
)
11571 ERREXIT (cinfo
, JERR_INPUT_EOF
);
11573 src
->bytes_in_buffer
-= num_bytes
;
11574 src
->next_input_byte
+= num_bytes
;
11579 /* Method to terminate data source. Called by
11580 jpeg_finish_decompress() after all data has been processed. */
11583 our_term_source (cinfo
)
11584 j_decompress_ptr cinfo
;
11589 /* Set up the JPEG lib for reading an image from DATA which contains
11590 LEN bytes. CINFO is the decompression info structure created for
11591 reading the image. */
11594 jpeg_memory_src (cinfo
, data
, len
)
11595 j_decompress_ptr cinfo
;
11599 struct jpeg_source_mgr
*src
;
11601 if (cinfo
->src
== NULL
)
11603 /* First time for this JPEG object? */
11604 cinfo
->src
= (struct jpeg_source_mgr
*)
11605 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
11606 sizeof (struct jpeg_source_mgr
));
11607 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11608 src
->next_input_byte
= data
;
11611 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11612 src
->init_source
= our_init_source
;
11613 src
->fill_input_buffer
= our_fill_input_buffer
;
11614 src
->skip_input_data
= our_skip_input_data
;
11615 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
11616 src
->term_source
= our_term_source
;
11617 src
->bytes_in_buffer
= len
;
11618 src
->next_input_byte
= data
;
11622 /* Load image IMG for use on frame F. Patterned after example.c
11623 from the JPEG lib. */
11630 struct jpeg_decompress_struct cinfo
;
11631 struct my_jpeg_error_mgr mgr
;
11632 Lisp_Object file
, specified_file
;
11633 Lisp_Object specified_data
;
11634 FILE * volatile fp
= NULL
;
11636 int row_stride
, x
, y
;
11637 XImage
*ximg
= NULL
;
11639 unsigned long *colors
;
11641 struct gcpro gcpro1
;
11643 /* Open the JPEG file. */
11644 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11645 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11649 if (NILP (specified_data
))
11651 file
= x_find_image_file (specified_file
);
11652 if (!STRINGP (file
))
11654 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11659 fp
= fopen (XSTRING (file
)->data
, "r");
11662 image_error ("Cannot open `%s'", file
, Qnil
);
11668 /* Customize libjpeg's error handling to call my_error_exit when an
11669 error is detected. This function will perform a longjmp. */
11670 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
11671 mgr
.pub
.error_exit
= my_error_exit
;
11673 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
11677 /* Called from my_error_exit. Display a JPEG error. */
11678 char buffer
[JMSG_LENGTH_MAX
];
11679 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
11680 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
11681 build_string (buffer
));
11684 /* Close the input file and destroy the JPEG object. */
11687 jpeg_destroy_decompress (&cinfo
);
11689 /* If we already have an XImage, free that. */
11690 x_destroy_x_image (ximg
);
11692 /* Free pixmap and colors. */
11693 x_clear_image (f
, img
);
11699 /* Create the JPEG decompression object. Let it read from fp.
11700 Read the JPEG image header. */
11701 jpeg_create_decompress (&cinfo
);
11703 if (NILP (specified_data
))
11704 jpeg_stdio_src (&cinfo
, fp
);
11706 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
11707 STRING_BYTES (XSTRING (specified_data
)));
11709 jpeg_read_header (&cinfo
, TRUE
);
11711 /* Customize decompression so that color quantization will be used.
11712 Start decompression. */
11713 cinfo
.quantize_colors
= TRUE
;
11714 jpeg_start_decompress (&cinfo
);
11715 width
= img
->width
= cinfo
.output_width
;
11716 height
= img
->height
= cinfo
.output_height
;
11718 /* Create X image and pixmap. */
11719 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
11721 longjmp (mgr
.setjmp_buffer
, 2);
11723 /* Allocate colors. When color quantization is used,
11724 cinfo.actual_number_of_colors has been set with the number of
11725 colors generated, and cinfo.colormap is a two-dimensional array
11726 of color indices in the range 0..cinfo.actual_number_of_colors.
11727 No more than 255 colors will be generated. */
11731 if (cinfo
.out_color_components
> 2)
11732 ir
= 0, ig
= 1, ib
= 2;
11733 else if (cinfo
.out_color_components
> 1)
11734 ir
= 0, ig
= 1, ib
= 0;
11736 ir
= 0, ig
= 0, ib
= 0;
11738 /* Use the color table mechanism because it handles colors that
11739 cannot be allocated nicely. Such colors will be replaced with
11740 a default color, and we don't have to care about which colors
11741 can be freed safely, and which can't. */
11742 init_color_table ();
11743 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
11746 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
11748 /* Multiply RGB values with 255 because X expects RGB values
11749 in the range 0..0xffff. */
11750 int r
= cinfo
.colormap
[ir
][i
] << 8;
11751 int g
= cinfo
.colormap
[ig
][i
] << 8;
11752 int b
= cinfo
.colormap
[ib
][i
] << 8;
11753 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
11756 /* Remember those colors actually allocated. */
11757 img
->colors
= colors_in_color_table (&img
->ncolors
);
11758 free_color_table ();
11762 row_stride
= width
* cinfo
.output_components
;
11763 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
11765 for (y
= 0; y
< height
; ++y
)
11767 jpeg_read_scanlines (&cinfo
, buffer
, 1);
11768 for (x
= 0; x
< cinfo
.output_width
; ++x
)
11769 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
11773 jpeg_finish_decompress (&cinfo
);
11774 jpeg_destroy_decompress (&cinfo
);
11778 /* Maybe fill in the background field while we have ximg handy. */
11779 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11780 IMAGE_BACKGROUND (img
, f
, ximg
);
11782 /* Put the image into the pixmap. */
11783 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11784 x_destroy_x_image (ximg
);
11790 #endif /* HAVE_JPEG */
11794 /***********************************************************************
11796 ***********************************************************************/
11800 #include <tiffio.h>
11802 static int tiff_image_p
P_ ((Lisp_Object object
));
11803 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
11805 /* The symbol `tiff' identifying images of this type. */
11809 /* Indices of image specification fields in tiff_format, below. */
11811 enum tiff_keyword_index
11820 TIFF_HEURISTIC_MASK
,
11826 /* Vector of image_keyword structures describing the format
11827 of valid user-defined image specifications. */
11829 static struct image_keyword tiff_format
[TIFF_LAST
] =
11831 {":type", IMAGE_SYMBOL_VALUE
, 1},
11832 {":data", IMAGE_STRING_VALUE
, 0},
11833 {":file", IMAGE_STRING_VALUE
, 0},
11834 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11835 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11836 {":relief", IMAGE_INTEGER_VALUE
, 0},
11837 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11838 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11839 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11840 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11843 /* Structure describing the image type `tiff'. */
11845 static struct image_type tiff_type
=
11855 /* Return non-zero if OBJECT is a valid TIFF image specification. */
11858 tiff_image_p (object
)
11859 Lisp_Object object
;
11861 struct image_keyword fmt
[TIFF_LAST
];
11862 bcopy (tiff_format
, fmt
, sizeof fmt
);
11864 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
11865 || (fmt
[TIFF_ASCENT
].count
11866 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
11869 /* Must specify either the :data or :file keyword. */
11870 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
11874 /* Reading from a memory buffer for TIFF images Based on the PNG
11875 memory source, but we have to provide a lot of extra functions.
11878 We really only need to implement read and seek, but I am not
11879 convinced that the TIFF library is smart enough not to destroy
11880 itself if we only hand it the function pointers we need to
11885 unsigned char *bytes
;
11889 tiff_memory_source
;
11892 tiff_read_from_memory (data
, buf
, size
)
11897 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11899 if (size
> src
->len
- src
->index
)
11900 return (size_t) -1;
11901 bcopy (src
->bytes
+ src
->index
, buf
, size
);
11902 src
->index
+= size
;
11907 tiff_write_from_memory (data
, buf
, size
)
11912 return (size_t) -1;
11916 tiff_seek_in_memory (data
, off
, whence
)
11921 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11926 case SEEK_SET
: /* Go from beginning of source. */
11930 case SEEK_END
: /* Go from end of source. */
11931 idx
= src
->len
+ off
;
11934 case SEEK_CUR
: /* Go from current position. */
11935 idx
= src
->index
+ off
;
11938 default: /* Invalid `whence'. */
11942 if (idx
> src
->len
|| idx
< 0)
11950 tiff_close_memory (data
)
11958 tiff_mmap_memory (data
, pbase
, psize
)
11963 /* It is already _IN_ memory. */
11968 tiff_unmap_memory (data
, base
, size
)
11973 /* We don't need to do this. */
11977 tiff_size_of_memory (data
)
11980 return ((tiff_memory_source
*) data
)->len
;
11985 tiff_error_handler (title
, format
, ap
)
11986 const char *title
, *format
;
11992 len
= sprintf (buf
, "TIFF error: %s ", title
);
11993 vsprintf (buf
+ len
, format
, ap
);
11994 add_to_log (buf
, Qnil
, Qnil
);
11999 tiff_warning_handler (title
, format
, ap
)
12000 const char *title
, *format
;
12006 len
= sprintf (buf
, "TIFF warning: %s ", title
);
12007 vsprintf (buf
+ len
, format
, ap
);
12008 add_to_log (buf
, Qnil
, Qnil
);
12012 /* Load TIFF image IMG for use on frame F. Value is non-zero if
12020 Lisp_Object file
, specified_file
;
12021 Lisp_Object specified_data
;
12023 int width
, height
, x
, y
;
12027 struct gcpro gcpro1
;
12028 tiff_memory_source memsrc
;
12030 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12031 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12035 TIFFSetErrorHandler (tiff_error_handler
);
12036 TIFFSetWarningHandler (tiff_warning_handler
);
12038 if (NILP (specified_data
))
12040 /* Read from a file */
12041 file
= x_find_image_file (specified_file
);
12042 if (!STRINGP (file
))
12044 image_error ("Cannot find image file `%s'", file
, Qnil
);
12049 /* Try to open the image file. */
12050 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
12053 image_error ("Cannot open `%s'", file
, Qnil
);
12060 /* Memory source! */
12061 memsrc
.bytes
= XSTRING (specified_data
)->data
;
12062 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
12065 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
12066 (TIFFReadWriteProc
) tiff_read_from_memory
,
12067 (TIFFReadWriteProc
) tiff_write_from_memory
,
12068 tiff_seek_in_memory
,
12070 tiff_size_of_memory
,
12072 tiff_unmap_memory
);
12076 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
12082 /* Get width and height of the image, and allocate a raster buffer
12083 of width x height 32-bit values. */
12084 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
12085 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
12086 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
12088 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
12092 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
12098 /* Create the X image and pixmap. */
12099 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12106 /* Initialize the color table. */
12107 init_color_table ();
12109 /* Process the pixel raster. Origin is in the lower-left corner. */
12110 for (y
= 0; y
< height
; ++y
)
12112 uint32
*row
= buf
+ y
* width
;
12114 for (x
= 0; x
< width
; ++x
)
12116 uint32 abgr
= row
[x
];
12117 int r
= TIFFGetR (abgr
) << 8;
12118 int g
= TIFFGetG (abgr
) << 8;
12119 int b
= TIFFGetB (abgr
) << 8;
12120 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
12124 /* Remember the colors allocated for the image. Free the color table. */
12125 img
->colors
= colors_in_color_table (&img
->ncolors
);
12126 free_color_table ();
12128 img
->width
= width
;
12129 img
->height
= height
;
12131 /* Maybe fill in the background field while we have ximg handy. */
12132 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12133 IMAGE_BACKGROUND (img
, f
, ximg
);
12135 /* Put the image into the pixmap, then free the X image and its buffer. */
12136 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12137 x_destroy_x_image (ximg
);
12144 #endif /* HAVE_TIFF != 0 */
12148 /***********************************************************************
12150 ***********************************************************************/
12154 #include <gif_lib.h>
12156 static int gif_image_p
P_ ((Lisp_Object object
));
12157 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
12159 /* The symbol `gif' identifying images of this type. */
12163 /* Indices of image specification fields in gif_format, below. */
12165 enum gif_keyword_index
12174 GIF_HEURISTIC_MASK
,
12181 /* Vector of image_keyword structures describing the format
12182 of valid user-defined image specifications. */
12184 static struct image_keyword gif_format
[GIF_LAST
] =
12186 {":type", IMAGE_SYMBOL_VALUE
, 1},
12187 {":data", IMAGE_STRING_VALUE
, 0},
12188 {":file", IMAGE_STRING_VALUE
, 0},
12189 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
12190 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12191 {":relief", IMAGE_INTEGER_VALUE
, 0},
12192 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12193 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12194 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12195 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
12196 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12199 /* Structure describing the image type `gif'. */
12201 static struct image_type gif_type
=
12210 /* Return non-zero if OBJECT is a valid GIF image specification. */
12213 gif_image_p (object
)
12214 Lisp_Object object
;
12216 struct image_keyword fmt
[GIF_LAST
];
12217 bcopy (gif_format
, fmt
, sizeof fmt
);
12219 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
12220 || (fmt
[GIF_ASCENT
].count
12221 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
12224 /* Must specify either the :data or :file keyword. */
12225 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
12228 /* Reading a GIF image from memory
12229 Based on the PNG memory stuff to a certain extent. */
12233 unsigned char *bytes
;
12239 /* Make the current memory source available to gif_read_from_memory.
12240 It's done this way because not all versions of libungif support
12241 a UserData field in the GifFileType structure. */
12242 static gif_memory_source
*current_gif_memory_src
;
12245 gif_read_from_memory (file
, buf
, len
)
12250 gif_memory_source
*src
= current_gif_memory_src
;
12252 if (len
> src
->len
- src
->index
)
12255 bcopy (src
->bytes
+ src
->index
, buf
, len
);
12261 /* Load GIF image IMG for use on frame F. Value is non-zero if
12269 Lisp_Object file
, specified_file
;
12270 Lisp_Object specified_data
;
12271 int rc
, width
, height
, x
, y
, i
;
12273 ColorMapObject
*gif_color_map
;
12274 unsigned long pixel_colors
[256];
12276 struct gcpro gcpro1
;
12278 int ino
, image_left
, image_top
, image_width
, image_height
;
12279 gif_memory_source memsrc
;
12280 unsigned char *raster
;
12282 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12283 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12287 if (NILP (specified_data
))
12289 file
= x_find_image_file (specified_file
);
12290 if (!STRINGP (file
))
12292 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
12297 /* Open the GIF file. */
12298 gif
= DGifOpenFileName (XSTRING (file
)->data
);
12301 image_error ("Cannot open `%s'", file
, Qnil
);
12308 /* Read from memory! */
12309 current_gif_memory_src
= &memsrc
;
12310 memsrc
.bytes
= XSTRING (specified_data
)->data
;
12311 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
12314 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
12317 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
12323 /* Read entire contents. */
12324 rc
= DGifSlurp (gif
);
12325 if (rc
== GIF_ERROR
)
12327 image_error ("Error reading `%s'", img
->spec
, Qnil
);
12328 DGifCloseFile (gif
);
12333 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
12334 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
12335 if (ino
>= gif
->ImageCount
)
12337 image_error ("Invalid image number `%s' in image `%s'",
12339 DGifCloseFile (gif
);
12344 width
= img
->width
= gif
->SWidth
;
12345 height
= img
->height
= gif
->SHeight
;
12347 /* Create the X image and pixmap. */
12348 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12350 DGifCloseFile (gif
);
12355 /* Allocate colors. */
12356 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
12357 if (!gif_color_map
)
12358 gif_color_map
= gif
->SColorMap
;
12359 init_color_table ();
12360 bzero (pixel_colors
, sizeof pixel_colors
);
12362 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
12364 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
12365 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
12366 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
12367 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
12370 img
->colors
= colors_in_color_table (&img
->ncolors
);
12371 free_color_table ();
12373 /* Clear the part of the screen image that are not covered by
12374 the image from the GIF file. Full animated GIF support
12375 requires more than can be done here (see the gif89 spec,
12376 disposal methods). Let's simply assume that the part
12377 not covered by a sub-image is in the frame's background color. */
12378 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
12379 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
12380 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
12381 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
12383 for (y
= 0; y
< image_top
; ++y
)
12384 for (x
= 0; x
< width
; ++x
)
12385 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12387 for (y
= image_top
+ image_height
; y
< height
; ++y
)
12388 for (x
= 0; x
< width
; ++x
)
12389 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12391 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
12393 for (x
= 0; x
< image_left
; ++x
)
12394 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12395 for (x
= image_left
+ image_width
; x
< width
; ++x
)
12396 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12399 /* Read the GIF image into the X image. We use a local variable
12400 `raster' here because RasterBits below is a char *, and invites
12401 problems with bytes >= 0x80. */
12402 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
12404 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
12406 static int interlace_start
[] = {0, 4, 2, 1};
12407 static int interlace_increment
[] = {8, 8, 4, 2};
12409 int row
= interlace_start
[0];
12413 for (y
= 0; y
< image_height
; y
++)
12415 if (row
>= image_height
)
12417 row
= interlace_start
[++pass
];
12418 while (row
>= image_height
)
12419 row
= interlace_start
[++pass
];
12422 for (x
= 0; x
< image_width
; x
++)
12424 int i
= raster
[(y
* image_width
) + x
];
12425 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
12429 row
+= interlace_increment
[pass
];
12434 for (y
= 0; y
< image_height
; ++y
)
12435 for (x
= 0; x
< image_width
; ++x
)
12437 int i
= raster
[y
* image_width
+ x
];
12438 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
12442 DGifCloseFile (gif
);
12444 /* Maybe fill in the background field while we have ximg handy. */
12445 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12446 IMAGE_BACKGROUND (img
, f
, ximg
);
12448 /* Put the image into the pixmap, then free the X image and its buffer. */
12449 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12450 x_destroy_x_image (ximg
);
12456 #endif /* HAVE_GIF != 0 */
12460 /***********************************************************************
12462 ***********************************************************************/
12464 Lisp_Object Qpostscript
;
12466 #ifdef HAVE_GHOSTSCRIPT
12467 static int gs_image_p
P_ ((Lisp_Object object
));
12468 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
12469 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
12471 /* The symbol `postscript' identifying images of this type. */
12473 /* Keyword symbols. */
12475 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
12477 /* Indices of image specification fields in gs_format, below. */
12479 enum gs_keyword_index
12497 /* Vector of image_keyword structures describing the format
12498 of valid user-defined image specifications. */
12500 static struct image_keyword gs_format
[GS_LAST
] =
12502 {":type", IMAGE_SYMBOL_VALUE
, 1},
12503 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12504 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12505 {":file", IMAGE_STRING_VALUE
, 1},
12506 {":loader", IMAGE_FUNCTION_VALUE
, 0},
12507 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
12508 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
12509 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12510 {":relief", IMAGE_INTEGER_VALUE
, 0},
12511 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12512 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12513 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12514 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12517 /* Structure describing the image type `ghostscript'. */
12519 static struct image_type gs_type
=
12529 /* Free X resources of Ghostscript image IMG which is used on frame F. */
12532 gs_clear_image (f
, img
)
12536 /* IMG->data.ptr_val may contain a recorded colormap. */
12537 xfree (img
->data
.ptr_val
);
12538 x_clear_image (f
, img
);
12542 /* Return non-zero if OBJECT is a valid Ghostscript image
12546 gs_image_p (object
)
12547 Lisp_Object object
;
12549 struct image_keyword fmt
[GS_LAST
];
12553 bcopy (gs_format
, fmt
, sizeof fmt
);
12555 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
12556 || (fmt
[GS_ASCENT
].count
12557 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
12560 /* Bounding box must be a list or vector containing 4 integers. */
12561 tem
= fmt
[GS_BOUNDING_BOX
].value
;
12564 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
12565 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
12570 else if (VECTORP (tem
))
12572 if (XVECTOR (tem
)->size
!= 4)
12574 for (i
= 0; i
< 4; ++i
)
12575 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
12585 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
12594 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
12595 struct gcpro gcpro1
, gcpro2
;
12597 double in_width
, in_height
;
12598 Lisp_Object pixel_colors
= Qnil
;
12600 /* Compute pixel size of pixmap needed from the given size in the
12601 image specification. Sizes in the specification are in pt. 1 pt
12602 = 1/72 in, xdpi and ydpi are stored in the frame's X display
12604 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
12605 in_width
= XFASTINT (pt_width
) / 72.0;
12606 img
->width
= in_width
* FRAME_W32_DISPLAY_INFO (f
)->resx
;
12607 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
12608 in_height
= XFASTINT (pt_height
) / 72.0;
12609 img
->height
= in_height
* FRAME_W32_DISPLAY_INFO (f
)->resy
;
12611 /* Create the pixmap. */
12613 xassert (img
->pixmap
== 0);
12614 img
->pixmap
= XCreatePixmap (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12615 img
->width
, img
->height
,
12616 one_w32_display_info
.n_cbits
);
12621 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
12625 /* Call the loader to fill the pixmap. It returns a process object
12626 if successful. We do not record_unwind_protect here because
12627 other places in redisplay like calling window scroll functions
12628 don't either. Let the Lisp loader use `unwind-protect' instead. */
12629 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
12631 sprintf (buffer
, "%lu %lu",
12632 (unsigned long) FRAME_W32_WINDOW (f
),
12633 (unsigned long) img
->pixmap
);
12634 window_and_pixmap_id
= build_string (buffer
);
12636 sprintf (buffer
, "%lu %lu",
12637 FRAME_FOREGROUND_PIXEL (f
),
12638 FRAME_BACKGROUND_PIXEL (f
));
12639 pixel_colors
= build_string (buffer
);
12641 XSETFRAME (frame
, f
);
12642 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
12644 loader
= intern ("gs-load-image");
12646 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
12647 make_number (img
->width
),
12648 make_number (img
->height
),
12649 window_and_pixmap_id
,
12652 return PROCESSP (img
->data
.lisp_val
);
12656 /* Kill the Ghostscript process that was started to fill PIXMAP on
12657 frame F. Called from XTread_socket when receiving an event
12658 telling Emacs that Ghostscript has finished drawing. */
12661 x_kill_gs_process (pixmap
, f
)
12665 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
12669 /* Find the image containing PIXMAP. */
12670 for (i
= 0; i
< c
->used
; ++i
)
12671 if (c
->images
[i
]->pixmap
== pixmap
)
12674 /* Should someone in between have cleared the image cache, for
12675 instance, give up. */
12679 /* Kill the GS process. We should have found PIXMAP in the image
12680 cache and its image should contain a process object. */
12681 img
= c
->images
[i
];
12682 xassert (PROCESSP (img
->data
.lisp_val
));
12683 Fkill_process (img
->data
.lisp_val
, Qnil
);
12684 img
->data
.lisp_val
= Qnil
;
12686 /* On displays with a mutable colormap, figure out the colors
12687 allocated for the image by looking at the pixels of an XImage for
12689 class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
12690 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
12696 /* Try to get an XImage for img->pixmep. */
12697 ximg
= XGetImage (FRAME_W32_DISPLAY (f
), img
->pixmap
,
12698 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
12703 /* Initialize the color table. */
12704 init_color_table ();
12706 /* For each pixel of the image, look its color up in the
12707 color table. After having done so, the color table will
12708 contain an entry for each color used by the image. */
12709 for (y
= 0; y
< img
->height
; ++y
)
12710 for (x
= 0; x
< img
->width
; ++x
)
12712 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
12713 lookup_pixel_color (f
, pixel
);
12716 /* Record colors in the image. Free color table and XImage. */
12717 img
->colors
= colors_in_color_table (&img
->ncolors
);
12718 free_color_table ();
12719 XDestroyImage (ximg
);
12721 #if 0 /* This doesn't seem to be the case. If we free the colors
12722 here, we get a BadAccess later in x_clear_image when
12723 freeing the colors. */
12724 /* We have allocated colors once, but Ghostscript has also
12725 allocated colors on behalf of us. So, to get the
12726 reference counts right, free them once. */
12728 x_free_colors (FRAME_W32_DISPLAY (f
), cmap
,
12729 img
->colors
, img
->ncolors
, 0);
12733 image_error ("Cannot get X image of `%s'; colors will not be freed",
12739 /* Now that we have the pixmap, compute mask and transform the
12740 image if requested. */
12742 postprocess_image (f
, img
);
12746 #endif /* HAVE_GHOSTSCRIPT */
12749 /***********************************************************************
12751 ***********************************************************************/
12753 DEFUN ("x-change-window-property", Fx_change_window_property
,
12754 Sx_change_window_property
, 2, 3, 0,
12755 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
12756 PROP and VALUE must be strings. FRAME nil or omitted means use the
12757 selected frame. Value is VALUE. */)
12758 (prop
, value
, frame
)
12759 Lisp_Object frame
, prop
, value
;
12761 #if 0 /* TODO : port window properties to W32 */
12762 struct frame
*f
= check_x_frame (frame
);
12765 CHECK_STRING (prop
);
12766 CHECK_STRING (value
);
12769 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12770 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12771 prop_atom
, XA_STRING
, 8, PropModeReplace
,
12772 XSTRING (value
)->data
, XSTRING (value
)->size
);
12774 /* Make sure the property is set when we return. */
12775 XFlush (FRAME_W32_DISPLAY (f
));
12784 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
12785 Sx_delete_window_property
, 1, 2, 0,
12786 doc
: /* Remove window property PROP from X window of FRAME.
12787 FRAME nil or omitted means use the selected frame. Value is PROP. */)
12789 Lisp_Object prop
, frame
;
12791 #if 0 /* TODO : port window properties to W32 */
12793 struct frame
*f
= check_x_frame (frame
);
12796 CHECK_STRING (prop
);
12798 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12799 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
12801 /* Make sure the property is removed when we return. */
12802 XFlush (FRAME_W32_DISPLAY (f
));
12810 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
12812 doc
: /* Value is the value of window property PROP on FRAME.
12813 If FRAME is nil or omitted, use the selected frame. Value is nil
12814 if FRAME hasn't a property with name PROP or if PROP has no string
12817 Lisp_Object prop
, frame
;
12819 #if 0 /* TODO : port window properties to W32 */
12821 struct frame
*f
= check_x_frame (frame
);
12824 Lisp_Object prop_value
= Qnil
;
12825 char *tmp_data
= NULL
;
12828 unsigned long actual_size
, bytes_remaining
;
12830 CHECK_STRING (prop
);
12832 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12833 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12834 prop_atom
, 0, 0, False
, XA_STRING
,
12835 &actual_type
, &actual_format
, &actual_size
,
12836 &bytes_remaining
, (unsigned char **) &tmp_data
);
12839 int size
= bytes_remaining
;
12844 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12845 prop_atom
, 0, bytes_remaining
,
12847 &actual_type
, &actual_format
,
12848 &actual_size
, &bytes_remaining
,
12849 (unsigned char **) &tmp_data
);
12851 prop_value
= make_string (tmp_data
, size
);
12866 /***********************************************************************
12868 ***********************************************************************/
12870 /* If non-null, an asynchronous timer that, when it expires, displays
12871 an hourglass cursor on all frames. */
12873 static struct atimer
*hourglass_atimer
;
12875 /* Non-zero means an hourglass cursor is currently shown. */
12877 static int hourglass_shown_p
;
12879 /* Number of seconds to wait before displaying an hourglass cursor. */
12881 static Lisp_Object Vhourglass_delay
;
12883 /* Default number of seconds to wait before displaying an hourglass
12886 #define DEFAULT_HOURGLASS_DELAY 1
12888 /* Function prototypes. */
12890 static void show_hourglass
P_ ((struct atimer
*));
12891 static void hide_hourglass
P_ ((void));
12894 /* Cancel a currently active hourglass timer, and start a new one. */
12899 #if 0 /* TODO: cursor shape changes. */
12901 int secs
, usecs
= 0;
12903 cancel_hourglass ();
12905 if (INTEGERP (Vhourglass_delay
)
12906 && XINT (Vhourglass_delay
) > 0)
12907 secs
= XFASTINT (Vhourglass_delay
);
12908 else if (FLOATP (Vhourglass_delay
)
12909 && XFLOAT_DATA (Vhourglass_delay
) > 0)
12912 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
12913 secs
= XFASTINT (tem
);
12914 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
12917 secs
= DEFAULT_HOURGLASS_DELAY
;
12919 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
12920 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
12921 show_hourglass
, NULL
);
12926 /* Cancel the hourglass cursor timer if active, hide an hourglass
12927 cursor if shown. */
12930 cancel_hourglass ()
12932 if (hourglass_atimer
)
12934 cancel_atimer (hourglass_atimer
);
12935 hourglass_atimer
= NULL
;
12938 if (hourglass_shown_p
)
12943 /* Timer function of hourglass_atimer. TIMER is equal to
12946 Display an hourglass cursor on all frames by mapping the frames'
12947 hourglass_window. Set the hourglass_p flag in the frames'
12948 output_data.x structure to indicate that an hourglass cursor is
12949 shown on the frames. */
12952 show_hourglass (timer
)
12953 struct atimer
*timer
;
12955 #if 0 /* TODO: cursor shape changes. */
12956 /* The timer implementation will cancel this timer automatically
12957 after this function has run. Set hourglass_atimer to null
12958 so that we know the timer doesn't have to be canceled. */
12959 hourglass_atimer
= NULL
;
12961 if (!hourglass_shown_p
)
12963 Lisp_Object rest
, frame
;
12967 FOR_EACH_FRAME (rest
, frame
)
12968 if (FRAME_W32_P (XFRAME (frame
)))
12970 struct frame
*f
= XFRAME (frame
);
12972 f
->output_data
.w32
->hourglass_p
= 1;
12974 if (!f
->output_data
.w32
->hourglass_window
)
12976 unsigned long mask
= CWCursor
;
12977 XSetWindowAttributes attrs
;
12979 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
12981 f
->output_data
.w32
->hourglass_window
12982 = XCreateWindow (FRAME_X_DISPLAY (f
),
12983 FRAME_OUTER_WINDOW (f
),
12984 0, 0, 32000, 32000, 0, 0,
12990 XMapRaised (FRAME_X_DISPLAY (f
),
12991 f
->output_data
.w32
->hourglass_window
);
12992 XFlush (FRAME_X_DISPLAY (f
));
12995 hourglass_shown_p
= 1;
13002 /* Hide the hourglass cursor on all frames, if it is currently shown. */
13007 #if 0 /* TODO: cursor shape changes. */
13008 if (hourglass_shown_p
)
13010 Lisp_Object rest
, frame
;
13013 FOR_EACH_FRAME (rest
, frame
)
13015 struct frame
*f
= XFRAME (frame
);
13017 if (FRAME_W32_P (f
)
13018 /* Watch out for newly created frames. */
13019 && f
->output_data
.x
->hourglass_window
)
13021 XUnmapWindow (FRAME_X_DISPLAY (f
),
13022 f
->output_data
.x
->hourglass_window
);
13023 /* Sync here because XTread_socket looks at the
13024 hourglass_p flag that is reset to zero below. */
13025 XSync (FRAME_X_DISPLAY (f
), False
);
13026 f
->output_data
.x
->hourglass_p
= 0;
13030 hourglass_shown_p
= 0;
13038 /***********************************************************************
13040 ***********************************************************************/
13042 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
13043 Lisp_Object
, Lisp_Object
));
13044 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
13045 Lisp_Object
, int, int, int *, int *));
13047 /* The frame of a currently visible tooltip. */
13049 Lisp_Object tip_frame
;
13051 /* If non-nil, a timer started that hides the last tooltip when it
13054 Lisp_Object tip_timer
;
13057 /* If non-nil, a vector of 3 elements containing the last args
13058 with which x-show-tip was called. See there. */
13060 Lisp_Object last_show_tip_args
;
13062 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
13064 Lisp_Object Vx_max_tooltip_size
;
13068 unwind_create_tip_frame (frame
)
13071 Lisp_Object deleted
;
13073 deleted
= unwind_create_frame (frame
);
13074 if (EQ (deleted
, Qt
))
13084 /* Create a frame for a tooltip on the display described by DPYINFO.
13085 PARMS is a list of frame parameters. TEXT is the string to
13086 display in the tip frame. Value is the frame.
13088 Note that functions called here, esp. x_default_parameter can
13089 signal errors, for instance when a specified color name is
13090 undefined. We have to make sure that we're in a consistent state
13091 when this happens. */
13094 x_create_tip_frame (dpyinfo
, parms
, text
)
13095 struct w32_display_info
*dpyinfo
;
13096 Lisp_Object parms
, text
;
13099 Lisp_Object frame
, tem
;
13101 long window_prompting
= 0;
13103 int count
= BINDING_STACK_SIZE ();
13104 struct gcpro gcpro1
, gcpro2
, gcpro3
;
13106 int face_change_count_before
= face_change_count
;
13107 Lisp_Object buffer
;
13108 struct buffer
*old_buffer
;
13112 /* Use this general default value to start with until we know if
13113 this frame has a specified name. */
13114 Vx_resource_name
= Vinvocation_name
;
13116 #ifdef MULTI_KBOARD
13117 kb
= dpyinfo
->kboard
;
13119 kb
= &the_only_kboard
;
13122 /* Get the name of the frame to use for resource lookup. */
13123 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
13124 if (!STRINGP (name
)
13125 && !EQ (name
, Qunbound
)
13127 error ("Invalid frame name--not a string or nil");
13128 Vx_resource_name
= name
;
13131 GCPRO3 (parms
, name
, frame
);
13132 f
= make_frame (1);
13133 XSETFRAME (frame
, f
);
13135 buffer
= Fget_buffer_create (build_string (" *tip*"));
13136 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
13137 old_buffer
= current_buffer
;
13138 set_buffer_internal_1 (XBUFFER (buffer
));
13139 current_buffer
->truncate_lines
= Qnil
;
13141 Finsert (1, &text
);
13142 set_buffer_internal_1 (old_buffer
);
13144 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
13145 record_unwind_protect (unwind_create_tip_frame
, frame
);
13147 /* By setting the output method, we're essentially saying that
13148 the frame is live, as per FRAME_LIVE_P. If we get a signal
13149 from this point on, x_destroy_window might screw up reference
13151 f
->output_method
= output_w32
;
13152 f
->output_data
.w32
=
13153 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
13154 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
13156 FRAME_FONTSET (f
) = -1;
13157 f
->icon_name
= Qnil
;
13159 #if 0 /* GLYPH_DEBUG TODO: image support. */
13160 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
13161 dpyinfo_refcount
= dpyinfo
->reference_count
;
13162 #endif /* GLYPH_DEBUG */
13163 #ifdef MULTI_KBOARD
13164 FRAME_KBOARD (f
) = kb
;
13166 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
13167 f
->output_data
.w32
->explicit_parent
= 0;
13169 /* Set the name; the functions to which we pass f expect the name to
13171 if (EQ (name
, Qunbound
) || NILP (name
))
13173 f
->name
= build_string (dpyinfo
->w32_id_name
);
13174 f
->explicit_name
= 0;
13179 f
->explicit_name
= 1;
13180 /* use the frame's title when getting resources for this frame. */
13181 specbind (Qx_resource_name
, name
);
13184 /* Extract the window parameters from the supplied values
13185 that are needed to determine window geometry. */
13189 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
13192 /* First, try whatever font the caller has specified. */
13193 if (STRINGP (font
))
13195 tem
= Fquery_fontset (font
, Qnil
);
13197 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
13199 font
= x_new_font (f
, XSTRING (font
)->data
);
13202 /* Try out a font which we hope has bold and italic variations. */
13203 if (!STRINGP (font
))
13204 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
13205 if (! STRINGP (font
))
13206 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
13207 /* If those didn't work, look for something which will at least work. */
13208 if (! STRINGP (font
))
13209 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
13211 if (! STRINGP (font
))
13212 font
= build_string ("Fixedsys");
13214 x_default_parameter (f
, parms
, Qfont
, font
,
13215 "font", "Font", RES_TYPE_STRING
);
13218 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
13219 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
13220 /* This defaults to 2 in order to match xterm. We recognize either
13221 internalBorderWidth or internalBorder (which is what xterm calls
13223 if (NILP (Fassq (Qinternal_border_width
, parms
)))
13227 value
= w32_get_arg (parms
, Qinternal_border_width
,
13228 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
13229 if (! EQ (value
, Qunbound
))
13230 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
13233 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
13234 "internalBorderWidth", "internalBorderWidth",
13237 /* Also do the stuff which must be set before the window exists. */
13238 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
13239 "foreground", "Foreground", RES_TYPE_STRING
);
13240 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
13241 "background", "Background", RES_TYPE_STRING
);
13242 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
13243 "pointerColor", "Foreground", RES_TYPE_STRING
);
13244 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
13245 "cursorColor", "Foreground", RES_TYPE_STRING
);
13246 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
13247 "borderColor", "BorderColor", RES_TYPE_STRING
);
13249 /* Init faces before x_default_parameter is called for scroll-bar
13250 parameters because that function calls x_set_scroll_bar_width,
13251 which calls change_frame_size, which calls Fset_window_buffer,
13252 which runs hooks, which call Fvertical_motion. At the end, we
13253 end up in init_iterator with a null face cache, which should not
13255 init_frame_faces (f
);
13257 f
->output_data
.w32
->dwStyle
= WS_BORDER
| WS_POPUP
| WS_DISABLED
;
13258 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
13259 window_prompting
= x_figure_window_size (f
, parms
);
13261 if (window_prompting
& XNegative
)
13263 if (window_prompting
& YNegative
)
13264 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
13266 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
13270 if (window_prompting
& YNegative
)
13271 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
13273 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
13276 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
13279 my_create_tip_window (f
);
13284 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
13285 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
13286 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
13287 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
13288 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
13289 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
13291 /* Dimensions, especially f->height, must be done via change_frame_size.
13292 Change will not be effected unless different from the current
13295 height
= f
->height
;
13297 SET_FRAME_WIDTH (f
, 0);
13298 change_frame_size (f
, height
, width
, 1, 0, 0);
13300 /* Set up faces after all frame parameters are known. This call
13301 also merges in face attributes specified for new frames.
13303 Frame parameters may be changed if .Xdefaults contains
13304 specifications for the default font. For example, if there is an
13305 `Emacs.default.attributeBackground: pink', the `background-color'
13306 attribute of the frame get's set, which let's the internal border
13307 of the tooltip frame appear in pink. Prevent this. */
13309 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
13311 /* Set tip_frame here, so that */
13313 call1 (Qface_set_after_frame_default
, frame
);
13315 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
13316 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
13324 /* It is now ok to make the frame official even if we get an error
13325 below. And the frame needs to be on Vframe_list or making it
13326 visible won't work. */
13327 Vframe_list
= Fcons (frame
, Vframe_list
);
13329 /* Now that the frame is official, it counts as a reference to
13331 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
13333 /* Setting attributes of faces of the tooltip frame from resources
13334 and similar will increment face_change_count, which leads to the
13335 clearing of all current matrices. Since this isn't necessary
13336 here, avoid it by resetting face_change_count to the value it
13337 had before we created the tip frame. */
13338 face_change_count
= face_change_count_before
;
13340 /* Discard the unwind_protect. */
13341 return unbind_to (count
, frame
);
13345 /* Compute where to display tip frame F. PARMS is the list of frame
13346 parameters for F. DX and DY are specified offsets from the current
13347 location of the mouse. WIDTH and HEIGHT are the width and height
13348 of the tooltip. Return coordinates relative to the root window of
13349 the display in *ROOT_X, and *ROOT_Y. */
13352 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
13354 Lisp_Object parms
, dx
, dy
;
13356 int *root_x
, *root_y
;
13358 Lisp_Object left
, top
;
13360 /* User-specified position? */
13361 left
= Fcdr (Fassq (Qleft
, parms
));
13362 top
= Fcdr (Fassq (Qtop
, parms
));
13364 /* Move the tooltip window where the mouse pointer is. Resize and
13366 if (!INTEGERP (left
) || !INTEGERP (top
))
13371 GetCursorPos (&pt
);
13377 if (INTEGERP (top
))
13378 *root_y
= XINT (top
);
13379 else if (*root_y
+ XINT (dy
) - height
< 0)
13380 *root_y
-= XINT (dy
);
13384 *root_y
+= XINT (dy
);
13387 if (INTEGERP (left
))
13388 *root_x
= XINT (left
);
13389 else if (*root_x
+ XINT (dx
) + width
> FRAME_W32_DISPLAY_INFO (f
)->width
)
13390 *root_x
-= width
+ XINT (dx
);
13392 *root_x
+= XINT (dx
);
13396 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
13397 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
13398 A tooltip window is a small window displaying a string.
13400 FRAME nil or omitted means use the selected frame.
13402 PARMS is an optional list of frame parameters which can be
13403 used to change the tooltip's appearance.
13405 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
13406 means use the default timeout of 5 seconds.
13408 If the list of frame parameters PARAMS contains a `left' parameter,
13409 the tooltip is displayed at that x-position. Otherwise it is
13410 displayed at the mouse position, with offset DX added (default is 5 if
13411 DX isn't specified). Likewise for the y-position; if a `top' frame
13412 parameter is specified, it determines the y-position of the tooltip
13413 window, otherwise it is displayed at the mouse position, with offset
13414 DY added (default is -10).
13416 A tooltip's maximum size is specified by `x-max-tooltip-size'.
13417 Text larger than the specified size is clipped. */)
13418 (string
, frame
, parms
, timeout
, dx
, dy
)
13419 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
13423 int root_x
, root_y
;
13424 struct buffer
*old_buffer
;
13425 struct text_pos pos
;
13426 int i
, width
, height
;
13427 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
13428 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
13429 int count
= BINDING_STACK_SIZE ();
13431 specbind (Qinhibit_redisplay
, Qt
);
13433 GCPRO4 (string
, parms
, frame
, timeout
);
13435 CHECK_STRING (string
);
13436 f
= check_x_frame (frame
);
13437 if (NILP (timeout
))
13438 timeout
= make_number (5);
13440 CHECK_NATNUM (timeout
);
13443 dx
= make_number (5);
13448 dy
= make_number (-10);
13452 if (NILP (last_show_tip_args
))
13453 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
13455 if (!NILP (tip_frame
))
13457 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
13458 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
13459 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
13461 if (EQ (frame
, last_frame
)
13462 && !NILP (Fequal (last_string
, string
))
13463 && !NILP (Fequal (last_parms
, parms
)))
13465 struct frame
*f
= XFRAME (tip_frame
);
13467 /* Only DX and DY have changed. */
13468 if (!NILP (tip_timer
))
13470 Lisp_Object timer
= tip_timer
;
13472 call1 (Qcancel_timer
, timer
);
13476 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
13477 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
13478 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
13479 root_x
, root_y
, 0, 0,
13480 SWP_NOSIZE
| SWP_NOACTIVATE
);
13486 /* Hide a previous tip, if any. */
13489 ASET (last_show_tip_args
, 0, string
);
13490 ASET (last_show_tip_args
, 1, frame
);
13491 ASET (last_show_tip_args
, 2, parms
);
13493 /* Add default values to frame parameters. */
13494 if (NILP (Fassq (Qname
, parms
)))
13495 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
13496 if (NILP (Fassq (Qinternal_border_width
, parms
)))
13497 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
13498 if (NILP (Fassq (Qborder_width
, parms
)))
13499 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
13500 if (NILP (Fassq (Qborder_color
, parms
)))
13501 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
13502 if (NILP (Fassq (Qbackground_color
, parms
)))
13503 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
13506 /* Block input until the tip has been fully drawn, to avoid crashes
13507 when drawing tips in menus. */
13510 /* Create a frame for the tooltip, and record it in the global
13511 variable tip_frame. */
13512 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
, string
);
13513 f
= XFRAME (frame
);
13515 /* Set up the frame's root window. */
13516 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
13517 w
->left
= w
->top
= make_number (0);
13519 if (CONSP (Vx_max_tooltip_size
)
13520 && INTEGERP (XCAR (Vx_max_tooltip_size
))
13521 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
13522 && INTEGERP (XCDR (Vx_max_tooltip_size
))
13523 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
13525 w
->width
= XCAR (Vx_max_tooltip_size
);
13526 w
->height
= XCDR (Vx_max_tooltip_size
);
13530 w
->width
= make_number (80);
13531 w
->height
= make_number (40);
13534 f
->window_width
= XINT (w
->width
);
13536 w
->pseudo_window_p
= 1;
13538 /* Display the tooltip text in a temporary buffer. */
13539 old_buffer
= current_buffer
;
13540 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
13541 current_buffer
->truncate_lines
= Qnil
;
13542 clear_glyph_matrix (w
->desired_matrix
);
13543 clear_glyph_matrix (w
->current_matrix
);
13544 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
13545 try_window (FRAME_ROOT_WINDOW (f
), pos
);
13547 /* Compute width and height of the tooltip. */
13548 width
= height
= 0;
13549 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
13551 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
13552 struct glyph
*last
;
13555 /* Stop at the first empty row at the end. */
13556 if (!row
->enabled_p
|| !row
->displays_text_p
)
13559 /* Let the row go over the full width of the frame. */
13560 row
->full_width_p
= 1;
13562 #ifdef TODO /* Investigate why some fonts need more width than is
13563 calculated for some tooltips. */
13564 /* There's a glyph at the end of rows that is use to place
13565 the cursor there. Don't include the width of this glyph. */
13566 if (row
->used
[TEXT_AREA
])
13568 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
13569 row_width
= row
->pixel_width
- last
->pixel_width
;
13573 row_width
= row
->pixel_width
;
13575 /* TODO: find why tips do not draw along baseline as instructed. */
13576 height
+= row
->height
;
13577 width
= max (width
, row_width
);
13580 /* Add the frame's internal border to the width and height the X
13581 window should have. */
13582 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13583 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13585 /* Move the tooltip window where the mouse pointer is. Resize and
13587 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
13590 /* Adjust Window size to take border into account. */
13592 rect
.left
= rect
.top
= 0;
13593 rect
.right
= width
;
13594 rect
.bottom
= height
;
13595 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
13596 FRAME_EXTERNAL_MENU_BAR (f
));
13598 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
13599 root_x
, root_y
, rect
.right
- rect
.left
,
13600 rect
.bottom
- rect
.top
, SWP_NOACTIVATE
);
13602 /* Let redisplay know that we have made the frame visible already. */
13603 f
->async_visible
= 1;
13605 ShowWindow (FRAME_W32_WINDOW (f
), SW_SHOWNOACTIVATE
);
13608 /* Draw into the window. */
13609 w
->must_be_updated_p
= 1;
13610 update_single_window (w
, 1);
13614 /* Restore original current buffer. */
13615 set_buffer_internal_1 (old_buffer
);
13616 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
13619 /* Let the tip disappear after timeout seconds. */
13620 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
13621 intern ("x-hide-tip"));
13624 return unbind_to (count
, Qnil
);
13628 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
13629 doc
: /* Hide the current tooltip window, if there is any.
13630 Value is t if tooltip was open, nil otherwise. */)
13634 Lisp_Object deleted
, frame
, timer
;
13635 struct gcpro gcpro1
, gcpro2
;
13637 /* Return quickly if nothing to do. */
13638 if (NILP (tip_timer
) && NILP (tip_frame
))
13643 GCPRO2 (frame
, timer
);
13644 tip_frame
= tip_timer
= deleted
= Qnil
;
13646 count
= BINDING_STACK_SIZE ();
13647 specbind (Qinhibit_redisplay
, Qt
);
13648 specbind (Qinhibit_quit
, Qt
);
13651 call1 (Qcancel_timer
, timer
);
13653 if (FRAMEP (frame
))
13655 Fdelete_frame (frame
, Qnil
);
13660 return unbind_to (count
, deleted
);
13665 /***********************************************************************
13666 File selection dialog
13667 ***********************************************************************/
13669 extern Lisp_Object Qfile_name_history
;
13671 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
13672 doc
: /* Read file name, prompting with PROMPT in directory DIR.
13673 Use a file selection dialog.
13674 Select DEFAULT-FILENAME in the dialog's file selection box, if
13675 specified. Ensure that file exists if MUSTMATCH is non-nil. */)
13676 (prompt
, dir
, default_filename
, mustmatch
)
13677 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
13679 struct frame
*f
= SELECTED_FRAME ();
13680 Lisp_Object file
= Qnil
;
13681 int count
= specpdl_ptr
- specpdl
;
13682 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
13683 char filename
[MAX_PATH
+ 1];
13684 char init_dir
[MAX_PATH
+ 1];
13685 int use_dialog_p
= 1;
13687 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
13688 CHECK_STRING (prompt
);
13689 CHECK_STRING (dir
);
13691 /* Create the dialog with PROMPT as title, using DIR as initial
13692 directory and using "*" as pattern. */
13693 dir
= Fexpand_file_name (dir
, Qnil
);
13694 strncpy (init_dir
, XSTRING (dir
)->data
, MAX_PATH
);
13695 init_dir
[MAX_PATH
] = '\0';
13696 unixtodos_filename (init_dir
);
13698 if (STRINGP (default_filename
))
13700 char *file_name_only
;
13701 char *full_path_name
= XSTRING (default_filename
)->data
;
13703 unixtodos_filename (full_path_name
);
13705 file_name_only
= strrchr (full_path_name
, '\\');
13706 if (!file_name_only
)
13707 file_name_only
= full_path_name
;
13712 /* If default_file_name is a directory, don't use the open
13713 file dialog, as it does not support selecting
13715 if (!(*file_name_only
))
13719 strncpy (filename
, file_name_only
, MAX_PATH
);
13720 filename
[MAX_PATH
] = '\0';
13723 filename
[0] = '\0';
13727 OPENFILENAME file_details
;
13729 /* Prevent redisplay. */
13730 specbind (Qinhibit_redisplay
, Qt
);
13733 bzero (&file_details
, sizeof (file_details
));
13734 file_details
.lStructSize
= sizeof (file_details
);
13735 file_details
.hwndOwner
= FRAME_W32_WINDOW (f
);
13736 /* Undocumented Bug in Common File Dialog:
13737 If a filter is not specified, shell links are not resolved. */
13738 file_details
.lpstrFilter
= "ALL Files (*.*)\0*.*\0\0";
13739 file_details
.lpstrFile
= filename
;
13740 file_details
.nMaxFile
= sizeof (filename
);
13741 file_details
.lpstrInitialDir
= init_dir
;
13742 file_details
.lpstrTitle
= XSTRING (prompt
)->data
;
13743 file_details
.Flags
= OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
;
13745 if (!NILP (mustmatch
))
13746 file_details
.Flags
|= OFN_FILEMUSTEXIST
| OFN_PATHMUSTEXIST
;
13748 if (GetOpenFileName (&file_details
))
13750 dostounix_filename (filename
);
13751 file
= build_string (filename
);
13757 file
= unbind_to (count
, file
);
13759 /* Open File dialog will not allow folders to be selected, so resort
13760 to minibuffer completing reads for directories. */
13762 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
13763 dir
, mustmatch
, dir
, Qfile_name_history
,
13764 default_filename
, Qnil
);
13768 /* Make "Cancel" equivalent to C-g. */
13770 Fsignal (Qquit
, Qnil
);
13772 return unbind_to (count
, file
);
13777 /***********************************************************************
13778 w32 specialized functions
13779 ***********************************************************************/
13781 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
13782 doc
: /* Select a font using the W32 font dialog.
13783 Returns an X font string corresponding to the selection. */)
13787 FRAME_PTR f
= check_x_frame (frame
);
13795 bzero (&cf
, sizeof (cf
));
13796 bzero (&lf
, sizeof (lf
));
13798 cf
.lStructSize
= sizeof (cf
);
13799 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
13800 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
13801 cf
.lpLogFont
= &lf
;
13803 /* Initialize as much of the font details as we can from the current
13805 hdc
= GetDC (FRAME_W32_WINDOW (f
));
13806 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
13807 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
13808 if (GetTextMetrics (hdc
, &tm
))
13810 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
13811 lf
.lfWeight
= tm
.tmWeight
;
13812 lf
.lfItalic
= tm
.tmItalic
;
13813 lf
.lfUnderline
= tm
.tmUnderlined
;
13814 lf
.lfStrikeOut
= tm
.tmStruckOut
;
13815 lf
.lfCharSet
= tm
.tmCharSet
;
13816 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
13818 SelectObject (hdc
, oldobj
);
13819 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
13821 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
13824 return build_string (buf
);
13827 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
13828 Sw32_send_sys_command
, 1, 2, 0,
13829 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
13830 Some useful values for command are 0xf030 to maximise frame (0xf020
13831 to minimize), 0xf120 to restore frame to original size, and 0xf100
13832 to activate the menubar for keyboard access. 0xf140 activates the
13833 screen saver if defined.
13835 If optional parameter FRAME is not specified, use selected frame. */)
13837 Lisp_Object command
, frame
;
13839 FRAME_PTR f
= check_x_frame (frame
);
13841 CHECK_NUMBER (command
);
13843 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
13848 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
13849 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
13850 This is a wrapper around the ShellExecute system function, which
13851 invokes the application registered to handle OPERATION for DOCUMENT.
13852 OPERATION is typically \"open\", \"print\" or \"explore\" (but can be
13853 nil for the default action), and DOCUMENT is typically the name of a
13854 document file or URL, but can also be a program executable to run or
13855 a directory to open in the Windows Explorer.
13857 If DOCUMENT is a program executable, PARAMETERS can be a string
13858 containing command line parameters, but otherwise should be nil.
13860 SHOW-FLAG can be used to control whether the invoked application is hidden
13861 or minimized. If SHOW-FLAG is nil, the application is displayed normally,
13862 otherwise it is an integer representing a ShowWindow flag:
13866 3 - start maximized
13867 6 - start minimized */)
13868 (operation
, document
, parameters
, show_flag
)
13869 Lisp_Object operation
, document
, parameters
, show_flag
;
13871 Lisp_Object current_dir
;
13873 CHECK_STRING (document
);
13875 /* Encode filename and current directory. */
13876 current_dir
= ENCODE_FILE (current_buffer
->directory
);
13877 document
= ENCODE_FILE (document
);
13878 if ((int) ShellExecute (NULL
,
13879 (STRINGP (operation
) ?
13880 XSTRING (operation
)->data
: NULL
),
13881 XSTRING (document
)->data
,
13882 (STRINGP (parameters
) ?
13883 XSTRING (parameters
)->data
: NULL
),
13884 XSTRING (current_dir
)->data
,
13885 (INTEGERP (show_flag
) ?
13886 XINT (show_flag
) : SW_SHOWDEFAULT
))
13889 error ("ShellExecute failed: %s", w32_strerror (0));
13892 /* Lookup virtual keycode from string representing the name of a
13893 non-ascii keystroke into the corresponding virtual key, using
13894 lispy_function_keys. */
13896 lookup_vk_code (char *key
)
13900 for (i
= 0; i
< 256; i
++)
13901 if (lispy_function_keys
[i
] != 0
13902 && strcmp (lispy_function_keys
[i
], key
) == 0)
13908 /* Convert a one-element vector style key sequence to a hot key
13911 w32_parse_hot_key (key
)
13914 /* Copied from Fdefine_key and store_in_keymap. */
13915 register Lisp_Object c
;
13917 int lisp_modifiers
;
13919 struct gcpro gcpro1
;
13921 CHECK_VECTOR (key
);
13923 if (XFASTINT (Flength (key
)) != 1)
13928 c
= Faref (key
, make_number (0));
13930 if (CONSP (c
) && lucid_event_type_list_p (c
))
13931 c
= Fevent_convert_list (c
);
13935 if (! INTEGERP (c
) && ! SYMBOLP (c
))
13936 error ("Key definition is invalid");
13938 /* Work out the base key and the modifiers. */
13941 c
= parse_modifiers (c
);
13942 lisp_modifiers
= Fcar (Fcdr (c
));
13946 vk_code
= lookup_vk_code (XSYMBOL (c
)->name
->data
);
13948 else if (INTEGERP (c
))
13950 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
13951 /* Many ascii characters are their own virtual key code. */
13952 vk_code
= XINT (c
) & CHARACTERBITS
;
13955 if (vk_code
< 0 || vk_code
> 255)
13958 if ((lisp_modifiers
& meta_modifier
) != 0
13959 && !NILP (Vw32_alt_is_meta
))
13960 lisp_modifiers
|= alt_modifier
;
13962 /* Supply defs missing from mingw32. */
13964 #define MOD_ALT 0x0001
13965 #define MOD_CONTROL 0x0002
13966 #define MOD_SHIFT 0x0004
13967 #define MOD_WIN 0x0008
13970 /* Convert lisp modifiers to Windows hot-key form. */
13971 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
13972 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
13973 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
13974 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
13976 return HOTKEY (vk_code
, w32_modifiers
);
13979 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
13980 Sw32_register_hot_key
, 1, 1, 0,
13981 doc
: /* Register KEY as a hot-key combination.
13982 Certain key combinations like Alt-Tab are reserved for system use on
13983 Windows, and therefore are normally intercepted by the system. However,
13984 most of these key combinations can be received by registering them as
13985 hot-keys, overriding their special meaning.
13987 KEY must be a one element key definition in vector form that would be
13988 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
13989 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
13990 is always interpreted as the Windows modifier keys.
13992 The return value is the hotkey-id if registered, otherwise nil. */)
13996 key
= w32_parse_hot_key (key
);
13998 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
14000 /* Reuse an empty slot if possible. */
14001 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
14003 /* Safe to add new key to list, even if we have focus. */
14005 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
14007 XSETCAR (item
, key
);
14009 /* Notify input thread about new hot-key definition, so that it
14010 takes effect without needing to switch focus. */
14011 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
14018 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
14019 Sw32_unregister_hot_key
, 1, 1, 0,
14020 doc
: /* Unregister HOTKEY as a hot-key combination. */)
14026 if (!INTEGERP (key
))
14027 key
= w32_parse_hot_key (key
);
14029 item
= Fmemq (key
, w32_grabbed_keys
);
14033 /* Notify input thread about hot-key definition being removed, so
14034 that it takes effect without needing focus switch. */
14035 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
14036 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
14039 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
14046 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
14047 Sw32_registered_hot_keys
, 0, 0, 0,
14048 doc
: /* Return list of registered hot-key IDs. */)
14051 return Fcopy_sequence (w32_grabbed_keys
);
14054 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
14055 Sw32_reconstruct_hot_key
, 1, 1, 0,
14056 doc
: /* Convert hot-key ID to a lisp key combination. */)
14058 Lisp_Object hotkeyid
;
14060 int vk_code
, w32_modifiers
;
14063 CHECK_NUMBER (hotkeyid
);
14065 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
14066 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
14068 if (lispy_function_keys
[vk_code
])
14069 key
= intern (lispy_function_keys
[vk_code
]);
14071 key
= make_number (vk_code
);
14073 key
= Fcons (key
, Qnil
);
14074 if (w32_modifiers
& MOD_SHIFT
)
14075 key
= Fcons (Qshift
, key
);
14076 if (w32_modifiers
& MOD_CONTROL
)
14077 key
= Fcons (Qctrl
, key
);
14078 if (w32_modifiers
& MOD_ALT
)
14079 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
14080 if (w32_modifiers
& MOD_WIN
)
14081 key
= Fcons (Qhyper
, key
);
14086 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
14087 Sw32_toggle_lock_key
, 1, 2, 0,
14088 doc
: /* Toggle the state of the lock key KEY.
14089 KEY can be `capslock', `kp-numlock', or `scroll'.
14090 If the optional parameter NEW-STATE is a number, then the state of KEY
14091 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
14093 Lisp_Object key
, new_state
;
14097 if (EQ (key
, intern ("capslock")))
14098 vk_code
= VK_CAPITAL
;
14099 else if (EQ (key
, intern ("kp-numlock")))
14100 vk_code
= VK_NUMLOCK
;
14101 else if (EQ (key
, intern ("scroll")))
14102 vk_code
= VK_SCROLL
;
14106 if (!dwWindowsThreadId
)
14107 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
14109 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
14110 (WPARAM
) vk_code
, (LPARAM
) new_state
))
14113 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
14114 return make_number (msg
.wParam
);
14119 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
14120 doc
: /* Return storage information about the file system FILENAME is on.
14121 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
14122 storage of the file system, FREE is the free storage, and AVAIL is the
14123 storage available to a non-superuser. All 3 numbers are in bytes.
14124 If the underlying system call fails, value is nil. */)
14126 Lisp_Object filename
;
14128 Lisp_Object encoded
, value
;
14130 CHECK_STRING (filename
);
14131 filename
= Fexpand_file_name (filename
, Qnil
);
14132 encoded
= ENCODE_FILE (filename
);
14136 /* Determining the required information on Windows turns out, sadly,
14137 to be more involved than one would hope. The original Win32 api
14138 call for this will return bogus information on some systems, but we
14139 must dynamically probe for the replacement api, since that was
14140 added rather late on. */
14142 HMODULE hKernel
= GetModuleHandle ("kernel32");
14143 BOOL (*pfn_GetDiskFreeSpaceEx
)
14144 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
14145 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
14147 /* On Windows, we may need to specify the root directory of the
14148 volume holding FILENAME. */
14149 char rootname
[MAX_PATH
];
14150 char *name
= XSTRING (encoded
)->data
;
14152 /* find the root name of the volume if given */
14153 if (isalpha (name
[0]) && name
[1] == ':')
14155 rootname
[0] = name
[0];
14156 rootname
[1] = name
[1];
14157 rootname
[2] = '\\';
14160 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
14162 char *str
= rootname
;
14166 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
14176 if (pfn_GetDiskFreeSpaceEx
)
14178 LARGE_INTEGER availbytes
;
14179 LARGE_INTEGER freebytes
;
14180 LARGE_INTEGER totalbytes
;
14182 if (pfn_GetDiskFreeSpaceEx(rootname
,
14186 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
14187 make_float ((double) freebytes
.QuadPart
),
14188 make_float ((double) availbytes
.QuadPart
));
14192 DWORD sectors_per_cluster
;
14193 DWORD bytes_per_sector
;
14194 DWORD free_clusters
;
14195 DWORD total_clusters
;
14197 if (GetDiskFreeSpace(rootname
,
14198 §ors_per_cluster
,
14202 value
= list3 (make_float ((double) total_clusters
14203 * sectors_per_cluster
* bytes_per_sector
),
14204 make_float ((double) free_clusters
14205 * sectors_per_cluster
* bytes_per_sector
),
14206 make_float ((double) free_clusters
14207 * sectors_per_cluster
* bytes_per_sector
));
14214 /***********************************************************************
14216 ***********************************************************************/
14221 /* This is zero if not using MS-Windows. */
14224 /* The section below is built by the lisp expression at the top of the file,
14225 just above where these variables are declared. */
14226 /*&&& init symbols here &&&*/
14227 Qauto_raise
= intern ("auto-raise");
14228 staticpro (&Qauto_raise
);
14229 Qauto_lower
= intern ("auto-lower");
14230 staticpro (&Qauto_lower
);
14231 Qbar
= intern ("bar");
14233 Qborder_color
= intern ("border-color");
14234 staticpro (&Qborder_color
);
14235 Qborder_width
= intern ("border-width");
14236 staticpro (&Qborder_width
);
14237 Qbox
= intern ("box");
14239 Qcursor_color
= intern ("cursor-color");
14240 staticpro (&Qcursor_color
);
14241 Qcursor_type
= intern ("cursor-type");
14242 staticpro (&Qcursor_type
);
14243 Qgeometry
= intern ("geometry");
14244 staticpro (&Qgeometry
);
14245 Qicon_left
= intern ("icon-left");
14246 staticpro (&Qicon_left
);
14247 Qicon_top
= intern ("icon-top");
14248 staticpro (&Qicon_top
);
14249 Qicon_type
= intern ("icon-type");
14250 staticpro (&Qicon_type
);
14251 Qicon_name
= intern ("icon-name");
14252 staticpro (&Qicon_name
);
14253 Qinternal_border_width
= intern ("internal-border-width");
14254 staticpro (&Qinternal_border_width
);
14255 Qleft
= intern ("left");
14256 staticpro (&Qleft
);
14257 Qright
= intern ("right");
14258 staticpro (&Qright
);
14259 Qmouse_color
= intern ("mouse-color");
14260 staticpro (&Qmouse_color
);
14261 Qnone
= intern ("none");
14262 staticpro (&Qnone
);
14263 Qparent_id
= intern ("parent-id");
14264 staticpro (&Qparent_id
);
14265 Qscroll_bar_width
= intern ("scroll-bar-width");
14266 staticpro (&Qscroll_bar_width
);
14267 Qsuppress_icon
= intern ("suppress-icon");
14268 staticpro (&Qsuppress_icon
);
14269 Qundefined_color
= intern ("undefined-color");
14270 staticpro (&Qundefined_color
);
14271 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
14272 staticpro (&Qvertical_scroll_bars
);
14273 Qvisibility
= intern ("visibility");
14274 staticpro (&Qvisibility
);
14275 Qwindow_id
= intern ("window-id");
14276 staticpro (&Qwindow_id
);
14277 Qx_frame_parameter
= intern ("x-frame-parameter");
14278 staticpro (&Qx_frame_parameter
);
14279 Qx_resource_name
= intern ("x-resource-name");
14280 staticpro (&Qx_resource_name
);
14281 Quser_position
= intern ("user-position");
14282 staticpro (&Quser_position
);
14283 Quser_size
= intern ("user-size");
14284 staticpro (&Quser_size
);
14285 Qscreen_gamma
= intern ("screen-gamma");
14286 staticpro (&Qscreen_gamma
);
14287 Qline_spacing
= intern ("line-spacing");
14288 staticpro (&Qline_spacing
);
14289 Qcenter
= intern ("center");
14290 staticpro (&Qcenter
);
14291 Qcancel_timer
= intern ("cancel-timer");
14292 staticpro (&Qcancel_timer
);
14293 /* This is the end of symbol initialization. */
14295 Qhyper
= intern ("hyper");
14296 staticpro (&Qhyper
);
14297 Qsuper
= intern ("super");
14298 staticpro (&Qsuper
);
14299 Qmeta
= intern ("meta");
14300 staticpro (&Qmeta
);
14301 Qalt
= intern ("alt");
14303 Qctrl
= intern ("ctrl");
14304 staticpro (&Qctrl
);
14305 Qcontrol
= intern ("control");
14306 staticpro (&Qcontrol
);
14307 Qshift
= intern ("shift");
14308 staticpro (&Qshift
);
14310 /* Text property `display' should be nonsticky by default. */
14311 Vtext_property_default_nonsticky
14312 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
14315 Qlaplace
= intern ("laplace");
14316 staticpro (&Qlaplace
);
14317 Qemboss
= intern ("emboss");
14318 staticpro (&Qemboss
);
14319 Qedge_detection
= intern ("edge-detection");
14320 staticpro (&Qedge_detection
);
14321 Qheuristic
= intern ("heuristic");
14322 staticpro (&Qheuristic
);
14323 QCmatrix
= intern (":matrix");
14324 staticpro (&QCmatrix
);
14325 QCcolor_adjustment
= intern (":color-adjustment");
14326 staticpro (&QCcolor_adjustment
);
14327 QCmask
= intern (":mask");
14328 staticpro (&QCmask
);
14330 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
14331 staticpro (&Qface_set_after_frame_default
);
14333 Fput (Qundefined_color
, Qerror_conditions
,
14334 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
14335 Fput (Qundefined_color
, Qerror_message
,
14336 build_string ("Undefined color"));
14338 staticpro (&w32_grabbed_keys
);
14339 w32_grabbed_keys
= Qnil
;
14341 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
14342 doc
: /* An array of color name mappings for windows. */);
14343 Vw32_color_map
= Qnil
;
14345 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
14346 doc
: /* Non-nil if alt key presses are passed on to Windows.
14347 When non-nil, for example, alt pressed and released and then space will
14348 open the System menu. When nil, Emacs silently swallows alt key events. */);
14349 Vw32_pass_alt_to_system
= Qnil
;
14351 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
14352 doc
: /* Non-nil if the alt key is to be considered the same as the meta key.
14353 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta. */);
14354 Vw32_alt_is_meta
= Qt
;
14356 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
14357 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
14358 XSETINT (Vw32_quit_key
, 0);
14360 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14361 &Vw32_pass_lwindow_to_system
,
14362 doc
: /* Non-nil if the left \"Windows\" key is passed on to Windows.
14363 When non-nil, the Start menu is opened by tapping the key. */);
14364 Vw32_pass_lwindow_to_system
= Qt
;
14366 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14367 &Vw32_pass_rwindow_to_system
,
14368 doc
: /* Non-nil if the right \"Windows\" key is passed on to Windows.
14369 When non-nil, the Start menu is opened by tapping the key. */);
14370 Vw32_pass_rwindow_to_system
= Qt
;
14372 DEFVAR_INT ("w32-phantom-key-code",
14373 &Vw32_phantom_key_code
,
14374 doc
: /* Virtual key code used to generate \"phantom\" key presses.
14375 Value is a number between 0 and 255.
14377 Phantom key presses are generated in order to stop the system from
14378 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
14379 `w32-pass-rwindow-to-system' is nil. */);
14380 /* Although 255 is technically not a valid key code, it works and
14381 means that this hack won't interfere with any real key code. */
14382 Vw32_phantom_key_code
= 255;
14384 DEFVAR_LISP ("w32-enable-num-lock",
14385 &Vw32_enable_num_lock
,
14386 doc
: /* Non-nil if Num Lock should act normally.
14387 Set to nil to see Num Lock as the key `kp-numlock'. */);
14388 Vw32_enable_num_lock
= Qt
;
14390 DEFVAR_LISP ("w32-enable-caps-lock",
14391 &Vw32_enable_caps_lock
,
14392 doc
: /* Non-nil if Caps Lock should act normally.
14393 Set to nil to see Caps Lock as the key `capslock'. */);
14394 Vw32_enable_caps_lock
= Qt
;
14396 DEFVAR_LISP ("w32-scroll-lock-modifier",
14397 &Vw32_scroll_lock_modifier
,
14398 doc
: /* Modifier to use for the Scroll Lock on state.
14399 The value can be hyper, super, meta, alt, control or shift for the
14400 respective modifier, or nil to see Scroll Lock as the key `scroll'.
14401 Any other value will cause the key to be ignored. */);
14402 Vw32_scroll_lock_modifier
= Qt
;
14404 DEFVAR_LISP ("w32-lwindow-modifier",
14405 &Vw32_lwindow_modifier
,
14406 doc
: /* Modifier to use for the left \"Windows\" key.
14407 The value can be hyper, super, meta, alt, control or shift for the
14408 respective modifier, or nil to appear as the key `lwindow'.
14409 Any other value will cause the key to be ignored. */);
14410 Vw32_lwindow_modifier
= Qnil
;
14412 DEFVAR_LISP ("w32-rwindow-modifier",
14413 &Vw32_rwindow_modifier
,
14414 doc
: /* Modifier to use for the right \"Windows\" key.
14415 The value can be hyper, super, meta, alt, control or shift for the
14416 respective modifier, or nil to appear as the key `rwindow'.
14417 Any other value will cause the key to be ignored. */);
14418 Vw32_rwindow_modifier
= Qnil
;
14420 DEFVAR_LISP ("w32-apps-modifier",
14421 &Vw32_apps_modifier
,
14422 doc
: /* Modifier to use for the \"Apps\" key.
14423 The value can be hyper, super, meta, alt, control or shift for the
14424 respective modifier, or nil to appear as the key `apps'.
14425 Any other value will cause the key to be ignored. */);
14426 Vw32_apps_modifier
= Qnil
;
14428 DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts
,
14429 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
14430 Vw32_enable_synthesized_fonts
= Qnil
;
14432 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
14433 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
14434 Vw32_enable_palette
= Qt
;
14436 DEFVAR_INT ("w32-mouse-button-tolerance",
14437 &Vw32_mouse_button_tolerance
,
14438 doc
: /* Analogue of double click interval for faking middle mouse events.
14439 The value is the minimum time in milliseconds that must elapse between
14440 left/right button down events before they are considered distinct events.
14441 If both mouse buttons are depressed within this interval, a middle mouse
14442 button down event is generated instead. */);
14443 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
14445 DEFVAR_INT ("w32-mouse-move-interval",
14446 &Vw32_mouse_move_interval
,
14447 doc
: /* Minimum interval between mouse move events.
14448 The value is the minimum time in milliseconds that must elapse between
14449 successive mouse move (or scroll bar drag) events before they are
14450 reported as lisp events. */);
14451 XSETINT (Vw32_mouse_move_interval
, 0);
14453 init_x_parm_symbols ();
14455 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
14456 doc
: /* List of directories to search for bitmap files for w32. */);
14457 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
14459 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
14460 doc
: /* The shape of the pointer when over text.
14461 Changing the value does not affect existing frames
14462 unless you set the mouse color. */);
14463 Vx_pointer_shape
= Qnil
;
14465 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
14466 doc
: /* The name Emacs uses to look up resources; for internal use only.
14467 `x-get-resource' uses this as the first component of the instance name
14468 when requesting resource values.
14469 Emacs initially sets `x-resource-name' to the name under which Emacs
14470 was invoked, or to the value specified with the `-name' or `-rn'
14471 switches, if present. */);
14472 Vx_resource_name
= Qnil
;
14474 Vx_nontext_pointer_shape
= Qnil
;
14476 Vx_mode_pointer_shape
= Qnil
;
14478 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
14479 doc
: /* The shape of the pointer when Emacs is busy.
14480 This variable takes effect when you create a new frame
14481 or when you set the mouse color. */);
14482 Vx_hourglass_pointer_shape
= Qnil
;
14484 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
14485 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
14486 display_hourglass_p
= 1;
14488 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
14489 doc
: /* *Seconds to wait before displaying an hourglass pointer.
14490 Value must be an integer or float. */);
14491 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
14493 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
14494 &Vx_sensitive_text_pointer_shape
,
14495 doc
: /* The shape of the pointer when over mouse-sensitive text.
14496 This variable takes effect when you create a new frame
14497 or when you set the mouse color. */);
14498 Vx_sensitive_text_pointer_shape
= Qnil
;
14500 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
14501 &Vx_window_horizontal_drag_shape
,
14502 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
14503 This variable takes effect when you create a new frame
14504 or when you set the mouse color. */);
14505 Vx_window_horizontal_drag_shape
= Qnil
;
14507 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
14508 doc
: /* A string indicating the foreground color of the cursor box. */);
14509 Vx_cursor_fore_pixel
= Qnil
;
14511 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
14512 doc
: /* Maximum size for tooltips.
14513 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
14514 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
14516 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
14517 doc
: /* Non-nil if no window manager is in use.
14518 Emacs doesn't try to figure this out; this is always nil
14519 unless you set it to something else. */);
14520 /* We don't have any way to find this out, so set it to nil
14521 and maybe the user would like to set it to t. */
14522 Vx_no_window_manager
= Qnil
;
14524 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
14525 &Vx_pixel_size_width_font_regexp
,
14526 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
14528 Since Emacs gets width of a font matching with this regexp from
14529 PIXEL_SIZE field of the name, font finding mechanism gets faster for
14530 such a font. This is especially effective for such large fonts as
14531 Chinese, Japanese, and Korean. */);
14532 Vx_pixel_size_width_font_regexp
= Qnil
;
14534 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
14535 doc
: /* Time after which cached images are removed from the cache.
14536 When an image has not been displayed this many seconds, remove it
14537 from the image cache. Value must be an integer or nil with nil
14538 meaning don't clear the cache. */);
14539 Vimage_cache_eviction_delay
= make_number (30 * 60);
14541 DEFVAR_LISP ("w32-bdf-filename-alist",
14542 &Vw32_bdf_filename_alist
,
14543 doc
: /* List of bdf fonts and their corresponding filenames. */);
14544 Vw32_bdf_filename_alist
= Qnil
;
14546 DEFVAR_BOOL ("w32-strict-fontnames",
14547 &w32_strict_fontnames
,
14548 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
14549 Default is nil, which allows old fontnames that are not XLFD compliant,
14550 and allows third-party CJK display to work by specifying false charset
14551 fields to trick Emacs into translating to Big5, SJIS etc.
14552 Setting this to t will prevent wrong fonts being selected when
14553 fontsets are automatically created. */);
14554 w32_strict_fontnames
= 0;
14556 DEFVAR_BOOL ("w32-strict-painting",
14557 &w32_strict_painting
,
14558 doc
: /* Non-nil means use strict rules for repainting frames.
14559 Set this to nil to get the old behaviour for repainting; this should
14560 only be necessary if the default setting causes problems. */);
14561 w32_strict_painting
= 1;
14563 DEFVAR_LISP ("w32-charset-info-alist",
14564 &Vw32_charset_info_alist
,
14565 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
14566 Each entry should be of the form:
14568 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
14570 where CHARSET_NAME is a string used in font names to identify the charset,
14571 WINDOWS_CHARSET is a symbol that can be one of:
14572 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
14573 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
14574 w32-charset-chinesebig5,
14575 #ifdef JOHAB_CHARSET
14576 w32-charset-johab, w32-charset-hebrew,
14577 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
14578 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
14579 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
14581 #ifdef UNICODE_CHARSET
14582 w32-charset-unicode,
14584 or w32-charset-oem.
14585 CODEPAGE should be an integer specifying the codepage that should be used
14586 to display the character set, t to do no translation and output as Unicode,
14587 or nil to do no translation and output as 8 bit (or multibyte on far-east
14588 versions of Windows) characters. */);
14589 Vw32_charset_info_alist
= Qnil
;
14591 staticpro (&Qw32_charset_ansi
);
14592 Qw32_charset_ansi
= intern ("w32-charset-ansi");
14593 staticpro (&Qw32_charset_symbol
);
14594 Qw32_charset_symbol
= intern ("w32-charset-symbol");
14595 staticpro (&Qw32_charset_shiftjis
);
14596 Qw32_charset_shiftjis
= intern ("w32-charset-shiftjis");
14597 staticpro (&Qw32_charset_hangeul
);
14598 Qw32_charset_hangeul
= intern ("w32-charset-hangeul");
14599 staticpro (&Qw32_charset_chinesebig5
);
14600 Qw32_charset_chinesebig5
= intern ("w32-charset-chinesebig5");
14601 staticpro (&Qw32_charset_gb2312
);
14602 Qw32_charset_gb2312
= intern ("w32-charset-gb2312");
14603 staticpro (&Qw32_charset_oem
);
14604 Qw32_charset_oem
= intern ("w32-charset-oem");
14606 #ifdef JOHAB_CHARSET
14608 static int w32_extra_charsets_defined
= 1;
14609 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
14610 doc
: /* Internal variable. */);
14612 staticpro (&Qw32_charset_johab
);
14613 Qw32_charset_johab
= intern ("w32-charset-johab");
14614 staticpro (&Qw32_charset_easteurope
);
14615 Qw32_charset_easteurope
= intern ("w32-charset-easteurope");
14616 staticpro (&Qw32_charset_turkish
);
14617 Qw32_charset_turkish
= intern ("w32-charset-turkish");
14618 staticpro (&Qw32_charset_baltic
);
14619 Qw32_charset_baltic
= intern ("w32-charset-baltic");
14620 staticpro (&Qw32_charset_russian
);
14621 Qw32_charset_russian
= intern ("w32-charset-russian");
14622 staticpro (&Qw32_charset_arabic
);
14623 Qw32_charset_arabic
= intern ("w32-charset-arabic");
14624 staticpro (&Qw32_charset_greek
);
14625 Qw32_charset_greek
= intern ("w32-charset-greek");
14626 staticpro (&Qw32_charset_hebrew
);
14627 Qw32_charset_hebrew
= intern ("w32-charset-hebrew");
14628 staticpro (&Qw32_charset_vietnamese
);
14629 Qw32_charset_vietnamese
= intern ("w32-charset-vietnamese");
14630 staticpro (&Qw32_charset_thai
);
14631 Qw32_charset_thai
= intern ("w32-charset-thai");
14632 staticpro (&Qw32_charset_mac
);
14633 Qw32_charset_mac
= intern ("w32-charset-mac");
14637 #ifdef UNICODE_CHARSET
14639 static int w32_unicode_charset_defined
= 1;
14640 DEFVAR_BOOL ("w32-unicode-charset-defined",
14641 &w32_unicode_charset_defined
,
14642 doc
: /* Internal variable. */);
14644 staticpro (&Qw32_charset_unicode
);
14645 Qw32_charset_unicode
= intern ("w32-charset-unicode");
14648 defsubr (&Sx_get_resource
);
14649 #if 0 /* TODO: Port to W32 */
14650 defsubr (&Sx_change_window_property
);
14651 defsubr (&Sx_delete_window_property
);
14652 defsubr (&Sx_window_property
);
14654 defsubr (&Sxw_display_color_p
);
14655 defsubr (&Sx_display_grayscale_p
);
14656 defsubr (&Sxw_color_defined_p
);
14657 defsubr (&Sxw_color_values
);
14658 defsubr (&Sx_server_max_request_size
);
14659 defsubr (&Sx_server_vendor
);
14660 defsubr (&Sx_server_version
);
14661 defsubr (&Sx_display_pixel_width
);
14662 defsubr (&Sx_display_pixel_height
);
14663 defsubr (&Sx_display_mm_width
);
14664 defsubr (&Sx_display_mm_height
);
14665 defsubr (&Sx_display_screens
);
14666 defsubr (&Sx_display_planes
);
14667 defsubr (&Sx_display_color_cells
);
14668 defsubr (&Sx_display_visual_class
);
14669 defsubr (&Sx_display_backing_store
);
14670 defsubr (&Sx_display_save_under
);
14671 defsubr (&Sx_parse_geometry
);
14672 defsubr (&Sx_create_frame
);
14673 defsubr (&Sx_open_connection
);
14674 defsubr (&Sx_close_connection
);
14675 defsubr (&Sx_display_list
);
14676 defsubr (&Sx_synchronize
);
14678 /* W32 specific functions */
14680 defsubr (&Sw32_focus_frame
);
14681 defsubr (&Sw32_select_font
);
14682 defsubr (&Sw32_define_rgb_color
);
14683 defsubr (&Sw32_default_color_map
);
14684 defsubr (&Sw32_load_color_file
);
14685 defsubr (&Sw32_send_sys_command
);
14686 defsubr (&Sw32_shell_execute
);
14687 defsubr (&Sw32_register_hot_key
);
14688 defsubr (&Sw32_unregister_hot_key
);
14689 defsubr (&Sw32_registered_hot_keys
);
14690 defsubr (&Sw32_reconstruct_hot_key
);
14691 defsubr (&Sw32_toggle_lock_key
);
14692 defsubr (&Sw32_find_bdf_fonts
);
14694 defsubr (&Sfile_system_info
);
14696 /* Setting callback functions for fontset handler. */
14697 get_font_info_func
= w32_get_font_info
;
14699 #if 0 /* This function pointer doesn't seem to be used anywhere.
14700 And the pointer assigned has the wrong type, anyway. */
14701 list_fonts_func
= w32_list_fonts
;
14704 load_font_func
= w32_load_font
;
14705 find_ccl_program_func
= w32_find_ccl_program
;
14706 query_font_func
= w32_query_font
;
14707 set_frame_fontset_func
= x_set_font
;
14708 check_window_system_func
= check_w32
;
14710 #if 0 /* TODO Image support for W32 */
14712 Qxbm
= intern ("xbm");
14714 QCtype
= intern (":type");
14715 staticpro (&QCtype
);
14716 QCconversion
= intern (":conversion");
14717 staticpro (&QCconversion
);
14718 QCheuristic_mask
= intern (":heuristic-mask");
14719 staticpro (&QCheuristic_mask
);
14720 QCcolor_symbols
= intern (":color-symbols");
14721 staticpro (&QCcolor_symbols
);
14722 QCascent
= intern (":ascent");
14723 staticpro (&QCascent
);
14724 QCmargin
= intern (":margin");
14725 staticpro (&QCmargin
);
14726 QCrelief
= intern (":relief");
14727 staticpro (&QCrelief
);
14728 Qpostscript
= intern ("postscript");
14729 staticpro (&Qpostscript
);
14730 QCloader
= intern (":loader");
14731 staticpro (&QCloader
);
14732 QCbounding_box
= intern (":bounding-box");
14733 staticpro (&QCbounding_box
);
14734 QCpt_width
= intern (":pt-width");
14735 staticpro (&QCpt_width
);
14736 QCpt_height
= intern (":pt-height");
14737 staticpro (&QCpt_height
);
14738 QCindex
= intern (":index");
14739 staticpro (&QCindex
);
14740 Qpbm
= intern ("pbm");
14744 Qxpm
= intern ("xpm");
14749 Qjpeg
= intern ("jpeg");
14750 staticpro (&Qjpeg
);
14754 Qtiff
= intern ("tiff");
14755 staticpro (&Qtiff
);
14759 Qgif
= intern ("gif");
14764 Qpng
= intern ("png");
14768 defsubr (&Sclear_image_cache
);
14771 defsubr (&Simagep
);
14772 defsubr (&Slookup_image
);
14776 hourglass_atimer
= NULL
;
14777 hourglass_shown_p
= 0;
14778 defsubr (&Sx_show_tip
);
14779 defsubr (&Sx_hide_tip
);
14781 staticpro (&tip_timer
);
14783 staticpro (&tip_frame
);
14785 last_show_tip_args
= Qnil
;
14786 staticpro (&last_show_tip_args
);
14788 defsubr (&Sx_file_dialog
);
14795 image_types
= NULL
;
14796 Vimage_types
= Qnil
;
14798 #if 0 /* TODO : Image support for W32 */
14799 define_image_type (&xbm_type
);
14800 define_image_type (&gs_type
);
14801 define_image_type (&pbm_type
);
14804 define_image_type (&xpm_type
);
14808 define_image_type (&jpeg_type
);
14812 define_image_type (&tiff_type
);
14816 define_image_type (&gif_type
);
14820 define_image_type (&png_type
);
14831 button
= MessageBox (NULL
,
14832 "A fatal error has occurred!\n\n"
14833 "Select Abort to exit, Retry to debug, Ignore to continue",
14834 "Emacs Abort Dialog",
14835 MB_ICONEXCLAMATION
| MB_TASKMODAL
14836 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
14851 /* For convenience when debugging. */
14855 return GetLastError ();