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"
56 #define FILE_NAME_TEXT_FIELD edt1
58 extern void free_frame_menubar ();
59 extern void x_compute_fringe_widths
P_ ((struct frame
*, int));
60 extern double atof ();
61 extern int w32_console_toggle_lock_key
P_ ((int, Lisp_Object
));
62 extern void w32_menu_display_help
P_ ((HWND
, HMENU
, UINT
, UINT
));
63 extern void w32_free_menu_strings
P_ ((HWND
));
67 extern char *lispy_function_keys
[];
69 /* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
70 it, and including `bitmaps/gray' more than once is a problem when
71 config.h defines `static' as an empty replacement string. */
73 int gray_bitmap_width
= gray_width
;
74 int gray_bitmap_height
= gray_height
;
75 unsigned char *gray_bitmap_bits
= gray_bits
;
77 /* The colormap for converting color names to RGB values */
78 Lisp_Object Vw32_color_map
;
80 /* Non nil if alt key presses are passed on to Windows. */
81 Lisp_Object Vw32_pass_alt_to_system
;
83 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
85 Lisp_Object Vw32_alt_is_meta
;
87 /* If non-zero, the windows virtual key code for an alternative quit key. */
88 Lisp_Object Vw32_quit_key
;
90 /* Non nil if left window key events are passed on to Windows (this only
91 affects whether "tapping" the key opens the Start menu). */
92 Lisp_Object Vw32_pass_lwindow_to_system
;
94 /* Non nil if right window key events are passed on to Windows (this
95 only affects whether "tapping" the key opens the Start menu). */
96 Lisp_Object Vw32_pass_rwindow_to_system
;
98 /* Virtual key code used to generate "phantom" key presses in order
99 to stop system from acting on Windows key events. */
100 Lisp_Object Vw32_phantom_key_code
;
102 /* Modifier associated with the left "Windows" key, or nil to act as a
104 Lisp_Object Vw32_lwindow_modifier
;
106 /* Modifier associated with the right "Windows" key, or nil to act as a
108 Lisp_Object Vw32_rwindow_modifier
;
110 /* Modifier associated with the "Apps" key, or nil to act as a normal
112 Lisp_Object Vw32_apps_modifier
;
114 /* Value is nil if Num Lock acts as a function key. */
115 Lisp_Object Vw32_enable_num_lock
;
117 /* Value is nil if Caps Lock acts as a function key. */
118 Lisp_Object Vw32_enable_caps_lock
;
120 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
121 Lisp_Object Vw32_scroll_lock_modifier
;
123 /* Switch to control whether we inhibit requests for synthesized bold
124 and italic versions of fonts. */
125 int w32_enable_synthesized_fonts
;
127 /* Enable palette management. */
128 Lisp_Object Vw32_enable_palette
;
130 /* Control how close left/right button down events must be to
131 be converted to a middle button down event. */
132 Lisp_Object Vw32_mouse_button_tolerance
;
134 /* Minimum interval between mouse movement (and scroll bar drag)
135 events that are passed on to the event loop. */
136 Lisp_Object Vw32_mouse_move_interval
;
138 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
139 int w32_pass_extra_mouse_buttons_to_system
;
141 /* The name we're using in resource queries. */
142 Lisp_Object Vx_resource_name
;
144 /* Non nil if no window manager is in use. */
145 Lisp_Object Vx_no_window_manager
;
147 /* Non-zero means we're allowed to display a hourglass pointer. */
149 int display_hourglass_p
;
151 /* The background and shape of the mouse pointer, and shape when not
152 over text or in the modeline. */
154 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
155 Lisp_Object Vx_hourglass_pointer_shape
, Vx_window_horizontal_drag_shape
;
157 /* The shape when over mouse-sensitive text. */
159 Lisp_Object Vx_sensitive_text_pointer_shape
;
161 /* Color of chars displayed in cursor box. */
163 Lisp_Object Vx_cursor_fore_pixel
;
165 /* Nonzero if using Windows. */
167 static int w32_in_use
;
169 /* Search path for bitmap files. */
171 Lisp_Object Vx_bitmap_file_path
;
173 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
175 Lisp_Object Vx_pixel_size_width_font_regexp
;
177 /* Alist of bdf fonts and the files that define them. */
178 Lisp_Object Vw32_bdf_filename_alist
;
180 /* A flag to control whether fonts are matched strictly or not. */
181 int w32_strict_fontnames
;
183 /* A flag to control whether we should only repaint if GetUpdateRect
184 indicates there is an update region. */
185 int w32_strict_painting
;
187 /* Associative list linking character set strings to Windows codepages. */
188 Lisp_Object Vw32_charset_info_alist
;
190 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
191 #ifndef VIETNAMESE_CHARSET
192 #define VIETNAMESE_CHARSET 163
195 Lisp_Object Qauto_raise
;
196 Lisp_Object Qauto_lower
;
197 Lisp_Object Qborder_color
;
198 Lisp_Object Qborder_width
;
199 extern Lisp_Object Qbox
;
200 Lisp_Object Qcursor_color
;
201 Lisp_Object Qcursor_type
;
202 Lisp_Object Qgeometry
;
203 Lisp_Object Qicon_left
;
204 Lisp_Object Qicon_top
;
205 Lisp_Object Qicon_type
;
206 Lisp_Object Qicon_name
;
207 Lisp_Object Qinternal_border_width
;
210 Lisp_Object Qmouse_color
;
212 Lisp_Object Qparent_id
;
213 Lisp_Object Qscroll_bar_width
;
214 Lisp_Object Qsuppress_icon
;
215 Lisp_Object Qundefined_color
;
216 Lisp_Object Qvertical_scroll_bars
;
217 Lisp_Object Qvisibility
;
218 Lisp_Object Qwindow_id
;
219 Lisp_Object Qx_frame_parameter
;
220 Lisp_Object Qx_resource_name
;
221 Lisp_Object Quser_position
;
222 Lisp_Object Quser_size
;
223 Lisp_Object Qscreen_gamma
;
224 Lisp_Object Qline_spacing
;
226 Lisp_Object Qcancel_timer
;
232 Lisp_Object Qcontrol
;
235 Lisp_Object Qw32_charset_ansi
;
236 Lisp_Object Qw32_charset_default
;
237 Lisp_Object Qw32_charset_symbol
;
238 Lisp_Object Qw32_charset_shiftjis
;
239 Lisp_Object Qw32_charset_hangeul
;
240 Lisp_Object Qw32_charset_gb2312
;
241 Lisp_Object Qw32_charset_chinesebig5
;
242 Lisp_Object Qw32_charset_oem
;
244 #ifndef JOHAB_CHARSET
245 #define JOHAB_CHARSET 130
248 Lisp_Object Qw32_charset_easteurope
;
249 Lisp_Object Qw32_charset_turkish
;
250 Lisp_Object Qw32_charset_baltic
;
251 Lisp_Object Qw32_charset_russian
;
252 Lisp_Object Qw32_charset_arabic
;
253 Lisp_Object Qw32_charset_greek
;
254 Lisp_Object Qw32_charset_hebrew
;
255 Lisp_Object Qw32_charset_vietnamese
;
256 Lisp_Object Qw32_charset_thai
;
257 Lisp_Object Qw32_charset_johab
;
258 Lisp_Object Qw32_charset_mac
;
261 #ifdef UNICODE_CHARSET
262 Lisp_Object Qw32_charset_unicode
;
265 Lisp_Object Qfullscreen
;
266 Lisp_Object Qfullwidth
;
267 Lisp_Object Qfullheight
;
268 Lisp_Object Qfullboth
;
270 extern Lisp_Object Qtop
;
271 extern Lisp_Object Qdisplay
;
273 /* State variables for emulating a three button mouse. */
278 static int button_state
= 0;
279 static W32Msg saved_mouse_button_msg
;
280 static unsigned mouse_button_timer
= 0; /* non-zero when timer is active */
281 static W32Msg saved_mouse_move_msg
;
282 static unsigned mouse_move_timer
= 0;
284 /* Window that is tracking the mouse. */
285 static HWND track_mouse_window
;
286 FARPROC track_mouse_event_fn
;
288 /* W95 mousewheel handler */
289 unsigned int msh_mousewheel
= 0;
292 #define MOUSE_BUTTON_ID 1
293 #define MOUSE_MOVE_ID 2
294 #define MENU_FREE_ID 3
295 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
297 #define MENU_FREE_DELAY 1000
298 static unsigned menu_free_timer
= 0;
300 /* The below are defined in frame.c. */
302 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
303 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
304 extern Lisp_Object Qtool_bar_lines
;
306 extern Lisp_Object Vwindow_system_version
;
308 Lisp_Object Qface_set_after_frame_default
;
311 int image_cache_refcount
, dpyinfo_refcount
;
315 /* From w32term.c. */
316 extern Lisp_Object Vw32_num_mouse_buttons
;
317 extern Lisp_Object Vw32_recognize_altgr
;
319 extern HWND w32_system_caret_hwnd
;
321 extern int w32_system_caret_height
;
322 extern int w32_system_caret_x
;
323 extern int w32_system_caret_y
;
324 extern int w32_use_visible_system_caret
;
326 static HWND w32_visible_system_caret_hwnd
;
329 /* Error if we are not connected to MS-Windows. */
334 error ("MS-Windows not in use or not initialized");
337 /* Nonzero if we can use mouse menus.
338 You should not call this unless HAVE_MENUS is defined. */
346 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
347 and checking validity for W32. */
350 check_x_frame (frame
)
356 frame
= selected_frame
;
357 CHECK_LIVE_FRAME (frame
);
359 if (! FRAME_W32_P (f
))
360 error ("non-w32 frame used");
364 /* Let the user specify a display with a frame.
365 nil stands for the selected frame--or, if that is not a w32 frame,
366 the first display on the list. */
368 static struct w32_display_info
*
369 check_x_display_info (frame
)
374 struct frame
*sf
= XFRAME (selected_frame
);
376 if (FRAME_W32_P (sf
) && FRAME_LIVE_P (sf
))
377 return FRAME_W32_DISPLAY_INFO (sf
);
379 return &one_w32_display_info
;
381 else if (STRINGP (frame
))
382 return x_display_info_for_name (frame
);
387 CHECK_LIVE_FRAME (frame
);
389 if (! FRAME_W32_P (f
))
390 error ("non-w32 frame used");
391 return FRAME_W32_DISPLAY_INFO (f
);
395 /* Return the Emacs frame-object corresponding to an w32 window.
396 It could be the frame's main window or an icon window. */
398 /* This function can be called during GC, so use GC_xxx type test macros. */
401 x_window_to_frame (dpyinfo
, wdesc
)
402 struct w32_display_info
*dpyinfo
;
405 Lisp_Object tail
, frame
;
408 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
411 if (!GC_FRAMEP (frame
))
414 if (!FRAME_W32_P (f
) || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
416 if (f
->output_data
.w32
->hourglass_window
== wdesc
)
419 if (FRAME_W32_WINDOW (f
) == wdesc
)
427 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
428 id, which is just an int that this section returns. Bitmaps are
429 reference counted so they can be shared among frames.
431 Bitmap indices are guaranteed to be > 0, so a negative number can
432 be used to indicate no bitmap.
434 If you use x_create_bitmap_from_data, then you must keep track of
435 the bitmaps yourself. That is, creating a bitmap from the same
436 data more than once will not be caught. */
439 /* Functions to access the contents of a bitmap, given an id. */
442 x_bitmap_height (f
, id
)
446 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
450 x_bitmap_width (f
, id
)
454 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
458 x_bitmap_pixmap (f
, id
)
462 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
466 /* Allocate a new bitmap record. Returns index of new record. */
469 x_allocate_bitmap_record (f
)
472 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
475 if (dpyinfo
->bitmaps
== NULL
)
477 dpyinfo
->bitmaps_size
= 10;
479 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
480 dpyinfo
->bitmaps_last
= 1;
484 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
485 return ++dpyinfo
->bitmaps_last
;
487 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
488 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
491 dpyinfo
->bitmaps_size
*= 2;
493 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
494 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
495 return ++dpyinfo
->bitmaps_last
;
498 /* Add one reference to the reference count of the bitmap with id ID. */
501 x_reference_bitmap (f
, id
)
505 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
508 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
511 x_create_bitmap_from_data (f
, bits
, width
, height
)
514 unsigned int width
, height
;
516 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
520 bitmap
= CreateBitmap (width
, height
,
521 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
522 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
528 id
= x_allocate_bitmap_record (f
);
529 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
530 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
531 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
532 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
533 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
534 dpyinfo
->bitmaps
[id
- 1].height
= height
;
535 dpyinfo
->bitmaps
[id
- 1].width
= width
;
540 /* Create bitmap from file FILE for frame F. */
543 x_create_bitmap_from_file (f
, file
)
548 #if 0 /* TODO : bitmap support */
549 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
550 unsigned int width
, height
;
552 int xhot
, yhot
, result
, id
;
558 /* Look for an existing bitmap with the same name. */
559 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
561 if (dpyinfo
->bitmaps
[id
].refcount
562 && dpyinfo
->bitmaps
[id
].file
563 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) SDATA (file
)))
565 ++dpyinfo
->bitmaps
[id
].refcount
;
570 /* Search bitmap-file-path for the file, if appropriate. */
571 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, Qnil
);
576 filename
= (char *) SDATA (found
);
578 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
584 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
585 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
586 if (result
!= BitmapSuccess
)
589 id
= x_allocate_bitmap_record (f
);
590 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
591 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
592 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (SCHARS (file
) + 1);
593 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
594 dpyinfo
->bitmaps
[id
- 1].height
= height
;
595 dpyinfo
->bitmaps
[id
- 1].width
= width
;
596 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, SDATA (file
));
602 /* Remove reference to bitmap with id number ID. */
605 x_destroy_bitmap (f
, id
)
609 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
613 --dpyinfo
->bitmaps
[id
- 1].refcount
;
614 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
617 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
618 if (dpyinfo
->bitmaps
[id
- 1].file
)
620 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
621 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
628 /* Free all the bitmaps for the display specified by DPYINFO. */
631 x_destroy_all_bitmaps (dpyinfo
)
632 struct w32_display_info
*dpyinfo
;
635 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
636 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
638 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
639 if (dpyinfo
->bitmaps
[i
].file
)
640 xfree (dpyinfo
->bitmaps
[i
].file
);
642 dpyinfo
->bitmaps_last
= 0;
645 /* Connect the frame-parameter names for W32 frames
646 to the ways of passing the parameter values to the window system.
648 The name of a parameter, as a Lisp symbol,
649 has an `x-frame-parameter' property which is an integer in Lisp
650 but can be interpreted as an `enum x_frame_parm' in C. */
654 X_PARM_FOREGROUND_COLOR
,
655 X_PARM_BACKGROUND_COLOR
,
662 X_PARM_INTERNAL_BORDER_WIDTH
,
666 X_PARM_VERT_SCROLL_BAR
,
668 X_PARM_MENU_BAR_LINES
672 struct x_frame_parm_table
675 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
678 BOOL my_show_window
P_ ((struct frame
*, HWND
, int));
679 void my_set_window_pos
P_ ((HWND
, HWND
, int, int, int, int, UINT
));
680 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
681 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
682 static void x_change_window_heights
P_ ((Lisp_Object
, int));
683 /* TODO: Native Input Method support; see x_create_im. */
684 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
685 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
686 static void x_set_fullscreen
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
687 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
688 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
689 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
690 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
691 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
692 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
693 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
694 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
695 static void x_set_fringe_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
696 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
697 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
699 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
700 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
701 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
702 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
704 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
705 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
706 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
707 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
708 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
709 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
710 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
711 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
714 static struct x_frame_parm_table x_frame_parms
[] =
716 {"auto-raise", x_set_autoraise
},
717 {"auto-lower", x_set_autolower
},
718 {"background-color", x_set_background_color
},
719 {"border-color", x_set_border_color
},
720 {"border-width", x_set_border_width
},
721 {"cursor-color", x_set_cursor_color
},
722 {"cursor-type", x_set_cursor_type
},
723 {"font", x_set_font
},
724 {"foreground-color", x_set_foreground_color
},
725 {"icon-name", x_set_icon_name
},
726 {"icon-type", x_set_icon_type
},
727 {"internal-border-width", x_set_internal_border_width
},
728 {"menu-bar-lines", x_set_menu_bar_lines
},
729 {"mouse-color", x_set_mouse_color
},
730 {"name", x_explicitly_set_name
},
731 {"scroll-bar-width", x_set_scroll_bar_width
},
732 {"title", x_set_title
},
733 {"unsplittable", x_set_unsplittable
},
734 {"vertical-scroll-bars", x_set_vertical_scroll_bars
},
735 {"visibility", x_set_visibility
},
736 {"tool-bar-lines", x_set_tool_bar_lines
},
737 {"screen-gamma", x_set_screen_gamma
},
738 {"line-spacing", x_set_line_spacing
},
739 {"left-fringe", x_set_fringe_width
},
740 {"right-fringe", x_set_fringe_width
},
741 {"fullscreen", x_set_fullscreen
},
744 /* Attach the `x-frame-parameter' properties to
745 the Lisp symbol names of parameters relevant to W32. */
748 init_x_parm_symbols ()
752 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
753 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
757 /* Really try to move where we want to be in case of fullscreen. Some WMs
758 moves the window where we tell them. Some (mwm, twm) moves the outer
759 window manager window there instead.
760 Try to compensate for those WM here. */
762 x_fullscreen_move (f
, new_top
, new_left
)
767 if (new_top
!= f
->output_data
.w32
->top_pos
768 || new_left
!= f
->output_data
.w32
->left_pos
)
770 int move_x
= new_left
;
771 int move_y
= new_top
;
773 f
->output_data
.w32
->want_fullscreen
|= FULLSCREEN_MOVE_WAIT
;
774 x_set_offset (f
, move_x
, move_y
, 1);
778 /* Change the parameters of frame F as specified by ALIST.
779 If a parameter is not specially recognized, do nothing;
780 otherwise call the `x_set_...' function for that parameter. */
783 x_set_frame_parameters (f
, alist
)
789 /* If both of these parameters are present, it's more efficient to
790 set them both at once. So we wait until we've looked at the
791 entire list before we set them. */
795 Lisp_Object left
, top
;
797 /* Same with these. */
798 Lisp_Object icon_left
, icon_top
;
800 /* Record in these vectors all the parms specified. */
804 int left_no_change
= 0, top_no_change
= 0;
805 int icon_left_no_change
= 0, icon_top_no_change
= 0;
806 int fullscreen_is_being_set
= 0;
808 struct gcpro gcpro1
, gcpro2
;
811 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
814 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
815 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
817 /* Extract parm names and values into those vectors. */
820 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
825 parms
[i
] = Fcar (elt
);
826 values
[i
] = Fcdr (elt
);
829 /* TAIL and ALIST are not used again below here. */
832 GCPRO2 (*parms
, *values
);
836 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
837 because their values appear in VALUES and strings are not valid. */
838 top
= left
= Qunbound
;
839 icon_left
= icon_top
= Qunbound
;
841 /* Provide default values for HEIGHT and WIDTH. */
842 if (FRAME_NEW_WIDTH (f
))
843 width
= FRAME_NEW_WIDTH (f
);
845 width
= FRAME_WIDTH (f
);
847 if (FRAME_NEW_HEIGHT (f
))
848 height
= FRAME_NEW_HEIGHT (f
);
850 height
= FRAME_HEIGHT (f
);
852 /* Process foreground_color and background_color before anything else.
853 They are independent of other properties, but other properties (e.g.,
854 cursor_color) are dependent upon them. */
855 /* Process default font as well, since fringe widths depends on it. */
856 for (p
= 0; p
< i
; p
++)
858 Lisp_Object prop
, val
;
862 if (EQ (prop
, Qforeground_color
)
863 || EQ (prop
, Qbackground_color
)
865 || EQ (prop
, Qfullscreen
))
867 register Lisp_Object param_index
, old_value
;
869 old_value
= get_frame_param (f
, prop
);
870 fullscreen_is_being_set
|= EQ (prop
, Qfullscreen
);
872 if (NILP (Fequal (val
, old_value
)))
874 store_frame_param (f
, prop
, val
);
876 param_index
= Fget (prop
, Qx_frame_parameter
);
877 if (NATNUMP (param_index
)
878 && (XFASTINT (param_index
)
879 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
880 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
885 /* Now process them in reverse of specified order. */
886 for (i
--; i
>= 0; i
--)
888 Lisp_Object prop
, val
;
893 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
894 width
= XFASTINT (val
);
895 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
896 height
= XFASTINT (val
);
897 else if (EQ (prop
, Qtop
))
899 else if (EQ (prop
, Qleft
))
901 else if (EQ (prop
, Qicon_top
))
903 else if (EQ (prop
, Qicon_left
))
905 else if (EQ (prop
, Qforeground_color
)
906 || EQ (prop
, Qbackground_color
)
908 || EQ (prop
, Qfullscreen
))
909 /* Processed above. */
913 register Lisp_Object param_index
, old_value
;
915 old_value
= get_frame_param (f
, prop
);
917 store_frame_param (f
, prop
, val
);
919 param_index
= Fget (prop
, Qx_frame_parameter
);
920 if (NATNUMP (param_index
)
921 && (XFASTINT (param_index
)
922 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
923 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
927 /* Don't die if just one of these was set. */
928 if (EQ (left
, Qunbound
))
931 if (f
->output_data
.w32
->left_pos
< 0)
932 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
934 XSETINT (left
, f
->output_data
.w32
->left_pos
);
936 if (EQ (top
, Qunbound
))
939 if (f
->output_data
.w32
->top_pos
< 0)
940 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
942 XSETINT (top
, f
->output_data
.w32
->top_pos
);
945 /* If one of the icon positions was not set, preserve or default it. */
946 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
948 icon_left_no_change
= 1;
949 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
950 if (NILP (icon_left
))
951 XSETINT (icon_left
, 0);
953 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
955 icon_top_no_change
= 1;
956 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
958 XSETINT (icon_top
, 0);
961 if (FRAME_VISIBLE_P (f
) && fullscreen_is_being_set
)
963 /* If the frame is visible already and the fullscreen parameter is
964 being set, it is too late to set WM manager hints to specify
966 Here we first get the width, height and position that applies to
967 fullscreen. We then move the frame to the appropriate
968 position. Resize of the frame is taken care of in the code after
969 this if-statement. */
970 int new_left
, new_top
;
972 x_fullscreen_adjust (f
, &width
, &height
, &new_top
, &new_left
);
973 x_fullscreen_move (f
, new_top
, new_left
);
976 /* Don't set these parameters unless they've been explicitly
977 specified. The window might be mapped or resized while we're in
978 this function, and we don't want to override that unless the lisp
979 code has asked for it.
981 Don't set these parameters unless they actually differ from the
982 window's current parameters; the window may not actually exist
987 check_frame_size (f
, &height
, &width
);
989 XSETFRAME (frame
, f
);
991 if (width
!= FRAME_WIDTH (f
)
992 || height
!= FRAME_HEIGHT (f
)
993 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
994 Fset_frame_size (frame
, make_number (width
), make_number (height
));
996 if ((!NILP (left
) || !NILP (top
))
997 && ! (left_no_change
&& top_no_change
)
998 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
999 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
1004 /* Record the signs. */
1005 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1006 if (EQ (left
, Qminus
))
1007 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
1008 else if (INTEGERP (left
))
1010 leftpos
= XINT (left
);
1012 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
1014 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1015 && CONSP (XCDR (left
))
1016 && INTEGERP (XCAR (XCDR (left
))))
1018 leftpos
= - XINT (XCAR (XCDR (left
)));
1019 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
1021 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1022 && CONSP (XCDR (left
))
1023 && INTEGERP (XCAR (XCDR (left
))))
1025 leftpos
= XINT (XCAR (XCDR (left
)));
1028 if (EQ (top
, Qminus
))
1029 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
1030 else if (INTEGERP (top
))
1032 toppos
= XINT (top
);
1034 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
1036 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1037 && CONSP (XCDR (top
))
1038 && INTEGERP (XCAR (XCDR (top
))))
1040 toppos
= - XINT (XCAR (XCDR (top
)));
1041 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
1043 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1044 && CONSP (XCDR (top
))
1045 && INTEGERP (XCAR (XCDR (top
))))
1047 toppos
= XINT (XCAR (XCDR (top
)));
1051 /* Store the numeric value of the position. */
1052 f
->output_data
.w32
->top_pos
= toppos
;
1053 f
->output_data
.w32
->left_pos
= leftpos
;
1055 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
1057 /* Actually set that position, and convert to absolute. */
1058 x_set_offset (f
, leftpos
, toppos
, -1);
1061 if ((!NILP (icon_left
) || !NILP (icon_top
))
1062 && ! (icon_left_no_change
&& icon_top_no_change
))
1063 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1069 /* Store the screen positions of frame F into XPTR and YPTR.
1070 These are the positions of the containing window manager window,
1071 not Emacs's own window. */
1074 x_real_positions (f
, xptr
, yptr
)
1081 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
1082 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
1087 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
1089 /* Remember x_pixels_diff and y_pixels_diff. */
1090 f
->output_data
.w32
->x_pixels_diff
= pt
.x
- rect
.left
;
1091 f
->output_data
.w32
->y_pixels_diff
= pt
.y
- rect
.top
;
1097 /* Insert a description of internally-recorded parameters of frame X
1098 into the parameter alist *ALISTPTR that is to be given to the user.
1099 Only parameters that are specific to W32
1100 and whose values are not correctly recorded in the frame's
1101 param_alist need to be considered here. */
1104 x_report_frame_params (f
, alistptr
)
1106 Lisp_Object
*alistptr
;
1111 /* Represent negative positions (off the top or left screen edge)
1112 in a way that Fmodify_frame_parameters will understand correctly. */
1113 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
1114 if (f
->output_data
.w32
->left_pos
>= 0)
1115 store_in_alist (alistptr
, Qleft
, tem
);
1117 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1119 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
1120 if (f
->output_data
.w32
->top_pos
>= 0)
1121 store_in_alist (alistptr
, Qtop
, tem
);
1123 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1125 store_in_alist (alistptr
, Qborder_width
,
1126 make_number (f
->output_data
.w32
->border_width
));
1127 store_in_alist (alistptr
, Qinternal_border_width
,
1128 make_number (f
->output_data
.w32
->internal_border_width
));
1129 store_in_alist (alistptr
, Qleft_fringe
,
1130 make_number (f
->output_data
.w32
->left_fringe_width
));
1131 store_in_alist (alistptr
, Qright_fringe
,
1132 make_number (f
->output_data
.w32
->right_fringe_width
));
1133 store_in_alist (alistptr
, Qscroll_bar_width
,
1134 make_number (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1135 ? FRAME_SCROLL_BAR_PIXEL_WIDTH(f
)
1137 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
1138 store_in_alist (alistptr
, Qwindow_id
,
1139 build_string (buf
));
1140 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1141 FRAME_SAMPLE_VISIBILITY (f
);
1142 store_in_alist (alistptr
, Qvisibility
,
1143 (FRAME_VISIBLE_P (f
) ? Qt
1144 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1145 store_in_alist (alistptr
, Qdisplay
,
1146 XCAR (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
));
1150 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
,
1151 Sw32_define_rgb_color
, 4, 4, 0,
1152 doc
: /* Convert RGB numbers to a windows color reference and associate with NAME.
1153 This adds or updates a named color to w32-color-map, making it
1154 available for use. The original entry's RGB ref is returned, or nil
1155 if the entry is new. */)
1156 (red
, green
, blue
, name
)
1157 Lisp_Object red
, green
, blue
, name
;
1160 Lisp_Object oldrgb
= Qnil
;
1164 CHECK_NUMBER (green
);
1165 CHECK_NUMBER (blue
);
1166 CHECK_STRING (name
);
1168 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
1172 /* replace existing entry in w32-color-map or add new entry. */
1173 entry
= Fassoc (name
, Vw32_color_map
);
1176 entry
= Fcons (name
, rgb
);
1177 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
1181 oldrgb
= Fcdr (entry
);
1182 Fsetcdr (entry
, rgb
);
1190 DEFUN ("w32-load-color-file", Fw32_load_color_file
,
1191 Sw32_load_color_file
, 1, 1, 0,
1192 doc
: /* Create an alist of color entries from an external file.
1193 Assign this value to w32-color-map to replace the existing color map.
1195 The file should define one named RGB color per line like so:
1197 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
1199 Lisp_Object filename
;
1202 Lisp_Object cmap
= Qnil
;
1203 Lisp_Object abspath
;
1205 CHECK_STRING (filename
);
1206 abspath
= Fexpand_file_name (filename
, Qnil
);
1208 fp
= fopen (SDATA (filename
), "rt");
1212 int red
, green
, blue
;
1217 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
1218 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
1220 char *name
= buf
+ num
;
1221 num
= strlen (name
) - 1;
1222 if (name
[num
] == '\n')
1224 cmap
= Fcons (Fcons (build_string (name
),
1225 make_number (RGB (red
, green
, blue
))),
1237 /* The default colors for the w32 color map */
1238 typedef struct colormap_t
1244 colormap_t w32_color_map
[] =
1246 {"snow" , PALETTERGB (255,250,250)},
1247 {"ghost white" , PALETTERGB (248,248,255)},
1248 {"GhostWhite" , PALETTERGB (248,248,255)},
1249 {"white smoke" , PALETTERGB (245,245,245)},
1250 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1251 {"gainsboro" , PALETTERGB (220,220,220)},
1252 {"floral white" , PALETTERGB (255,250,240)},
1253 {"FloralWhite" , PALETTERGB (255,250,240)},
1254 {"old lace" , PALETTERGB (253,245,230)},
1255 {"OldLace" , PALETTERGB (253,245,230)},
1256 {"linen" , PALETTERGB (250,240,230)},
1257 {"antique white" , PALETTERGB (250,235,215)},
1258 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1259 {"papaya whip" , PALETTERGB (255,239,213)},
1260 {"PapayaWhip" , PALETTERGB (255,239,213)},
1261 {"blanched almond" , PALETTERGB (255,235,205)},
1262 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1263 {"bisque" , PALETTERGB (255,228,196)},
1264 {"peach puff" , PALETTERGB (255,218,185)},
1265 {"PeachPuff" , PALETTERGB (255,218,185)},
1266 {"navajo white" , PALETTERGB (255,222,173)},
1267 {"NavajoWhite" , PALETTERGB (255,222,173)},
1268 {"moccasin" , PALETTERGB (255,228,181)},
1269 {"cornsilk" , PALETTERGB (255,248,220)},
1270 {"ivory" , PALETTERGB (255,255,240)},
1271 {"lemon chiffon" , PALETTERGB (255,250,205)},
1272 {"LemonChiffon" , PALETTERGB (255,250,205)},
1273 {"seashell" , PALETTERGB (255,245,238)},
1274 {"honeydew" , PALETTERGB (240,255,240)},
1275 {"mint cream" , PALETTERGB (245,255,250)},
1276 {"MintCream" , PALETTERGB (245,255,250)},
1277 {"azure" , PALETTERGB (240,255,255)},
1278 {"alice blue" , PALETTERGB (240,248,255)},
1279 {"AliceBlue" , PALETTERGB (240,248,255)},
1280 {"lavender" , PALETTERGB (230,230,250)},
1281 {"lavender blush" , PALETTERGB (255,240,245)},
1282 {"LavenderBlush" , PALETTERGB (255,240,245)},
1283 {"misty rose" , PALETTERGB (255,228,225)},
1284 {"MistyRose" , PALETTERGB (255,228,225)},
1285 {"white" , PALETTERGB (255,255,255)},
1286 {"black" , PALETTERGB ( 0, 0, 0)},
1287 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1288 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1289 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1290 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1291 {"dim gray" , PALETTERGB (105,105,105)},
1292 {"DimGray" , PALETTERGB (105,105,105)},
1293 {"dim grey" , PALETTERGB (105,105,105)},
1294 {"DimGrey" , PALETTERGB (105,105,105)},
1295 {"slate gray" , PALETTERGB (112,128,144)},
1296 {"SlateGray" , PALETTERGB (112,128,144)},
1297 {"slate grey" , PALETTERGB (112,128,144)},
1298 {"SlateGrey" , PALETTERGB (112,128,144)},
1299 {"light slate gray" , PALETTERGB (119,136,153)},
1300 {"LightSlateGray" , PALETTERGB (119,136,153)},
1301 {"light slate grey" , PALETTERGB (119,136,153)},
1302 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1303 {"gray" , PALETTERGB (190,190,190)},
1304 {"grey" , PALETTERGB (190,190,190)},
1305 {"light grey" , PALETTERGB (211,211,211)},
1306 {"LightGrey" , PALETTERGB (211,211,211)},
1307 {"light gray" , PALETTERGB (211,211,211)},
1308 {"LightGray" , PALETTERGB (211,211,211)},
1309 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1310 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1311 {"navy" , PALETTERGB ( 0, 0,128)},
1312 {"navy blue" , PALETTERGB ( 0, 0,128)},
1313 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1314 {"cornflower blue" , PALETTERGB (100,149,237)},
1315 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1316 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1317 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1318 {"slate blue" , PALETTERGB (106, 90,205)},
1319 {"SlateBlue" , PALETTERGB (106, 90,205)},
1320 {"medium slate blue" , PALETTERGB (123,104,238)},
1321 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1322 {"light slate blue" , PALETTERGB (132,112,255)},
1323 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1324 {"medium blue" , PALETTERGB ( 0, 0,205)},
1325 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1326 {"royal blue" , PALETTERGB ( 65,105,225)},
1327 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1328 {"blue" , PALETTERGB ( 0, 0,255)},
1329 {"dodger blue" , PALETTERGB ( 30,144,255)},
1330 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1331 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1332 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1333 {"sky blue" , PALETTERGB (135,206,235)},
1334 {"SkyBlue" , PALETTERGB (135,206,235)},
1335 {"light sky blue" , PALETTERGB (135,206,250)},
1336 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1337 {"steel blue" , PALETTERGB ( 70,130,180)},
1338 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1339 {"light steel blue" , PALETTERGB (176,196,222)},
1340 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1341 {"light blue" , PALETTERGB (173,216,230)},
1342 {"LightBlue" , PALETTERGB (173,216,230)},
1343 {"powder blue" , PALETTERGB (176,224,230)},
1344 {"PowderBlue" , PALETTERGB (176,224,230)},
1345 {"pale turquoise" , PALETTERGB (175,238,238)},
1346 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1347 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1348 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1349 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1350 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1351 {"turquoise" , PALETTERGB ( 64,224,208)},
1352 {"cyan" , PALETTERGB ( 0,255,255)},
1353 {"light cyan" , PALETTERGB (224,255,255)},
1354 {"LightCyan" , PALETTERGB (224,255,255)},
1355 {"cadet blue" , PALETTERGB ( 95,158,160)},
1356 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1357 {"medium aquamarine" , PALETTERGB (102,205,170)},
1358 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1359 {"aquamarine" , PALETTERGB (127,255,212)},
1360 {"dark green" , PALETTERGB ( 0,100, 0)},
1361 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1362 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1363 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1364 {"dark sea green" , PALETTERGB (143,188,143)},
1365 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1366 {"sea green" , PALETTERGB ( 46,139, 87)},
1367 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1368 {"medium sea green" , PALETTERGB ( 60,179,113)},
1369 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1370 {"light sea green" , PALETTERGB ( 32,178,170)},
1371 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1372 {"pale green" , PALETTERGB (152,251,152)},
1373 {"PaleGreen" , PALETTERGB (152,251,152)},
1374 {"spring green" , PALETTERGB ( 0,255,127)},
1375 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1376 {"lawn green" , PALETTERGB (124,252, 0)},
1377 {"LawnGreen" , PALETTERGB (124,252, 0)},
1378 {"green" , PALETTERGB ( 0,255, 0)},
1379 {"chartreuse" , PALETTERGB (127,255, 0)},
1380 {"medium spring green" , PALETTERGB ( 0,250,154)},
1381 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1382 {"green yellow" , PALETTERGB (173,255, 47)},
1383 {"GreenYellow" , PALETTERGB (173,255, 47)},
1384 {"lime green" , PALETTERGB ( 50,205, 50)},
1385 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1386 {"yellow green" , PALETTERGB (154,205, 50)},
1387 {"YellowGreen" , PALETTERGB (154,205, 50)},
1388 {"forest green" , PALETTERGB ( 34,139, 34)},
1389 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1390 {"olive drab" , PALETTERGB (107,142, 35)},
1391 {"OliveDrab" , PALETTERGB (107,142, 35)},
1392 {"dark khaki" , PALETTERGB (189,183,107)},
1393 {"DarkKhaki" , PALETTERGB (189,183,107)},
1394 {"khaki" , PALETTERGB (240,230,140)},
1395 {"pale goldenrod" , PALETTERGB (238,232,170)},
1396 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1397 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1398 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1399 {"light yellow" , PALETTERGB (255,255,224)},
1400 {"LightYellow" , PALETTERGB (255,255,224)},
1401 {"yellow" , PALETTERGB (255,255, 0)},
1402 {"gold" , PALETTERGB (255,215, 0)},
1403 {"light goldenrod" , PALETTERGB (238,221,130)},
1404 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1405 {"goldenrod" , PALETTERGB (218,165, 32)},
1406 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1407 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1408 {"rosy brown" , PALETTERGB (188,143,143)},
1409 {"RosyBrown" , PALETTERGB (188,143,143)},
1410 {"indian red" , PALETTERGB (205, 92, 92)},
1411 {"IndianRed" , PALETTERGB (205, 92, 92)},
1412 {"saddle brown" , PALETTERGB (139, 69, 19)},
1413 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1414 {"sienna" , PALETTERGB (160, 82, 45)},
1415 {"peru" , PALETTERGB (205,133, 63)},
1416 {"burlywood" , PALETTERGB (222,184,135)},
1417 {"beige" , PALETTERGB (245,245,220)},
1418 {"wheat" , PALETTERGB (245,222,179)},
1419 {"sandy brown" , PALETTERGB (244,164, 96)},
1420 {"SandyBrown" , PALETTERGB (244,164, 96)},
1421 {"tan" , PALETTERGB (210,180,140)},
1422 {"chocolate" , PALETTERGB (210,105, 30)},
1423 {"firebrick" , PALETTERGB (178,34, 34)},
1424 {"brown" , PALETTERGB (165,42, 42)},
1425 {"dark salmon" , PALETTERGB (233,150,122)},
1426 {"DarkSalmon" , PALETTERGB (233,150,122)},
1427 {"salmon" , PALETTERGB (250,128,114)},
1428 {"light salmon" , PALETTERGB (255,160,122)},
1429 {"LightSalmon" , PALETTERGB (255,160,122)},
1430 {"orange" , PALETTERGB (255,165, 0)},
1431 {"dark orange" , PALETTERGB (255,140, 0)},
1432 {"DarkOrange" , PALETTERGB (255,140, 0)},
1433 {"coral" , PALETTERGB (255,127, 80)},
1434 {"light coral" , PALETTERGB (240,128,128)},
1435 {"LightCoral" , PALETTERGB (240,128,128)},
1436 {"tomato" , PALETTERGB (255, 99, 71)},
1437 {"orange red" , PALETTERGB (255, 69, 0)},
1438 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1439 {"red" , PALETTERGB (255, 0, 0)},
1440 {"hot pink" , PALETTERGB (255,105,180)},
1441 {"HotPink" , PALETTERGB (255,105,180)},
1442 {"deep pink" , PALETTERGB (255, 20,147)},
1443 {"DeepPink" , PALETTERGB (255, 20,147)},
1444 {"pink" , PALETTERGB (255,192,203)},
1445 {"light pink" , PALETTERGB (255,182,193)},
1446 {"LightPink" , PALETTERGB (255,182,193)},
1447 {"pale violet red" , PALETTERGB (219,112,147)},
1448 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1449 {"maroon" , PALETTERGB (176, 48, 96)},
1450 {"medium violet red" , PALETTERGB (199, 21,133)},
1451 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1452 {"violet red" , PALETTERGB (208, 32,144)},
1453 {"VioletRed" , PALETTERGB (208, 32,144)},
1454 {"magenta" , PALETTERGB (255, 0,255)},
1455 {"violet" , PALETTERGB (238,130,238)},
1456 {"plum" , PALETTERGB (221,160,221)},
1457 {"orchid" , PALETTERGB (218,112,214)},
1458 {"medium orchid" , PALETTERGB (186, 85,211)},
1459 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1460 {"dark orchid" , PALETTERGB (153, 50,204)},
1461 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1462 {"dark violet" , PALETTERGB (148, 0,211)},
1463 {"DarkViolet" , PALETTERGB (148, 0,211)},
1464 {"blue violet" , PALETTERGB (138, 43,226)},
1465 {"BlueViolet" , PALETTERGB (138, 43,226)},
1466 {"purple" , PALETTERGB (160, 32,240)},
1467 {"medium purple" , PALETTERGB (147,112,219)},
1468 {"MediumPurple" , PALETTERGB (147,112,219)},
1469 {"thistle" , PALETTERGB (216,191,216)},
1470 {"gray0" , PALETTERGB ( 0, 0, 0)},
1471 {"grey0" , PALETTERGB ( 0, 0, 0)},
1472 {"dark grey" , PALETTERGB (169,169,169)},
1473 {"DarkGrey" , PALETTERGB (169,169,169)},
1474 {"dark gray" , PALETTERGB (169,169,169)},
1475 {"DarkGray" , PALETTERGB (169,169,169)},
1476 {"dark blue" , PALETTERGB ( 0, 0,139)},
1477 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1478 {"dark cyan" , PALETTERGB ( 0,139,139)},
1479 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1480 {"dark magenta" , PALETTERGB (139, 0,139)},
1481 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1482 {"dark red" , PALETTERGB (139, 0, 0)},
1483 {"DarkRed" , PALETTERGB (139, 0, 0)},
1484 {"light green" , PALETTERGB (144,238,144)},
1485 {"LightGreen" , PALETTERGB (144,238,144)},
1488 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1489 0, 0, 0, doc
: /* Return the default color map. */)
1493 colormap_t
*pc
= w32_color_map
;
1500 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1502 cmap
= Fcons (Fcons (build_string (pc
->name
),
1503 make_number (pc
->colorref
)),
1512 w32_to_x_color (rgb
)
1521 color
= Frassq (rgb
, Vw32_color_map
);
1526 return (Fcar (color
));
1532 w32_color_map_lookup (colorname
)
1535 Lisp_Object tail
, ret
= Qnil
;
1539 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1541 register Lisp_Object elt
, tem
;
1544 if (!CONSP (elt
)) continue;
1548 if (lstrcmpi (SDATA (tem
), colorname
) == 0)
1550 ret
= XUINT (Fcdr (elt
));
1564 x_to_w32_color (colorname
)
1567 register Lisp_Object ret
= Qnil
;
1571 if (colorname
[0] == '#')
1573 /* Could be an old-style RGB Device specification. */
1576 color
= colorname
+ 1;
1578 size
= strlen(color
);
1579 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1587 for (i
= 0; i
< 3; i
++)
1591 unsigned long value
;
1593 /* The check for 'x' in the following conditional takes into
1594 account the fact that strtol allows a "0x" in front of
1595 our numbers, and we don't. */
1596 if (!isxdigit(color
[0]) || color
[1] == 'x')
1600 value
= strtoul(color
, &end
, 16);
1602 if (errno
== ERANGE
|| end
- color
!= size
)
1607 value
= value
* 0x10;
1618 colorval
|= (value
<< pos
);
1629 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1637 color
= colorname
+ 4;
1638 for (i
= 0; i
< 3; i
++)
1641 unsigned long value
;
1643 /* The check for 'x' in the following conditional takes into
1644 account the fact that strtol allows a "0x" in front of
1645 our numbers, and we don't. */
1646 if (!isxdigit(color
[0]) || color
[1] == 'x')
1648 value
= strtoul(color
, &end
, 16);
1649 if (errno
== ERANGE
)
1651 switch (end
- color
)
1654 value
= value
* 0x10 + value
;
1667 if (value
== ULONG_MAX
)
1669 colorval
|= (value
<< pos
);
1683 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1685 /* This is an RGB Intensity specification. */
1692 color
= colorname
+ 5;
1693 for (i
= 0; i
< 3; i
++)
1699 value
= strtod(color
, &end
);
1700 if (errno
== ERANGE
)
1702 if (value
< 0.0 || value
> 1.0)
1704 val
= (UINT
)(0x100 * value
);
1705 /* We used 0x100 instead of 0xFF to give a continuous
1706 range between 0.0 and 1.0 inclusive. The next statement
1707 fixes the 1.0 case. */
1710 colorval
|= (val
<< pos
);
1724 /* I am not going to attempt to handle any of the CIE color schemes
1725 or TekHVC, since I don't know the algorithms for conversion to
1728 /* If we fail to lookup the color name in w32_color_map, then check the
1729 colorname to see if it can be crudely approximated: If the X color
1730 ends in a number (e.g., "darkseagreen2"), strip the number and
1731 return the result of looking up the base color name. */
1732 ret
= w32_color_map_lookup (colorname
);
1735 int len
= strlen (colorname
);
1737 if (isdigit (colorname
[len
- 1]))
1739 char *ptr
, *approx
= alloca (len
+ 1);
1741 strcpy (approx
, colorname
);
1742 ptr
= &approx
[len
- 1];
1743 while (ptr
> approx
&& isdigit (*ptr
))
1746 ret
= w32_color_map_lookup (approx
);
1756 w32_regenerate_palette (FRAME_PTR f
)
1758 struct w32_palette_entry
* list
;
1759 LOGPALETTE
* log_palette
;
1760 HPALETTE new_palette
;
1763 /* don't bother trying to create palette if not supported */
1764 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1767 log_palette
= (LOGPALETTE
*)
1768 alloca (sizeof (LOGPALETTE
) +
1769 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1770 log_palette
->palVersion
= 0x300;
1771 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1773 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1775 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1776 i
++, list
= list
->next
)
1777 log_palette
->palPalEntry
[i
] = list
->entry
;
1779 new_palette
= CreatePalette (log_palette
);
1783 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1784 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1785 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1787 /* Realize display palette and garbage all frames. */
1788 release_frame_dc (f
, get_frame_dc (f
));
1793 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1794 #define SET_W32_COLOR(pe, color) \
1797 pe.peRed = GetRValue (color); \
1798 pe.peGreen = GetGValue (color); \
1799 pe.peBlue = GetBValue (color); \
1804 /* Keep these around in case we ever want to track color usage. */
1806 w32_map_color (FRAME_PTR f
, COLORREF color
)
1808 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1810 if (NILP (Vw32_enable_palette
))
1813 /* check if color is already mapped */
1816 if (W32_COLOR (list
->entry
) == color
)
1824 /* not already mapped, so add to list and recreate Windows palette */
1825 list
= (struct w32_palette_entry
*)
1826 xmalloc (sizeof (struct w32_palette_entry
));
1827 SET_W32_COLOR (list
->entry
, color
);
1829 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1830 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1831 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1833 /* set flag that palette must be regenerated */
1834 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1838 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1840 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1841 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1843 if (NILP (Vw32_enable_palette
))
1846 /* check if color is already mapped */
1849 if (W32_COLOR (list
->entry
) == color
)
1851 if (--list
->refcount
== 0)
1855 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1865 /* set flag that palette must be regenerated */
1866 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1871 /* Gamma-correct COLOR on frame F. */
1874 gamma_correct (f
, color
)
1880 *color
= PALETTERGB (
1881 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1882 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1883 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1888 /* Decide if color named COLOR is valid for the display associated with
1889 the selected frame; if so, return the rgb values in COLOR_DEF.
1890 If ALLOC is nonzero, allocate a new colormap cell. */
1893 w32_defined_color (f
, color
, color_def
, alloc
)
1899 register Lisp_Object tem
;
1900 COLORREF w32_color_ref
;
1902 tem
= x_to_w32_color (color
);
1908 /* Apply gamma correction. */
1909 w32_color_ref
= XUINT (tem
);
1910 gamma_correct (f
, &w32_color_ref
);
1911 XSETINT (tem
, w32_color_ref
);
1914 /* Map this color to the palette if it is enabled. */
1915 if (!NILP (Vw32_enable_palette
))
1917 struct w32_palette_entry
* entry
=
1918 one_w32_display_info
.color_list
;
1919 struct w32_palette_entry
** prev
=
1920 &one_w32_display_info
.color_list
;
1922 /* check if color is already mapped */
1925 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1927 prev
= &entry
->next
;
1928 entry
= entry
->next
;
1931 if (entry
== NULL
&& alloc
)
1933 /* not already mapped, so add to list */
1934 entry
= (struct w32_palette_entry
*)
1935 xmalloc (sizeof (struct w32_palette_entry
));
1936 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1939 one_w32_display_info
.num_colors
++;
1941 /* set flag that palette must be regenerated */
1942 one_w32_display_info
.regen_palette
= TRUE
;
1945 /* Ensure COLORREF value is snapped to nearest color in (default)
1946 palette by simulating the PALETTERGB macro. This works whether
1947 or not the display device has a palette. */
1948 w32_color_ref
= XUINT (tem
) | 0x2000000;
1950 color_def
->pixel
= w32_color_ref
;
1951 color_def
->red
= GetRValue (w32_color_ref
);
1952 color_def
->green
= GetGValue (w32_color_ref
);
1953 color_def
->blue
= GetBValue (w32_color_ref
);
1963 /* Given a string ARG naming a color, compute a pixel value from it
1964 suitable for screen F.
1965 If F is not a color screen, return DEF (default) regardless of what
1969 x_decode_color (f
, arg
, def
)
1978 if (strcmp (SDATA (arg
), "black") == 0)
1979 return BLACK_PIX_DEFAULT (f
);
1980 else if (strcmp (SDATA (arg
), "white") == 0)
1981 return WHITE_PIX_DEFAULT (f
);
1983 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1986 /* w32_defined_color is responsible for coping with failures
1987 by looking for a near-miss. */
1988 if (w32_defined_color (f
, SDATA (arg
), &cdef
, 1))
1991 /* defined_color failed; return an ultimate default. */
1995 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1996 the previous value of that parameter, NEW_VALUE is the new value. */
1999 x_set_line_spacing (f
, new_value
, old_value
)
2001 Lisp_Object new_value
, old_value
;
2003 if (NILP (new_value
))
2004 f
->extra_line_spacing
= 0;
2005 else if (NATNUMP (new_value
))
2006 f
->extra_line_spacing
= XFASTINT (new_value
);
2008 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
2009 Fcons (new_value
, Qnil
)));
2010 if (FRAME_VISIBLE_P (f
))
2015 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
2016 the previous value of that parameter, NEW_VALUE is the new value. */
2019 x_set_fullscreen (f
, new_value
, old_value
)
2021 Lisp_Object new_value
, old_value
;
2023 if (NILP (new_value
))
2024 f
->output_data
.w32
->want_fullscreen
= FULLSCREEN_NONE
;
2025 else if (EQ (new_value
, Qfullboth
))
2026 f
->output_data
.w32
->want_fullscreen
= FULLSCREEN_BOTH
;
2027 else if (EQ (new_value
, Qfullwidth
))
2028 f
->output_data
.w32
->want_fullscreen
= FULLSCREEN_WIDTH
;
2029 else if (EQ (new_value
, Qfullheight
))
2030 f
->output_data
.w32
->want_fullscreen
= FULLSCREEN_HEIGHT
;
2034 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
2035 the previous value of that parameter, NEW_VALUE is the new value. */
2038 x_set_screen_gamma (f
, new_value
, old_value
)
2040 Lisp_Object new_value
, old_value
;
2042 if (NILP (new_value
))
2044 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
2045 /* The value 0.4545 is the normal viewing gamma. */
2046 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
2048 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
2049 Fcons (new_value
, Qnil
)));
2051 clear_face_cache (0);
2055 /* Functions called only from `x_set_frame_param'
2056 to set individual parameters.
2058 If FRAME_W32_WINDOW (f) is 0,
2059 the frame is being created and its window does not exist yet.
2060 In that case, just record the parameter's new value
2061 in the standard place; do not attempt to change the window. */
2064 x_set_foreground_color (f
, arg
, oldval
)
2066 Lisp_Object arg
, oldval
;
2068 struct w32_output
*x
= f
->output_data
.w32
;
2069 PIX_TYPE fg
, old_fg
;
2071 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2072 old_fg
= FRAME_FOREGROUND_PIXEL (f
);
2073 FRAME_FOREGROUND_PIXEL (f
) = fg
;
2075 if (FRAME_W32_WINDOW (f
) != 0)
2077 if (x
->cursor_pixel
== old_fg
)
2078 x
->cursor_pixel
= fg
;
2080 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
2081 if (FRAME_VISIBLE_P (f
))
2087 x_set_background_color (f
, arg
, oldval
)
2089 Lisp_Object arg
, oldval
;
2091 FRAME_BACKGROUND_PIXEL (f
)
2092 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
2094 if (FRAME_W32_WINDOW (f
) != 0)
2096 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
2097 FRAME_BACKGROUND_PIXEL (f
));
2099 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
2101 if (FRAME_VISIBLE_P (f
))
2107 x_set_mouse_color (f
, arg
, oldval
)
2109 Lisp_Object arg
, oldval
;
2111 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
2115 if (!EQ (Qnil
, arg
))
2116 f
->output_data
.w32
->mouse_pixel
2117 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2118 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
2120 /* Don't let pointers be invisible. */
2121 if (mask_color
== f
->output_data
.w32
->mouse_pixel
2122 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
2123 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
2125 #if 0 /* TODO : cursor changes */
2128 /* It's not okay to crash if the user selects a screwy cursor. */
2129 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
2131 if (!EQ (Qnil
, Vx_pointer_shape
))
2133 CHECK_NUMBER (Vx_pointer_shape
);
2134 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
2137 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2138 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
2140 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
2142 CHECK_NUMBER (Vx_nontext_pointer_shape
);
2143 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2144 XINT (Vx_nontext_pointer_shape
));
2147 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
2148 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2150 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
2152 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
2153 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2154 XINT (Vx_hourglass_pointer_shape
));
2157 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
2158 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
2160 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2161 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
2163 CHECK_NUMBER (Vx_mode_pointer_shape
);
2164 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2165 XINT (Vx_mode_pointer_shape
));
2168 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2169 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
2171 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
2173 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
2175 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2176 XINT (Vx_sensitive_text_pointer_shape
));
2179 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
2181 if (!NILP (Vx_window_horizontal_drag_shape
))
2183 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
2184 horizontal_drag_cursor
2185 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
2186 XINT (Vx_window_horizontal_drag_shape
));
2189 horizontal_drag_cursor
2190 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
2192 /* Check and report errors with the above calls. */
2193 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
2194 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
2197 XColor fore_color
, back_color
;
2199 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
2200 back_color
.pixel
= mask_color
;
2201 XQueryColor (FRAME_W32_DISPLAY (f
),
2202 DefaultColormap (FRAME_W32_DISPLAY (f
),
2203 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2205 XQueryColor (FRAME_W32_DISPLAY (f
),
2206 DefaultColormap (FRAME_W32_DISPLAY (f
),
2207 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2209 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
2210 &fore_color
, &back_color
);
2211 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
2212 &fore_color
, &back_color
);
2213 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
2214 &fore_color
, &back_color
);
2215 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
2216 &fore_color
, &back_color
);
2217 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
2218 &fore_color
, &back_color
);
2221 if (FRAME_W32_WINDOW (f
) != 0)
2222 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
2224 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
2225 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
2226 f
->output_data
.w32
->text_cursor
= cursor
;
2228 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
2229 && f
->output_data
.w32
->nontext_cursor
!= 0)
2230 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
2231 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
2233 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
2234 && f
->output_data
.w32
->hourglass_cursor
!= 0)
2235 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
2236 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
2238 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
2239 && f
->output_data
.w32
->modeline_cursor
!= 0)
2240 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
2241 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
2243 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
2244 && f
->output_data
.w32
->cross_cursor
!= 0)
2245 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
2246 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
2248 XFlush (FRAME_W32_DISPLAY (f
));
2251 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
2255 /* Defined in w32term.c. */
2256 void x_update_cursor (struct frame
*f
, int on_p
);
2259 x_set_cursor_color (f
, arg
, oldval
)
2261 Lisp_Object arg
, oldval
;
2263 unsigned long fore_pixel
, pixel
;
2265 if (!NILP (Vx_cursor_fore_pixel
))
2266 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
2267 WHITE_PIX_DEFAULT (f
));
2269 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2271 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2273 /* Make sure that the cursor color differs from the background color. */
2274 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
2276 pixel
= f
->output_data
.w32
->mouse_pixel
;
2277 if (pixel
== fore_pixel
)
2278 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2281 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
2282 f
->output_data
.w32
->cursor_pixel
= pixel
;
2284 if (FRAME_W32_WINDOW (f
) != 0)
2287 /* Update frame's cursor_gc. */
2288 f
->output_data
.w32
->cursor_gc
->foreground
= fore_pixel
;
2289 f
->output_data
.w32
->cursor_gc
->background
= pixel
;
2293 if (FRAME_VISIBLE_P (f
))
2295 x_update_cursor (f
, 0);
2296 x_update_cursor (f
, 1);
2300 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
2303 /* Set the border-color of frame F to pixel value PIX.
2304 Note that this does not fully take effect if done before
2307 x_set_border_pixel (f
, pix
)
2311 f
->output_data
.w32
->border_pixel
= pix
;
2313 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
2315 if (FRAME_VISIBLE_P (f
))
2320 /* Set the border-color of frame F to value described by ARG.
2321 ARG can be a string naming a color.
2322 The border-color is used for the border that is drawn by the server.
2323 Note that this does not fully take effect if done before
2324 F has a window; it must be redone when the window is created. */
2327 x_set_border_color (f
, arg
, oldval
)
2329 Lisp_Object arg
, oldval
;
2334 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2335 x_set_border_pixel (f
, pix
);
2336 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
2341 x_set_cursor_type (f
, arg
, oldval
)
2343 Lisp_Object arg
, oldval
;
2345 set_frame_cursor_types (f
, arg
);
2347 /* Make sure the cursor gets redrawn. This is overkill, but how
2348 often do people change cursor types? */
2349 update_mode_lines
++;
2353 x_set_icon_type (f
, arg
, oldval
)
2355 Lisp_Object arg
, oldval
;
2359 if (NILP (arg
) && NILP (oldval
))
2362 if (STRINGP (arg
) && STRINGP (oldval
)
2363 && EQ (Fstring_equal (oldval
, arg
), Qt
))
2366 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
2371 result
= x_bitmap_icon (f
, arg
);
2375 error ("No icon window available");
2381 /* Return non-nil if frame F wants a bitmap icon. */
2389 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
2397 x_set_icon_name (f
, arg
, oldval
)
2399 Lisp_Object arg
, oldval
;
2403 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2406 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2412 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2417 result
= x_text_icon (f
,
2418 (char *) SDATA ((!NILP (f
->icon_name
)
2427 error ("No icon window available");
2430 /* If the window was unmapped (and its icon was mapped),
2431 the new icon is not mapped, so map the window in its stead. */
2432 if (FRAME_VISIBLE_P (f
))
2434 #ifdef USE_X_TOOLKIT
2435 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2437 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2440 XFlush (FRAME_W32_DISPLAY (f
));
2445 extern Lisp_Object
x_new_font ();
2446 extern Lisp_Object
x_new_fontset();
2449 x_set_font (f
, arg
, oldval
)
2451 Lisp_Object arg
, oldval
;
2454 Lisp_Object fontset_name
;
2456 int old_fontset
= FRAME_FONTSET(f
);
2460 fontset_name
= Fquery_fontset (arg
, Qnil
);
2463 result
= (STRINGP (fontset_name
)
2464 ? x_new_fontset (f
, SDATA (fontset_name
))
2465 : x_new_font (f
, SDATA (arg
)));
2468 if (EQ (result
, Qnil
))
2469 error ("Font `%s' is not defined", SDATA (arg
));
2470 else if (EQ (result
, Qt
))
2471 error ("The characters of the given font have varying widths");
2472 else if (STRINGP (result
))
2474 if (STRINGP (fontset_name
))
2476 /* Fontset names are built from ASCII font names, so the
2477 names may be equal despite there was a change. */
2478 if (old_fontset
== FRAME_FONTSET (f
))
2481 else if (!NILP (Fequal (result
, oldval
)))
2484 store_frame_param (f
, Qfont
, result
);
2485 recompute_basic_faces (f
);
2490 do_pending_window_change (0);
2492 /* Don't call `face-set-after-frame-default' when faces haven't been
2493 initialized yet. This is the case when called from
2494 Fx_create_frame. In that case, the X widget or window doesn't
2495 exist either, and we can end up in x_report_frame_params with a
2496 null widget which gives a segfault. */
2497 if (FRAME_FACE_CACHE (f
))
2499 XSETFRAME (frame
, f
);
2500 call1 (Qface_set_after_frame_default
, frame
);
2505 x_set_fringe_width (f
, new_value
, old_value
)
2507 Lisp_Object new_value
, old_value
;
2509 x_compute_fringe_widths (f
, 1);
2513 x_set_border_width (f
, arg
, oldval
)
2515 Lisp_Object arg
, oldval
;
2519 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2522 if (FRAME_W32_WINDOW (f
) != 0)
2523 error ("Cannot change the border width of a window");
2525 f
->output_data
.w32
->border_width
= XINT (arg
);
2529 x_set_internal_border_width (f
, arg
, oldval
)
2531 Lisp_Object arg
, oldval
;
2533 int old
= f
->output_data
.w32
->internal_border_width
;
2536 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2537 if (f
->output_data
.w32
->internal_border_width
< 0)
2538 f
->output_data
.w32
->internal_border_width
= 0;
2540 if (f
->output_data
.w32
->internal_border_width
== old
)
2543 if (FRAME_W32_WINDOW (f
) != 0)
2545 x_set_window_size (f
, 0, f
->width
, f
->height
);
2546 SET_FRAME_GARBAGED (f
);
2547 do_pending_window_change (0);
2550 SET_FRAME_GARBAGED (f
);
2554 x_set_visibility (f
, value
, oldval
)
2556 Lisp_Object value
, oldval
;
2559 XSETFRAME (frame
, f
);
2562 Fmake_frame_invisible (frame
, Qt
);
2563 else if (EQ (value
, Qicon
))
2564 Ficonify_frame (frame
);
2566 Fmake_frame_visible (frame
);
2570 /* Change window heights in windows rooted in WINDOW by N lines. */
2573 x_change_window_heights (window
, n
)
2577 struct window
*w
= XWINDOW (window
);
2579 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2580 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2582 if (INTEGERP (w
->orig_top
))
2583 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2584 if (INTEGERP (w
->orig_height
))
2585 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2587 /* Handle just the top child in a vertical split. */
2588 if (!NILP (w
->vchild
))
2589 x_change_window_heights (w
->vchild
, n
);
2591 /* Adjust all children in a horizontal split. */
2592 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2594 w
= XWINDOW (window
);
2595 x_change_window_heights (window
, n
);
2600 x_set_menu_bar_lines (f
, value
, oldval
)
2602 Lisp_Object value
, oldval
;
2605 int olines
= FRAME_MENU_BAR_LINES (f
);
2607 /* Right now, menu bars don't work properly in minibuf-only frames;
2608 most of the commands try to apply themselves to the minibuffer
2609 frame itself, and get an error because you can't switch buffers
2610 in or split the minibuffer window. */
2611 if (FRAME_MINIBUF_ONLY_P (f
))
2614 if (INTEGERP (value
))
2615 nlines
= XINT (value
);
2619 FRAME_MENU_BAR_LINES (f
) = 0;
2621 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2624 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2625 free_frame_menubar (f
);
2626 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2628 /* Adjust the frame size so that the client (text) dimensions
2629 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2631 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2632 do_pending_window_change (0);
2638 /* Set the number of lines used for the tool bar of frame F to VALUE.
2639 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2640 is the old number of tool bar lines. This function changes the
2641 height of all windows on frame F to match the new tool bar height.
2642 The frame's height doesn't change. */
2645 x_set_tool_bar_lines (f
, value
, oldval
)
2647 Lisp_Object value
, oldval
;
2649 int delta
, nlines
, root_height
;
2650 Lisp_Object root_window
;
2652 /* Treat tool bars like menu bars. */
2653 if (FRAME_MINIBUF_ONLY_P (f
))
2656 /* Use VALUE only if an integer >= 0. */
2657 if (INTEGERP (value
) && XINT (value
) >= 0)
2658 nlines
= XFASTINT (value
);
2662 /* Make sure we redisplay all windows in this frame. */
2663 ++windows_or_buffers_changed
;
2665 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2667 /* Don't resize the tool-bar to more than we have room for. */
2668 root_window
= FRAME_ROOT_WINDOW (f
);
2669 root_height
= XINT (XWINDOW (root_window
)->height
);
2670 if (root_height
- delta
< 1)
2672 delta
= root_height
- 1;
2673 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2676 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2677 x_change_window_heights (root_window
, delta
);
2680 /* We also have to make sure that the internal border at the top of
2681 the frame, below the menu bar or tool bar, is redrawn when the
2682 tool bar disappears. This is so because the internal border is
2683 below the tool bar if one is displayed, but is below the menu bar
2684 if there isn't a tool bar. The tool bar draws into the area
2685 below the menu bar. */
2686 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2690 clear_current_matrices (f
);
2691 updating_frame
= NULL
;
2694 /* If the tool bar gets smaller, the internal border below it
2695 has to be cleared. It was formerly part of the display
2696 of the larger tool bar, and updating windows won't clear it. */
2699 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2700 int width
= PIXEL_WIDTH (f
);
2701 int y
= nlines
* CANON_Y_UNIT (f
);
2705 HDC hdc
= get_frame_dc (f
);
2706 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
2707 release_frame_dc (f
, hdc
);
2711 if (WINDOWP (f
->tool_bar_window
))
2712 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2717 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2720 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2721 name; if NAME is a string, set F's name to NAME and set
2722 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2724 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2725 suggesting a new name, which lisp code should override; if
2726 F->explicit_name is set, ignore the new name; otherwise, set it. */
2729 x_set_name (f
, name
, explicit)
2734 /* Make sure that requests from lisp code override requests from
2735 Emacs redisplay code. */
2738 /* If we're switching from explicit to implicit, we had better
2739 update the mode lines and thereby update the title. */
2740 if (f
->explicit_name
&& NILP (name
))
2741 update_mode_lines
= 1;
2743 f
->explicit_name
= ! NILP (name
);
2745 else if (f
->explicit_name
)
2748 /* If NAME is nil, set the name to the w32_id_name. */
2751 /* Check for no change needed in this very common case
2752 before we do any consing. */
2753 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2756 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2759 CHECK_STRING (name
);
2761 /* Don't change the name if it's already NAME. */
2762 if (! NILP (Fstring_equal (name
, f
->name
)))
2767 /* For setting the frame title, the title parameter should override
2768 the name parameter. */
2769 if (! NILP (f
->title
))
2772 if (FRAME_W32_WINDOW (f
))
2774 if (STRING_MULTIBYTE (name
))
2775 name
= ENCODE_SYSTEM (name
);
2778 SetWindowText(FRAME_W32_WINDOW (f
), SDATA (name
));
2783 /* This function should be called when the user's lisp code has
2784 specified a name for the frame; the name will override any set by the
2787 x_explicitly_set_name (f
, arg
, oldval
)
2789 Lisp_Object arg
, oldval
;
2791 x_set_name (f
, arg
, 1);
2794 /* This function should be called by Emacs redisplay code to set the
2795 name; names set this way will never override names set by the user's
2798 x_implicitly_set_name (f
, arg
, oldval
)
2800 Lisp_Object arg
, oldval
;
2802 x_set_name (f
, arg
, 0);
2805 /* Change the title of frame F to NAME.
2806 If NAME is nil, use the frame name as the title.
2808 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2809 name; if NAME is a string, set F's name to NAME and set
2810 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2812 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2813 suggesting a new name, which lisp code should override; if
2814 F->explicit_name is set, ignore the new name; otherwise, set it. */
2817 x_set_title (f
, name
, old_name
)
2819 Lisp_Object name
, old_name
;
2821 /* Don't change the title if it's already NAME. */
2822 if (EQ (name
, f
->title
))
2825 update_mode_lines
= 1;
2832 if (FRAME_W32_WINDOW (f
))
2834 if (STRING_MULTIBYTE (name
))
2835 name
= ENCODE_SYSTEM (name
);
2838 SetWindowText(FRAME_W32_WINDOW (f
), SDATA (name
));
2844 x_set_autoraise (f
, arg
, oldval
)
2846 Lisp_Object arg
, oldval
;
2848 f
->auto_raise
= !EQ (Qnil
, arg
);
2852 x_set_autolower (f
, arg
, oldval
)
2854 Lisp_Object arg
, oldval
;
2856 f
->auto_lower
= !EQ (Qnil
, arg
);
2860 x_set_unsplittable (f
, arg
, oldval
)
2862 Lisp_Object arg
, oldval
;
2864 f
->no_split
= !NILP (arg
);
2868 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2870 Lisp_Object arg
, oldval
;
2872 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2873 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2874 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2875 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2877 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2878 vertical_scroll_bar_none
:
2879 /* Put scroll bars on the right by default, as is conventional
2882 ? vertical_scroll_bar_left
2883 : vertical_scroll_bar_right
;
2885 /* We set this parameter before creating the window for the
2886 frame, so we can get the geometry right from the start.
2887 However, if the window hasn't been created yet, we shouldn't
2888 call x_set_window_size. */
2889 if (FRAME_W32_WINDOW (f
))
2890 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2891 do_pending_window_change (0);
2896 x_set_scroll_bar_width (f
, arg
, oldval
)
2898 Lisp_Object arg
, oldval
;
2900 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2904 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
2905 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) +
2907 if (FRAME_W32_WINDOW (f
))
2908 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2909 do_pending_window_change (0);
2911 else if (INTEGERP (arg
) && XINT (arg
) > 0
2912 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2914 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2915 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2917 if (FRAME_W32_WINDOW (f
))
2918 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2919 do_pending_window_change (0);
2921 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2922 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2923 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2926 /* Subroutines of creating a frame. */
2928 /* Make sure that Vx_resource_name is set to a reasonable value.
2929 Fix it up, or set it to `emacs' if it is too hopeless. */
2932 validate_x_resource_name ()
2935 /* Number of valid characters in the resource name. */
2937 /* Number of invalid characters in the resource name. */
2942 if (STRINGP (Vx_resource_name
))
2944 unsigned char *p
= SDATA (Vx_resource_name
);
2947 len
= SBYTES (Vx_resource_name
);
2949 /* Only letters, digits, - and _ are valid in resource names.
2950 Count the valid characters and count the invalid ones. */
2951 for (i
= 0; i
< len
; i
++)
2954 if (! ((c
>= 'a' && c
<= 'z')
2955 || (c
>= 'A' && c
<= 'Z')
2956 || (c
>= '0' && c
<= '9')
2957 || c
== '-' || c
== '_'))
2964 /* Not a string => completely invalid. */
2965 bad_count
= 5, good_count
= 0;
2967 /* If name is valid already, return. */
2971 /* If name is entirely invalid, or nearly so, use `emacs'. */
2973 || (good_count
== 1 && bad_count
> 0))
2975 Vx_resource_name
= build_string ("emacs");
2979 /* Name is partly valid. Copy it and replace the invalid characters
2980 with underscores. */
2982 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2984 for (i
= 0; i
< len
; i
++)
2986 int c
= SREF (new, i
);
2987 if (! ((c
>= 'a' && c
<= 'z')
2988 || (c
>= 'A' && c
<= 'Z')
2989 || (c
>= '0' && c
<= '9')
2990 || c
== '-' || c
== '_'))
2996 extern char *x_get_string_resource ();
2998 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2999 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3000 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3001 class, where INSTANCE is the name under which Emacs was invoked, or
3002 the name specified by the `-name' or `-rn' command-line arguments.
3004 The optional arguments COMPONENT and SUBCLASS add to the key and the
3005 class, respectively. You must specify both of them or neither.
3006 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3007 and the class is `Emacs.CLASS.SUBCLASS'. */)
3008 (attribute
, class, component
, subclass
)
3009 Lisp_Object attribute
, class, component
, subclass
;
3011 register char *value
;
3015 CHECK_STRING (attribute
);
3016 CHECK_STRING (class);
3018 if (!NILP (component
))
3019 CHECK_STRING (component
);
3020 if (!NILP (subclass
))
3021 CHECK_STRING (subclass
);
3022 if (NILP (component
) != NILP (subclass
))
3023 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3025 validate_x_resource_name ();
3027 /* Allocate space for the components, the dots which separate them,
3028 and the final '\0'. Make them big enough for the worst case. */
3029 name_key
= (char *) alloca (SBYTES (Vx_resource_name
)
3030 + (STRINGP (component
)
3031 ? SBYTES (component
) : 0)
3032 + SBYTES (attribute
)
3035 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3037 + (STRINGP (subclass
)
3038 ? SBYTES (subclass
) : 0)
3041 /* Start with emacs.FRAMENAME for the name (the specific one)
3042 and with `Emacs' for the class key (the general one). */
3043 strcpy (name_key
, SDATA (Vx_resource_name
));
3044 strcpy (class_key
, EMACS_CLASS
);
3046 strcat (class_key
, ".");
3047 strcat (class_key
, SDATA (class));
3049 if (!NILP (component
))
3051 strcat (class_key
, ".");
3052 strcat (class_key
, SDATA (subclass
));
3054 strcat (name_key
, ".");
3055 strcat (name_key
, SDATA (component
));
3058 strcat (name_key
, ".");
3059 strcat (name_key
, SDATA (attribute
));
3061 value
= x_get_string_resource (Qnil
,
3062 name_key
, class_key
);
3064 if (value
!= (char *) 0)
3065 return build_string (value
);
3070 /* Used when C code wants a resource value. */
3073 x_get_resource_string (attribute
, class)
3074 char *attribute
, *class;
3078 struct frame
*sf
= SELECTED_FRAME ();
3080 /* Allocate space for the components, the dots which separate them,
3081 and the final '\0'. */
3082 name_key
= (char *) alloca (SBYTES (Vinvocation_name
)
3083 + strlen (attribute
) + 2);
3084 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3085 + strlen (class) + 2);
3087 sprintf (name_key
, "%s.%s",
3088 SDATA (Vinvocation_name
),
3090 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3092 return x_get_string_resource (sf
, name_key
, class_key
);
3095 /* Types we might convert a resource string into. */
3105 /* Return the value of parameter PARAM.
3107 First search ALIST, then Vdefault_frame_alist, then the X defaults
3108 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3110 Convert the resource to the type specified by desired_type.
3112 If no default is specified, return Qunbound. If you call
3113 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
3114 and don't let it get stored in any Lisp-visible variables! */
3117 w32_get_arg (alist
, param
, attribute
, class, type
)
3118 Lisp_Object alist
, param
;
3121 enum resource_types type
;
3123 register Lisp_Object tem
;
3125 tem
= Fassq (param
, alist
);
3127 tem
= Fassq (param
, Vdefault_frame_alist
);
3133 tem
= Fx_get_resource (build_string (attribute
),
3134 build_string (class),
3142 case RES_TYPE_NUMBER
:
3143 return make_number (atoi (SDATA (tem
)));
3145 case RES_TYPE_FLOAT
:
3146 return make_float (atof (SDATA (tem
)));
3148 case RES_TYPE_BOOLEAN
:
3149 tem
= Fdowncase (tem
);
3150 if (!strcmp (SDATA (tem
), "on")
3151 || !strcmp (SDATA (tem
), "true"))
3156 case RES_TYPE_STRING
:
3159 case RES_TYPE_SYMBOL
:
3160 /* As a special case, we map the values `true' and `on'
3161 to Qt, and `false' and `off' to Qnil. */
3164 lower
= Fdowncase (tem
);
3165 if (!strcmp (SDATA (lower
), "on")
3166 || !strcmp (SDATA (lower
), "true"))
3168 else if (!strcmp (SDATA (lower
), "off")
3169 || !strcmp (SDATA (lower
), "false"))
3172 return Fintern (tem
, Qnil
);
3185 /* Record in frame F the specified or default value according to ALIST
3186 of the parameter named PROP (a Lisp symbol).
3187 If no value is specified for PROP, look for an X default for XPROP
3188 on the frame named NAME.
3189 If that is not found either, use the value DEFLT. */
3192 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3199 enum resource_types type
;
3203 tem
= w32_get_arg (alist
, prop
, xprop
, xclass
, type
);
3204 if (EQ (tem
, Qunbound
))
3206 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3210 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3211 doc
: /* Parse an X-style geometry string STRING.
3212 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3213 The properties returned may include `top', `left', `height', and `width'.
3214 The value of `left' or `top' may be an integer,
3215 or a list (+ N) meaning N pixels relative to top/left corner,
3216 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3221 unsigned int width
, height
;
3224 CHECK_STRING (string
);
3226 geometry
= XParseGeometry ((char *) SDATA (string
),
3227 &x
, &y
, &width
, &height
);
3230 if (geometry
& XValue
)
3232 Lisp_Object element
;
3234 if (x
>= 0 && (geometry
& XNegative
))
3235 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3236 else if (x
< 0 && ! (geometry
& XNegative
))
3237 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3239 element
= Fcons (Qleft
, make_number (x
));
3240 result
= Fcons (element
, result
);
3243 if (geometry
& YValue
)
3245 Lisp_Object element
;
3247 if (y
>= 0 && (geometry
& YNegative
))
3248 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3249 else if (y
< 0 && ! (geometry
& YNegative
))
3250 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3252 element
= Fcons (Qtop
, make_number (y
));
3253 result
= Fcons (element
, result
);
3256 if (geometry
& WidthValue
)
3257 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3258 if (geometry
& HeightValue
)
3259 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3264 /* Calculate the desired size and position of this window,
3265 and return the flags saying which aspects were specified.
3267 This function does not make the coordinates positive. */
3269 #define DEFAULT_ROWS 40
3270 #define DEFAULT_COLS 80
3273 x_figure_window_size (f
, parms
)
3277 register Lisp_Object tem0
, tem1
, tem2
;
3278 long window_prompting
= 0;
3280 /* Default values if we fall through.
3281 Actually, if that happens we should get
3282 window manager prompting. */
3283 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3284 f
->height
= DEFAULT_ROWS
;
3285 /* Window managers expect that if program-specified
3286 positions are not (0,0), they're intentional, not defaults. */
3287 f
->output_data
.w32
->top_pos
= 0;
3288 f
->output_data
.w32
->left_pos
= 0;
3290 /* Ensure that old new_width and new_height will not override the
3292 FRAME_NEW_WIDTH (f
) = 0;
3293 FRAME_NEW_HEIGHT (f
) = 0;
3295 tem0
= w32_get_arg (parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3296 tem1
= w32_get_arg (parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3297 tem2
= w32_get_arg (parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3298 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3300 if (!EQ (tem0
, Qunbound
))
3302 CHECK_NUMBER (tem0
);
3303 f
->height
= XINT (tem0
);
3305 if (!EQ (tem1
, Qunbound
))
3307 CHECK_NUMBER (tem1
);
3308 SET_FRAME_WIDTH (f
, XINT (tem1
));
3310 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3311 window_prompting
|= USSize
;
3313 window_prompting
|= PSize
;
3316 f
->output_data
.w32
->vertical_scroll_bar_extra
3317 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3319 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
3320 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
3321 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
3323 x_compute_fringe_widths (f
, 0);
3325 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3326 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3328 tem0
= w32_get_arg (parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3329 tem1
= w32_get_arg (parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3330 tem2
= w32_get_arg (parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3331 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3333 if (EQ (tem0
, Qminus
))
3335 f
->output_data
.w32
->top_pos
= 0;
3336 window_prompting
|= YNegative
;
3338 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3339 && CONSP (XCDR (tem0
))
3340 && INTEGERP (XCAR (XCDR (tem0
))))
3342 f
->output_data
.w32
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3343 window_prompting
|= YNegative
;
3345 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3346 && CONSP (XCDR (tem0
))
3347 && INTEGERP (XCAR (XCDR (tem0
))))
3349 f
->output_data
.w32
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3351 else if (EQ (tem0
, Qunbound
))
3352 f
->output_data
.w32
->top_pos
= 0;
3355 CHECK_NUMBER (tem0
);
3356 f
->output_data
.w32
->top_pos
= XINT (tem0
);
3357 if (f
->output_data
.w32
->top_pos
< 0)
3358 window_prompting
|= YNegative
;
3361 if (EQ (tem1
, Qminus
))
3363 f
->output_data
.w32
->left_pos
= 0;
3364 window_prompting
|= XNegative
;
3366 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3367 && CONSP (XCDR (tem1
))
3368 && INTEGERP (XCAR (XCDR (tem1
))))
3370 f
->output_data
.w32
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3371 window_prompting
|= XNegative
;
3373 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3374 && CONSP (XCDR (tem1
))
3375 && INTEGERP (XCAR (XCDR (tem1
))))
3377 f
->output_data
.w32
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3379 else if (EQ (tem1
, Qunbound
))
3380 f
->output_data
.w32
->left_pos
= 0;
3383 CHECK_NUMBER (tem1
);
3384 f
->output_data
.w32
->left_pos
= XINT (tem1
);
3385 if (f
->output_data
.w32
->left_pos
< 0)
3386 window_prompting
|= XNegative
;
3389 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3390 window_prompting
|= USPosition
;
3392 window_prompting
|= PPosition
;
3395 if (f
->output_data
.w32
->want_fullscreen
!= FULLSCREEN_NONE
)
3400 /* It takes both for some WM:s to place it where we want */
3401 window_prompting
= USPosition
| PPosition
;
3402 x_fullscreen_adjust (f
, &width
, &height
, &top
, &left
);
3405 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3406 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3407 f
->output_data
.w32
->left_pos
= left
;
3408 f
->output_data
.w32
->top_pos
= top
;
3411 return window_prompting
;
3416 extern LRESULT CALLBACK
w32_wnd_proc ();
3419 w32_init_class (hinst
)
3424 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
3425 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
3427 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
3428 wc
.hInstance
= hinst
;
3429 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
3430 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
3431 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
3432 wc
.lpszMenuName
= NULL
;
3433 wc
.lpszClassName
= EMACS_CLASS
;
3435 return (RegisterClass (&wc
));
3439 w32_createscrollbar (f
, bar
)
3441 struct scroll_bar
* bar
;
3443 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
3444 /* Position and size of scroll bar. */
3445 XINT(bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
3447 XINT(bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
3449 FRAME_W32_WINDOW (f
),
3456 w32_createwindow (f
)
3462 rect
.left
= rect
.top
= 0;
3463 rect
.right
= PIXEL_WIDTH (f
);
3464 rect
.bottom
= PIXEL_HEIGHT (f
);
3466 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
3467 FRAME_EXTERNAL_MENU_BAR (f
));
3469 /* Do first time app init */
3473 w32_init_class (hinst
);
3476 FRAME_W32_WINDOW (f
) = hwnd
3477 = CreateWindow (EMACS_CLASS
,
3479 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
3480 f
->output_data
.w32
->left_pos
,
3481 f
->output_data
.w32
->top_pos
,
3482 rect
.right
- rect
.left
,
3483 rect
.bottom
- rect
.top
,
3491 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
3492 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
3493 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
3494 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
3495 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
3497 /* Enable drag-n-drop. */
3498 DragAcceptFiles (hwnd
, TRUE
);
3500 /* Do this to discard the default setting specified by our parent. */
3501 ShowWindow (hwnd
, SW_HIDE
);
3506 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
3513 wmsg
->msg
.hwnd
= hwnd
;
3514 wmsg
->msg
.message
= msg
;
3515 wmsg
->msg
.wParam
= wParam
;
3516 wmsg
->msg
.lParam
= lParam
;
3517 wmsg
->msg
.time
= GetMessageTime ();
3522 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
3523 between left and right keys as advertised. We test for this
3524 support dynamically, and set a flag when the support is absent. If
3525 absent, we keep track of the left and right control and alt keys
3526 ourselves. This is particularly necessary on keyboards that rely
3527 upon the AltGr key, which is represented as having the left control
3528 and right alt keys pressed. For these keyboards, we need to know
3529 when the left alt key has been pressed in addition to the AltGr key
3530 so that we can properly support M-AltGr-key sequences (such as M-@
3531 on Swedish keyboards). */
3533 #define EMACS_LCONTROL 0
3534 #define EMACS_RCONTROL 1
3535 #define EMACS_LMENU 2
3536 #define EMACS_RMENU 3
3538 static int modifiers
[4];
3539 static int modifiers_recorded
;
3540 static int modifier_key_support_tested
;
3543 test_modifier_support (unsigned int wparam
)
3547 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3549 if (wparam
== VK_CONTROL
)
3559 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
3560 modifiers_recorded
= 1;
3562 modifiers_recorded
= 0;
3563 modifier_key_support_tested
= 1;
3567 record_keydown (unsigned int wparam
, unsigned int lparam
)
3571 if (!modifier_key_support_tested
)
3572 test_modifier_support (wparam
);
3574 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3577 if (wparam
== VK_CONTROL
)
3578 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3580 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3586 record_keyup (unsigned int wparam
, unsigned int lparam
)
3590 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3593 if (wparam
== VK_CONTROL
)
3594 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3596 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3601 /* Emacs can lose focus while a modifier key has been pressed. When
3602 it regains focus, be conservative and clear all modifiers since
3603 we cannot reconstruct the left and right modifier state. */
3609 if (GetFocus () == NULL
)
3610 /* Emacs doesn't have keyboard focus. Do nothing. */
3613 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3614 alt
= GetAsyncKeyState (VK_MENU
);
3616 if (!(ctrl
& 0x08000))
3617 /* Clear any recorded control modifier state. */
3618 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3620 if (!(alt
& 0x08000))
3621 /* Clear any recorded alt modifier state. */
3622 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3624 /* Update the state of all modifier keys, because modifiers used in
3625 hot-key combinations can get stuck on if Emacs loses focus as a
3626 result of a hot-key being pressed. */
3630 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3632 GetKeyboardState (keystate
);
3633 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
3634 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
3635 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
3636 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
3637 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
3638 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
3639 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
3640 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
3641 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
3642 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
3643 SetKeyboardState (keystate
);
3647 /* Synchronize modifier state with what is reported with the current
3648 keystroke. Even if we cannot distinguish between left and right
3649 modifier keys, we know that, if no modifiers are set, then neither
3650 the left or right modifier should be set. */
3654 if (!modifiers_recorded
)
3657 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3658 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3660 if (!(GetKeyState (VK_MENU
) & 0x8000))
3661 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3665 modifier_set (int vkey
)
3667 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
3668 return (GetKeyState (vkey
) & 0x1);
3669 if (!modifiers_recorded
)
3670 return (GetKeyState (vkey
) & 0x8000);
3675 return modifiers
[EMACS_LCONTROL
];
3677 return modifiers
[EMACS_RCONTROL
];
3679 return modifiers
[EMACS_LMENU
];
3681 return modifiers
[EMACS_RMENU
];
3683 return (GetKeyState (vkey
) & 0x8000);
3686 /* Convert between the modifier bits W32 uses and the modifier bits
3690 w32_key_to_modifier (int key
)
3692 Lisp_Object key_mapping
;
3697 key_mapping
= Vw32_lwindow_modifier
;
3700 key_mapping
= Vw32_rwindow_modifier
;
3703 key_mapping
= Vw32_apps_modifier
;
3706 key_mapping
= Vw32_scroll_lock_modifier
;
3712 /* NB. This code runs in the input thread, asychronously to the lisp
3713 thread, so we must be careful to ensure access to lisp data is
3714 thread-safe. The following code is safe because the modifier
3715 variable values are updated atomically from lisp and symbols are
3716 not relocated by GC. Also, we don't have to worry about seeing GC
3718 if (EQ (key_mapping
, Qhyper
))
3719 return hyper_modifier
;
3720 if (EQ (key_mapping
, Qsuper
))
3721 return super_modifier
;
3722 if (EQ (key_mapping
, Qmeta
))
3723 return meta_modifier
;
3724 if (EQ (key_mapping
, Qalt
))
3725 return alt_modifier
;
3726 if (EQ (key_mapping
, Qctrl
))
3727 return ctrl_modifier
;
3728 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
3729 return ctrl_modifier
;
3730 if (EQ (key_mapping
, Qshift
))
3731 return shift_modifier
;
3733 /* Don't generate any modifier if not explicitly requested. */
3738 w32_get_modifiers ()
3740 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
3741 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
3742 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
3743 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
3744 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
3745 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
3746 (modifier_set (VK_MENU
) ?
3747 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
3750 /* We map the VK_* modifiers into console modifier constants
3751 so that we can use the same routines to handle both console
3752 and window input. */
3755 construct_console_modifiers ()
3760 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3761 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3762 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
3763 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
3764 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3765 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3766 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3767 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3768 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
3769 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
3770 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
3776 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
3780 /* Convert to emacs modifiers. */
3781 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
3787 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
3789 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
3792 if (virt_key
== VK_RETURN
)
3793 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3795 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
3796 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
3798 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
3799 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
3801 if (virt_key
== VK_CLEAR
)
3802 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
3807 /* List of special key combinations which w32 would normally capture,
3808 but emacs should grab instead. Not directly visible to lisp, to
3809 simplify synchronization. Each item is an integer encoding a virtual
3810 key code and modifier combination to capture. */
3811 Lisp_Object w32_grabbed_keys
;
3813 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3814 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3815 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3816 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3818 /* Register hot-keys for reserved key combinations when Emacs has
3819 keyboard focus, since this is the only way Emacs can receive key
3820 combinations like Alt-Tab which are used by the system. */
3823 register_hot_keys (hwnd
)
3826 Lisp_Object keylist
;
3828 /* Use GC_CONSP, since we are called asynchronously. */
3829 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3831 Lisp_Object key
= XCAR (keylist
);
3833 /* Deleted entries get set to nil. */
3834 if (!INTEGERP (key
))
3837 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
3838 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
3843 unregister_hot_keys (hwnd
)
3846 Lisp_Object keylist
;
3848 /* Use GC_CONSP, since we are called asynchronously. */
3849 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3851 Lisp_Object key
= XCAR (keylist
);
3853 if (!INTEGERP (key
))
3856 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
3860 /* Main message dispatch loop. */
3863 w32_msg_pump (deferred_msg
* msg_buf
)
3869 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3871 while (GetMessage (&msg
, NULL
, 0, 0))
3873 if (msg
.hwnd
== NULL
)
3875 switch (msg
.message
)
3878 /* Produced by complete_deferred_msg; just ignore. */
3880 case WM_EMACS_CREATEWINDOW
:
3881 w32_createwindow ((struct frame
*) msg
.wParam
);
3882 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3885 case WM_EMACS_SETLOCALE
:
3886 SetThreadLocale (msg
.wParam
);
3887 /* Reply is not expected. */
3889 case WM_EMACS_SETKEYBOARDLAYOUT
:
3890 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
3891 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3895 case WM_EMACS_REGISTER_HOT_KEY
:
3896 focus_window
= GetFocus ();
3897 if (focus_window
!= NULL
)
3898 RegisterHotKey (focus_window
,
3899 HOTKEY_ID (msg
.wParam
),
3900 HOTKEY_MODIFIERS (msg
.wParam
),
3901 HOTKEY_VK_CODE (msg
.wParam
));
3902 /* Reply is not expected. */
3904 case WM_EMACS_UNREGISTER_HOT_KEY
:
3905 focus_window
= GetFocus ();
3906 if (focus_window
!= NULL
)
3907 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
3908 /* Mark item as erased. NB: this code must be
3909 thread-safe. The next line is okay because the cons
3910 cell is never made into garbage and is not relocated by
3912 XSETCAR ((Lisp_Object
) msg
.lParam
, Qnil
);
3913 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3916 case WM_EMACS_TOGGLE_LOCK_KEY
:
3918 int vk_code
= (int) msg
.wParam
;
3919 int cur_state
= (GetKeyState (vk_code
) & 1);
3920 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
3922 /* NB: This code must be thread-safe. It is safe to
3923 call NILP because symbols are not relocated by GC,
3924 and pointer here is not touched by GC (so the markbit
3925 can't be set). Numbers are safe because they are
3926 immediate values. */
3927 if (NILP (new_state
)
3928 || (NUMBERP (new_state
)
3929 && ((XUINT (new_state
)) & 1) != cur_state
))
3931 one_w32_display_info
.faked_key
= vk_code
;
3933 keybd_event ((BYTE
) vk_code
,
3934 (BYTE
) MapVirtualKey (vk_code
, 0),
3935 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3936 keybd_event ((BYTE
) vk_code
,
3937 (BYTE
) MapVirtualKey (vk_code
, 0),
3938 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3939 keybd_event ((BYTE
) vk_code
,
3940 (BYTE
) MapVirtualKey (vk_code
, 0),
3941 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3942 cur_state
= !cur_state
;
3944 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3950 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3955 DispatchMessage (&msg
);
3958 /* Exit nested loop when our deferred message has completed. */
3959 if (msg_buf
->completed
)
3964 deferred_msg
* deferred_msg_head
;
3966 static deferred_msg
*
3967 find_deferred_msg (HWND hwnd
, UINT msg
)
3969 deferred_msg
* item
;
3971 /* Don't actually need synchronization for read access, since
3972 modification of single pointer is always atomic. */
3973 /* enter_crit (); */
3975 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3976 if (item
->w32msg
.msg
.hwnd
== hwnd
3977 && item
->w32msg
.msg
.message
== msg
)
3980 /* leave_crit (); */
3986 send_deferred_msg (deferred_msg
* msg_buf
,
3992 /* Only input thread can send deferred messages. */
3993 if (GetCurrentThreadId () != dwWindowsThreadId
)
3996 /* It is an error to send a message that is already deferred. */
3997 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4000 /* Enforced synchronization is not needed because this is the only
4001 function that alters deferred_msg_head, and the following critical
4002 section is guaranteed to only be serially reentered (since only the
4003 input thread can call us). */
4005 /* enter_crit (); */
4007 msg_buf
->completed
= 0;
4008 msg_buf
->next
= deferred_msg_head
;
4009 deferred_msg_head
= msg_buf
;
4010 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
4012 /* leave_crit (); */
4014 /* Start a new nested message loop to process other messages until
4015 this one is completed. */
4016 w32_msg_pump (msg_buf
);
4018 deferred_msg_head
= msg_buf
->next
;
4020 return msg_buf
->result
;
4024 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
4026 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
4028 if (msg_buf
== NULL
)
4029 /* Message may have been cancelled, so don't abort(). */
4032 msg_buf
->result
= result
;
4033 msg_buf
->completed
= 1;
4035 /* Ensure input thread is woken so it notices the completion. */
4036 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
4040 cancel_all_deferred_msgs ()
4042 deferred_msg
* item
;
4044 /* Don't actually need synchronization for read access, since
4045 modification of single pointer is always atomic. */
4046 /* enter_crit (); */
4048 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
4051 item
->completed
= 1;
4054 /* leave_crit (); */
4056 /* Ensure input thread is woken so it notices the completion. */
4057 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
4065 deferred_msg dummy_buf
;
4067 /* Ensure our message queue is created */
4069 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
4071 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
4074 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
4075 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
4076 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
4078 /* This is the inital message loop which should only exit when the
4079 application quits. */
4080 w32_msg_pump (&dummy_buf
);
4086 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
4096 wmsg
.dwModifiers
= modifiers
;
4098 /* Detect quit_char and set quit-flag directly. Note that we
4099 still need to post a message to ensure the main thread will be
4100 woken up if blocked in sys_select(), but we do NOT want to post
4101 the quit_char message itself (because it will usually be as if
4102 the user had typed quit_char twice). Instead, we post a dummy
4103 message that has no particular effect. */
4106 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
4107 c
= make_ctrl_char (c
) & 0377;
4109 || (wmsg
.dwModifiers
== 0 &&
4110 XFASTINT (Vw32_quit_key
) && wParam
== XFASTINT (Vw32_quit_key
)))
4114 /* The choice of message is somewhat arbitrary, as long as
4115 the main thread handler just ignores it. */
4118 /* Interrupt any blocking system calls. */
4121 /* As a safety precaution, forcibly complete any deferred
4122 messages. This is a kludge, but I don't see any particularly
4123 clean way to handle the situation where a deferred message is
4124 "dropped" in the lisp thread, and will thus never be
4125 completed, eg. by the user trying to activate the menubar
4126 when the lisp thread is busy, and then typing C-g when the
4127 menubar doesn't open promptly (with the result that the
4128 menubar never responds at all because the deferred
4129 WM_INITMENU message is never completed). Another problem
4130 situation is when the lisp thread calls SendMessage (to send
4131 a window manager command) when a message has been deferred;
4132 the lisp thread gets blocked indefinitely waiting for the
4133 deferred message to be completed, which itself is waiting for
4134 the lisp thread to respond.
4136 Note that we don't want to block the input thread waiting for
4137 a reponse from the lisp thread (although that would at least
4138 solve the deadlock problem above), because we want to be able
4139 to receive C-g to interrupt the lisp thread. */
4140 cancel_all_deferred_msgs ();
4144 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4147 /* Main window procedure */
4150 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
4157 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
4159 int windows_translate
;
4162 /* Note that it is okay to call x_window_to_frame, even though we are
4163 not running in the main lisp thread, because frame deletion
4164 requires the lisp thread to synchronize with this thread. Thus, if
4165 a frame struct is returned, it can be used without concern that the
4166 lisp thread might make it disappear while we are using it.
4168 NB. Walking the frame list in this thread is safe (as long as
4169 writes of Lisp_Object slots are atomic, which they are on Windows).
4170 Although delete-frame can destructively modify the frame list while
4171 we are walking it, a garbage collection cannot occur until after
4172 delete-frame has synchronized with this thread.
4174 It is also safe to use functions that make GDI calls, such as
4175 w32_clear_rect, because these functions must obtain a DC handle
4176 from the frame struct using get_frame_dc which is thread-aware. */
4181 f
= x_window_to_frame (dpyinfo
, hwnd
);
4184 HDC hdc
= get_frame_dc (f
);
4185 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
4186 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
4187 release_frame_dc (f
, hdc
);
4189 #if defined (W32_DEBUG_DISPLAY)
4190 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4192 wmsg
.rect
.left
, wmsg
.rect
.top
,
4193 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4194 #endif /* W32_DEBUG_DISPLAY */
4197 case WM_PALETTECHANGED
:
4198 /* ignore our own changes */
4199 if ((HWND
)wParam
!= hwnd
)
4201 f
= x_window_to_frame (dpyinfo
, hwnd
);
4203 /* get_frame_dc will realize our palette and force all
4204 frames to be redrawn if needed. */
4205 release_frame_dc (f
, get_frame_dc (f
));
4210 PAINTSTRUCT paintStruct
;
4212 bzero (&update_rect
, sizeof (update_rect
));
4214 f
= x_window_to_frame (dpyinfo
, hwnd
);
4217 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
4221 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4222 fails. Apparently this can happen under some
4224 if (GetUpdateRect (hwnd
, &update_rect
, FALSE
) || !w32_strict_painting
)
4227 BeginPaint (hwnd
, &paintStruct
);
4229 /* The rectangles returned by GetUpdateRect and BeginPaint
4230 do not always match. Play it safe by assuming both areas
4232 UnionRect (&(wmsg
.rect
), &update_rect
, &(paintStruct
.rcPaint
));
4234 #if defined (W32_DEBUG_DISPLAY)
4235 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4237 wmsg
.rect
.left
, wmsg
.rect
.top
,
4238 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4239 DebPrint ((" [update region is %d,%d-%d,%d]\n",
4240 update_rect
.left
, update_rect
.top
,
4241 update_rect
.right
, update_rect
.bottom
));
4243 EndPaint (hwnd
, &paintStruct
);
4246 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4251 /* If GetUpdateRect returns 0 (meaning there is no update
4252 region), assume the whole window needs to be repainted. */
4253 GetClientRect(hwnd
, &wmsg
.rect
);
4254 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4258 case WM_INPUTLANGCHANGE
:
4259 /* Inform lisp thread of keyboard layout changes. */
4260 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4262 /* Clear dead keys in the keyboard state; for simplicity only
4263 preserve modifier key states. */
4268 GetKeyboardState (keystate
);
4269 for (i
= 0; i
< 256; i
++)
4286 SetKeyboardState (keystate
);
4291 /* Synchronize hot keys with normal input. */
4292 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
4297 record_keyup (wParam
, lParam
);
4302 /* Ignore keystrokes we fake ourself; see below. */
4303 if (dpyinfo
->faked_key
== wParam
)
4305 dpyinfo
->faked_key
= 0;
4306 /* Make sure TranslateMessage sees them though (as long as
4307 they don't produce WM_CHAR messages). This ensures that
4308 indicator lights are toggled promptly on Windows 9x, for
4310 if (lispy_function_keys
[wParam
] != 0)
4312 windows_translate
= 1;
4318 /* Synchronize modifiers with current keystroke. */
4320 record_keydown (wParam
, lParam
);
4321 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
4323 windows_translate
= 0;
4328 if (NILP (Vw32_pass_lwindow_to_system
))
4330 /* Prevent system from acting on keyup (which opens the
4331 Start menu if no other key was pressed) by simulating a
4332 press of Space which we will ignore. */
4333 if (GetAsyncKeyState (wParam
) & 1)
4335 if (NUMBERP (Vw32_phantom_key_code
))
4336 key
= XUINT (Vw32_phantom_key_code
) & 255;
4339 dpyinfo
->faked_key
= key
;
4340 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4343 if (!NILP (Vw32_lwindow_modifier
))
4347 if (NILP (Vw32_pass_rwindow_to_system
))
4349 if (GetAsyncKeyState (wParam
) & 1)
4351 if (NUMBERP (Vw32_phantom_key_code
))
4352 key
= XUINT (Vw32_phantom_key_code
) & 255;
4355 dpyinfo
->faked_key
= key
;
4356 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4359 if (!NILP (Vw32_rwindow_modifier
))
4363 if (!NILP (Vw32_apps_modifier
))
4367 if (NILP (Vw32_pass_alt_to_system
))
4368 /* Prevent DefWindowProc from activating the menu bar if an
4369 Alt key is pressed and released by itself. */
4371 windows_translate
= 1;
4374 /* Decide whether to treat as modifier or function key. */
4375 if (NILP (Vw32_enable_caps_lock
))
4376 goto disable_lock_key
;
4377 windows_translate
= 1;
4380 /* Decide whether to treat as modifier or function key. */
4381 if (NILP (Vw32_enable_num_lock
))
4382 goto disable_lock_key
;
4383 windows_translate
= 1;
4386 /* Decide whether to treat as modifier or function key. */
4387 if (NILP (Vw32_scroll_lock_modifier
))
4388 goto disable_lock_key
;
4389 windows_translate
= 1;
4392 /* Ensure the appropriate lock key state (and indicator light)
4393 remains in the same state. We do this by faking another
4394 press of the relevant key. Apparently, this really is the
4395 only way to toggle the state of the indicator lights. */
4396 dpyinfo
->faked_key
= wParam
;
4397 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4398 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4399 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4400 KEYEVENTF_EXTENDEDKEY
| 0, 0);
4401 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4402 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4403 /* Ensure indicator lights are updated promptly on Windows 9x
4404 (TranslateMessage apparently does this), after forwarding
4406 post_character_message (hwnd
, msg
, wParam
, lParam
,
4407 w32_get_key_modifiers (wParam
, lParam
));
4408 windows_translate
= 1;
4412 case VK_PROCESSKEY
: /* Generated by IME. */
4413 windows_translate
= 1;
4416 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4417 which is confusing for purposes of key binding; convert
4418 VK_CANCEL events into VK_PAUSE events. */
4422 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4423 for purposes of key binding; convert these back into
4424 VK_NUMLOCK events, at least when we want to see NumLock key
4425 presses. (Note that there is never any possibility that
4426 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4427 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
4428 wParam
= VK_NUMLOCK
;
4431 /* If not defined as a function key, change it to a WM_CHAR message. */
4432 if (lispy_function_keys
[wParam
] == 0)
4434 DWORD modifiers
= construct_console_modifiers ();
4436 if (!NILP (Vw32_recognize_altgr
)
4437 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
4439 /* Always let TranslateMessage handle AltGr key chords;
4440 for some reason, ToAscii doesn't always process AltGr
4441 chords correctly. */
4442 windows_translate
= 1;
4444 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
4446 /* Handle key chords including any modifiers other
4447 than shift directly, in order to preserve as much
4448 modifier information as possible. */
4449 if ('A' <= wParam
&& wParam
<= 'Z')
4451 /* Don't translate modified alphabetic keystrokes,
4452 so the user doesn't need to constantly switch
4453 layout to type control or meta keystrokes when
4454 the normal layout translates alphabetic
4455 characters to non-ascii characters. */
4456 if (!modifier_set (VK_SHIFT
))
4457 wParam
+= ('a' - 'A');
4462 /* Try to handle other keystrokes by determining the
4463 base character (ie. translating the base key plus
4467 KEY_EVENT_RECORD key
;
4469 key
.bKeyDown
= TRUE
;
4470 key
.wRepeatCount
= 1;
4471 key
.wVirtualKeyCode
= wParam
;
4472 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
4473 key
.uChar
.AsciiChar
= 0;
4474 key
.dwControlKeyState
= modifiers
;
4476 add
= w32_kbd_patch_key (&key
);
4477 /* 0 means an unrecognised keycode, negative means
4478 dead key. Ignore both. */
4481 /* Forward asciified character sequence. */
4482 post_character_message
4483 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
4484 w32_get_key_modifiers (wParam
, lParam
));
4485 w32_kbd_patch_key (&key
);
4492 /* Let TranslateMessage handle everything else. */
4493 windows_translate
= 1;
4499 if (windows_translate
)
4501 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
4503 windows_msg
.time
= GetMessageTime ();
4504 TranslateMessage (&windows_msg
);
4512 post_character_message (hwnd
, msg
, wParam
, lParam
,
4513 w32_get_key_modifiers (wParam
, lParam
));
4516 /* Simulate middle mouse button events when left and right buttons
4517 are used together, but only if user has two button mouse. */
4518 case WM_LBUTTONDOWN
:
4519 case WM_RBUTTONDOWN
:
4520 if (XINT (Vw32_num_mouse_buttons
) > 2)
4521 goto handle_plain_button
;
4524 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
4525 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
4527 if (button_state
& this)
4530 if (button_state
== 0)
4533 button_state
|= this;
4535 if (button_state
& other
)
4537 if (mouse_button_timer
)
4539 KillTimer (hwnd
, mouse_button_timer
);
4540 mouse_button_timer
= 0;
4542 /* Generate middle mouse event instead. */
4543 msg
= WM_MBUTTONDOWN
;
4544 button_state
|= MMOUSE
;
4546 else if (button_state
& MMOUSE
)
4548 /* Ignore button event if we've already generated a
4549 middle mouse down event. This happens if the
4550 user releases and press one of the two buttons
4551 after we've faked a middle mouse event. */
4556 /* Flush out saved message. */
4557 post_msg (&saved_mouse_button_msg
);
4559 wmsg
.dwModifiers
= w32_get_modifiers ();
4560 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4562 /* Clear message buffer. */
4563 saved_mouse_button_msg
.msg
.hwnd
= 0;
4567 /* Hold onto message for now. */
4568 mouse_button_timer
=
4569 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
4570 XINT (Vw32_mouse_button_tolerance
), NULL
);
4571 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
4572 saved_mouse_button_msg
.msg
.message
= msg
;
4573 saved_mouse_button_msg
.msg
.wParam
= wParam
;
4574 saved_mouse_button_msg
.msg
.lParam
= lParam
;
4575 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
4576 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
4583 if (XINT (Vw32_num_mouse_buttons
) > 2)
4584 goto handle_plain_button
;
4587 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
4588 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
4590 if ((button_state
& this) == 0)
4593 button_state
&= ~this;
4595 if (button_state
& MMOUSE
)
4597 /* Only generate event when second button is released. */
4598 if ((button_state
& other
) == 0)
4601 button_state
&= ~MMOUSE
;
4603 if (button_state
) abort ();
4610 /* Flush out saved message if necessary. */
4611 if (saved_mouse_button_msg
.msg
.hwnd
)
4613 post_msg (&saved_mouse_button_msg
);
4616 wmsg
.dwModifiers
= w32_get_modifiers ();
4617 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4619 /* Always clear message buffer and cancel timer. */
4620 saved_mouse_button_msg
.msg
.hwnd
= 0;
4621 KillTimer (hwnd
, mouse_button_timer
);
4622 mouse_button_timer
= 0;
4624 if (button_state
== 0)
4629 case WM_XBUTTONDOWN
:
4631 if (w32_pass_extra_mouse_buttons_to_system
)
4633 /* else fall through and process them. */
4634 case WM_MBUTTONDOWN
:
4636 handle_plain_button
:
4641 if (parse_button (msg
, HIWORD (wParam
), &button
, &up
))
4643 if (up
) ReleaseCapture ();
4644 else SetCapture (hwnd
);
4645 button
= (button
== 0) ? LMOUSE
:
4646 ((button
== 1) ? MMOUSE
: RMOUSE
);
4648 button_state
&= ~button
;
4650 button_state
|= button
;
4654 wmsg
.dwModifiers
= w32_get_modifiers ();
4655 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4657 /* Need to return true for XBUTTON messages, false for others,
4658 to indicate that we processed the message. */
4659 return (msg
== WM_XBUTTONDOWN
|| msg
== WM_XBUTTONUP
);
4662 /* If the mouse has just moved into the frame, start tracking
4663 it, so we will be notified when it leaves the frame. Mouse
4664 tracking only works under W98 and NT4 and later. On earlier
4665 versions, there is no way of telling when the mouse leaves the
4666 frame, so we just have to put up with help-echo and mouse
4667 highlighting remaining while the frame is not active. */
4668 if (track_mouse_event_fn
&& !track_mouse_window
)
4670 TRACKMOUSEEVENT tme
;
4671 tme
.cbSize
= sizeof (tme
);
4672 tme
.dwFlags
= TME_LEAVE
;
4673 tme
.hwndTrack
= hwnd
;
4675 track_mouse_event_fn (&tme
);
4676 track_mouse_window
= hwnd
;
4679 if (XINT (Vw32_mouse_move_interval
) <= 0
4680 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
4682 wmsg
.dwModifiers
= w32_get_modifiers ();
4683 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4687 /* Hang onto mouse move and scroll messages for a bit, to avoid
4688 sending such events to Emacs faster than it can process them.
4689 If we get more events before the timer from the first message
4690 expires, we just replace the first message. */
4692 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
4694 SetTimer (hwnd
, MOUSE_MOVE_ID
,
4695 XINT (Vw32_mouse_move_interval
), NULL
);
4697 /* Hold onto message for now. */
4698 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
4699 saved_mouse_move_msg
.msg
.message
= msg
;
4700 saved_mouse_move_msg
.msg
.wParam
= wParam
;
4701 saved_mouse_move_msg
.msg
.lParam
= lParam
;
4702 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
4703 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
4708 wmsg
.dwModifiers
= w32_get_modifiers ();
4709 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4713 wmsg
.dwModifiers
= w32_get_modifiers ();
4714 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4718 /* Flush out saved messages if necessary. */
4719 if (wParam
== mouse_button_timer
)
4721 if (saved_mouse_button_msg
.msg
.hwnd
)
4723 post_msg (&saved_mouse_button_msg
);
4724 saved_mouse_button_msg
.msg
.hwnd
= 0;
4726 KillTimer (hwnd
, mouse_button_timer
);
4727 mouse_button_timer
= 0;
4729 else if (wParam
== mouse_move_timer
)
4731 if (saved_mouse_move_msg
.msg
.hwnd
)
4733 post_msg (&saved_mouse_move_msg
);
4734 saved_mouse_move_msg
.msg
.hwnd
= 0;
4736 KillTimer (hwnd
, mouse_move_timer
);
4737 mouse_move_timer
= 0;
4739 else if (wParam
== menu_free_timer
)
4741 KillTimer (hwnd
, menu_free_timer
);
4742 menu_free_timer
= 0;
4743 f
= x_window_to_frame (dpyinfo
, hwnd
);
4744 if (!f
->output_data
.w32
->menu_command_in_progress
)
4746 /* Free memory used by owner-drawn and help-echo strings. */
4747 w32_free_menu_strings (hwnd
);
4748 f
->output_data
.w32
->menubar_active
= 0;
4754 /* Windows doesn't send us focus messages when putting up and
4755 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4756 The only indication we get that something happened is receiving
4757 this message afterwards. So this is a good time to reset our
4758 keyboard modifiers' state. */
4765 /* We must ensure menu bar is fully constructed and up to date
4766 before allowing user interaction with it. To achieve this
4767 we send this message to the lisp thread and wait for a
4768 reply (whose value is not actually needed) to indicate that
4769 the menu bar is now ready for use, so we can now return.
4771 To remain responsive in the meantime, we enter a nested message
4772 loop that can process all other messages.
4774 However, we skip all this if the message results from calling
4775 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4776 thread a message because it is blocked on us at this point. We
4777 set menubar_active before calling TrackPopupMenu to indicate
4778 this (there is no possibility of confusion with real menubar
4781 f
= x_window_to_frame (dpyinfo
, hwnd
);
4783 && (f
->output_data
.w32
->menubar_active
4784 /* We can receive this message even in the absence of a
4785 menubar (ie. when the system menu is activated) - in this
4786 case we do NOT want to forward the message, otherwise it
4787 will cause the menubar to suddenly appear when the user
4788 had requested it to be turned off! */
4789 || f
->output_data
.w32
->menubar_widget
== NULL
))
4793 deferred_msg msg_buf
;
4795 /* Detect if message has already been deferred; in this case
4796 we cannot return any sensible value to ignore this. */
4797 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4800 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
4803 case WM_EXITMENULOOP
:
4804 f
= x_window_to_frame (dpyinfo
, hwnd
);
4806 /* If a menu command is not already in progress, check again
4807 after a short delay, since Windows often (always?) sends the
4808 WM_EXITMENULOOP before the corresponding WM_COMMAND message. */
4809 if (f
&& !f
->output_data
.w32
->menu_command_in_progress
)
4810 menu_free_timer
= SetTimer (hwnd
, MENU_FREE_ID
, MENU_FREE_DELAY
, NULL
);
4814 /* Direct handling of help_echo in menus. Should be safe now
4815 that we generate the help_echo by placing a help event in the
4818 HMENU menu
= (HMENU
) lParam
;
4819 UINT menu_item
= (UINT
) LOWORD (wParam
);
4820 UINT flags
= (UINT
) HIWORD (wParam
);
4822 w32_menu_display_help (hwnd
, menu
, menu_item
, flags
);
4826 case WM_MEASUREITEM
:
4827 f
= x_window_to_frame (dpyinfo
, hwnd
);
4830 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
4832 if (pMis
->CtlType
== ODT_MENU
)
4834 /* Work out dimensions for popup menu titles. */
4835 char * title
= (char *) pMis
->itemData
;
4836 HDC hdc
= GetDC (hwnd
);
4837 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4838 LOGFONT menu_logfont
;
4842 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4843 menu_logfont
.lfWeight
= FW_BOLD
;
4844 menu_font
= CreateFontIndirect (&menu_logfont
);
4845 old_font
= SelectObject (hdc
, menu_font
);
4847 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
4850 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
4851 pMis
->itemWidth
= size
.cx
;
4852 if (pMis
->itemHeight
< size
.cy
)
4853 pMis
->itemHeight
= size
.cy
;
4856 pMis
->itemWidth
= 0;
4858 SelectObject (hdc
, old_font
);
4859 DeleteObject (menu_font
);
4860 ReleaseDC (hwnd
, hdc
);
4867 f
= x_window_to_frame (dpyinfo
, hwnd
);
4870 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
4872 if (pDis
->CtlType
== ODT_MENU
)
4874 /* Draw popup menu title. */
4875 char * title
= (char *) pDis
->itemData
;
4878 HDC hdc
= pDis
->hDC
;
4879 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4880 LOGFONT menu_logfont
;
4883 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4884 menu_logfont
.lfWeight
= FW_BOLD
;
4885 menu_font
= CreateFontIndirect (&menu_logfont
);
4886 old_font
= SelectObject (hdc
, menu_font
);
4888 /* Always draw title as if not selected. */
4891 + GetSystemMetrics (SM_CXMENUCHECK
),
4893 ETO_OPAQUE
, &pDis
->rcItem
,
4894 title
, strlen (title
), NULL
);
4896 SelectObject (hdc
, old_font
);
4897 DeleteObject (menu_font
);
4905 /* Still not right - can't distinguish between clicks in the
4906 client area of the frame from clicks forwarded from the scroll
4907 bars - may have to hook WM_NCHITTEST to remember the mouse
4908 position and then check if it is in the client area ourselves. */
4909 case WM_MOUSEACTIVATE
:
4910 /* Discard the mouse click that activates a frame, allowing the
4911 user to click anywhere without changing point (or worse!).
4912 Don't eat mouse clicks on scrollbars though!! */
4913 if (LOWORD (lParam
) == HTCLIENT
)
4914 return MA_ACTIVATEANDEAT
;
4919 /* No longer tracking mouse. */
4920 track_mouse_window
= NULL
;
4922 case WM_ACTIVATEAPP
:
4924 case WM_WINDOWPOSCHANGED
:
4926 /* Inform lisp thread that a frame might have just been obscured
4927 or exposed, so should recheck visibility of all frames. */
4928 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4932 dpyinfo
->faked_key
= 0;
4934 register_hot_keys (hwnd
);
4937 unregister_hot_keys (hwnd
);
4940 /* Relinquish the system caret. */
4941 if (w32_system_caret_hwnd
)
4943 w32_visible_system_caret_hwnd
= NULL
;
4944 w32_system_caret_hwnd
= NULL
;
4949 f
= x_window_to_frame (dpyinfo
, hwnd
);
4950 if (f
&& HIWORD (wParam
) == 0)
4952 f
->output_data
.w32
->menu_command_in_progress
= 1;
4953 if (menu_free_timer
)
4955 KillTimer (hwnd
, menu_free_timer
);
4956 menu_free_timer
= 0;
4962 wmsg
.dwModifiers
= w32_get_modifiers ();
4963 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4967 wmsg
.dwModifiers
= w32_get_modifiers ();
4968 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4971 case WM_WINDOWPOSCHANGING
:
4972 /* Don't restrict the sizing of tip frames. */
4973 if (hwnd
== tip_window
)
4977 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
4979 wp
.length
= sizeof (WINDOWPLACEMENT
);
4980 GetWindowPlacement (hwnd
, &wp
);
4982 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
4989 DWORD internal_border
;
4990 DWORD scrollbar_extra
;
4993 wp
.length
= sizeof(wp
);
4994 GetWindowRect (hwnd
, &wr
);
4998 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
4999 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
5000 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
5001 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
5005 memset (&rect
, 0, sizeof (rect
));
5006 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
5007 GetMenu (hwnd
) != NULL
);
5009 /* Force width and height of client area to be exact
5010 multiples of the character cell dimensions. */
5011 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
5012 - 2 * internal_border
- scrollbar_extra
)
5014 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
5015 - 2 * internal_border
)
5020 /* For right/bottom sizing we can just fix the sizes.
5021 However for top/left sizing we will need to fix the X
5022 and Y positions as well. */
5027 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
5028 && (lppos
->flags
& SWP_NOMOVE
) == 0)
5030 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
5037 lppos
->flags
|= SWP_NOMOVE
;
5048 case WM_GETMINMAXINFO
:
5049 /* Hack to correct bug that allows Emacs frames to be resized
5050 below the Minimum Tracking Size. */
5051 ((LPMINMAXINFO
) lParam
)->ptMinTrackSize
.y
++;
5052 /* Hack to allow resizing the Emacs frame above the screen size.
5053 Note that Windows 9x limits coordinates to 16-bits. */
5054 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
5055 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
5058 case WM_EMACS_CREATESCROLLBAR
:
5059 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
5060 (struct scroll_bar
*) lParam
);
5062 case WM_EMACS_SHOWWINDOW
:
5063 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
5065 case WM_EMACS_SETFOREGROUND
:
5067 HWND foreground_window
;
5068 DWORD foreground_thread
, retval
;
5070 /* On NT 5.0, and apparently Windows 98, it is necessary to
5071 attach to the thread that currently has focus in order to
5072 pull the focus away from it. */
5073 foreground_window
= GetForegroundWindow ();
5074 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
5075 if (!foreground_window
5076 || foreground_thread
== GetCurrentThreadId ()
5077 || !AttachThreadInput (GetCurrentThreadId (),
5078 foreground_thread
, TRUE
))
5079 foreground_thread
= 0;
5081 retval
= SetForegroundWindow ((HWND
) wParam
);
5083 /* Detach from the previous foreground thread. */
5084 if (foreground_thread
)
5085 AttachThreadInput (GetCurrentThreadId (),
5086 foreground_thread
, FALSE
);
5091 case WM_EMACS_SETWINDOWPOS
:
5093 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
5094 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
5095 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
5098 case WM_EMACS_DESTROYWINDOW
:
5099 DragAcceptFiles ((HWND
) wParam
, FALSE
);
5100 return DestroyWindow ((HWND
) wParam
);
5102 case WM_EMACS_HIDE_CARET
:
5103 return HideCaret (hwnd
);
5105 case WM_EMACS_SHOW_CARET
:
5106 return ShowCaret (hwnd
);
5108 case WM_EMACS_DESTROY_CARET
:
5109 w32_system_caret_hwnd
= NULL
;
5110 w32_visible_system_caret_hwnd
= NULL
;
5111 return DestroyCaret ();
5113 case WM_EMACS_TRACK_CARET
:
5114 /* If there is currently no system caret, create one. */
5115 if (w32_system_caret_hwnd
== NULL
)
5117 /* Use the default caret width, and avoid changing it
5118 unneccesarily, as it confuses screen reader software. */
5119 w32_system_caret_hwnd
= hwnd
;
5120 CreateCaret (hwnd
, NULL
, 0,
5121 w32_system_caret_height
);
5124 if (!SetCaretPos (w32_system_caret_x
, w32_system_caret_y
))
5126 /* Ensure visible caret gets turned on when requested. */
5127 else if (w32_use_visible_system_caret
5128 && w32_visible_system_caret_hwnd
!= hwnd
)
5130 w32_visible_system_caret_hwnd
= hwnd
;
5131 return ShowCaret (hwnd
);
5133 /* Ensure visible caret gets turned off when requested. */
5134 else if (!w32_use_visible_system_caret
5135 && w32_visible_system_caret_hwnd
)
5137 w32_visible_system_caret_hwnd
= NULL
;
5138 return HideCaret (hwnd
);
5143 case WM_EMACS_TRACKPOPUPMENU
:
5148 pos
= (POINT
*)lParam
;
5149 flags
= TPM_CENTERALIGN
;
5150 if (button_state
& LMOUSE
)
5151 flags
|= TPM_LEFTBUTTON
;
5152 else if (button_state
& RMOUSE
)
5153 flags
|= TPM_RIGHTBUTTON
;
5155 /* Remember we did a SetCapture on the initial mouse down event,
5156 so for safety, we make sure the capture is cancelled now. */
5160 /* Use menubar_active to indicate that WM_INITMENU is from
5161 TrackPopupMenu below, and should be ignored. */
5162 f
= x_window_to_frame (dpyinfo
, hwnd
);
5164 f
->output_data
.w32
->menubar_active
= 1;
5166 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
5170 /* Eat any mouse messages during popupmenu */
5171 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
5173 /* Get the menu selection, if any */
5174 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
5176 retval
= LOWORD (amsg
.wParam
);
5192 /* Check for messages registered at runtime. */
5193 if (msg
== msh_mousewheel
)
5195 wmsg
.dwModifiers
= w32_get_modifiers ();
5196 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
5201 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
5205 /* The most common default return code for handled messages is 0. */
5210 my_create_window (f
)
5215 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
5217 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
5221 /* Create a tooltip window. Unlike my_create_window, we do not do this
5222 indirectly via the Window thread, as we do not need to process Window
5223 messages for the tooltip. Creating tooltips indirectly also creates
5224 deadlocks when tooltips are created for menu items. */
5226 my_create_tip_window (f
)
5231 rect
.left
= rect
.top
= 0;
5232 rect
.right
= PIXEL_WIDTH (f
);
5233 rect
.bottom
= PIXEL_HEIGHT (f
);
5235 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
5236 FRAME_EXTERNAL_MENU_BAR (f
));
5238 tip_window
= FRAME_W32_WINDOW (f
)
5239 = CreateWindow (EMACS_CLASS
,
5241 f
->output_data
.w32
->dwStyle
,
5242 f
->output_data
.w32
->left_pos
,
5243 f
->output_data
.w32
->top_pos
,
5244 rect
.right
- rect
.left
,
5245 rect
.bottom
- rect
.top
,
5246 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
5253 SetWindowLong (tip_window
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
5254 SetWindowLong (tip_window
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
5255 SetWindowLong (tip_window
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
5256 SetWindowLong (tip_window
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
5258 /* Tip frames have no scrollbars. */
5259 SetWindowLong (tip_window
, WND_SCROLLBAR_INDEX
, 0);
5261 /* Do this to discard the default setting specified by our parent. */
5262 ShowWindow (tip_window
, SW_HIDE
);
5267 /* Create and set up the w32 window for frame F. */
5270 w32_window (f
, window_prompting
, minibuffer_only
)
5272 long window_prompting
;
5273 int minibuffer_only
;
5277 /* Use the resource name as the top-level window name
5278 for looking up resources. Make a non-Lisp copy
5279 for the window manager, so GC relocation won't bother it.
5281 Elsewhere we specify the window name for the window manager. */
5284 char *str
= (char *) SDATA (Vx_resource_name
);
5285 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
5286 strcpy (f
->namebuf
, str
);
5289 my_create_window (f
);
5291 validate_x_resource_name ();
5293 /* x_set_name normally ignores requests to set the name if the
5294 requested name is the same as the current name. This is the one
5295 place where that assumption isn't correct; f->name is set, but
5296 the server hasn't been told. */
5299 int explicit = f
->explicit_name
;
5301 f
->explicit_name
= 0;
5304 x_set_name (f
, name
, explicit);
5309 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
5310 initialize_frame_menubar (f
);
5312 if (FRAME_W32_WINDOW (f
) == 0)
5313 error ("Unable to create window");
5316 /* Handle the icon stuff for this window. Perhaps later we might
5317 want an x_set_icon_position which can be called interactively as
5325 Lisp_Object icon_x
, icon_y
;
5327 /* Set the position of the icon. Note that Windows 95 groups all
5328 icons in the tray. */
5329 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
5330 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
5331 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
5333 CHECK_NUMBER (icon_x
);
5334 CHECK_NUMBER (icon_y
);
5336 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
5337 error ("Both left and top icon corners of icon must be specified");
5341 if (! EQ (icon_x
, Qunbound
))
5342 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
5345 /* Start up iconic or window? */
5346 x_wm_set_window_state
5347 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
5351 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
5364 XGCValues gc_values
;
5368 /* Create the GC's of this frame.
5369 Note that many default values are used. */
5372 gc_values
.font
= f
->output_data
.w32
->font
;
5374 /* Cursor has cursor-color background, background-color foreground. */
5375 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
5376 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
5377 f
->output_data
.w32
->cursor_gc
5378 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
5379 (GCFont
| GCForeground
| GCBackground
),
5383 f
->output_data
.w32
->white_relief
.gc
= 0;
5384 f
->output_data
.w32
->black_relief
.gc
= 0;
5390 /* Handler for signals raised during x_create_frame and
5391 x_create_top_frame. FRAME is the frame which is partially
5395 unwind_create_frame (frame
)
5398 struct frame
*f
= XFRAME (frame
);
5400 /* If frame is ``official'', nothing to do. */
5401 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
5404 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5407 x_free_frame_resources (f
);
5409 /* Check that reference counts are indeed correct. */
5410 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
5411 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
5420 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
5422 doc
: /* Make a new window, which is called a \"frame\" in Emacs terms.
5423 Returns an Emacs frame object.
5424 ALIST is an alist of frame parameters.
5425 If the parameters specify that the frame should not have a minibuffer,
5426 and do not specify a specific minibuffer window to use,
5427 then `default-minibuffer-frame' must be a frame whose minibuffer can
5428 be shared by the new frame.
5430 This function is an internal primitive--use `make-frame' instead. */)
5435 Lisp_Object frame
, tem
;
5437 int minibuffer_only
= 0;
5438 long window_prompting
= 0;
5440 int count
= SPECPDL_INDEX ();
5441 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
5442 Lisp_Object display
;
5443 struct w32_display_info
*dpyinfo
= NULL
;
5449 /* Use this general default value to start with
5450 until we know if this frame has a specified name. */
5451 Vx_resource_name
= Vinvocation_name
;
5453 display
= w32_get_arg (parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
5454 if (EQ (display
, Qunbound
))
5456 dpyinfo
= check_x_display_info (display
);
5458 kb
= dpyinfo
->kboard
;
5460 kb
= &the_only_kboard
;
5463 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
5465 && ! EQ (name
, Qunbound
)
5467 error ("Invalid frame name--not a string or nil");
5470 Vx_resource_name
= name
;
5472 /* See if parent window is specified. */
5473 parent
= w32_get_arg (parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
5474 if (EQ (parent
, Qunbound
))
5476 if (! NILP (parent
))
5477 CHECK_NUMBER (parent
);
5479 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5480 /* No need to protect DISPLAY because that's not used after passing
5481 it to make_frame_without_minibuffer. */
5483 GCPRO4 (parms
, parent
, name
, frame
);
5484 tem
= w32_get_arg (parms
, Qminibuffer
, "minibuffer", "Minibuffer",
5486 if (EQ (tem
, Qnone
) || NILP (tem
))
5487 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
5488 else if (EQ (tem
, Qonly
))
5490 f
= make_minibuffer_frame ();
5491 minibuffer_only
= 1;
5493 else if (WINDOWP (tem
))
5494 f
= make_frame_without_minibuffer (tem
, kb
, display
);
5498 XSETFRAME (frame
, f
);
5500 /* Note that Windows does support scroll bars. */
5501 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
5502 /* By default, make scrollbars the system standard width. */
5503 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
5505 f
->output_method
= output_w32
;
5506 f
->output_data
.w32
=
5507 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
5508 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
5509 FRAME_FONTSET (f
) = -1;
5510 record_unwind_protect (unwind_create_frame
, frame
);
5513 = w32_get_arg (parms
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
5514 if (! STRINGP (f
->icon_name
))
5515 f
->icon_name
= Qnil
;
5517 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
5519 FRAME_KBOARD (f
) = kb
;
5522 /* Specify the parent under which to make this window. */
5526 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
5527 f
->output_data
.w32
->explicit_parent
= 1;
5531 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5532 f
->output_data
.w32
->explicit_parent
= 0;
5535 /* Set the name; the functions to which we pass f expect the name to
5537 if (EQ (name
, Qunbound
) || NILP (name
))
5539 f
->name
= build_string (dpyinfo
->w32_id_name
);
5540 f
->explicit_name
= 0;
5545 f
->explicit_name
= 1;
5546 /* use the frame's title when getting resources for this frame. */
5547 specbind (Qx_resource_name
, name
);
5550 /* Extract the window parameters from the supplied values
5551 that are needed to determine window geometry. */
5555 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
5558 /* First, try whatever font the caller has specified. */
5561 tem
= Fquery_fontset (font
, Qnil
);
5563 font
= x_new_fontset (f
, SDATA (tem
));
5565 font
= x_new_font (f
, SDATA (font
));
5567 /* Try out a font which we hope has bold and italic variations. */
5568 if (!STRINGP (font
))
5569 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
5570 if (! STRINGP (font
))
5571 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
5572 /* If those didn't work, look for something which will at least work. */
5573 if (! STRINGP (font
))
5574 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
5576 if (! STRINGP (font
))
5577 font
= build_string ("Fixedsys");
5579 x_default_parameter (f
, parms
, Qfont
, font
,
5580 "font", "Font", RES_TYPE_STRING
);
5583 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
5584 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
5585 /* This defaults to 2 in order to match xterm. We recognize either
5586 internalBorderWidth or internalBorder (which is what xterm calls
5588 if (NILP (Fassq (Qinternal_border_width
, parms
)))
5592 value
= w32_get_arg (parms
, Qinternal_border_width
,
5593 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
5594 if (! EQ (value
, Qunbound
))
5595 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
5598 /* Default internalBorderWidth to 0 on Windows to match other programs. */
5599 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
5600 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
5601 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qright
,
5602 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
5604 /* Also do the stuff which must be set before the window exists. */
5605 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
5606 "foreground", "Foreground", RES_TYPE_STRING
);
5607 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
5608 "background", "Background", RES_TYPE_STRING
);
5609 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
5610 "pointerColor", "Foreground", RES_TYPE_STRING
);
5611 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
5612 "cursorColor", "Foreground", RES_TYPE_STRING
);
5613 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
5614 "borderColor", "BorderColor", RES_TYPE_STRING
);
5615 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
5616 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
5617 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
5618 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
5619 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
5620 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
5621 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
5622 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
5625 /* Init faces before x_default_parameter is called for scroll-bar
5626 parameters because that function calls x_set_scroll_bar_width,
5627 which calls change_frame_size, which calls Fset_window_buffer,
5628 which runs hooks, which call Fvertical_motion. At the end, we
5629 end up in init_iterator with a null face cache, which should not
5631 init_frame_faces (f
);
5633 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
5634 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
5635 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
5636 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
5638 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
5639 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
5640 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
5641 "title", "Title", RES_TYPE_STRING
);
5642 x_default_parameter (f
, parms
, Qfullscreen
, Qnil
,
5643 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
5645 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
5646 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5648 /* Add the tool-bar height to the initial frame height so that the
5649 user gets a text display area of the size he specified with -g or
5650 via .Xdefaults. Later changes of the tool-bar height don't
5651 change the frame size. This is done so that users can create
5652 tall Emacs frames without having to guess how tall the tool-bar
5654 if (FRAME_TOOL_BAR_LINES (f
))
5656 int margin
, relief
, bar_height
;
5658 relief
= (tool_bar_button_relief
>= 0
5659 ? tool_bar_button_relief
5660 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
5662 if (INTEGERP (Vtool_bar_button_margin
)
5663 && XINT (Vtool_bar_button_margin
) > 0)
5664 margin
= XFASTINT (Vtool_bar_button_margin
);
5665 else if (CONSP (Vtool_bar_button_margin
)
5666 && INTEGERP (XCDR (Vtool_bar_button_margin
))
5667 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
5668 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
5672 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
5673 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
5676 window_prompting
= x_figure_window_size (f
, parms
);
5678 if (window_prompting
& XNegative
)
5680 if (window_prompting
& YNegative
)
5681 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
5683 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
5687 if (window_prompting
& YNegative
)
5688 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
5690 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
5693 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
5695 tem
= w32_get_arg (parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
5696 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
5698 w32_window (f
, window_prompting
, minibuffer_only
);
5703 /* Now consider the frame official. */
5704 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
5705 Vframe_list
= Fcons (frame
, Vframe_list
);
5707 /* We need to do this after creating the window, so that the
5708 icon-creation functions can say whose icon they're describing. */
5709 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
5710 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
5712 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
5713 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5714 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
5715 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5716 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
5717 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
5718 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
5719 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
5721 /* Dimensions, especially f->height, must be done via change_frame_size.
5722 Change will not be effected unless different from the current
5728 SET_FRAME_WIDTH (f
, 0);
5729 change_frame_size (f
, height
, width
, 1, 0, 0);
5731 /* Tell the server what size and position, etc, we want, and how
5732 badly we want them. This should be done after we have the menu
5733 bar so that its size can be taken into account. */
5735 x_wm_set_size_hint (f
, window_prompting
, 0);
5738 /* Avoid a bug that causes the new frame to never become visible if
5739 an echo area message is displayed during the following call1. */
5740 specbind(Qredisplay_dont_pause
, Qt
);
5742 /* Set up faces after all frame parameters are known. This call
5743 also merges in face attributes specified for new frames. If we
5744 don't do this, the `menu' face for instance won't have the right
5745 colors, and the menu bar won't appear in the specified colors for
5747 call1 (Qface_set_after_frame_default
, frame
);
5749 /* Make the window appear on the frame and enable display, unless
5750 the caller says not to. However, with explicit parent, Emacs
5751 cannot control visibility, so don't try. */
5752 if (! f
->output_data
.w32
->explicit_parent
)
5754 Lisp_Object visibility
;
5756 visibility
= w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
5757 if (EQ (visibility
, Qunbound
))
5760 if (EQ (visibility
, Qicon
))
5761 x_iconify_frame (f
);
5762 else if (! NILP (visibility
))
5763 x_make_frame_visible (f
);
5765 /* Must have been Qnil. */
5770 /* Make sure windows on this frame appear in calls to next-window
5771 and similar functions. */
5772 Vwindow_list
= Qnil
;
5774 return unbind_to (count
, frame
);
5777 /* FRAME is used only to get a handle on the X display. We don't pass the
5778 display info directly because we're called from frame.c, which doesn't
5779 know about that structure. */
5781 x_get_focus_frame (frame
)
5782 struct frame
*frame
;
5784 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
5786 if (! dpyinfo
->w32_focus_frame
)
5789 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
5793 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
5794 doc
: /* Give FRAME input focus, raising to foreground if necessary. */)
5798 x_focus_on_frame (check_x_frame (frame
));
5803 /* Return the charset portion of a font name. */
5804 char * xlfd_charset_of_font (char * fontname
)
5806 char *charset
, *encoding
;
5808 encoding
= strrchr(fontname
, '-');
5809 if (!encoding
|| encoding
== fontname
)
5812 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
5813 if (*charset
== '-')
5816 if (charset
== fontname
|| strcmp(charset
, "-*-*") == 0)
5822 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
5823 int size
, char* filename
);
5824 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
5825 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
5827 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
5829 static struct font_info
*
5830 w32_load_system_font (f
,fontname
,size
)
5835 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5836 Lisp_Object font_names
;
5838 /* Get a list of all the fonts that match this name. Once we
5839 have a list of matching fonts, we compare them against the fonts
5840 we already have loaded by comparing names. */
5841 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
5843 if (!NILP (font_names
))
5848 /* First check if any are already loaded, as that is cheaper
5849 than loading another one. */
5850 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5851 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
5852 if (dpyinfo
->font_table
[i
].name
5853 && (!strcmp (dpyinfo
->font_table
[i
].name
,
5854 SDATA (XCAR (tail
)))
5855 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
5856 SDATA (XCAR (tail
)))))
5857 return (dpyinfo
->font_table
+ i
);
5859 fontname
= (char *) SDATA (XCAR (font_names
));
5861 else if (w32_strict_fontnames
)
5863 /* If EnumFontFamiliesEx was available, we got a full list of
5864 fonts back so stop now to avoid the possibility of loading a
5865 random font. If we had to fall back to EnumFontFamilies, the
5866 list is incomplete, so continue whether the font we want was
5868 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5869 FARPROC enum_font_families_ex
5870 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
5871 if (enum_font_families_ex
)
5875 /* Load the font and add it to the table. */
5877 char *full_name
, *encoding
, *charset
;
5879 struct font_info
*fontp
;
5885 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
5888 if (!*lf
.lfFaceName
)
5889 /* If no name was specified for the font, we get a random font
5890 from CreateFontIndirect - this is not particularly
5891 desirable, especially since CreateFontIndirect does not
5892 fill out the missing name in lf, so we never know what we
5896 /* Specify anti-aliasing to prevent Cleartype fonts being used,
5897 since those fonts leave garbage behind. */
5898 lf
.lfQuality
= ANTIALIASED_QUALITY
;
5900 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
5901 bzero (font
, sizeof (*font
));
5903 /* Set bdf to NULL to indicate that this is a Windows font. */
5908 font
->hfont
= CreateFontIndirect (&lf
);
5910 if (font
->hfont
== NULL
)
5919 codepage
= w32_codepage_for_font (fontname
);
5921 hdc
= GetDC (dpyinfo
->root_window
);
5922 oldobj
= SelectObject (hdc
, font
->hfont
);
5924 ok
= GetTextMetrics (hdc
, &font
->tm
);
5925 if (codepage
== CP_UNICODE
)
5926 font
->double_byte_p
= 1;
5929 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5930 don't report themselves as double byte fonts, when
5931 patently they are. So instead of trusting
5932 GetFontLanguageInfo, we check the properties of the
5933 codepage directly, since that is ultimately what we are
5934 working from anyway. */
5935 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5937 GetCPInfo (codepage
, &cpi
);
5938 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
5941 SelectObject (hdc
, oldobj
);
5942 ReleaseDC (dpyinfo
->root_window
, hdc
);
5943 /* Fill out details in lf according to the font that was
5945 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
5946 lf
.lfWidth
= font
->tm
.tmAveCharWidth
;
5947 lf
.lfWeight
= font
->tm
.tmWeight
;
5948 lf
.lfItalic
= font
->tm
.tmItalic
;
5949 lf
.lfCharSet
= font
->tm
.tmCharSet
;
5950 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
5951 ? VARIABLE_PITCH
: FIXED_PITCH
);
5952 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
5953 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
5955 w32_cache_char_metrics (font
);
5962 w32_unload_font (dpyinfo
, font
);
5966 /* Find a free slot in the font table. */
5967 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
5968 if (dpyinfo
->font_table
[i
].name
== NULL
)
5971 /* If no free slot found, maybe enlarge the font table. */
5972 if (i
== dpyinfo
->n_fonts
5973 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
5976 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
5977 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
5979 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
5982 fontp
= dpyinfo
->font_table
+ i
;
5983 if (i
== dpyinfo
->n_fonts
)
5986 /* Now fill in the slots of *FONTP. */
5989 fontp
->font_idx
= i
;
5990 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
5991 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
5993 charset
= xlfd_charset_of_font (fontname
);
5995 /* Cache the W32 codepage for a font. This makes w32_encode_char
5996 (called for every glyph during redisplay) much faster. */
5997 fontp
->codepage
= codepage
;
5999 /* Work out the font's full name. */
6000 full_name
= (char *)xmalloc (100);
6001 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
6002 fontp
->full_name
= full_name
;
6005 /* If all else fails - just use the name we used to load it. */
6007 fontp
->full_name
= fontp
->name
;
6010 fontp
->size
= FONT_WIDTH (font
);
6011 fontp
->height
= FONT_HEIGHT (font
);
6013 /* The slot `encoding' specifies how to map a character
6014 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
6015 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
6016 (0:0x20..0x7F, 1:0xA0..0xFF,
6017 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
6018 2:0xA020..0xFF7F). For the moment, we don't know which charset
6019 uses this font. So, we set information in fontp->encoding[1]
6020 which is never used by any charset. If mapping can't be
6021 decided, set FONT_ENCODING_NOT_DECIDED. */
6023 /* SJIS fonts need to be set to type 4, all others seem to work as
6024 type FONT_ENCODING_NOT_DECIDED. */
6025 encoding
= strrchr (fontp
->name
, '-');
6026 if (encoding
&& strnicmp (encoding
+1, "sjis", 4) == 0)
6027 fontp
->encoding
[1] = 4;
6029 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
6031 /* The following three values are set to 0 under W32, which is
6032 what they get set to if XGetFontProperty fails under X. */
6033 fontp
->baseline_offset
= 0;
6034 fontp
->relative_compose
= 0;
6035 fontp
->default_ascent
= 0;
6037 /* Set global flag fonts_changed_p to non-zero if the font loaded
6038 has a character with a smaller width than any other character
6039 before, or if the font loaded has a smaller height than any
6040 other font loaded before. If this happens, it will make a
6041 glyph matrix reallocation necessary. */
6042 fonts_changed_p
|= x_compute_min_glyph_bounds (f
);
6048 /* Load font named FONTNAME of size SIZE for frame F, and return a
6049 pointer to the structure font_info while allocating it dynamically.
6050 If loading fails, return NULL. */
6052 w32_load_font (f
,fontname
,size
)
6057 Lisp_Object bdf_fonts
;
6058 struct font_info
*retval
= NULL
;
6060 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
6062 while (!retval
&& CONSP (bdf_fonts
))
6064 char *bdf_name
, *bdf_file
;
6065 Lisp_Object bdf_pair
;
6067 bdf_name
= SDATA (XCAR (bdf_fonts
));
6068 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
6069 bdf_file
= SDATA (XCDR (bdf_pair
));
6071 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
6073 bdf_fonts
= XCDR (bdf_fonts
);
6079 return w32_load_system_font(f
, fontname
, size
);
6084 w32_unload_font (dpyinfo
, font
)
6085 struct w32_display_info
*dpyinfo
;
6090 if (font
->per_char
) xfree (font
->per_char
);
6091 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
6093 if (font
->hfont
) DeleteObject(font
->hfont
);
6098 /* The font conversion stuff between x and w32 */
6100 /* X font string is as follows (from faces.el)
6104 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
6105 * (weight\? "\\([^-]*\\)") ; 1
6106 * (slant "\\([ior]\\)") ; 2
6107 * (slant\? "\\([^-]?\\)") ; 2
6108 * (swidth "\\([^-]*\\)") ; 3
6109 * (adstyle "[^-]*") ; 4
6110 * (pixelsize "[0-9]+")
6111 * (pointsize "[0-9][0-9]+")
6112 * (resx "[0-9][0-9]+")
6113 * (resy "[0-9][0-9]+")
6114 * (spacing "[cmp?*]")
6115 * (avgwidth "[0-9]+")
6116 * (registry "[^-]+")
6117 * (encoding "[^-]+")
6122 x_to_w32_weight (lpw
)
6125 if (!lpw
) return (FW_DONTCARE
);
6127 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
6128 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
6129 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
6130 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
6131 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
6132 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
6133 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
6134 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
6135 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
6136 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
6143 w32_to_x_weight (fnweight
)
6146 if (fnweight
>= FW_HEAVY
) return "heavy";
6147 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
6148 if (fnweight
>= FW_BOLD
) return "bold";
6149 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
6150 if (fnweight
>= FW_MEDIUM
) return "medium";
6151 if (fnweight
>= FW_NORMAL
) return "normal";
6152 if (fnweight
>= FW_LIGHT
) return "light";
6153 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
6154 if (fnweight
>= FW_THIN
) return "thin";
6160 x_to_w32_charset (lpcs
)
6163 Lisp_Object this_entry
, w32_charset
;
6165 int len
= strlen (lpcs
);
6167 /* Support "*-#nnn" format for unknown charsets. */
6168 if (strncmp (lpcs
, "*-#", 3) == 0)
6169 return atoi (lpcs
+ 3);
6171 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
6172 charset
= alloca (len
+ 1);
6173 strcpy (charset
, lpcs
);
6174 lpcs
= strchr (charset
, '*');
6178 /* Look through w32-charset-info-alist for the character set.
6179 Format of each entry is
6180 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6182 this_entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6184 if (NILP(this_entry
))
6186 /* At startup, we want iso8859-1 fonts to come up properly. */
6187 if (stricmp(charset
, "iso8859-1") == 0)
6188 return ANSI_CHARSET
;
6190 return DEFAULT_CHARSET
;
6193 w32_charset
= Fcar (Fcdr (this_entry
));
6195 /* Translate Lisp symbol to number. */
6196 if (w32_charset
== Qw32_charset_ansi
)
6197 return ANSI_CHARSET
;
6198 if (w32_charset
== Qw32_charset_symbol
)
6199 return SYMBOL_CHARSET
;
6200 if (w32_charset
== Qw32_charset_shiftjis
)
6201 return SHIFTJIS_CHARSET
;
6202 if (w32_charset
== Qw32_charset_hangeul
)
6203 return HANGEUL_CHARSET
;
6204 if (w32_charset
== Qw32_charset_chinesebig5
)
6205 return CHINESEBIG5_CHARSET
;
6206 if (w32_charset
== Qw32_charset_gb2312
)
6207 return GB2312_CHARSET
;
6208 if (w32_charset
== Qw32_charset_oem
)
6210 #ifdef JOHAB_CHARSET
6211 if (w32_charset
== Qw32_charset_johab
)
6212 return JOHAB_CHARSET
;
6213 if (w32_charset
== Qw32_charset_easteurope
)
6214 return EASTEUROPE_CHARSET
;
6215 if (w32_charset
== Qw32_charset_turkish
)
6216 return TURKISH_CHARSET
;
6217 if (w32_charset
== Qw32_charset_baltic
)
6218 return BALTIC_CHARSET
;
6219 if (w32_charset
== Qw32_charset_russian
)
6220 return RUSSIAN_CHARSET
;
6221 if (w32_charset
== Qw32_charset_arabic
)
6222 return ARABIC_CHARSET
;
6223 if (w32_charset
== Qw32_charset_greek
)
6224 return GREEK_CHARSET
;
6225 if (w32_charset
== Qw32_charset_hebrew
)
6226 return HEBREW_CHARSET
;
6227 if (w32_charset
== Qw32_charset_vietnamese
)
6228 return VIETNAMESE_CHARSET
;
6229 if (w32_charset
== Qw32_charset_thai
)
6230 return THAI_CHARSET
;
6231 if (w32_charset
== Qw32_charset_mac
)
6233 #endif /* JOHAB_CHARSET */
6234 #ifdef UNICODE_CHARSET
6235 if (w32_charset
== Qw32_charset_unicode
)
6236 return UNICODE_CHARSET
;
6239 return DEFAULT_CHARSET
;
6244 w32_to_x_charset (fncharset
)
6247 static char buf
[32];
6248 Lisp_Object charset_type
;
6253 /* Handle startup case of w32-charset-info-alist not
6254 being set up yet. */
6255 if (NILP(Vw32_charset_info_alist
))
6257 charset_type
= Qw32_charset_ansi
;
6259 case DEFAULT_CHARSET
:
6260 charset_type
= Qw32_charset_default
;
6262 case SYMBOL_CHARSET
:
6263 charset_type
= Qw32_charset_symbol
;
6265 case SHIFTJIS_CHARSET
:
6266 charset_type
= Qw32_charset_shiftjis
;
6268 case HANGEUL_CHARSET
:
6269 charset_type
= Qw32_charset_hangeul
;
6271 case GB2312_CHARSET
:
6272 charset_type
= Qw32_charset_gb2312
;
6274 case CHINESEBIG5_CHARSET
:
6275 charset_type
= Qw32_charset_chinesebig5
;
6278 charset_type
= Qw32_charset_oem
;
6281 /* More recent versions of Windows (95 and NT4.0) define more
6283 #ifdef EASTEUROPE_CHARSET
6284 case EASTEUROPE_CHARSET
:
6285 charset_type
= Qw32_charset_easteurope
;
6287 case TURKISH_CHARSET
:
6288 charset_type
= Qw32_charset_turkish
;
6290 case BALTIC_CHARSET
:
6291 charset_type
= Qw32_charset_baltic
;
6293 case RUSSIAN_CHARSET
:
6294 charset_type
= Qw32_charset_russian
;
6296 case ARABIC_CHARSET
:
6297 charset_type
= Qw32_charset_arabic
;
6300 charset_type
= Qw32_charset_greek
;
6302 case HEBREW_CHARSET
:
6303 charset_type
= Qw32_charset_hebrew
;
6305 case VIETNAMESE_CHARSET
:
6306 charset_type
= Qw32_charset_vietnamese
;
6309 charset_type
= Qw32_charset_thai
;
6312 charset_type
= Qw32_charset_mac
;
6315 charset_type
= Qw32_charset_johab
;
6319 #ifdef UNICODE_CHARSET
6320 case UNICODE_CHARSET
:
6321 charset_type
= Qw32_charset_unicode
;
6325 /* Encode numerical value of unknown charset. */
6326 sprintf (buf
, "*-#%u", fncharset
);
6332 char * best_match
= NULL
;
6334 /* Look through w32-charset-info-alist for the character set.
6335 Prefer ISO codepages, and prefer lower numbers in the ISO
6336 range. Only return charsets for codepages which are installed.
6338 Format of each entry is
6339 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6341 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
6344 Lisp_Object w32_charset
;
6345 Lisp_Object codepage
;
6347 Lisp_Object this_entry
= XCAR (rest
);
6349 /* Skip invalid entries in alist. */
6350 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
6351 || !CONSP (XCDR (this_entry
))
6352 || !SYMBOLP (XCAR (XCDR (this_entry
))))
6355 x_charset
= SDATA (XCAR (this_entry
));
6356 w32_charset
= XCAR (XCDR (this_entry
));
6357 codepage
= XCDR (XCDR (this_entry
));
6359 /* Look for Same charset and a valid codepage (or non-int
6360 which means ignore). */
6361 if (w32_charset
== charset_type
6362 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
6363 || IsValidCodePage (XINT (codepage
))))
6365 /* If we don't have a match already, then this is the
6368 best_match
= x_charset
;
6369 /* If this is an ISO codepage, and the best so far isn't,
6370 then this is better. */
6371 else if (strnicmp (best_match
, "iso", 3) != 0
6372 && strnicmp (x_charset
, "iso", 3) == 0)
6373 best_match
= x_charset
;
6374 /* If both are ISO8859 codepages, choose the one with the
6375 lowest number in the encoding field. */
6376 else if (strnicmp (best_match
, "iso8859-", 8) == 0
6377 && strnicmp (x_charset
, "iso8859-", 8) == 0)
6379 int best_enc
= atoi (best_match
+ 8);
6380 int this_enc
= atoi (x_charset
+ 8);
6381 if (this_enc
> 0 && this_enc
< best_enc
)
6382 best_match
= x_charset
;
6387 /* If no match, encode the numeric value. */
6390 sprintf (buf
, "*-#%u", fncharset
);
6394 strncpy(buf
, best_match
, 31);
6401 /* Return all the X charsets that map to a font. */
6403 w32_to_all_x_charsets (fncharset
)
6406 static char buf
[32];
6407 Lisp_Object charset_type
;
6408 Lisp_Object retval
= Qnil
;
6413 /* Handle startup case of w32-charset-info-alist not
6414 being set up yet. */
6415 if (NILP(Vw32_charset_info_alist
))
6416 return Fcons (build_string ("iso8859-1"), Qnil
);
6418 charset_type
= Qw32_charset_ansi
;
6420 case DEFAULT_CHARSET
:
6421 charset_type
= Qw32_charset_default
;
6423 case SYMBOL_CHARSET
:
6424 charset_type
= Qw32_charset_symbol
;
6426 case SHIFTJIS_CHARSET
:
6427 charset_type
= Qw32_charset_shiftjis
;
6429 case HANGEUL_CHARSET
:
6430 charset_type
= Qw32_charset_hangeul
;
6432 case GB2312_CHARSET
:
6433 charset_type
= Qw32_charset_gb2312
;
6435 case CHINESEBIG5_CHARSET
:
6436 charset_type
= Qw32_charset_chinesebig5
;
6439 charset_type
= Qw32_charset_oem
;
6442 /* More recent versions of Windows (95 and NT4.0) define more
6444 #ifdef EASTEUROPE_CHARSET
6445 case EASTEUROPE_CHARSET
:
6446 charset_type
= Qw32_charset_easteurope
;
6448 case TURKISH_CHARSET
:
6449 charset_type
= Qw32_charset_turkish
;
6451 case BALTIC_CHARSET
:
6452 charset_type
= Qw32_charset_baltic
;
6454 case RUSSIAN_CHARSET
:
6455 charset_type
= Qw32_charset_russian
;
6457 case ARABIC_CHARSET
:
6458 charset_type
= Qw32_charset_arabic
;
6461 charset_type
= Qw32_charset_greek
;
6463 case HEBREW_CHARSET
:
6464 charset_type
= Qw32_charset_hebrew
;
6466 case VIETNAMESE_CHARSET
:
6467 charset_type
= Qw32_charset_vietnamese
;
6470 charset_type
= Qw32_charset_thai
;
6473 charset_type
= Qw32_charset_mac
;
6476 charset_type
= Qw32_charset_johab
;
6480 #ifdef UNICODE_CHARSET
6481 case UNICODE_CHARSET
:
6482 charset_type
= Qw32_charset_unicode
;
6486 /* Encode numerical value of unknown charset. */
6487 sprintf (buf
, "*-#%u", fncharset
);
6488 return Fcons (build_string (buf
), Qnil
);
6493 /* Look through w32-charset-info-alist for the character set.
6494 Only return charsets for codepages which are installed.
6496 Format of each entry in Vw32_charset_info_alist is
6497 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6499 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
6501 Lisp_Object x_charset
;
6502 Lisp_Object w32_charset
;
6503 Lisp_Object codepage
;
6505 Lisp_Object this_entry
= XCAR (rest
);
6507 /* Skip invalid entries in alist. */
6508 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
6509 || !CONSP (XCDR (this_entry
))
6510 || !SYMBOLP (XCAR (XCDR (this_entry
))))
6513 x_charset
= XCAR (this_entry
);
6514 w32_charset
= XCAR (XCDR (this_entry
));
6515 codepage
= XCDR (XCDR (this_entry
));
6517 /* Look for Same charset and a valid codepage (or non-int
6518 which means ignore). */
6519 if (w32_charset
== charset_type
6520 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
6521 || IsValidCodePage (XINT (codepage
))))
6523 retval
= Fcons (x_charset
, retval
);
6527 /* If no match, encode the numeric value. */
6530 sprintf (buf
, "*-#%u", fncharset
);
6531 return Fcons (build_string (buf
), Qnil
);
6538 /* Get the Windows codepage corresponding to the specified font. The
6539 charset info in the font name is used to look up
6540 w32-charset-to-codepage-alist. */
6542 w32_codepage_for_font (char *fontname
)
6544 Lisp_Object codepage
, entry
;
6545 char *charset_str
, *charset
, *end
;
6547 if (NILP (Vw32_charset_info_alist
))
6550 /* Extract charset part of font string. */
6551 charset
= xlfd_charset_of_font (fontname
);
6556 charset_str
= (char *) alloca (strlen (charset
) + 1);
6557 strcpy (charset_str
, charset
);
6560 /* Remove leading "*-". */
6561 if (strncmp ("*-", charset_str
, 2) == 0)
6562 charset
= charset_str
+ 2;
6565 charset
= charset_str
;
6567 /* Stop match at wildcard (including preceding '-'). */
6568 if (end
= strchr (charset
, '*'))
6570 if (end
> charset
&& *(end
-1) == '-')
6575 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6579 codepage
= Fcdr (Fcdr (entry
));
6581 if (NILP (codepage
))
6583 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
6585 else if (INTEGERP (codepage
))
6586 return XINT (codepage
);
6593 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
6594 LOGFONT
* lplogfont
;
6597 char * specific_charset
;
6601 char height_pixels
[8];
6603 char width_pixels
[8];
6604 char *fontname_dash
;
6605 int display_resy
= (int) one_w32_display_info
.resy
;
6606 int display_resx
= (int) one_w32_display_info
.resx
;
6608 struct coding_system coding
;
6610 if (!lpxstr
) abort ();
6615 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
6616 fonttype
= "raster";
6617 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
6618 fonttype
= "outline";
6620 fonttype
= "unknown";
6622 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system
),
6624 coding
.src_multibyte
= 0;
6625 coding
.dst_multibyte
= 1;
6626 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6627 /* We explicitely disable composition handling because selection
6628 data should not contain any composition sequence. */
6629 coding
.composing
= COMPOSITION_DISABLED
;
6630 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
6632 fontname
= alloca(sizeof(*fontname
) * bufsz
);
6633 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
6634 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
6635 *(fontname
+ coding
.produced
) = '\0';
6637 /* Replace dashes with underscores so the dashes are not
6639 fontname_dash
= fontname
;
6640 while (fontname_dash
= strchr (fontname_dash
, '-'))
6641 *fontname_dash
= '_';
6643 if (lplogfont
->lfHeight
)
6645 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
6646 sprintf (height_dpi
, "%u",
6647 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
6651 strcpy (height_pixels
, "*");
6652 strcpy (height_dpi
, "*");
6654 if (lplogfont
->lfWidth
)
6655 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
6657 strcpy (width_pixels
, "*");
6659 _snprintf (lpxstr
, len
- 1,
6660 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6661 fonttype
, /* foundry */
6662 fontname
, /* family */
6663 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
6664 lplogfont
->lfItalic
?'i':'r', /* slant */
6666 /* add style name */
6667 height_pixels
, /* pixel size */
6668 height_dpi
, /* point size */
6669 display_resx
, /* resx */
6670 display_resy
, /* resy */
6671 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
6672 ? 'p' : 'c', /* spacing */
6673 width_pixels
, /* avg width */
6674 specific_charset
? specific_charset
6675 : w32_to_x_charset (lplogfont
->lfCharSet
)
6676 /* charset registry and encoding */
6679 lpxstr
[len
- 1] = 0; /* just to be sure */
6684 x_to_w32_font (lpxstr
, lplogfont
)
6686 LOGFONT
* lplogfont
;
6688 struct coding_system coding
;
6690 if (!lplogfont
) return (FALSE
);
6692 memset (lplogfont
, 0, sizeof (*lplogfont
));
6694 /* Set default value for each field. */
6696 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
6697 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
6698 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
6700 /* go for maximum quality */
6701 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
6702 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
6703 lplogfont
->lfQuality
= PROOF_QUALITY
;
6706 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
6707 lplogfont
->lfWeight
= FW_DONTCARE
;
6708 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
6713 /* Provide a simple escape mechanism for specifying Windows font names
6714 * directly -- if font spec does not beginning with '-', assume this
6716 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6722 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
6723 width
[10], resy
[10], remainder
[50];
6725 int dpi
= (int) one_w32_display_info
.resy
;
6727 fields
= sscanf (lpxstr
,
6728 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
6729 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
6733 /* In the general case when wildcards cover more than one field,
6734 we don't know which field is which, so don't fill any in.
6735 However, we need to cope with this particular form, which is
6736 generated by font_list_1 (invoked by try_font_list):
6737 "-raster-6x10-*-gb2312*-*"
6738 and make sure to correctly parse the charset field. */
6741 fields
= sscanf (lpxstr
,
6742 "-%*[^-]-%49[^-]-*-%49s",
6745 else if (fields
< 9)
6751 if (fields
> 0 && name
[0] != '*')
6757 (Fcheck_coding_system (Vlocale_coding_system
), &coding
);
6758 coding
.src_multibyte
= 1;
6759 coding
.dst_multibyte
= 1;
6760 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
6761 buf
= (unsigned char *) alloca (bufsize
);
6762 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6763 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
6764 if (coding
.produced
>= LF_FACESIZE
)
6765 coding
.produced
= LF_FACESIZE
- 1;
6766 buf
[coding
.produced
] = 0;
6767 strcpy (lplogfont
->lfFaceName
, buf
);
6771 lplogfont
->lfFaceName
[0] = '\0';
6776 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6780 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
6784 if (fields
> 0 && pixels
[0] != '*')
6785 lplogfont
->lfHeight
= atoi (pixels
);
6789 if (fields
> 0 && resy
[0] != '*')
6792 if (tem
> 0) dpi
= tem
;
6795 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
6796 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
6799 lplogfont
->lfPitchAndFamily
=
6800 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
6804 if (fields
> 0 && width
[0] != '*')
6805 lplogfont
->lfWidth
= atoi (width
) / 10;
6809 /* Strip the trailing '-' if present. (it shouldn't be, as it
6810 fails the test against xlfd-tight-regexp in fontset.el). */
6812 int len
= strlen (remainder
);
6813 if (len
> 0 && remainder
[len
-1] == '-')
6814 remainder
[len
-1] = 0;
6816 encoding
= remainder
;
6818 if (strncmp (encoding
, "*-", 2) == 0)
6821 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
6826 char name
[100], height
[10], width
[10], weight
[20];
6828 fields
= sscanf (lpxstr
,
6829 "%99[^:]:%9[^:]:%9[^:]:%19s",
6830 name
, height
, width
, weight
);
6832 if (fields
== EOF
) return (FALSE
);
6836 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
6837 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
6841 lplogfont
->lfFaceName
[0] = 0;
6847 lplogfont
->lfHeight
= atoi (height
);
6852 lplogfont
->lfWidth
= atoi (width
);
6856 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6859 /* This makes TrueType fonts work better. */
6860 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
6865 /* Strip the pixel height and point height from the given xlfd, and
6866 return the pixel height. If no pixel height is specified, calculate
6867 one from the point height, or if that isn't defined either, return
6868 0 (which usually signifies a scalable font).
6871 xlfd_strip_height (char *fontname
)
6873 int pixel_height
, field_number
;
6874 char *read_from
, *write_to
;
6878 pixel_height
= field_number
= 0;
6881 /* Look for height fields. */
6882 for (read_from
= fontname
; *read_from
; read_from
++)
6884 if (*read_from
== '-')
6887 if (field_number
== 7) /* Pixel height. */
6890 write_to
= read_from
;
6892 /* Find end of field. */
6893 for (;*read_from
&& *read_from
!= '-'; read_from
++)
6896 /* Split the fontname at end of field. */
6902 pixel_height
= atoi (write_to
);
6903 /* Blank out field. */
6904 if (read_from
> write_to
)
6909 /* If the pixel height field is at the end (partial xlfd),
6912 return pixel_height
;
6914 /* If we got a pixel height, the point height can be
6915 ignored. Just blank it out and break now. */
6918 /* Find end of point size field. */
6919 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6925 /* Blank out the point size field. */
6926 if (read_from
> write_to
)
6932 return pixel_height
;
6936 /* If the point height is already blank, break now. */
6937 if (*read_from
== '-')
6943 else if (field_number
== 8)
6945 /* If we didn't get a pixel height, try to get the point
6946 height and convert that. */
6948 char *point_size_start
= read_from
++;
6950 /* Find end of field. */
6951 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6960 point_size
= atoi (point_size_start
);
6962 /* Convert to pixel height. */
6963 pixel_height
= point_size
6964 * one_w32_display_info
.height_in
/ 720;
6966 /* Blank out this field and break. */
6974 /* Shift the rest of the font spec into place. */
6975 if (write_to
&& read_from
> write_to
)
6977 for (; *read_from
; read_from
++, write_to
++)
6978 *write_to
= *read_from
;
6982 return pixel_height
;
6985 /* Assume parameter 1 is fully qualified, no wildcards. */
6987 w32_font_match (fontname
, pattern
)
6991 char *regex
= alloca (strlen (pattern
) * 2 + 3);
6992 char *font_name_copy
= alloca (strlen (fontname
) + 1);
6995 /* Copy fontname so we can modify it during comparison. */
6996 strcpy (font_name_copy
, fontname
);
7001 /* Turn pattern into a regexp and do a regexp match. */
7002 for (; *pattern
; pattern
++)
7004 if (*pattern
== '?')
7006 else if (*pattern
== '*')
7017 /* Strip out font heights and compare them seperately, since
7018 rounding error can cause mismatches. This also allows a
7019 comparison between a font that declares only a pixel height and a
7020 pattern that declares the point height.
7023 int font_height
, pattern_height
;
7025 font_height
= xlfd_strip_height (font_name_copy
);
7026 pattern_height
= xlfd_strip_height (regex
);
7028 /* Compare now, and don't bother doing expensive regexp matching
7029 if the heights differ. */
7030 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
7034 return (fast_c_string_match_ignore_case (build_string (regex
),
7035 font_name_copy
) >= 0);
7038 /* Callback functions, and a structure holding info they need, for
7039 listing system fonts on W32. We need one set of functions to do the
7040 job properly, but these don't work on NT 3.51 and earlier, so we
7041 have a second set which don't handle character sets properly to
7044 In both cases, there are two passes made. The first pass gets one
7045 font from each family, the second pass lists all the fonts from
7048 typedef struct enumfont_t
7053 XFontStruct
*size_ref
;
7054 Lisp_Object pattern
;
7060 enum_font_maybe_add_to_list (enumfont_t
*, LOGFONT
*, char *, Lisp_Object
);
7064 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
7066 NEWTEXTMETRIC
* lptm
;
7070 /* Ignore struck out and underlined versions of fonts. */
7071 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
7074 /* Only return fonts with names starting with @ if they were
7075 explicitly specified, since Microsoft uses an initial @ to
7076 denote fonts for vertical writing, without providing a more
7077 convenient way of identifying them. */
7078 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
7079 && lpef
->logfont
.lfFaceName
[0] != '@')
7082 /* Check that the character set matches if it was specified */
7083 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
7084 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
7087 if (FontType
== RASTER_FONTTYPE
)
7089 /* DBCS raster fonts have problems displaying, so skip them. */
7090 int charset
= lplf
->elfLogFont
.lfCharSet
;
7091 if (charset
== SHIFTJIS_CHARSET
7092 || charset
== HANGEUL_CHARSET
7093 || charset
== CHINESEBIG5_CHARSET
7094 || charset
== GB2312_CHARSET
7095 #ifdef JOHAB_CHARSET
7096 || charset
== JOHAB_CHARSET
7104 Lisp_Object width
= Qnil
;
7105 Lisp_Object charset_list
= Qnil
;
7106 char *charset
= NULL
;
7108 /* Truetype fonts do not report their true metrics until loaded */
7109 if (FontType
!= RASTER_FONTTYPE
)
7111 if (!NILP (lpef
->pattern
))
7113 /* Scalable fonts are as big as you want them to be. */
7114 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
7115 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
7116 width
= make_number (lpef
->logfont
.lfWidth
);
7120 lplf
->elfLogFont
.lfHeight
= 0;
7121 lplf
->elfLogFont
.lfWidth
= 0;
7125 /* Make sure the height used here is the same as everywhere
7126 else (ie character height, not cell height). */
7127 if (lplf
->elfLogFont
.lfHeight
> 0)
7129 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
7130 if (FontType
== RASTER_FONTTYPE
)
7131 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
7133 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
7136 if (!NILP (lpef
->pattern
))
7138 charset
= xlfd_charset_of_font (SDATA (lpef
->pattern
));
7140 /* We already checked charsets above, but DEFAULT_CHARSET
7141 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
7143 && strncmp (charset
, "*-*", 3) != 0
7144 && lpef
->logfont
.lfCharSet
== DEFAULT_CHARSET
7145 && strcmp (charset
, w32_to_x_charset (DEFAULT_CHARSET
)) != 0)
7150 charset_list
= Fcons (build_string (charset
), Qnil
);
7152 charset_list
= w32_to_all_x_charsets (lplf
->elfLogFont
.lfCharSet
);
7154 /* Loop through the charsets. */
7155 for ( ; CONSP (charset_list
); charset_list
= Fcdr (charset_list
))
7157 Lisp_Object this_charset
= Fcar (charset_list
);
7158 charset
= SDATA (this_charset
);
7160 /* List bold and italic variations if w32-enable-synthesized-fonts
7161 is non-nil and this is a plain font. */
7162 if (w32_enable_synthesized_fonts
7163 && lplf
->elfLogFont
.lfWeight
== FW_NORMAL
7164 && lplf
->elfLogFont
.lfItalic
== FALSE
)
7166 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7169 lplf
->elfLogFont
.lfWeight
= FW_BOLD
;
7170 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7173 lplf
->elfLogFont
.lfItalic
= TRUE
;
7174 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7177 lplf
->elfLogFont
.lfWeight
= FW_NORMAL
;
7178 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7182 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7191 enum_font_maybe_add_to_list (lpef
, logfont
, match_charset
, width
)
7194 char * match_charset
;
7199 if (!w32_to_x_font (logfont
, buf
, 100, match_charset
))
7202 if (NILP (lpef
->pattern
)
7203 || w32_font_match (buf
, SDATA (lpef
->pattern
)))
7205 /* Check if we already listed this font. This may happen if
7206 w32_enable_synthesized_fonts is non-nil, and there are real
7207 bold and italic versions of the font. */
7208 Lisp_Object font_name
= build_string (buf
);
7209 if (NILP (Fmember (font_name
, lpef
->list
)))
7211 Lisp_Object entry
= Fcons (font_name
, width
);
7212 lpef
->list
= Fcons (entry
, lpef
->list
);
7220 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
7222 NEWTEXTMETRIC
* lptm
;
7226 return EnumFontFamilies (lpef
->hdc
,
7227 lplf
->elfLogFont
.lfFaceName
,
7228 (FONTENUMPROC
) enum_font_cb2
,
7234 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
7235 ENUMLOGFONTEX
* lplf
;
7236 NEWTEXTMETRICEX
* lptm
;
7240 /* We are not interested in the extra info we get back from the 'Ex
7241 version - only the fact that we get character set variations
7242 enumerated seperately. */
7243 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
7248 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
7249 ENUMLOGFONTEX
* lplf
;
7250 NEWTEXTMETRICEX
* lptm
;
7254 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
7255 FARPROC enum_font_families_ex
7256 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
7257 /* We don't really expect EnumFontFamiliesEx to disappear once we
7258 get here, so don't bother handling it gracefully. */
7259 if (enum_font_families_ex
== NULL
)
7260 error ("gdi32.dll has disappeared!");
7261 return enum_font_families_ex (lpef
->hdc
,
7263 (FONTENUMPROC
) enum_fontex_cb2
,
7267 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
7268 and xterm.c in Emacs 20.3) */
7270 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
7272 char *fontname
, *ptnstr
;
7273 Lisp_Object list
, tem
, newlist
= Qnil
;
7276 list
= Vw32_bdf_filename_alist
;
7277 ptnstr
= SDATA (pattern
);
7279 for ( ; CONSP (list
); list
= XCDR (list
))
7283 fontname
= SDATA (XCAR (tem
));
7284 else if (STRINGP (tem
))
7285 fontname
= SDATA (tem
);
7289 if (w32_font_match (fontname
, ptnstr
))
7291 newlist
= Fcons (XCAR (tem
), newlist
);
7293 if (n_fonts
>= max_names
)
7302 /* Return a list of names of available fonts matching PATTERN on frame
7303 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
7304 to be listed. Frame F NULL means we have not yet created any
7305 frame, which means we can't get proper size info, as we don't have
7306 a device context to use for GetTextMetrics.
7307 MAXNAMES sets a limit on how many fonts to match. */
7310 w32_list_fonts (f
, pattern
, size
, maxnames
)
7312 Lisp_Object pattern
;
7316 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
7317 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
7318 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
7321 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
7322 if (NILP (patterns
))
7323 patterns
= Fcons (pattern
, Qnil
);
7325 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
7330 tpat
= XCAR (patterns
);
7332 if (!STRINGP (tpat
))
7335 /* Avoid expensive EnumFontFamilies functions if we are not
7336 going to be able to output one of these anyway. */
7337 codepage
= w32_codepage_for_font (SDATA (tpat
));
7338 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
7339 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
7340 && !IsValidCodePage(codepage
))
7343 /* See if we cached the result for this particular query.
7344 The cache is an alist of the form:
7345 ((PATTERN (FONTNAME . WIDTH) ...) ...)
7347 if (tem
= XCDR (dpyinfo
->name_list_element
),
7348 !NILP (list
= Fassoc (tpat
, tem
)))
7350 list
= Fcdr_safe (list
);
7351 /* We have a cached list. Don't have to get the list again. */
7356 /* At first, put PATTERN in the cache. */
7361 /* Use EnumFontFamiliesEx where it is available, as it knows
7362 about character sets. Fall back to EnumFontFamilies for
7363 older versions of NT that don't support the 'Ex function. */
7364 x_to_w32_font (SDATA (tpat
), &ef
.logfont
);
7366 LOGFONT font_match_pattern
;
7367 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
7368 FARPROC enum_font_families_ex
7369 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
7371 /* We do our own pattern matching so we can handle wildcards. */
7372 font_match_pattern
.lfFaceName
[0] = 0;
7373 font_match_pattern
.lfPitchAndFamily
= 0;
7374 /* We can use the charset, because if it is a wildcard it will
7375 be DEFAULT_CHARSET anyway. */
7376 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
7378 ef
.hdc
= GetDC (dpyinfo
->root_window
);
7380 if (enum_font_families_ex
)
7381 enum_font_families_ex (ef
.hdc
,
7382 &font_match_pattern
,
7383 (FONTENUMPROC
) enum_fontex_cb1
,
7386 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
7389 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
7395 /* Make a list of the fonts we got back.
7396 Store that in the font cache for the display. */
7397 XSETCDR (dpyinfo
->name_list_element
,
7398 Fcons (Fcons (tpat
, list
),
7399 XCDR (dpyinfo
->name_list_element
)));
7402 if (NILP (list
)) continue; /* Try the remaining alternatives. */
7404 newlist
= second_best
= Qnil
;
7406 /* Make a list of the fonts that have the right width. */
7407 for (; CONSP (list
); list
= XCDR (list
))
7414 if (NILP (XCAR (tem
)))
7418 newlist
= Fcons (XCAR (tem
), newlist
);
7420 if (n_fonts
>= maxnames
)
7425 if (!INTEGERP (XCDR (tem
)))
7427 /* Since we don't yet know the size of the font, we must
7428 load it and try GetTextMetrics. */
7429 W32FontStruct thisinfo
;
7434 if (!x_to_w32_font (SDATA (XCAR (tem
)), &lf
))
7438 thisinfo
.bdf
= NULL
;
7439 thisinfo
.hfont
= CreateFontIndirect (&lf
);
7440 if (thisinfo
.hfont
== NULL
)
7443 hdc
= GetDC (dpyinfo
->root_window
);
7444 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
7445 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
7446 XSETCDR (tem
, make_number (FONT_WIDTH (&thisinfo
)));
7448 XSETCDR (tem
, make_number (0));
7449 SelectObject (hdc
, oldobj
);
7450 ReleaseDC (dpyinfo
->root_window
, hdc
);
7451 DeleteObject(thisinfo
.hfont
);
7454 found_size
= XINT (XCDR (tem
));
7455 if (found_size
== size
)
7457 newlist
= Fcons (XCAR (tem
), newlist
);
7459 if (n_fonts
>= maxnames
)
7462 /* keep track of the closest matching size in case
7463 no exact match is found. */
7464 else if (found_size
> 0)
7466 if (NILP (second_best
))
7469 else if (found_size
< size
)
7471 if (XINT (XCDR (second_best
)) > size
7472 || XINT (XCDR (second_best
)) < found_size
)
7477 if (XINT (XCDR (second_best
)) > size
7478 && XINT (XCDR (second_best
)) >
7485 if (!NILP (newlist
))
7487 else if (!NILP (second_best
))
7489 newlist
= Fcons (XCAR (second_best
), Qnil
);
7494 /* Include any bdf fonts. */
7495 if (n_fonts
< maxnames
)
7497 Lisp_Object combined
[2];
7498 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
7499 combined
[1] = newlist
;
7500 newlist
= Fnconc(2, combined
);
7507 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7509 w32_get_font_info (f
, font_idx
)
7513 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
7518 w32_query_font (struct frame
*f
, char *fontname
)
7521 struct font_info
*pfi
;
7523 pfi
= FRAME_W32_FONT_TABLE (f
);
7525 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
7527 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
7533 /* Find a CCL program for a font specified by FONTP, and set the member
7534 `encoder' of the structure. */
7537 w32_find_ccl_program (fontp
)
7538 struct font_info
*fontp
;
7540 Lisp_Object list
, elt
;
7542 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
7546 && STRINGP (XCAR (elt
))
7547 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
7553 struct ccl_program
*ccl
7554 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
7556 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
7559 fontp
->font_encoder
= ccl
;
7564 /* Find BDF files in a specified directory. (use GCPRO when calling,
7565 as this calls lisp to get a directory listing). */
7567 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
7569 Lisp_Object filelist
, list
= Qnil
;
7572 if (!STRINGP(directory
))
7575 filelist
= Fdirectory_files (directory
, Qt
,
7576 build_string (".*\\.[bB][dD][fF]"), Qt
);
7578 for ( ; CONSP(filelist
); filelist
= XCDR (filelist
))
7580 Lisp_Object filename
= XCAR (filelist
);
7581 if (w32_BDF_to_x_font (SDATA (filename
), fontname
, 100))
7582 store_in_alist (&list
, build_string (fontname
), filename
);
7587 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
7589 doc
: /* Return a list of BDF fonts in DIR.
7590 The list is suitable for appending to w32-bdf-filename-alist. Fonts
7591 which do not contain an xlfd description will not be included in the
7592 list. DIR may be a list of directories. */)
7594 Lisp_Object directory
;
7596 Lisp_Object list
= Qnil
;
7597 struct gcpro gcpro1
, gcpro2
;
7599 if (!CONSP (directory
))
7600 return w32_find_bdf_fonts_in_dir (directory
);
7602 for ( ; CONSP (directory
); directory
= XCDR (directory
))
7604 Lisp_Object pair
[2];
7607 GCPRO2 (directory
, list
);
7608 pair
[1] = w32_find_bdf_fonts_in_dir( XCAR (directory
) );
7609 list
= Fnconc( 2, pair
);
7616 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
7617 doc
: /* Internal function called by `color-defined-p', which see. */)
7619 Lisp_Object color
, frame
;
7622 FRAME_PTR f
= check_x_frame (frame
);
7624 CHECK_STRING (color
);
7626 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
7632 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
7633 doc
: /* Internal function called by `color-values', which see. */)
7635 Lisp_Object color
, frame
;
7638 FRAME_PTR f
= check_x_frame (frame
);
7640 CHECK_STRING (color
);
7642 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
7646 rgb
[0] = make_number ((GetRValue (foo
.pixel
) << 8)
7647 | GetRValue (foo
.pixel
));
7648 rgb
[1] = make_number ((GetGValue (foo
.pixel
) << 8)
7649 | GetGValue (foo
.pixel
));
7650 rgb
[2] = make_number ((GetBValue (foo
.pixel
) << 8)
7651 | GetBValue (foo
.pixel
));
7652 return Flist (3, rgb
);
7658 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
7659 doc
: /* Internal function called by `display-color-p', which see. */)
7661 Lisp_Object display
;
7663 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7665 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
7671 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
7672 Sx_display_grayscale_p
, 0, 1, 0,
7673 doc
: /* Return t if the X display supports shades of gray.
7674 Note that color displays do support shades of gray.
7675 The optional argument DISPLAY specifies which display to ask about.
7676 DISPLAY should be either a frame or a display name (a string).
7677 If omitted or nil, that stands for the selected frame's display. */)
7679 Lisp_Object display
;
7681 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7683 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
7689 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
7690 Sx_display_pixel_width
, 0, 1, 0,
7691 doc
: /* Returns the width in pixels of DISPLAY.
7692 The optional argument DISPLAY specifies which display to ask about.
7693 DISPLAY should be either a frame or a display name (a string).
7694 If omitted or nil, that stands for the selected frame's display. */)
7696 Lisp_Object display
;
7698 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7700 return make_number (dpyinfo
->width
);
7703 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
7704 Sx_display_pixel_height
, 0, 1, 0,
7705 doc
: /* Returns the height in pixels of DISPLAY.
7706 The optional argument DISPLAY specifies which display to ask about.
7707 DISPLAY should be either a frame or a display name (a string).
7708 If omitted or nil, that stands for the selected frame's display. */)
7710 Lisp_Object display
;
7712 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7714 return make_number (dpyinfo
->height
);
7717 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
7719 doc
: /* Returns the number of bitplanes of DISPLAY.
7720 The optional argument DISPLAY specifies which display to ask about.
7721 DISPLAY should be either a frame or a display name (a string).
7722 If omitted or nil, that stands for the selected frame's display. */)
7724 Lisp_Object display
;
7726 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7728 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7731 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
7733 doc
: /* Returns the number of color cells of DISPLAY.
7734 The optional argument DISPLAY specifies which display to ask about.
7735 DISPLAY should be either a frame or a display name (a string).
7736 If omitted or nil, that stands for the selected frame's display. */)
7738 Lisp_Object display
;
7740 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7744 hdc
= GetDC (dpyinfo
->root_window
);
7745 if (dpyinfo
->has_palette
)
7746 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
7748 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
7750 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
7751 and because probably is more meaningful on Windows anyway */
7753 cap
= 1 << min(dpyinfo
->n_planes
* dpyinfo
->n_cbits
, 24);
7755 ReleaseDC (dpyinfo
->root_window
, hdc
);
7757 return make_number (cap
);
7760 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
7761 Sx_server_max_request_size
,
7763 doc
: /* Returns the maximum request size of the server of DISPLAY.
7764 The optional argument DISPLAY specifies which display to ask about.
7765 DISPLAY should be either a frame or a display name (a string).
7766 If omitted or nil, that stands for the selected frame's display. */)
7768 Lisp_Object display
;
7770 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7772 return make_number (1);
7775 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
7776 doc
: /* Returns the vendor ID string of the W32 system (Microsoft).
7777 The optional argument DISPLAY specifies which display to ask about.
7778 DISPLAY should be either a frame or a display name (a string).
7779 If omitted or nil, that stands for the selected frame's display. */)
7781 Lisp_Object display
;
7783 return build_string ("Microsoft Corp.");
7786 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
7787 doc
: /* Returns the version numbers of the server of DISPLAY.
7788 The value is a list of three integers: the major and minor
7789 version numbers, and the vendor-specific release
7790 number. See also the function `x-server-vendor'.
7792 The optional argument DISPLAY specifies which display to ask about.
7793 DISPLAY should be either a frame or a display name (a string).
7794 If omitted or nil, that stands for the selected frame's display. */)
7796 Lisp_Object display
;
7798 return Fcons (make_number (w32_major_version
),
7799 Fcons (make_number (w32_minor_version
),
7800 Fcons (make_number (w32_build_number
), Qnil
)));
7803 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
7804 doc
: /* Returns the number of screens on the server of DISPLAY.
7805 The optional argument DISPLAY specifies which display to ask about.
7806 DISPLAY should be either a frame or a display name (a string).
7807 If omitted or nil, that stands for the selected frame's display. */)
7809 Lisp_Object display
;
7811 return make_number (1);
7814 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
7815 Sx_display_mm_height
, 0, 1, 0,
7816 doc
: /* Returns the height in millimeters of DISPLAY.
7817 The optional argument DISPLAY specifies which display to ask about.
7818 DISPLAY should be either a frame or a display name (a string).
7819 If omitted or nil, that stands for the selected frame's display. */)
7821 Lisp_Object display
;
7823 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7827 hdc
= GetDC (dpyinfo
->root_window
);
7829 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
7831 ReleaseDC (dpyinfo
->root_window
, hdc
);
7833 return make_number (cap
);
7836 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
7837 doc
: /* Returns the width in millimeters of DISPLAY.
7838 The optional argument DISPLAY specifies which display to ask about.
7839 DISPLAY should be either a frame or a display name (a string).
7840 If omitted or nil, that stands for the selected frame's display. */)
7842 Lisp_Object display
;
7844 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7849 hdc
= GetDC (dpyinfo
->root_window
);
7851 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
7853 ReleaseDC (dpyinfo
->root_window
, hdc
);
7855 return make_number (cap
);
7858 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
7859 Sx_display_backing_store
, 0, 1, 0,
7860 doc
: /* Returns an indication of whether DISPLAY does backing store.
7861 The value may be `always', `when-mapped', or `not-useful'.
7862 The optional argument DISPLAY specifies which display to ask about.
7863 DISPLAY should be either a frame or a display name (a string).
7864 If omitted or nil, that stands for the selected frame's display. */)
7866 Lisp_Object display
;
7868 return intern ("not-useful");
7871 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
7872 Sx_display_visual_class
, 0, 1, 0,
7873 doc
: /* Returns the visual class of DISPLAY.
7874 The value is one of the symbols `static-gray', `gray-scale',
7875 `static-color', `pseudo-color', `true-color', or `direct-color'.
7877 The optional argument DISPLAY specifies which display to ask about.
7878 DISPLAY should be either a frame or a display name (a string).
7879 If omitted or nil, that stands for the selected frame's display. */)
7881 Lisp_Object display
;
7883 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7884 Lisp_Object result
= Qnil
;
7886 if (dpyinfo
->has_palette
)
7887 result
= intern ("pseudo-color");
7888 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
7889 result
= intern ("static-grey");
7890 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
7891 result
= intern ("static-color");
7892 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
7893 result
= intern ("true-color");
7898 DEFUN ("x-display-save-under", Fx_display_save_under
,
7899 Sx_display_save_under
, 0, 1, 0,
7900 doc
: /* Returns t if DISPLAY supports the save-under feature.
7901 The optional argument DISPLAY specifies which display to ask about.
7902 DISPLAY should be either a frame or a display name (a string).
7903 If omitted or nil, that stands for the selected frame's display. */)
7905 Lisp_Object display
;
7912 register struct frame
*f
;
7914 return PIXEL_WIDTH (f
);
7919 register struct frame
*f
;
7921 return PIXEL_HEIGHT (f
);
7926 register struct frame
*f
;
7928 return FONT_WIDTH (f
->output_data
.w32
->font
);
7933 register struct frame
*f
;
7935 return f
->output_data
.w32
->line_height
;
7940 register struct frame
*f
;
7942 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
7945 /* Return the display structure for the display named NAME.
7946 Open a new connection if necessary. */
7948 struct w32_display_info
*
7949 x_display_info_for_name (name
)
7953 struct w32_display_info
*dpyinfo
;
7955 CHECK_STRING (name
);
7957 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
7959 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
7962 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
7967 /* Use this general default value to start with. */
7968 Vx_resource_name
= Vinvocation_name
;
7970 validate_x_resource_name ();
7972 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
7973 (char *) SDATA (Vx_resource_name
));
7976 error ("Cannot connect to server %s", SDATA (name
));
7979 XSETFASTINT (Vwindow_system_version
, 3);
7984 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
7985 1, 3, 0, doc
: /* Open a connection to a server.
7986 DISPLAY is the name of the display to connect to.
7987 Optional second arg XRM-STRING is a string of resources in xrdb format.
7988 If the optional third arg MUST-SUCCEED is non-nil,
7989 terminate Emacs if we can't open the connection. */)
7990 (display
, xrm_string
, must_succeed
)
7991 Lisp_Object display
, xrm_string
, must_succeed
;
7993 unsigned char *xrm_option
;
7994 struct w32_display_info
*dpyinfo
;
7996 /* If initialization has already been done, return now to avoid
7997 overwriting critical parts of one_w32_display_info. */
8001 CHECK_STRING (display
);
8002 if (! NILP (xrm_string
))
8003 CHECK_STRING (xrm_string
);
8005 if (! EQ (Vwindow_system
, intern ("w32")))
8006 error ("Not using Microsoft Windows");
8008 /* Allow color mapping to be defined externally; first look in user's
8009 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
8011 Lisp_Object color_file
;
8012 struct gcpro gcpro1
;
8014 color_file
= build_string("~/rgb.txt");
8016 GCPRO1 (color_file
);
8018 if (NILP (Ffile_readable_p (color_file
)))
8020 Fexpand_file_name (build_string ("rgb.txt"),
8021 Fsymbol_value (intern ("data-directory")));
8023 Vw32_color_map
= Fw32_load_color_file (color_file
);
8027 if (NILP (Vw32_color_map
))
8028 Vw32_color_map
= Fw32_default_color_map ();
8030 if (! NILP (xrm_string
))
8031 xrm_option
= (unsigned char *) SDATA (xrm_string
);
8033 xrm_option
= (unsigned char *) 0;
8035 /* Use this general default value to start with. */
8036 /* First remove .exe suffix from invocation-name - it looks ugly. */
8038 char basename
[ MAX_PATH
], *str
;
8040 strcpy (basename
, SDATA (Vinvocation_name
));
8041 str
= strrchr (basename
, '.');
8043 Vinvocation_name
= build_string (basename
);
8045 Vx_resource_name
= Vinvocation_name
;
8047 validate_x_resource_name ();
8049 /* This is what opens the connection and sets x_current_display.
8050 This also initializes many symbols, such as those used for input. */
8051 dpyinfo
= w32_term_init (display
, xrm_option
,
8052 (char *) SDATA (Vx_resource_name
));
8056 if (!NILP (must_succeed
))
8057 fatal ("Cannot connect to server %s.\n",
8060 error ("Cannot connect to server %s", SDATA (display
));
8065 XSETFASTINT (Vwindow_system_version
, 3);
8069 DEFUN ("x-close-connection", Fx_close_connection
,
8070 Sx_close_connection
, 1, 1, 0,
8071 doc
: /* Close the connection to DISPLAY's server.
8072 For DISPLAY, specify either a frame or a display name (a string).
8073 If DISPLAY is nil, that stands for the selected frame's display. */)
8075 Lisp_Object display
;
8077 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
8080 if (dpyinfo
->reference_count
> 0)
8081 error ("Display still has frames on it");
8084 /* Free the fonts in the font table. */
8085 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
8086 if (dpyinfo
->font_table
[i
].name
)
8088 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
8089 xfree (dpyinfo
->font_table
[i
].full_name
);
8090 xfree (dpyinfo
->font_table
[i
].name
);
8091 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
8093 x_destroy_all_bitmaps (dpyinfo
);
8095 x_delete_display (dpyinfo
);
8101 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
8102 doc
: /* Return the list of display names that Emacs has connections to. */)
8105 Lisp_Object tail
, result
;
8108 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
8109 result
= Fcons (XCAR (XCAR (tail
)), result
);
8114 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
8115 doc
: /* This is a noop on W32 systems. */)
8117 Lisp_Object display
, on
;
8123 /***********************************************************************
8125 ***********************************************************************/
8127 /* Value is the number of elements of vector VECTOR. */
8129 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
8131 /* List of supported image types. Use define_image_type to add new
8132 types. Use lookup_image_type to find a type for a given symbol. */
8134 static struct image_type
*image_types
;
8136 /* The symbol `image' which is the car of the lists used to represent
8139 extern Lisp_Object Qimage
;
8141 /* The symbol `xbm' which is used as the type symbol for XBM images. */
8147 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
8148 extern Lisp_Object QCdata
, QCtype
;
8149 Lisp_Object QCascent
, QCmargin
, QCrelief
;
8150 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
8151 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
8153 /* Other symbols. */
8155 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
8157 /* Time in seconds after which images should be removed from the cache
8158 if not displayed. */
8160 Lisp_Object Vimage_cache_eviction_delay
;
8162 /* Function prototypes. */
8164 static void define_image_type
P_ ((struct image_type
*type
));
8165 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
8166 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
8167 static void x_laplace
P_ ((struct frame
*, struct image
*));
8168 static void x_emboss
P_ ((struct frame
*, struct image
*));
8169 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
8173 /* Define a new image type from TYPE. This adds a copy of TYPE to
8174 image_types and adds the symbol *TYPE->type to Vimage_types. */
8177 define_image_type (type
)
8178 struct image_type
*type
;
8180 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
8181 The initialized data segment is read-only. */
8182 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
8183 bcopy (type
, p
, sizeof *p
);
8184 p
->next
= image_types
;
8186 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
8190 /* Look up image type SYMBOL, and return a pointer to its image_type
8191 structure. Value is null if SYMBOL is not a known image type. */
8193 static INLINE
struct image_type
*
8194 lookup_image_type (symbol
)
8197 struct image_type
*type
;
8199 for (type
= image_types
; type
; type
= type
->next
)
8200 if (EQ (symbol
, *type
->type
))
8207 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
8208 valid image specification is a list whose car is the symbol
8209 `image', and whose rest is a property list. The property list must
8210 contain a value for key `:type'. That value must be the name of a
8211 supported image type. The rest of the property list depends on the
8215 valid_image_p (object
)
8220 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
8224 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
8225 if (EQ (XCAR (tem
), QCtype
))
8228 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
8230 struct image_type
*type
;
8231 type
= lookup_image_type (XCAR (tem
));
8233 valid_p
= type
->valid_p (object
);
8244 /* Log error message with format string FORMAT and argument ARG.
8245 Signaling an error, e.g. when an image cannot be loaded, is not a
8246 good idea because this would interrupt redisplay, and the error
8247 message display would lead to another redisplay. This function
8248 therefore simply displays a message. */
8251 image_error (format
, arg1
, arg2
)
8253 Lisp_Object arg1
, arg2
;
8255 add_to_log (format
, arg1
, arg2
);
8260 /***********************************************************************
8261 Image specifications
8262 ***********************************************************************/
8264 enum image_value_type
8266 IMAGE_DONT_CHECK_VALUE_TYPE
,
8268 IMAGE_STRING_OR_NIL_VALUE
,
8270 IMAGE_POSITIVE_INTEGER_VALUE
,
8271 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
8272 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
8274 IMAGE_INTEGER_VALUE
,
8275 IMAGE_FUNCTION_VALUE
,
8280 /* Structure used when parsing image specifications. */
8282 struct image_keyword
8284 /* Name of keyword. */
8287 /* The type of value allowed. */
8288 enum image_value_type type
;
8290 /* Non-zero means key must be present. */
8293 /* Used to recognize duplicate keywords in a property list. */
8296 /* The value that was found. */
8301 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
8303 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
8306 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
8307 has the format (image KEYWORD VALUE ...). One of the keyword/
8308 value pairs must be `:type TYPE'. KEYWORDS is a vector of
8309 image_keywords structures of size NKEYWORDS describing other
8310 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
8313 parse_image_spec (spec
, keywords
, nkeywords
, type
)
8315 struct image_keyword
*keywords
;
8322 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
8325 plist
= XCDR (spec
);
8326 while (CONSP (plist
))
8328 Lisp_Object key
, value
;
8330 /* First element of a pair must be a symbol. */
8332 plist
= XCDR (plist
);
8336 /* There must follow a value. */
8339 value
= XCAR (plist
);
8340 plist
= XCDR (plist
);
8342 /* Find key in KEYWORDS. Error if not found. */
8343 for (i
= 0; i
< nkeywords
; ++i
)
8344 if (strcmp (keywords
[i
].name
, SDATA (SYMBOL_NAME (key
))) == 0)
8350 /* Record that we recognized the keyword. If a keywords
8351 was found more than once, it's an error. */
8352 keywords
[i
].value
= value
;
8353 ++keywords
[i
].count
;
8355 if (keywords
[i
].count
> 1)
8358 /* Check type of value against allowed type. */
8359 switch (keywords
[i
].type
)
8361 case IMAGE_STRING_VALUE
:
8362 if (!STRINGP (value
))
8366 case IMAGE_STRING_OR_NIL_VALUE
:
8367 if (!STRINGP (value
) && !NILP (value
))
8371 case IMAGE_SYMBOL_VALUE
:
8372 if (!SYMBOLP (value
))
8376 case IMAGE_POSITIVE_INTEGER_VALUE
:
8377 if (!INTEGERP (value
) || XINT (value
) <= 0)
8381 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
8382 if (INTEGERP (value
) && XINT (value
) >= 0)
8385 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
8386 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
8390 case IMAGE_ASCENT_VALUE
:
8391 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
8393 else if (INTEGERP (value
)
8394 && XINT (value
) >= 0
8395 && XINT (value
) <= 100)
8399 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
8400 if (!INTEGERP (value
) || XINT (value
) < 0)
8404 case IMAGE_DONT_CHECK_VALUE_TYPE
:
8407 case IMAGE_FUNCTION_VALUE
:
8408 value
= indirect_function (value
);
8410 || COMPILEDP (value
)
8411 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
8415 case IMAGE_NUMBER_VALUE
:
8416 if (!INTEGERP (value
) && !FLOATP (value
))
8420 case IMAGE_INTEGER_VALUE
:
8421 if (!INTEGERP (value
))
8425 case IMAGE_BOOL_VALUE
:
8426 if (!NILP (value
) && !EQ (value
, Qt
))
8435 if (EQ (key
, QCtype
) && !EQ (type
, value
))
8439 /* Check that all mandatory fields are present. */
8440 for (i
= 0; i
< nkeywords
; ++i
)
8441 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
8444 return NILP (plist
);
8448 /* Return the value of KEY in image specification SPEC. Value is nil
8449 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8450 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8453 image_spec_value (spec
, key
, found
)
8454 Lisp_Object spec
, key
;
8459 xassert (valid_image_p (spec
));
8461 for (tail
= XCDR (spec
);
8462 CONSP (tail
) && CONSP (XCDR (tail
));
8463 tail
= XCDR (XCDR (tail
)))
8465 if (EQ (XCAR (tail
), key
))
8469 return XCAR (XCDR (tail
));
8479 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
8480 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
8481 PIXELS non-nil means return the size in pixels, otherwise return the
8482 size in canonical character units.
8483 FRAME is the frame on which the image will be displayed. FRAME nil
8484 or omitted means use the selected frame. */)
8485 (spec
, pixels
, frame
)
8486 Lisp_Object spec
, pixels
, frame
;
8491 if (valid_image_p (spec
))
8493 struct frame
*f
= check_x_frame (frame
);
8494 int id
= lookup_image (f
, spec
);
8495 struct image
*img
= IMAGE_FROM_ID (f
, id
);
8496 int width
= img
->width
+ 2 * img
->hmargin
;
8497 int height
= img
->height
+ 2 * img
->vmargin
;
8500 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
8501 make_float ((double) height
/ CANON_Y_UNIT (f
)));
8503 size
= Fcons (make_number (width
), make_number (height
));
8506 error ("Invalid image specification");
8512 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
8513 doc
: /* Return t if image SPEC has a mask bitmap.
8514 FRAME is the frame on which the image will be displayed. FRAME nil
8515 or omitted means use the selected frame. */)
8517 Lisp_Object spec
, frame
;
8522 if (valid_image_p (spec
))
8524 struct frame
*f
= check_x_frame (frame
);
8525 int id
= lookup_image (f
, spec
);
8526 struct image
*img
= IMAGE_FROM_ID (f
, id
);
8531 error ("Invalid image specification");
8537 /***********************************************************************
8538 Image type independent image structures
8539 ***********************************************************************/
8541 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
8542 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
8545 /* Allocate and return a new image structure for image specification
8546 SPEC. SPEC has a hash value of HASH. */
8548 static struct image
*
8549 make_image (spec
, hash
)
8553 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
8555 xassert (valid_image_p (spec
));
8556 bzero (img
, sizeof *img
);
8557 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
8558 xassert (img
->type
!= NULL
);
8560 img
->data
.lisp_val
= Qnil
;
8561 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
8567 /* Free image IMG which was used on frame F, including its resources. */
8576 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8578 /* Remove IMG from the hash table of its cache. */
8580 img
->prev
->next
= img
->next
;
8582 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
8585 img
->next
->prev
= img
->prev
;
8587 c
->images
[img
->id
] = NULL
;
8589 /* Free resources, then free IMG. */
8590 img
->type
->free (f
, img
);
8596 /* Prepare image IMG for display on frame F. Must be called before
8597 drawing an image. */
8600 prepare_image_for_display (f
, img
)
8606 /* We're about to display IMG, so set its timestamp to `now'. */
8608 img
->timestamp
= EMACS_SECS (t
);
8610 /* If IMG doesn't have a pixmap yet, load it now, using the image
8611 type dependent loader function. */
8612 if (img
->pixmap
== 0 && !img
->load_failed_p
)
8613 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8617 /* Value is the number of pixels for the ascent of image IMG when
8618 drawn in face FACE. */
8621 image_ascent (img
, face
)
8625 int height
= img
->height
+ img
->vmargin
;
8628 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
8631 ascent
= height
/ 2 - (FONT_DESCENT(face
->font
)
8632 - FONT_BASE(face
->font
)) / 2;
8634 ascent
= height
/ 2;
8637 ascent
= (int) (height
* img
->ascent
/ 100.0);
8644 /* Image background colors. */
8646 /* Find the "best" corner color of a bitmap. XIMG is assumed to a device
8647 context with the bitmap selected. */
8649 four_corners_best (ximg
, width
, height
)
8651 unsigned long width
, height
;
8653 COLORREF corners
[4], best
;
8656 /* Get the colors at the corners of ximg. */
8657 corners
[0] = GetPixel (ximg
, 0, 0);
8658 corners
[1] = GetPixel (ximg
, width
- 1, 0);
8659 corners
[2] = GetPixel (ximg
, width
- 1, height
- 1);
8660 corners
[3] = GetPixel (ximg
, 0, height
- 1);
8662 /* Choose the most frequently found color as background. */
8663 for (i
= best_count
= 0; i
< 4; ++i
)
8667 for (j
= n
= 0; j
< 4; ++j
)
8668 if (corners
[i
] == corners
[j
])
8672 best
= corners
[i
], best_count
= n
;
8678 /* Return the `background' field of IMG. If IMG doesn't have one yet,
8679 it is guessed heuristically. If non-zero, XIMG is an existing XImage
8680 object to use for the heuristic. */
8683 image_background (img
, f
, ximg
)
8688 if (! img
->background_valid
)
8689 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8691 #if 0 /* TODO: Image support. */
8692 int free_ximg
= !ximg
;
8695 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
8696 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8698 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
8701 XDestroyImage (ximg
);
8703 img
->background_valid
= 1;
8707 return img
->background
;
8710 /* Return the `background_transparent' field of IMG. If IMG doesn't
8711 have one yet, it is guessed heuristically. If non-zero, MASK is an
8712 existing XImage object to use for the heuristic. */
8715 image_background_transparent (img
, f
, mask
)
8720 if (! img
->background_transparent_valid
)
8721 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8723 #if 0 /* TODO: Image support. */
8726 int free_mask
= !mask
;
8729 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
8730 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8732 img
->background_transparent
8733 = !four_corners_best (mask
, img
->width
, img
->height
);
8736 XDestroyImage (mask
);
8740 img
->background_transparent
= 0;
8742 img
->background_transparent_valid
= 1;
8745 return img
->background_transparent
;
8749 /***********************************************************************
8750 Helper functions for X image types
8751 ***********************************************************************/
8753 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
8755 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8756 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
8758 Lisp_Object color_name
,
8759 unsigned long dflt
));
8762 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
8763 free the pixmap if any. MASK_P non-zero means clear the mask
8764 pixmap if any. COLORS_P non-zero means free colors allocated for
8765 the image, if any. */
8768 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
8771 int pixmap_p
, mask_p
, colors_p
;
8773 if (pixmap_p
&& img
->pixmap
)
8775 DeleteObject (img
->pixmap
);
8777 img
->background_valid
= 0;
8780 if (mask_p
&& img
->mask
)
8782 DeleteObject (img
->mask
);
8784 img
->background_transparent_valid
= 0;
8787 if (colors_p
&& img
->ncolors
)
8789 #if 0 /* TODO: color table support. */
8790 x_free_colors (f
, img
->colors
, img
->ncolors
);
8792 xfree (img
->colors
);
8798 /* Free X resources of image IMG which is used on frame F. */
8801 x_clear_image (f
, img
)
8808 DeleteObject (img
->pixmap
);
8815 #if 0 /* TODO: color table support */
8817 int class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
8819 /* If display has an immutable color map, freeing colors is not
8820 necessary and some servers don't allow it. So don't do it. */
8821 if (class != StaticColor
8822 && class != StaticGray
8823 && class != TrueColor
)
8827 cmap
= DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f
)->screen
);
8828 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
, img
->colors
,
8834 xfree (img
->colors
);
8841 /* Allocate color COLOR_NAME for image IMG on frame F. If color
8842 cannot be allocated, use DFLT. Add a newly allocated color to
8843 IMG->colors, so that it can be freed again. Value is the pixel
8846 static unsigned long
8847 x_alloc_image_color (f
, img
, color_name
, dflt
)
8850 Lisp_Object color_name
;
8854 unsigned long result
;
8856 xassert (STRINGP (color_name
));
8858 if (w32_defined_color (f
, SDATA (color_name
), &color
, 1))
8860 /* This isn't called frequently so we get away with simply
8861 reallocating the color vector to the needed size, here. */
8864 (unsigned long *) xrealloc (img
->colors
,
8865 img
->ncolors
* sizeof *img
->colors
);
8866 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
8867 result
= color
.pixel
;
8876 /***********************************************************************
8878 ***********************************************************************/
8880 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
8881 static void postprocess_image
P_ ((struct frame
*, struct image
*));
8884 /* Return a new, initialized image cache that is allocated from the
8885 heap. Call free_image_cache to free an image cache. */
8887 struct image_cache
*
8890 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
8893 bzero (c
, sizeof *c
);
8895 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
8896 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
8897 c
->buckets
= (struct image
**) xmalloc (size
);
8898 bzero (c
->buckets
, size
);
8903 /* Free image cache of frame F. Be aware that X frames share images
8907 free_image_cache (f
)
8910 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8915 /* Cache should not be referenced by any frame when freed. */
8916 xassert (c
->refcount
== 0);
8918 for (i
= 0; i
< c
->used
; ++i
)
8919 free_image (f
, c
->images
[i
]);
8923 FRAME_X_IMAGE_CACHE (f
) = NULL
;
8928 /* Clear image cache of frame F. FORCE_P non-zero means free all
8929 images. FORCE_P zero means clear only images that haven't been
8930 displayed for some time. Should be called from time to time to
8931 reduce the number of loaded images. If image-eviction-seconds is
8932 non-nil, this frees images in the cache which weren't displayed for
8933 at least that many seconds. */
8936 clear_image_cache (f
, force_p
)
8940 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8942 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
8949 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
8951 /* Block input so that we won't be interrupted by a SIGIO
8952 while being in an inconsistent state. */
8955 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
8957 struct image
*img
= c
->images
[i
];
8959 && (force_p
|| (img
->timestamp
< old
)))
8961 free_image (f
, img
);
8966 /* We may be clearing the image cache because, for example,
8967 Emacs was iconified for a longer period of time. In that
8968 case, current matrices may still contain references to
8969 images freed above. So, clear these matrices. */
8972 Lisp_Object tail
, frame
;
8974 FOR_EACH_FRAME (tail
, frame
)
8976 struct frame
*f
= XFRAME (frame
);
8978 && FRAME_X_IMAGE_CACHE (f
) == c
)
8979 clear_current_matrices (f
);
8982 ++windows_or_buffers_changed
;
8990 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
8992 doc
: /* Clear the image cache of FRAME.
8993 FRAME nil or omitted means use the selected frame.
8994 FRAME t means clear the image caches of all frames. */)
9002 FOR_EACH_FRAME (tail
, frame
)
9003 if (FRAME_W32_P (XFRAME (frame
)))
9004 clear_image_cache (XFRAME (frame
), 1);
9007 clear_image_cache (check_x_frame (frame
), 1);
9013 /* Compute masks and transform image IMG on frame F, as specified
9014 by the image's specification, */
9017 postprocess_image (f
, img
)
9021 #if 0 /* TODO: image support. */
9022 /* Manipulation of the image's mask. */
9025 Lisp_Object conversion
, spec
;
9030 /* `:heuristic-mask t'
9032 means build a mask heuristically.
9033 `:heuristic-mask (R G B)'
9034 `:mask (heuristic (R G B))'
9035 means build a mask from color (R G B) in the
9038 means remove a mask, if any. */
9040 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
9042 x_build_heuristic_mask (f
, img
, mask
);
9047 mask
= image_spec_value (spec
, QCmask
, &found_p
);
9049 if (EQ (mask
, Qheuristic
))
9050 x_build_heuristic_mask (f
, img
, Qt
);
9051 else if (CONSP (mask
)
9052 && EQ (XCAR (mask
), Qheuristic
))
9054 if (CONSP (XCDR (mask
)))
9055 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
9057 x_build_heuristic_mask (f
, img
, XCDR (mask
));
9059 else if (NILP (mask
) && found_p
&& img
->mask
)
9061 DeleteObject (img
->mask
);
9067 /* Should we apply an image transformation algorithm? */
9068 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
9069 if (EQ (conversion
, Qdisabled
))
9070 x_disable_image (f
, img
);
9071 else if (EQ (conversion
, Qlaplace
))
9073 else if (EQ (conversion
, Qemboss
))
9075 else if (CONSP (conversion
)
9076 && EQ (XCAR (conversion
), Qedge_detection
))
9079 tem
= XCDR (conversion
);
9081 x_edge_detection (f
, img
,
9082 Fplist_get (tem
, QCmatrix
),
9083 Fplist_get (tem
, QCcolor_adjustment
));
9090 /* Return the id of image with Lisp specification SPEC on frame F.
9091 SPEC must be a valid Lisp image specification (see valid_image_p). */
9094 lookup_image (f
, spec
)
9098 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9102 struct gcpro gcpro1
;
9105 /* F must be a window-system frame, and SPEC must be a valid image
9107 xassert (FRAME_WINDOW_P (f
));
9108 xassert (valid_image_p (spec
));
9112 /* Look up SPEC in the hash table of the image cache. */
9113 hash
= sxhash (spec
, 0);
9114 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
9116 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
9117 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
9120 /* If not found, create a new image and cache it. */
9123 extern Lisp_Object Qpostscript
;
9126 img
= make_image (spec
, hash
);
9127 cache_image (f
, img
);
9128 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
9130 /* If we can't load the image, and we don't have a width and
9131 height, use some arbitrary width and height so that we can
9132 draw a rectangle for it. */
9133 if (img
->load_failed_p
)
9137 value
= image_spec_value (spec
, QCwidth
, NULL
);
9138 img
->width
= (INTEGERP (value
)
9139 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
9140 value
= image_spec_value (spec
, QCheight
, NULL
);
9141 img
->height
= (INTEGERP (value
)
9142 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
9146 /* Handle image type independent image attributes
9147 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF',
9148 `:background COLOR'. */
9149 Lisp_Object ascent
, margin
, relief
, bg
;
9151 ascent
= image_spec_value (spec
, QCascent
, NULL
);
9152 if (INTEGERP (ascent
))
9153 img
->ascent
= XFASTINT (ascent
);
9154 else if (EQ (ascent
, Qcenter
))
9155 img
->ascent
= CENTERED_IMAGE_ASCENT
;
9157 margin
= image_spec_value (spec
, QCmargin
, NULL
);
9158 if (INTEGERP (margin
) && XINT (margin
) >= 0)
9159 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
9160 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
9161 && INTEGERP (XCDR (margin
)))
9163 if (XINT (XCAR (margin
)) > 0)
9164 img
->hmargin
= XFASTINT (XCAR (margin
));
9165 if (XINT (XCDR (margin
)) > 0)
9166 img
->vmargin
= XFASTINT (XCDR (margin
));
9169 relief
= image_spec_value (spec
, QCrelief
, NULL
);
9170 if (INTEGERP (relief
))
9172 img
->relief
= XINT (relief
);
9173 img
->hmargin
+= abs (img
->relief
);
9174 img
->vmargin
+= abs (img
->relief
);
9177 if (! img
->background_valid
)
9179 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
9183 = x_alloc_image_color (f
, img
, bg
,
9184 FRAME_BACKGROUND_PIXEL (f
));
9185 img
->background_valid
= 1;
9189 /* Do image transformations and compute masks, unless we
9190 don't have the image yet. */
9191 if (!EQ (*img
->type
->type
, Qpostscript
))
9192 postprocess_image (f
, img
);
9196 xassert (!interrupt_input_blocked
);
9199 /* We're using IMG, so set its timestamp to `now'. */
9200 EMACS_GET_TIME (now
);
9201 img
->timestamp
= EMACS_SECS (now
);
9205 /* Value is the image id. */
9210 /* Cache image IMG in the image cache of frame F. */
9213 cache_image (f
, img
)
9217 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9220 /* Find a free slot in c->images. */
9221 for (i
= 0; i
< c
->used
; ++i
)
9222 if (c
->images
[i
] == NULL
)
9225 /* If no free slot found, maybe enlarge c->images. */
9226 if (i
== c
->used
&& c
->used
== c
->size
)
9229 c
->images
= (struct image
**) xrealloc (c
->images
,
9230 c
->size
* sizeof *c
->images
);
9233 /* Add IMG to c->images, and assign IMG an id. */
9239 /* Add IMG to the cache's hash table. */
9240 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
9241 img
->next
= c
->buckets
[i
];
9243 img
->next
->prev
= img
;
9245 c
->buckets
[i
] = img
;
9249 /* Call FN on every image in the image cache of frame F. Used to mark
9250 Lisp Objects in the image cache. */
9253 forall_images_in_image_cache (f
, fn
)
9255 void (*fn
) P_ ((struct image
*img
));
9257 if (FRAME_LIVE_P (f
) && FRAME_W32_P (f
))
9259 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9263 for (i
= 0; i
< c
->used
; ++i
)
9272 /***********************************************************************
9274 ***********************************************************************/
9276 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
9277 XImage
**, Pixmap
*));
9278 static void x_destroy_x_image
P_ ((XImage
*));
9279 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
9282 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
9283 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
9284 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
9285 via xmalloc. DEPTH of zero signifies a 24 bit image, otherwise
9286 DEPTH should indicate the bit depth of the image. Print error
9287 messages via image_error if an error occurs. Value is non-zero if
9291 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
9293 int width
, height
, depth
;
9297 BITMAPINFOHEADER
*header
;
9299 int scanline_width_bits
;
9301 int palette_colors
= 0;
9306 if (depth
!= 1 && depth
!= 4 && depth
!= 8
9307 && depth
!= 16 && depth
!= 24 && depth
!= 32)
9309 image_error ("Invalid image bit depth specified", Qnil
, Qnil
);
9313 scanline_width_bits
= width
* depth
;
9314 remainder
= scanline_width_bits
% 32;
9317 scanline_width_bits
+= 32 - remainder
;
9319 /* Bitmaps with a depth less than 16 need a palette. */
9320 /* BITMAPINFO structure already contains the first RGBQUAD. */
9322 palette_colors
= 1 << depth
- 1;
9324 *ximg
= xmalloc (sizeof (XImage
) + palette_colors
* sizeof (RGBQUAD
));
9327 image_error ("Unable to allocate memory for XImage", Qnil
, Qnil
);
9331 header
= &((*ximg
)->info
.bmiHeader
);
9332 bzero (&((*ximg
)->info
), sizeof (BITMAPINFO
));
9333 header
->biSize
= sizeof (*header
);
9334 header
->biWidth
= width
;
9335 header
->biHeight
= -height
; /* negative indicates a top-down bitmap. */
9336 header
->biPlanes
= 1;
9337 header
->biBitCount
= depth
;
9338 header
->biCompression
= BI_RGB
;
9339 header
->biClrUsed
= palette_colors
;
9341 hdc
= get_frame_dc (f
);
9343 /* Create a DIBSection and raster array for the bitmap,
9344 and store its handle in *pixmap. */
9345 *pixmap
= CreateDIBSection (hdc
, &((*ximg
)->info
), DIB_RGB_COLORS
,
9346 &((*ximg
)->data
), NULL
, 0);
9348 /* Realize display palette and garbage all frames. */
9349 release_frame_dc (f
, hdc
);
9351 if (*pixmap
== NULL
)
9353 DWORD err
= GetLastError();
9354 Lisp_Object errcode
;
9355 /* All system errors are < 10000, so the following is safe. */
9356 XSETINT (errcode
, (int) err
);
9357 image_error ("Unable to create bitmap, error code %d", errcode
, Qnil
);
9358 x_destroy_x_image (*ximg
);
9366 /* Destroy XImage XIMG. Free XIMG->data. */
9369 x_destroy_x_image (ximg
)
9372 xassert (interrupt_input_blocked
);
9375 /* Data will be freed by DestroyObject. */
9382 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
9383 are width and height of both the image and pixmap. */
9386 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
9392 #if TODO /* W32 specific image code. */
9395 xassert (interrupt_input_blocked
);
9396 gc
= XCreateGC (NULL
, pixmap
, 0, NULL
);
9397 XPutImage (NULL
, pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
9403 /***********************************************************************
9405 ***********************************************************************/
9407 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
9408 static char *slurp_file
P_ ((char *, int *));
9411 /* Find image file FILE. Look in data-directory, then
9412 x-bitmap-file-path. Value is the full name of the file found, or
9413 nil if not found. */
9416 x_find_image_file (file
)
9419 Lisp_Object file_found
, search_path
;
9420 struct gcpro gcpro1
, gcpro2
;
9424 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
9425 GCPRO2 (file_found
, search_path
);
9427 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
9428 fd
= openp (search_path
, file
, Qnil
, &file_found
, Qnil
);
9440 /* Read FILE into memory. Value is a pointer to a buffer allocated
9441 with xmalloc holding FILE's contents. Value is null if an error
9442 occurred. *SIZE is set to the size of the file. */
9445 slurp_file (file
, size
)
9453 if (stat (file
, &st
) == 0
9454 && (fp
= fopen (file
, "r")) != NULL
9455 && (buf
= (char *) xmalloc (st
.st_size
),
9456 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
9477 /***********************************************************************
9479 ***********************************************************************/
9481 static int xbm_scan
P_ ((char **, char *, char *, int *));
9482 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
9483 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
9485 static int xbm_image_p
P_ ((Lisp_Object object
));
9486 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
9488 static int xbm_file_p
P_ ((Lisp_Object
));
9491 /* Indices of image specification fields in xbm_format, below. */
9493 enum xbm_keyword_index
9511 /* Vector of image_keyword structures describing the format
9512 of valid XBM image specifications. */
9514 static struct image_keyword xbm_format
[XBM_LAST
] =
9516 {":type", IMAGE_SYMBOL_VALUE
, 1},
9517 {":file", IMAGE_STRING_VALUE
, 0},
9518 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9519 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9520 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9521 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
9522 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
9523 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9524 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9525 {":relief", IMAGE_INTEGER_VALUE
, 0},
9526 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9527 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9528 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9531 /* Structure describing the image type XBM. */
9533 static struct image_type xbm_type
=
9542 /* Tokens returned from xbm_scan. */
9551 /* Return non-zero if OBJECT is a valid XBM-type image specification.
9552 A valid specification is a list starting with the symbol `image'
9553 The rest of the list is a property list which must contain an
9556 If the specification specifies a file to load, it must contain
9557 an entry `:file FILENAME' where FILENAME is a string.
9559 If the specification is for a bitmap loaded from memory it must
9560 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
9561 WIDTH and HEIGHT are integers > 0. DATA may be:
9563 1. a string large enough to hold the bitmap data, i.e. it must
9564 have a size >= (WIDTH + 7) / 8 * HEIGHT
9566 2. a bool-vector of size >= WIDTH * HEIGHT
9568 3. a vector of strings or bool-vectors, one for each line of the
9571 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
9572 may not be specified in this case because they are defined in the
9575 Both the file and data forms may contain the additional entries
9576 `:background COLOR' and `:foreground COLOR'. If not present,
9577 foreground and background of the frame on which the image is
9578 displayed is used. */
9581 xbm_image_p (object
)
9584 struct image_keyword kw
[XBM_LAST
];
9586 bcopy (xbm_format
, kw
, sizeof kw
);
9587 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
9590 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
9592 if (kw
[XBM_FILE
].count
)
9594 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
9597 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
9599 /* In-memory XBM file. */
9600 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
9608 /* Entries for `:width', `:height' and `:data' must be present. */
9609 if (!kw
[XBM_WIDTH
].count
9610 || !kw
[XBM_HEIGHT
].count
9611 || !kw
[XBM_DATA
].count
)
9614 data
= kw
[XBM_DATA
].value
;
9615 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
9616 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
9618 /* Check type of data, and width and height against contents of
9624 /* Number of elements of the vector must be >= height. */
9625 if (XVECTOR (data
)->size
< height
)
9628 /* Each string or bool-vector in data must be large enough
9629 for one line of the image. */
9630 for (i
= 0; i
< height
; ++i
)
9632 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
9637 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
9640 else if (BOOL_VECTOR_P (elt
))
9642 if (XBOOL_VECTOR (elt
)->size
< width
)
9649 else if (STRINGP (data
))
9652 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
9655 else if (BOOL_VECTOR_P (data
))
9657 if (XBOOL_VECTOR (data
)->size
< width
* height
)
9668 /* Scan a bitmap file. FP is the stream to read from. Value is
9669 either an enumerator from enum xbm_token, or a character for a
9670 single-character token, or 0 at end of file. If scanning an
9671 identifier, store the lexeme of the identifier in SVAL. If
9672 scanning a number, store its value in *IVAL. */
9675 xbm_scan (s
, end
, sval
, ival
)
9684 /* Skip white space. */
9685 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
9690 else if (isdigit (c
))
9692 int value
= 0, digit
;
9694 if (c
== '0' && *s
< end
)
9697 if (c
== 'x' || c
== 'X')
9704 else if (c
>= 'a' && c
<= 'f')
9705 digit
= c
- 'a' + 10;
9706 else if (c
>= 'A' && c
<= 'F')
9707 digit
= c
- 'A' + 10;
9710 value
= 16 * value
+ digit
;
9713 else if (isdigit (c
))
9717 && (c
= *(*s
)++, isdigit (c
)))
9718 value
= 8 * value
+ c
- '0';
9725 && (c
= *(*s
)++, isdigit (c
)))
9726 value
= 10 * value
+ c
- '0';
9734 else if (isalpha (c
) || c
== '_')
9738 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
9745 else if (c
== '/' && **s
== '*')
9747 /* C-style comment. */
9749 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
9762 /* XBM bits seem to be backward within bytes compared with how
9763 Windows does things. */
9764 static unsigned char reflect_byte (unsigned char orig
)
9767 unsigned char reflected
= 0x00;
9768 for (i
= 0; i
< 8; i
++)
9770 if (orig
& (0x01 << i
))
9771 reflected
|= 0x80 >> i
;
9777 /* Create a Windows bitmap from X bitmap data. */
9779 w32_create_pixmap_from_bitmap_data (int width
, int height
, char *data
)
9785 w1
= (width
+ 7) / 8; /* nb of 8bits elt in X bitmap */
9786 w2
= ((width
+ 15) / 16) * 2; /* nb of 16bits elt in W32 bitmap */
9787 bits
= (char *) xmalloc (height
* w2
);
9788 bzero (bits
, height
* w2
);
9789 for (i
= 0; i
< height
; i
++)
9792 for (j
= 0; j
< w1
; j
++)
9793 *p
++ = reflect_byte(*data
++);
9795 bmp
= CreateBitmap (width
, height
, 1, 1, bits
);
9802 /* Replacement for XReadBitmapFileData which isn't available under old
9803 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9804 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9805 the image. Return in *DATA the bitmap data allocated with xmalloc.
9806 Value is non-zero if successful. DATA null means just test if
9807 CONTENTS looks like an in-memory XBM file. */
9810 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
9811 char *contents
, *end
;
9812 int *width
, *height
;
9813 unsigned char **data
;
9816 char buffer
[BUFSIZ
];
9819 int bytes_per_line
, i
, nbytes
;
9825 LA1 = xbm_scan (&s, end, buffer, &value)
9827 #define expect(TOKEN) \
9828 if (LA1 != (TOKEN)) \
9833 #define expect_ident(IDENT) \
9834 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9839 *width
= *height
= -1;
9842 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
9844 /* Parse defines for width, height and hot-spots. */
9848 expect_ident ("define");
9849 expect (XBM_TK_IDENT
);
9851 if (LA1
== XBM_TK_NUMBER
);
9853 char *p
= strrchr (buffer
, '_');
9854 p
= p
? p
+ 1 : buffer
;
9855 if (strcmp (p
, "width") == 0)
9857 else if (strcmp (p
, "height") == 0)
9860 expect (XBM_TK_NUMBER
);
9863 if (*width
< 0 || *height
< 0)
9865 else if (data
== NULL
)
9868 /* Parse bits. Must start with `static'. */
9869 expect_ident ("static");
9870 if (LA1
== XBM_TK_IDENT
)
9872 if (strcmp (buffer
, "unsigned") == 0)
9875 expect_ident ("char");
9877 else if (strcmp (buffer
, "short") == 0)
9881 if (*width
% 16 && *width
% 16 < 9)
9884 else if (strcmp (buffer
, "char") == 0)
9892 expect (XBM_TK_IDENT
);
9898 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
9899 nbytes
= bytes_per_line
* *height
;
9900 p
= *data
= (char *) xmalloc (nbytes
);
9904 for (i
= 0; i
< nbytes
; i
+= 2)
9907 expect (XBM_TK_NUMBER
);
9910 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
9913 if (LA1
== ',' || LA1
== '}')
9921 for (i
= 0; i
< nbytes
; ++i
)
9924 expect (XBM_TK_NUMBER
);
9928 if (LA1
== ',' || LA1
== '}')
9953 /* Load XBM image IMG which will be displayed on frame F from buffer
9954 CONTENTS. END is the end of the buffer. Value is non-zero if
9958 xbm_load_image (f
, img
, contents
, end
)
9961 char *contents
, *end
;
9964 unsigned char *data
;
9967 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
9970 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
9971 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
9974 xassert (img
->width
> 0 && img
->height
> 0);
9976 /* Get foreground and background colors, maybe allocate colors. */
9977 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
9979 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
9980 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
9983 background
= x_alloc_image_color (f
, img
, value
, background
);
9984 img
->background
= background
;
9985 img
->background_valid
= 1;
9988 = w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
, data
);
9992 if (img
->pixmap
== 0)
9994 x_clear_image (f
, img
);
9995 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
10001 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
10007 /* Value is non-zero if DATA looks like an in-memory XBM file. */
10014 return (STRINGP (data
)
10015 && xbm_read_bitmap_data (SDATA (data
),
10022 /* Fill image IMG which is used on frame F with pixmap data. Value is
10023 non-zero if successful. */
10031 Lisp_Object file_name
;
10033 xassert (xbm_image_p (img
->spec
));
10035 /* If IMG->spec specifies a file name, create a non-file spec from it. */
10036 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
10037 if (STRINGP (file_name
))
10042 struct gcpro gcpro1
;
10044 file
= x_find_image_file (file_name
);
10046 if (!STRINGP (file
))
10048 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
10053 contents
= slurp_file (SDATA (file
), &size
);
10054 if (contents
== NULL
)
10056 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
10061 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
10066 struct image_keyword fmt
[XBM_LAST
];
10069 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
10070 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
10073 int in_memory_file_p
= 0;
10075 /* See if data looks like an in-memory XBM file. */
10076 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10077 in_memory_file_p
= xbm_file_p (data
);
10079 /* Parse the image specification. */
10080 bcopy (xbm_format
, fmt
, sizeof fmt
);
10081 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
10082 xassert (parsed_p
);
10084 /* Get specified width, and height. */
10085 if (!in_memory_file_p
)
10087 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
10088 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
10089 xassert (img
->width
> 0 && img
->height
> 0);
10092 /* Get foreground and background colors, maybe allocate colors. */
10093 if (fmt
[XBM_FOREGROUND
].count
10094 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
10095 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
10097 if (fmt
[XBM_BACKGROUND
].count
10098 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
10099 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
10102 if (in_memory_file_p
)
10103 success_p
= xbm_load_image (f
, img
, SDATA (data
),
10108 if (VECTORP (data
))
10112 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
10114 p
= bits
= (char *) alloca (nbytes
* img
->height
);
10115 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
10117 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
10118 if (STRINGP (line
))
10119 bcopy (SDATA (line
), p
, nbytes
);
10121 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
10124 else if (STRINGP (data
))
10125 bits
= SDATA (data
);
10127 bits
= XBOOL_VECTOR (data
)->data
;
10129 /* Create the pixmap. */
10130 depth
= one_w32_display_info
.n_cbits
;
10132 = w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
,
10139 image_error ("Unable to create pixmap for XBM image `%s'",
10141 x_clear_image (f
, img
);
10151 /***********************************************************************
10153 ***********************************************************************/
10157 static int xpm_image_p
P_ ((Lisp_Object object
));
10158 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
10159 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
10161 #include "X11/xpm.h"
10163 /* The symbol `xpm' identifying XPM-format images. */
10167 /* Indices of image specification fields in xpm_format, below. */
10169 enum xpm_keyword_index
10178 XPM_HEURISTIC_MASK
,
10185 /* Vector of image_keyword structures describing the format
10186 of valid XPM image specifications. */
10188 static struct image_keyword xpm_format
[XPM_LAST
] =
10190 {":type", IMAGE_SYMBOL_VALUE
, 1},
10191 {":file", IMAGE_STRING_VALUE
, 0},
10192 {":data", IMAGE_STRING_VALUE
, 0},
10193 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10194 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10195 {":relief", IMAGE_INTEGER_VALUE
, 0},
10196 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10197 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10198 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10199 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10200 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10203 /* Structure describing the image type XBM. */
10205 static struct image_type xpm_type
=
10215 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
10216 for XPM images. Such a list must consist of conses whose car and
10217 cdr are strings. */
10220 xpm_valid_color_symbols_p (color_symbols
)
10221 Lisp_Object color_symbols
;
10223 while (CONSP (color_symbols
))
10225 Lisp_Object sym
= XCAR (color_symbols
);
10227 || !STRINGP (XCAR (sym
))
10228 || !STRINGP (XCDR (sym
)))
10230 color_symbols
= XCDR (color_symbols
);
10233 return NILP (color_symbols
);
10237 /* Value is non-zero if OBJECT is a valid XPM image specification. */
10240 xpm_image_p (object
)
10241 Lisp_Object object
;
10243 struct image_keyword fmt
[XPM_LAST
];
10244 bcopy (xpm_format
, fmt
, sizeof fmt
);
10245 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
10246 /* Either `:file' or `:data' must be present. */
10247 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
10248 /* Either no `:color-symbols' or it's a list of conses
10249 whose car and cdr are strings. */
10250 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
10251 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
10252 && (fmt
[XPM_ASCENT
].count
== 0
10253 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
10257 /* Load image IMG which will be displayed on frame F. Value is
10258 non-zero if successful. */
10266 XpmAttributes attrs
;
10267 Lisp_Object specified_file
, color_symbols
;
10269 /* Configure the XPM lib. Use the visual of frame F. Allocate
10270 close colors. Return colors allocated. */
10271 bzero (&attrs
, sizeof attrs
);
10272 attrs
.visual
= FRAME_X_VISUAL (f
);
10273 attrs
.colormap
= FRAME_X_COLORMAP (f
);
10274 attrs
.valuemask
|= XpmVisual
;
10275 attrs
.valuemask
|= XpmColormap
;
10276 attrs
.valuemask
|= XpmReturnAllocPixels
;
10277 #ifdef XpmAllocCloseColors
10278 attrs
.alloc_close_colors
= 1;
10279 attrs
.valuemask
|= XpmAllocCloseColors
;
10281 attrs
.closeness
= 600;
10282 attrs
.valuemask
|= XpmCloseness
;
10285 /* If image specification contains symbolic color definitions, add
10286 these to `attrs'. */
10287 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
10288 if (CONSP (color_symbols
))
10291 XpmColorSymbol
*xpm_syms
;
10294 attrs
.valuemask
|= XpmColorSymbols
;
10296 /* Count number of symbols. */
10297 attrs
.numsymbols
= 0;
10298 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
10299 ++attrs
.numsymbols
;
10301 /* Allocate an XpmColorSymbol array. */
10302 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
10303 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
10304 bzero (xpm_syms
, size
);
10305 attrs
.colorsymbols
= xpm_syms
;
10307 /* Fill the color symbol array. */
10308 for (tail
= color_symbols
, i
= 0;
10310 ++i
, tail
= XCDR (tail
))
10312 Lisp_Object name
= XCAR (XCAR (tail
));
10313 Lisp_Object color
= XCDR (XCAR (tail
));
10314 xpm_syms
[i
].name
= (char *) alloca (SCHARS (name
) + 1);
10315 strcpy (xpm_syms
[i
].name
, SDATA (name
));
10316 xpm_syms
[i
].value
= (char *) alloca (SCHARS (color
) + 1);
10317 strcpy (xpm_syms
[i
].value
, SDATA (color
));
10321 /* Create a pixmap for the image, either from a file, or from a
10322 string buffer containing data in the same format as an XPM file. */
10324 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10325 if (STRINGP (specified_file
))
10327 Lisp_Object file
= x_find_image_file (specified_file
);
10328 if (!STRINGP (file
))
10330 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10335 rc
= XpmReadFileToPixmap (NULL
, FRAME_W32_WINDOW (f
),
10336 SDATA (file
), &img
->pixmap
, &img
->mask
,
10341 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
10342 rc
= XpmCreatePixmapFromBuffer (NULL
, FRAME_W32_WINDOW (f
),
10344 &img
->pixmap
, &img
->mask
,
10349 if (rc
== XpmSuccess
)
10351 /* Remember allocated colors. */
10352 img
->ncolors
= attrs
.nalloc_pixels
;
10353 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
10354 * sizeof *img
->colors
);
10355 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
10356 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
10358 img
->width
= attrs
.width
;
10359 img
->height
= attrs
.height
;
10360 xassert (img
->width
> 0 && img
->height
> 0);
10362 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
10364 XpmFreeAttributes (&attrs
);
10371 case XpmOpenFailed
:
10372 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
10375 case XpmFileInvalid
:
10376 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
10380 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
10383 case XpmColorFailed
:
10384 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
10388 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
10393 return rc
== XpmSuccess
;
10396 #endif /* HAVE_XPM != 0 */
10399 #if 0 /* TODO : Color tables on W32. */
10400 /***********************************************************************
10402 ***********************************************************************/
10404 /* An entry in the color table mapping an RGB color to a pixel color. */
10409 unsigned long pixel
;
10411 /* Next in color table collision list. */
10412 struct ct_color
*next
;
10415 /* The bucket vector size to use. Must be prime. */
10417 #define CT_SIZE 101
10419 /* Value is a hash of the RGB color given by R, G, and B. */
10421 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
10423 /* The color hash table. */
10425 struct ct_color
**ct_table
;
10427 /* Number of entries in the color table. */
10429 int ct_colors_allocated
;
10431 /* Function prototypes. */
10433 static void init_color_table
P_ ((void));
10434 static void free_color_table
P_ ((void));
10435 static unsigned long *colors_in_color_table
P_ ((int *n
));
10436 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
10437 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
10440 /* Initialize the color table. */
10443 init_color_table ()
10445 int size
= CT_SIZE
* sizeof (*ct_table
);
10446 ct_table
= (struct ct_color
**) xmalloc (size
);
10447 bzero (ct_table
, size
);
10448 ct_colors_allocated
= 0;
10452 /* Free memory associated with the color table. */
10455 free_color_table ()
10458 struct ct_color
*p
, *next
;
10460 for (i
= 0; i
< CT_SIZE
; ++i
)
10461 for (p
= ct_table
[i
]; p
; p
= next
)
10472 /* Value is a pixel color for RGB color R, G, B on frame F. If an
10473 entry for that color already is in the color table, return the
10474 pixel color of that entry. Otherwise, allocate a new color for R,
10475 G, B, and make an entry in the color table. */
10477 static unsigned long
10478 lookup_rgb_color (f
, r
, g
, b
)
10482 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
10483 int i
= hash
% CT_SIZE
;
10484 struct ct_color
*p
;
10486 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10487 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
10496 color
= PALETTERGB (r
, g
, b
);
10498 ++ct_colors_allocated
;
10500 p
= (struct ct_color
*) xmalloc (sizeof *p
);
10505 p
->next
= ct_table
[i
];
10513 /* Look up pixel color PIXEL which is used on frame F in the color
10514 table. If not already present, allocate it. Value is PIXEL. */
10516 static unsigned long
10517 lookup_pixel_color (f
, pixel
)
10519 unsigned long pixel
;
10521 int i
= pixel
% CT_SIZE
;
10522 struct ct_color
*p
;
10524 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10525 if (p
->pixel
== pixel
)
10536 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
10537 color
.pixel
= pixel
;
10538 XQueryColor (NULL
, cmap
, &color
);
10539 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
10544 ++ct_colors_allocated
;
10546 p
= (struct ct_color
*) xmalloc (sizeof *p
);
10548 p
->g
= color
.green
;
10551 p
->next
= ct_table
[i
];
10555 return FRAME_FOREGROUND_PIXEL (f
);
10561 /* Value is a vector of all pixel colors contained in the color table,
10562 allocated via xmalloc. Set *N to the number of colors. */
10564 static unsigned long *
10565 colors_in_color_table (n
)
10569 struct ct_color
*p
;
10570 unsigned long *colors
;
10572 if (ct_colors_allocated
== 0)
10579 colors
= (unsigned long *) xmalloc (ct_colors_allocated
10581 *n
= ct_colors_allocated
;
10583 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
10584 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10585 colors
[j
++] = p
->pixel
;
10594 /***********************************************************************
10596 ***********************************************************************/
10597 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
10598 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
10599 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
10600 static void XPutPixel (XImage
*, int, int, COLORREF
);
10602 /* Non-zero means draw a cross on images having `:conversion
10605 int cross_disabled_images
;
10607 /* Edge detection matrices for different edge-detection
10610 static int emboss_matrix
[9] = {
10611 /* x - 1 x x + 1 */
10612 2, -1, 0, /* y - 1 */
10614 0, 1, -2 /* y + 1 */
10617 static int laplace_matrix
[9] = {
10618 /* x - 1 x x + 1 */
10619 1, 0, 0, /* y - 1 */
10621 0, 0, -1 /* y + 1 */
10624 /* Value is the intensity of the color whose red/green/blue values
10625 are R, G, and B. */
10627 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
10630 /* On frame F, return an array of XColor structures describing image
10631 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
10632 non-zero means also fill the red/green/blue members of the XColor
10633 structures. Value is a pointer to the array of XColors structures,
10634 allocated with xmalloc; it must be freed by the caller. */
10637 x_to_xcolors (f
, img
, rgb_p
)
10643 XColor
*colors
, *p
;
10646 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
10647 #if 0 /* TODO: implement image colors. */
10648 /* Get the X image IMG->pixmap. */
10649 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10650 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10652 /* Fill the `pixel' members of the XColor array. I wished there
10653 were an easy and portable way to circumvent XGetPixel. */
10655 for (y
= 0; y
< img
->height
; ++y
)
10659 for (x
= 0; x
< img
->width
; ++x
, ++p
)
10660 p
->pixel
= XGetPixel (ximg
, x
, y
);
10663 x_query_colors (f
, row
, img
->width
);
10666 XDestroyImage (ximg
);
10671 /* Put a pixel of COLOR at position X, Y in XIMG. XIMG must have been
10672 created with CreateDIBSection, with the pointer to the bit values
10673 stored in ximg->data. */
10675 static void XPutPixel (ximg
, x
, y
, color
)
10680 int width
= ximg
->info
.bmiHeader
.biWidth
;
10681 int height
= ximg
->info
.bmiHeader
.biHeight
;
10682 int rowbytes
= width
* 3;
10683 unsigned char * pixel
;
10685 /* Don't support putting pixels in images with palettes. */
10686 xassert (ximg
->info
.bmiHeader
.biBitCount
== 24);
10688 /* Ensure scanlines are aligned on 4 byte boundaries. */
10690 rowbytes
+= 4 - (rowbytes
% 4);
10692 pixel
= ximg
->data
+ y
* rowbytes
+ x
* 3;
10693 *pixel
= 255 - GetRValue (color
);
10694 *(pixel
+ 1) = 255 - GetGValue (color
);
10695 *(pixel
+ 2) = 255 - GetBValue (color
);
10699 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
10700 RGB members are set. F is the frame on which this all happens.
10701 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
10704 x_from_xcolors (f
, img
, colors
)
10713 #if 0 /* TODO: color tables. */
10714 init_color_table ();
10716 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
10719 for (y
= 0; y
< img
->height
; ++y
)
10720 for (x
= 0; x
< img
->width
; ++x
, ++p
)
10722 unsigned long pixel
;
10723 #if 0 /* TODO: color tables. */
10724 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
10726 pixel
= PALETTERGB (p
->red
, p
->green
, p
->blue
);
10728 XPutPixel (oimg
, x
, y
, pixel
);
10732 x_clear_image_1 (f
, img
, 1, 0, 1);
10734 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
10735 x_destroy_x_image (oimg
);
10736 img
->pixmap
= pixmap
;
10737 #if 0 /* TODO: color tables. */
10738 img
->colors
= colors_in_color_table (&img
->ncolors
);
10739 free_color_table ();
10744 /* On frame F, perform edge-detection on image IMG.
10746 MATRIX is a nine-element array specifying the transformation
10747 matrix. See emboss_matrix for an example.
10749 COLOR_ADJUST is a color adjustment added to each pixel of the
10753 x_detect_edges (f
, img
, matrix
, color_adjust
)
10756 int matrix
[9], color_adjust
;
10758 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10762 for (i
= sum
= 0; i
< 9; ++i
)
10763 sum
+= abs (matrix
[i
]);
10765 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
10767 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
10769 for (y
= 0; y
< img
->height
; ++y
)
10771 p
= COLOR (new, 0, y
);
10772 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10773 p
= COLOR (new, img
->width
- 1, y
);
10774 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10777 for (x
= 1; x
< img
->width
- 1; ++x
)
10779 p
= COLOR (new, x
, 0);
10780 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10781 p
= COLOR (new, x
, img
->height
- 1);
10782 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10785 for (y
= 1; y
< img
->height
- 1; ++y
)
10787 p
= COLOR (new, 1, y
);
10789 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
10791 int r
, g
, b
, y1
, x1
;
10794 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
10795 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
10798 XColor
*t
= COLOR (colors
, x1
, y1
);
10799 r
+= matrix
[i
] * t
->red
;
10800 g
+= matrix
[i
] * t
->green
;
10801 b
+= matrix
[i
] * t
->blue
;
10804 r
= (r
/ sum
+ color_adjust
) & 0xffff;
10805 g
= (g
/ sum
+ color_adjust
) & 0xffff;
10806 b
= (b
/ sum
+ color_adjust
) & 0xffff;
10807 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
10812 x_from_xcolors (f
, img
, new);
10818 /* Perform the pre-defined `emboss' edge-detection on image IMG
10826 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
10830 /* Transform image IMG which is used on frame F with a Laplace
10831 edge-detection algorithm. The result is an image that can be used
10832 to draw disabled buttons, for example. */
10839 x_detect_edges (f
, img
, laplace_matrix
, 45000);
10843 /* Perform edge-detection on image IMG on frame F, with specified
10844 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
10846 MATRIX must be either
10848 - a list of at least 9 numbers in row-major form
10849 - a vector of at least 9 numbers
10851 COLOR_ADJUST nil means use a default; otherwise it must be a
10855 x_edge_detection (f
, img
, matrix
, color_adjust
)
10858 Lisp_Object matrix
, color_adjust
;
10863 if (CONSP (matrix
))
10866 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
10867 ++i
, matrix
= XCDR (matrix
))
10868 trans
[i
] = XFLOATINT (XCAR (matrix
));
10870 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
10872 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
10873 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
10876 if (NILP (color_adjust
))
10877 color_adjust
= make_number (0xffff / 2);
10879 if (i
== 9 && NUMBERP (color_adjust
))
10880 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
10884 /* Transform image IMG on frame F so that it looks disabled. */
10887 x_disable_image (f
, img
)
10891 struct w32_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
10893 if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
>= 2)
10895 /* Color (or grayscale). Convert to gray, and equalize. Just
10896 drawing such images with a stipple can look very odd, so
10897 we're using this method instead. */
10898 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10900 const int h
= 15000;
10901 const int l
= 30000;
10903 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
10907 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
10908 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
10909 p
->red
= p
->green
= p
->blue
= i2
;
10912 x_from_xcolors (f
, img
, colors
);
10915 /* Draw a cross over the disabled image, if we must or if we
10917 if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
< 2 || cross_disabled_images
)
10919 #if 0 /* TODO: full image support */
10920 Display
*dpy
= FRAME_X_DISPLAY (f
);
10923 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
10924 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
10925 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
10926 img
->width
- 1, img
->height
- 1);
10927 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
10928 img
->width
- 1, 0);
10933 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
10934 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
10935 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
10936 img
->width
- 1, img
->height
- 1);
10937 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
10938 img
->width
- 1, 0);
10946 /* Build a mask for image IMG which is used on frame F. FILE is the
10947 name of an image file, for error messages. HOW determines how to
10948 determine the background color of IMG. If it is a list '(R G B)',
10949 with R, G, and B being integers >= 0, take that as the color of the
10950 background. Otherwise, determine the background color of IMG
10951 heuristically. Value is non-zero if successful. */
10954 x_build_heuristic_mask (f
, img
, how
)
10959 #if 0 /* TODO: full image support. */
10960 Display
*dpy
= FRAME_W32_DISPLAY (f
);
10961 XImage
*ximg
, *mask_img
;
10962 int x
, y
, rc
, use_img_background
;
10963 unsigned long bg
= 0;
10967 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
10969 img
->background_transparent_valid
= 0;
10972 /* Create an image and pixmap serving as mask. */
10973 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
10974 &mask_img
, &img
->mask
);
10978 /* Get the X image of IMG->pixmap. */
10979 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
10982 /* Determine the background color of ximg. If HOW is `(R G B)'
10983 take that as color. Otherwise, use the image's background color. */
10984 use_img_background
= 1;
10990 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
10992 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
10996 if (i
== 3 && NILP (how
))
10998 char color_name
[30];
10999 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
11000 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
11001 use_img_background
= 0;
11005 if (use_img_background
)
11006 bg
= four_corners_best (ximg
, img
->width
, img
->height
);
11008 /* Set all bits in mask_img to 1 whose color in ximg is different
11009 from the background color bg. */
11010 for (y
= 0; y
< img
->height
; ++y
)
11011 for (x
= 0; x
< img
->width
; ++x
)
11012 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
11014 /* Fill in the background_transparent field while we have the mask handy. */
11015 image_background_transparent (img
, f
, mask_img
);
11017 /* Put mask_img into img->mask. */
11018 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
11019 x_destroy_x_image (mask_img
);
11020 XDestroyImage (ximg
);
11029 /***********************************************************************
11030 PBM (mono, gray, color)
11031 ***********************************************************************/
11033 static int pbm_image_p
P_ ((Lisp_Object object
));
11034 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
11035 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
11037 /* The symbol `pbm' identifying images of this type. */
11041 /* Indices of image specification fields in gs_format, below. */
11043 enum pbm_keyword_index
11052 PBM_HEURISTIC_MASK
,
11059 /* Vector of image_keyword structures describing the format
11060 of valid user-defined image specifications. */
11062 static struct image_keyword pbm_format
[PBM_LAST
] =
11064 {":type", IMAGE_SYMBOL_VALUE
, 1},
11065 {":file", IMAGE_STRING_VALUE
, 0},
11066 {":data", IMAGE_STRING_VALUE
, 0},
11067 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11068 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11069 {":relief", IMAGE_INTEGER_VALUE
, 0},
11070 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11071 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11072 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11073 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
11074 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11077 /* Structure describing the image type `pbm'. */
11079 static struct image_type pbm_type
=
11089 /* Return non-zero if OBJECT is a valid PBM image specification. */
11092 pbm_image_p (object
)
11093 Lisp_Object object
;
11095 struct image_keyword fmt
[PBM_LAST
];
11097 bcopy (pbm_format
, fmt
, sizeof fmt
);
11099 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
11100 || (fmt
[PBM_ASCENT
].count
11101 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
11104 /* Must specify either :data or :file. */
11105 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
11109 /* Scan a decimal number from *S and return it. Advance *S while
11110 reading the number. END is the end of the string. Value is -1 at
11114 pbm_scan_number (s
, end
)
11115 unsigned char **s
, *end
;
11121 /* Skip white-space. */
11122 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
11127 /* Skip comment to end of line. */
11128 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
11131 else if (isdigit (c
))
11133 /* Read decimal number. */
11135 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
11136 val
= 10 * val
+ c
- '0';
11147 /* Read FILE into memory. Value is a pointer to a buffer allocated
11148 with xmalloc holding FILE's contents. Value is null if an error
11149 occurred. *SIZE is set to the size of the file. */
11152 pbm_read_file (file
, size
)
11160 if (stat (SDATA (file
), &st
) == 0
11161 && (fp
= fopen (SDATA (file
), "r")) != NULL
11162 && (buf
= (char *) xmalloc (st
.st_size
),
11163 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
11165 *size
= st
.st_size
;
11183 /* Load PBM image IMG for use on frame F. */
11191 int width
, height
, max_color_idx
= 0;
11193 Lisp_Object file
, specified_file
;
11194 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
11195 struct gcpro gcpro1
;
11196 unsigned char *contents
= NULL
;
11197 unsigned char *end
, *p
;
11200 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11204 if (STRINGP (specified_file
))
11206 file
= x_find_image_file (specified_file
);
11207 if (!STRINGP (file
))
11209 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11214 contents
= slurp_file (SDATA (file
), &size
);
11215 if (contents
== NULL
)
11217 image_error ("Error reading `%s'", file
, Qnil
);
11223 end
= contents
+ size
;
11228 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11230 end
= p
+ SBYTES (data
);
11233 /* Check magic number. */
11234 if (end
- p
< 2 || *p
++ != 'P')
11236 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
11246 raw_p
= 0, type
= PBM_MONO
;
11250 raw_p
= 0, type
= PBM_GRAY
;
11254 raw_p
= 0, type
= PBM_COLOR
;
11258 raw_p
= 1, type
= PBM_MONO
;
11262 raw_p
= 1, type
= PBM_GRAY
;
11266 raw_p
= 1, type
= PBM_COLOR
;
11270 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
11274 /* Read width, height, maximum color-component. Characters
11275 starting with `#' up to the end of a line are ignored. */
11276 width
= pbm_scan_number (&p
, end
);
11277 height
= pbm_scan_number (&p
, end
);
11279 if (type
!= PBM_MONO
)
11281 max_color_idx
= pbm_scan_number (&p
, end
);
11282 if (raw_p
&& max_color_idx
> 255)
11283 max_color_idx
= 255;
11288 || (type
!= PBM_MONO
&& max_color_idx
< 0))
11291 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11294 #if 0 /* TODO: color tables. */
11295 /* Initialize the color hash table. */
11296 init_color_table ();
11299 if (type
== PBM_MONO
)
11302 struct image_keyword fmt
[PBM_LAST
];
11303 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
11304 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
11306 /* Parse the image specification. */
11307 bcopy (pbm_format
, fmt
, sizeof fmt
);
11308 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
11310 /* Get foreground and background colors, maybe allocate colors. */
11311 if (fmt
[PBM_FOREGROUND
].count
11312 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
11313 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
11314 if (fmt
[PBM_BACKGROUND
].count
11315 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
11317 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
11318 img
->background
= bg
;
11319 img
->background_valid
= 1;
11322 for (y
= 0; y
< height
; ++y
)
11323 for (x
= 0; x
< width
; ++x
)
11333 g
= pbm_scan_number (&p
, end
);
11335 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
11340 for (y
= 0; y
< height
; ++y
)
11341 for (x
= 0; x
< width
; ++x
)
11345 if (type
== PBM_GRAY
)
11346 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
11355 r
= pbm_scan_number (&p
, end
);
11356 g
= pbm_scan_number (&p
, end
);
11357 b
= pbm_scan_number (&p
, end
);
11360 if (r
< 0 || g
< 0 || b
< 0)
11362 x_destroy_x_image (ximg
);
11363 image_error ("Invalid pixel value in image `%s'",
11368 /* RGB values are now in the range 0..max_color_idx.
11369 Scale this to the range 0..0xff supported by W32. */
11370 r
= (int) ((double) r
* 255 / max_color_idx
);
11371 g
= (int) ((double) g
* 255 / max_color_idx
);
11372 b
= (int) ((double) b
* 255 / max_color_idx
);
11373 XPutPixel (ximg
, x
, y
,
11374 #if 0 /* TODO: color tables. */
11375 lookup_rgb_color (f
, r
, g
, b
));
11377 PALETTERGB (r
, g
, b
));
11382 #if 0 /* TODO: color tables. */
11383 /* Store in IMG->colors the colors allocated for the image, and
11384 free the color table. */
11385 img
->colors
= colors_in_color_table (&img
->ncolors
);
11386 free_color_table ();
11388 /* Maybe fill in the background field while we have ximg handy. */
11389 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11390 IMAGE_BACKGROUND (img
, f
, ximg
);
11392 /* Put the image into a pixmap. */
11393 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11394 x_destroy_x_image (ximg
);
11396 img
->width
= width
;
11397 img
->height
= height
;
11405 /***********************************************************************
11407 ***********************************************************************/
11413 /* Function prototypes. */
11415 static int png_image_p
P_ ((Lisp_Object object
));
11416 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
11418 /* The symbol `png' identifying images of this type. */
11422 /* Indices of image specification fields in png_format, below. */
11424 enum png_keyword_index
11433 PNG_HEURISTIC_MASK
,
11439 /* Vector of image_keyword structures describing the format
11440 of valid user-defined image specifications. */
11442 static struct image_keyword png_format
[PNG_LAST
] =
11444 {":type", IMAGE_SYMBOL_VALUE
, 1},
11445 {":data", IMAGE_STRING_VALUE
, 0},
11446 {":file", IMAGE_STRING_VALUE
, 0},
11447 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11448 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11449 {":relief", IMAGE_INTEGER_VALUE
, 0},
11450 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11451 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11452 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11453 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11456 /* Structure describing the image type `png'. */
11458 static struct image_type png_type
=
11468 /* Return non-zero if OBJECT is a valid PNG image specification. */
11471 png_image_p (object
)
11472 Lisp_Object object
;
11474 struct image_keyword fmt
[PNG_LAST
];
11475 bcopy (png_format
, fmt
, sizeof fmt
);
11477 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
11478 || (fmt
[PNG_ASCENT
].count
11479 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
11482 /* Must specify either the :data or :file keyword. */
11483 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
11487 /* Error and warning handlers installed when the PNG library
11491 my_png_error (png_ptr
, msg
)
11492 png_struct
*png_ptr
;
11495 xassert (png_ptr
!= NULL
);
11496 image_error ("PNG error: %s", build_string (msg
), Qnil
);
11497 longjmp (png_ptr
->jmpbuf
, 1);
11502 my_png_warning (png_ptr
, msg
)
11503 png_struct
*png_ptr
;
11506 xassert (png_ptr
!= NULL
);
11507 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
11510 /* Memory source for PNG decoding. */
11512 struct png_memory_storage
11514 unsigned char *bytes
; /* The data */
11515 size_t len
; /* How big is it? */
11516 int index
; /* Where are we? */
11520 /* Function set as reader function when reading PNG image from memory.
11521 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
11522 bytes from the input to DATA. */
11525 png_read_from_memory (png_ptr
, data
, length
)
11526 png_structp png_ptr
;
11530 struct png_memory_storage
*tbr
11531 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
11533 if (length
> tbr
->len
- tbr
->index
)
11534 png_error (png_ptr
, "Read error");
11536 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
11537 tbr
->index
= tbr
->index
+ length
;
11540 /* Load PNG image IMG for use on frame F. Value is non-zero if
11548 Lisp_Object file
, specified_file
;
11549 Lisp_Object specified_data
;
11551 XImage
*ximg
, *mask_img
= NULL
;
11552 struct gcpro gcpro1
;
11553 png_struct
*png_ptr
= NULL
;
11554 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
11555 FILE *volatile fp
= NULL
;
11557 png_byte
*volatile pixels
= NULL
;
11558 png_byte
**volatile rows
= NULL
;
11559 png_uint_32 width
, height
;
11560 int bit_depth
, color_type
, interlace_type
;
11562 png_uint_32 row_bytes
;
11565 double screen_gamma
, image_gamma
;
11567 struct png_memory_storage tbr
; /* Data to be read */
11569 /* Find out what file to load. */
11570 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11571 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11575 if (NILP (specified_data
))
11577 file
= x_find_image_file (specified_file
);
11578 if (!STRINGP (file
))
11580 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11585 /* Open the image file. */
11586 fp
= fopen (SDATA (file
), "rb");
11589 image_error ("Cannot open image file `%s'", file
, Qnil
);
11595 /* Check PNG signature. */
11596 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
11597 || !png_check_sig (sig
, sizeof sig
))
11599 image_error ("Not a PNG file:` %s'", file
, Qnil
);
11607 /* Read from memory. */
11608 tbr
.bytes
= SDATA (specified_data
);
11609 tbr
.len
= SBYTES (specified_data
);
11612 /* Check PNG signature. */
11613 if (tbr
.len
< sizeof sig
11614 || !png_check_sig (tbr
.bytes
, sizeof sig
))
11616 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
11621 /* Need to skip past the signature. */
11622 tbr
.bytes
+= sizeof (sig
);
11625 /* Initialize read and info structs for PNG lib. */
11626 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
11627 my_png_error
, my_png_warning
);
11630 if (fp
) fclose (fp
);
11635 info_ptr
= png_create_info_struct (png_ptr
);
11638 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
11639 if (fp
) fclose (fp
);
11644 end_info
= png_create_info_struct (png_ptr
);
11647 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
11648 if (fp
) fclose (fp
);
11653 /* Set error jump-back. We come back here when the PNG library
11654 detects an error. */
11655 if (setjmp (png_ptr
->jmpbuf
))
11659 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
11662 if (fp
) fclose (fp
);
11667 /* Read image info. */
11668 if (!NILP (specified_data
))
11669 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
11671 png_init_io (png_ptr
, fp
);
11673 png_set_sig_bytes (png_ptr
, sizeof sig
);
11674 png_read_info (png_ptr
, info_ptr
);
11675 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
11676 &interlace_type
, NULL
, NULL
);
11678 /* If image contains simply transparency data, we prefer to
11679 construct a clipping mask. */
11680 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
11685 /* This function is easier to write if we only have to handle
11686 one data format: RGB or RGBA with 8 bits per channel. Let's
11687 transform other formats into that format. */
11689 /* Strip more than 8 bits per channel. */
11690 if (bit_depth
== 16)
11691 png_set_strip_16 (png_ptr
);
11693 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
11695 png_set_expand (png_ptr
);
11697 /* Convert grayscale images to RGB. */
11698 if (color_type
== PNG_COLOR_TYPE_GRAY
11699 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
11700 png_set_gray_to_rgb (png_ptr
);
11702 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
11703 gamma_str
= getenv ("SCREEN_GAMMA");
11704 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
11706 /* Tell the PNG lib to handle gamma correction for us. */
11708 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
11709 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
11710 /* There is a special chunk in the image specifying the gamma. */
11711 png_set_sRGB (png_ptr
, info_ptr
, intent
);
11714 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
11715 /* Image contains gamma information. */
11716 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
11718 /* Use a default of 0.5 for the image gamma. */
11719 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
11721 /* Handle alpha channel by combining the image with a background
11722 color. Do this only if a real alpha channel is supplied. For
11723 simple transparency, we prefer a clipping mask. */
11724 if (!transparent_p
)
11726 png_color_16
*image_background
;
11727 Lisp_Object specified_bg
11728 = image_spec_value (img
->spec
, QCbackground
, NULL
);
11731 if (STRINGP (specified_bg
))
11732 /* The user specified `:background', use that. */
11735 if (w32_defined_color (f
, SDATA (specified_bg
), &color
, 0))
11737 png_color_16 user_bg
;
11739 bzero (&user_bg
, sizeof user_bg
);
11740 user_bg
.red
= color
.red
;
11741 user_bg
.green
= color
.green
;
11742 user_bg
.blue
= color
.blue
;
11744 png_set_background (png_ptr
, &user_bg
,
11745 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
11748 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
11749 /* Image contains a background color with which to
11750 combine the image. */
11751 png_set_background (png_ptr
, image_background
,
11752 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
11755 /* Image does not contain a background color with which
11756 to combine the image data via an alpha channel. Use
11757 the frame's background instead. */
11760 png_color_16 frame_background
;
11762 cmap
= FRAME_X_COLORMAP (f
);
11763 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
11764 x_query_color (f
, &color
);
11766 bzero (&frame_background
, sizeof frame_background
);
11767 frame_background
.red
= color
.red
;
11768 frame_background
.green
= color
.green
;
11769 frame_background
.blue
= color
.blue
;
11771 png_set_background (png_ptr
, &frame_background
,
11772 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
11776 /* Update info structure. */
11777 png_read_update_info (png_ptr
, info_ptr
);
11779 /* Get number of channels. Valid values are 1 for grayscale images
11780 and images with a palette, 2 for grayscale images with transparency
11781 information (alpha channel), 3 for RGB images, and 4 for RGB
11782 images with alpha channel, i.e. RGBA. If conversions above were
11783 sufficient we should only have 3 or 4 channels here. */
11784 channels
= png_get_channels (png_ptr
, info_ptr
);
11785 xassert (channels
== 3 || channels
== 4);
11787 /* Number of bytes needed for one row of the image. */
11788 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
11790 /* Allocate memory for the image. */
11791 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
11792 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
11793 for (i
= 0; i
< height
; ++i
)
11794 rows
[i
] = pixels
+ i
* row_bytes
;
11796 /* Read the entire image. */
11797 png_read_image (png_ptr
, rows
);
11798 png_read_end (png_ptr
, info_ptr
);
11805 /* Create the X image and pixmap. */
11806 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
11810 /* Create an image and pixmap serving as mask if the PNG image
11811 contains an alpha channel. */
11814 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
11815 &mask_img
, &img
->mask
))
11817 x_destroy_x_image (ximg
);
11818 XFreePixmap (FRAME_W32_DISPLAY (f
), img
->pixmap
);
11823 /* Fill the X image and mask from PNG data. */
11824 init_color_table ();
11826 for (y
= 0; y
< height
; ++y
)
11828 png_byte
*p
= rows
[y
];
11830 for (x
= 0; x
< width
; ++x
)
11837 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
11839 /* An alpha channel, aka mask channel, associates variable
11840 transparency with an image. Where other image formats
11841 support binary transparency---fully transparent or fully
11842 opaque---PNG allows up to 254 levels of partial transparency.
11843 The PNG library implements partial transparency by combining
11844 the image with a specified background color.
11846 I'm not sure how to handle this here nicely: because the
11847 background on which the image is displayed may change, for
11848 real alpha channel support, it would be necessary to create
11849 a new image for each possible background.
11851 What I'm doing now is that a mask is created if we have
11852 boolean transparency information. Otherwise I'm using
11853 the frame's background color to combine the image with. */
11858 XPutPixel (mask_img
, x
, y
, *p
> 0);
11864 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11865 /* Set IMG's background color from the PNG image, unless the user
11869 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
11871 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
11872 img
->background_valid
= 1;
11876 /* Remember colors allocated for this image. */
11877 img
->colors
= colors_in_color_table (&img
->ncolors
);
11878 free_color_table ();
11881 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
11885 img
->width
= width
;
11886 img
->height
= height
;
11888 /* Maybe fill in the background field while we have ximg handy. */
11889 IMAGE_BACKGROUND (img
, f
, ximg
);
11891 /* Put the image into the pixmap, then free the X image and its buffer. */
11892 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11893 x_destroy_x_image (ximg
);
11895 /* Same for the mask. */
11898 /* Fill in the background_transparent field while we have the mask
11900 image_background_transparent (img
, f
, mask_img
);
11902 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
11903 x_destroy_x_image (mask_img
);
11910 #endif /* HAVE_PNG != 0 */
11914 /***********************************************************************
11916 ***********************************************************************/
11920 /* Work around a warning about HAVE_STDLIB_H being redefined in
11922 #ifdef HAVE_STDLIB_H
11923 #define HAVE_STDLIB_H_1
11924 #undef HAVE_STDLIB_H
11925 #endif /* HAVE_STLIB_H */
11927 #include <jpeglib.h>
11928 #include <jerror.h>
11929 #include <setjmp.h>
11931 #ifdef HAVE_STLIB_H_1
11932 #define HAVE_STDLIB_H 1
11935 static int jpeg_image_p
P_ ((Lisp_Object object
));
11936 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
11938 /* The symbol `jpeg' identifying images of this type. */
11942 /* Indices of image specification fields in gs_format, below. */
11944 enum jpeg_keyword_index
11953 JPEG_HEURISTIC_MASK
,
11959 /* Vector of image_keyword structures describing the format
11960 of valid user-defined image specifications. */
11962 static struct image_keyword jpeg_format
[JPEG_LAST
] =
11964 {":type", IMAGE_SYMBOL_VALUE
, 1},
11965 {":data", IMAGE_STRING_VALUE
, 0},
11966 {":file", IMAGE_STRING_VALUE
, 0},
11967 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11968 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11969 {":relief", IMAGE_INTEGER_VALUE
, 0},
11970 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11971 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11972 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11973 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11976 /* Structure describing the image type `jpeg'. */
11978 static struct image_type jpeg_type
=
11988 /* Return non-zero if OBJECT is a valid JPEG image specification. */
11991 jpeg_image_p (object
)
11992 Lisp_Object object
;
11994 struct image_keyword fmt
[JPEG_LAST
];
11996 bcopy (jpeg_format
, fmt
, sizeof fmt
);
11998 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
11999 || (fmt
[JPEG_ASCENT
].count
12000 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
12003 /* Must specify either the :data or :file keyword. */
12004 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
12008 struct my_jpeg_error_mgr
12010 struct jpeg_error_mgr pub
;
12011 jmp_buf setjmp_buffer
;
12015 my_error_exit (cinfo
)
12016 j_common_ptr cinfo
;
12018 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
12019 longjmp (mgr
->setjmp_buffer
, 1);
12022 /* Init source method for JPEG data source manager. Called by
12023 jpeg_read_header() before any data is actually read. See
12024 libjpeg.doc from the JPEG lib distribution. */
12027 our_init_source (cinfo
)
12028 j_decompress_ptr cinfo
;
12033 /* Fill input buffer method for JPEG data source manager. Called
12034 whenever more data is needed. We read the whole image in one step,
12035 so this only adds a fake end of input marker at the end. */
12038 our_fill_input_buffer (cinfo
)
12039 j_decompress_ptr cinfo
;
12041 /* Insert a fake EOI marker. */
12042 struct jpeg_source_mgr
*src
= cinfo
->src
;
12043 static JOCTET buffer
[2];
12045 buffer
[0] = (JOCTET
) 0xFF;
12046 buffer
[1] = (JOCTET
) JPEG_EOI
;
12048 src
->next_input_byte
= buffer
;
12049 src
->bytes_in_buffer
= 2;
12054 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
12055 is the JPEG data source manager. */
12058 our_skip_input_data (cinfo
, num_bytes
)
12059 j_decompress_ptr cinfo
;
12062 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
12066 if (num_bytes
> src
->bytes_in_buffer
)
12067 ERREXIT (cinfo
, JERR_INPUT_EOF
);
12069 src
->bytes_in_buffer
-= num_bytes
;
12070 src
->next_input_byte
+= num_bytes
;
12075 /* Method to terminate data source. Called by
12076 jpeg_finish_decompress() after all data has been processed. */
12079 our_term_source (cinfo
)
12080 j_decompress_ptr cinfo
;
12085 /* Set up the JPEG lib for reading an image from DATA which contains
12086 LEN bytes. CINFO is the decompression info structure created for
12087 reading the image. */
12090 jpeg_memory_src (cinfo
, data
, len
)
12091 j_decompress_ptr cinfo
;
12095 struct jpeg_source_mgr
*src
;
12097 if (cinfo
->src
== NULL
)
12099 /* First time for this JPEG object? */
12100 cinfo
->src
= (struct jpeg_source_mgr
*)
12101 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
12102 sizeof (struct jpeg_source_mgr
));
12103 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
12104 src
->next_input_byte
= data
;
12107 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
12108 src
->init_source
= our_init_source
;
12109 src
->fill_input_buffer
= our_fill_input_buffer
;
12110 src
->skip_input_data
= our_skip_input_data
;
12111 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
12112 src
->term_source
= our_term_source
;
12113 src
->bytes_in_buffer
= len
;
12114 src
->next_input_byte
= data
;
12118 /* Load image IMG for use on frame F. Patterned after example.c
12119 from the JPEG lib. */
12126 struct jpeg_decompress_struct cinfo
;
12127 struct my_jpeg_error_mgr mgr
;
12128 Lisp_Object file
, specified_file
;
12129 Lisp_Object specified_data
;
12130 FILE * volatile fp
= NULL
;
12132 int row_stride
, x
, y
;
12133 XImage
*ximg
= NULL
;
12135 unsigned long *colors
;
12137 struct gcpro gcpro1
;
12139 /* Open the JPEG file. */
12140 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12141 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12145 if (NILP (specified_data
))
12147 file
= x_find_image_file (specified_file
);
12148 if (!STRINGP (file
))
12150 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
12155 fp
= fopen (SDATA (file
), "r");
12158 image_error ("Cannot open `%s'", file
, Qnil
);
12164 /* Customize libjpeg's error handling to call my_error_exit when an
12165 error is detected. This function will perform a longjmp. */
12166 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
12167 mgr
.pub
.error_exit
= my_error_exit
;
12169 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
12173 /* Called from my_error_exit. Display a JPEG error. */
12174 char buffer
[JMSG_LENGTH_MAX
];
12175 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
12176 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
12177 build_string (buffer
));
12180 /* Close the input file and destroy the JPEG object. */
12183 jpeg_destroy_decompress (&cinfo
);
12185 /* If we already have an XImage, free that. */
12186 x_destroy_x_image (ximg
);
12188 /* Free pixmap and colors. */
12189 x_clear_image (f
, img
);
12195 /* Create the JPEG decompression object. Let it read from fp.
12196 Read the JPEG image header. */
12197 jpeg_create_decompress (&cinfo
);
12199 if (NILP (specified_data
))
12200 jpeg_stdio_src (&cinfo
, fp
);
12202 jpeg_memory_src (&cinfo
, SDATA (specified_data
),
12203 SBYTES (specified_data
));
12205 jpeg_read_header (&cinfo
, TRUE
);
12207 /* Customize decompression so that color quantization will be used.
12208 Start decompression. */
12209 cinfo
.quantize_colors
= TRUE
;
12210 jpeg_start_decompress (&cinfo
);
12211 width
= img
->width
= cinfo
.output_width
;
12212 height
= img
->height
= cinfo
.output_height
;
12214 /* Create X image and pixmap. */
12215 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
12217 longjmp (mgr
.setjmp_buffer
, 2);
12219 /* Allocate colors. When color quantization is used,
12220 cinfo.actual_number_of_colors has been set with the number of
12221 colors generated, and cinfo.colormap is a two-dimensional array
12222 of color indices in the range 0..cinfo.actual_number_of_colors.
12223 No more than 255 colors will be generated. */
12227 if (cinfo
.out_color_components
> 2)
12228 ir
= 0, ig
= 1, ib
= 2;
12229 else if (cinfo
.out_color_components
> 1)
12230 ir
= 0, ig
= 1, ib
= 0;
12232 ir
= 0, ig
= 0, ib
= 0;
12234 /* Use the color table mechanism because it handles colors that
12235 cannot be allocated nicely. Such colors will be replaced with
12236 a default color, and we don't have to care about which colors
12237 can be freed safely, and which can't. */
12238 init_color_table ();
12239 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
12242 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
12244 /* Multiply RGB values with 255 because X expects RGB values
12245 in the range 0..0xffff. */
12246 int r
= cinfo
.colormap
[ir
][i
] << 8;
12247 int g
= cinfo
.colormap
[ig
][i
] << 8;
12248 int b
= cinfo
.colormap
[ib
][i
] << 8;
12249 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
12252 /* Remember those colors actually allocated. */
12253 img
->colors
= colors_in_color_table (&img
->ncolors
);
12254 free_color_table ();
12258 row_stride
= width
* cinfo
.output_components
;
12259 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
12261 for (y
= 0; y
< height
; ++y
)
12263 jpeg_read_scanlines (&cinfo
, buffer
, 1);
12264 for (x
= 0; x
< cinfo
.output_width
; ++x
)
12265 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
12269 jpeg_finish_decompress (&cinfo
);
12270 jpeg_destroy_decompress (&cinfo
);
12274 /* Maybe fill in the background field while we have ximg handy. */
12275 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12276 IMAGE_BACKGROUND (img
, f
, ximg
);
12278 /* Put the image into the pixmap. */
12279 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12280 x_destroy_x_image (ximg
);
12286 #endif /* HAVE_JPEG */
12290 /***********************************************************************
12292 ***********************************************************************/
12296 #include <tiffio.h>
12298 static int tiff_image_p
P_ ((Lisp_Object object
));
12299 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
12301 /* The symbol `tiff' identifying images of this type. */
12305 /* Indices of image specification fields in tiff_format, below. */
12307 enum tiff_keyword_index
12316 TIFF_HEURISTIC_MASK
,
12322 /* Vector of image_keyword structures describing the format
12323 of valid user-defined image specifications. */
12325 static struct image_keyword tiff_format
[TIFF_LAST
] =
12327 {":type", IMAGE_SYMBOL_VALUE
, 1},
12328 {":data", IMAGE_STRING_VALUE
, 0},
12329 {":file", IMAGE_STRING_VALUE
, 0},
12330 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
12331 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12332 {":relief", IMAGE_INTEGER_VALUE
, 0},
12333 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12334 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12335 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12336 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12339 /* Structure describing the image type `tiff'. */
12341 static struct image_type tiff_type
=
12351 /* Return non-zero if OBJECT is a valid TIFF image specification. */
12354 tiff_image_p (object
)
12355 Lisp_Object object
;
12357 struct image_keyword fmt
[TIFF_LAST
];
12358 bcopy (tiff_format
, fmt
, sizeof fmt
);
12360 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
12361 || (fmt
[TIFF_ASCENT
].count
12362 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
12365 /* Must specify either the :data or :file keyword. */
12366 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
12370 /* Reading from a memory buffer for TIFF images Based on the PNG
12371 memory source, but we have to provide a lot of extra functions.
12374 We really only need to implement read and seek, but I am not
12375 convinced that the TIFF library is smart enough not to destroy
12376 itself if we only hand it the function pointers we need to
12381 unsigned char *bytes
;
12385 tiff_memory_source
;
12388 tiff_read_from_memory (data
, buf
, size
)
12393 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
12395 if (size
> src
->len
- src
->index
)
12396 return (size_t) -1;
12397 bcopy (src
->bytes
+ src
->index
, buf
, size
);
12398 src
->index
+= size
;
12403 tiff_write_from_memory (data
, buf
, size
)
12408 return (size_t) -1;
12412 tiff_seek_in_memory (data
, off
, whence
)
12417 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
12422 case SEEK_SET
: /* Go from beginning of source. */
12426 case SEEK_END
: /* Go from end of source. */
12427 idx
= src
->len
+ off
;
12430 case SEEK_CUR
: /* Go from current position. */
12431 idx
= src
->index
+ off
;
12434 default: /* Invalid `whence'. */
12438 if (idx
> src
->len
|| idx
< 0)
12446 tiff_close_memory (data
)
12454 tiff_mmap_memory (data
, pbase
, psize
)
12459 /* It is already _IN_ memory. */
12464 tiff_unmap_memory (data
, base
, size
)
12469 /* We don't need to do this. */
12473 tiff_size_of_memory (data
)
12476 return ((tiff_memory_source
*) data
)->len
;
12481 tiff_error_handler (title
, format
, ap
)
12482 const char *title
, *format
;
12488 len
= sprintf (buf
, "TIFF error: %s ", title
);
12489 vsprintf (buf
+ len
, format
, ap
);
12490 add_to_log (buf
, Qnil
, Qnil
);
12495 tiff_warning_handler (title
, format
, ap
)
12496 const char *title
, *format
;
12502 len
= sprintf (buf
, "TIFF warning: %s ", title
);
12503 vsprintf (buf
+ len
, format
, ap
);
12504 add_to_log (buf
, Qnil
, Qnil
);
12508 /* Load TIFF image IMG for use on frame F. Value is non-zero if
12516 Lisp_Object file
, specified_file
;
12517 Lisp_Object specified_data
;
12519 int width
, height
, x
, y
;
12523 struct gcpro gcpro1
;
12524 tiff_memory_source memsrc
;
12526 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12527 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12531 TIFFSetErrorHandler (tiff_error_handler
);
12532 TIFFSetWarningHandler (tiff_warning_handler
);
12534 if (NILP (specified_data
))
12536 /* Read from a file */
12537 file
= x_find_image_file (specified_file
);
12538 if (!STRINGP (file
))
12540 image_error ("Cannot find image file `%s'", file
, Qnil
);
12545 /* Try to open the image file. */
12546 tiff
= TIFFOpen (SDATA (file
), "r");
12549 image_error ("Cannot open `%s'", file
, Qnil
);
12556 /* Memory source! */
12557 memsrc
.bytes
= SDATA (specified_data
);
12558 memsrc
.len
= SBYTES (specified_data
);
12561 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
12562 (TIFFReadWriteProc
) tiff_read_from_memory
,
12563 (TIFFReadWriteProc
) tiff_write_from_memory
,
12564 tiff_seek_in_memory
,
12566 tiff_size_of_memory
,
12568 tiff_unmap_memory
);
12572 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
12578 /* Get width and height of the image, and allocate a raster buffer
12579 of width x height 32-bit values. */
12580 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
12581 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
12582 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
12584 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
12588 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
12594 /* Create the X image and pixmap. */
12595 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12602 /* Initialize the color table. */
12603 init_color_table ();
12605 /* Process the pixel raster. Origin is in the lower-left corner. */
12606 for (y
= 0; y
< height
; ++y
)
12608 uint32
*row
= buf
+ y
* width
;
12610 for (x
= 0; x
< width
; ++x
)
12612 uint32 abgr
= row
[x
];
12613 int r
= TIFFGetR (abgr
) << 8;
12614 int g
= TIFFGetG (abgr
) << 8;
12615 int b
= TIFFGetB (abgr
) << 8;
12616 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
12620 /* Remember the colors allocated for the image. Free the color table. */
12621 img
->colors
= colors_in_color_table (&img
->ncolors
);
12622 free_color_table ();
12624 img
->width
= width
;
12625 img
->height
= height
;
12627 /* Maybe fill in the background field while we have ximg handy. */
12628 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12629 IMAGE_BACKGROUND (img
, f
, ximg
);
12631 /* Put the image into the pixmap, then free the X image and its buffer. */
12632 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12633 x_destroy_x_image (ximg
);
12640 #endif /* HAVE_TIFF != 0 */
12644 /***********************************************************************
12646 ***********************************************************************/
12650 #include <gif_lib.h>
12652 static int gif_image_p
P_ ((Lisp_Object object
));
12653 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
12655 /* The symbol `gif' identifying images of this type. */
12659 /* Indices of image specification fields in gif_format, below. */
12661 enum gif_keyword_index
12670 GIF_HEURISTIC_MASK
,
12677 /* Vector of image_keyword structures describing the format
12678 of valid user-defined image specifications. */
12680 static struct image_keyword gif_format
[GIF_LAST
] =
12682 {":type", IMAGE_SYMBOL_VALUE
, 1},
12683 {":data", IMAGE_STRING_VALUE
, 0},
12684 {":file", IMAGE_STRING_VALUE
, 0},
12685 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
12686 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12687 {":relief", IMAGE_INTEGER_VALUE
, 0},
12688 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12689 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12690 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12691 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
12692 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12695 /* Structure describing the image type `gif'. */
12697 static struct image_type gif_type
=
12706 /* Return non-zero if OBJECT is a valid GIF image specification. */
12709 gif_image_p (object
)
12710 Lisp_Object object
;
12712 struct image_keyword fmt
[GIF_LAST
];
12713 bcopy (gif_format
, fmt
, sizeof fmt
);
12715 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
12716 || (fmt
[GIF_ASCENT
].count
12717 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
12720 /* Must specify either the :data or :file keyword. */
12721 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
12724 /* Reading a GIF image from memory
12725 Based on the PNG memory stuff to a certain extent. */
12729 unsigned char *bytes
;
12735 /* Make the current memory source available to gif_read_from_memory.
12736 It's done this way because not all versions of libungif support
12737 a UserData field in the GifFileType structure. */
12738 static gif_memory_source
*current_gif_memory_src
;
12741 gif_read_from_memory (file
, buf
, len
)
12746 gif_memory_source
*src
= current_gif_memory_src
;
12748 if (len
> src
->len
- src
->index
)
12751 bcopy (src
->bytes
+ src
->index
, buf
, len
);
12757 /* Load GIF image IMG for use on frame F. Value is non-zero if
12765 Lisp_Object file
, specified_file
;
12766 Lisp_Object specified_data
;
12767 int rc
, width
, height
, x
, y
, i
;
12769 ColorMapObject
*gif_color_map
;
12770 unsigned long pixel_colors
[256];
12772 struct gcpro gcpro1
;
12774 int ino
, image_left
, image_top
, image_width
, image_height
;
12775 gif_memory_source memsrc
;
12776 unsigned char *raster
;
12778 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12779 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12783 if (NILP (specified_data
))
12785 file
= x_find_image_file (specified_file
);
12786 if (!STRINGP (file
))
12788 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
12793 /* Open the GIF file. */
12794 gif
= DGifOpenFileName (SDATA (file
));
12797 image_error ("Cannot open `%s'", file
, Qnil
);
12804 /* Read from memory! */
12805 current_gif_memory_src
= &memsrc
;
12806 memsrc
.bytes
= SDATA (specified_data
);
12807 memsrc
.len
= SBYTES (specified_data
);
12810 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
12813 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
12819 /* Read entire contents. */
12820 rc
= DGifSlurp (gif
);
12821 if (rc
== GIF_ERROR
)
12823 image_error ("Error reading `%s'", img
->spec
, Qnil
);
12824 DGifCloseFile (gif
);
12829 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
12830 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
12831 if (ino
>= gif
->ImageCount
)
12833 image_error ("Invalid image number `%s' in image `%s'",
12835 DGifCloseFile (gif
);
12840 width
= img
->width
= gif
->SWidth
;
12841 height
= img
->height
= gif
->SHeight
;
12843 /* Create the X image and pixmap. */
12844 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12846 DGifCloseFile (gif
);
12851 /* Allocate colors. */
12852 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
12853 if (!gif_color_map
)
12854 gif_color_map
= gif
->SColorMap
;
12855 init_color_table ();
12856 bzero (pixel_colors
, sizeof pixel_colors
);
12858 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
12860 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
12861 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
12862 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
12863 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
12866 img
->colors
= colors_in_color_table (&img
->ncolors
);
12867 free_color_table ();
12869 /* Clear the part of the screen image that are not covered by
12870 the image from the GIF file. Full animated GIF support
12871 requires more than can be done here (see the gif89 spec,
12872 disposal methods). Let's simply assume that the part
12873 not covered by a sub-image is in the frame's background color. */
12874 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
12875 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
12876 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
12877 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
12879 for (y
= 0; y
< image_top
; ++y
)
12880 for (x
= 0; x
< width
; ++x
)
12881 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12883 for (y
= image_top
+ image_height
; y
< height
; ++y
)
12884 for (x
= 0; x
< width
; ++x
)
12885 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12887 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
12889 for (x
= 0; x
< image_left
; ++x
)
12890 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12891 for (x
= image_left
+ image_width
; x
< width
; ++x
)
12892 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12895 /* Read the GIF image into the X image. We use a local variable
12896 `raster' here because RasterBits below is a char *, and invites
12897 problems with bytes >= 0x80. */
12898 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
12900 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
12902 static int interlace_start
[] = {0, 4, 2, 1};
12903 static int interlace_increment
[] = {8, 8, 4, 2};
12905 int row
= interlace_start
[0];
12909 for (y
= 0; y
< image_height
; y
++)
12911 if (row
>= image_height
)
12913 row
= interlace_start
[++pass
];
12914 while (row
>= image_height
)
12915 row
= interlace_start
[++pass
];
12918 for (x
= 0; x
< image_width
; x
++)
12920 int i
= raster
[(y
* image_width
) + x
];
12921 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
12925 row
+= interlace_increment
[pass
];
12930 for (y
= 0; y
< image_height
; ++y
)
12931 for (x
= 0; x
< image_width
; ++x
)
12933 int i
= raster
[y
* image_width
+ x
];
12934 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
12938 DGifCloseFile (gif
);
12940 /* Maybe fill in the background field while we have ximg handy. */
12941 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12942 IMAGE_BACKGROUND (img
, f
, ximg
);
12944 /* Put the image into the pixmap, then free the X image and its buffer. */
12945 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12946 x_destroy_x_image (ximg
);
12952 #endif /* HAVE_GIF != 0 */
12956 /***********************************************************************
12958 ***********************************************************************/
12960 Lisp_Object Qpostscript
;
12962 #ifdef HAVE_GHOSTSCRIPT
12963 static int gs_image_p
P_ ((Lisp_Object object
));
12964 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
12965 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
12967 /* The symbol `postscript' identifying images of this type. */
12969 /* Keyword symbols. */
12971 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
12973 /* Indices of image specification fields in gs_format, below. */
12975 enum gs_keyword_index
12993 /* Vector of image_keyword structures describing the format
12994 of valid user-defined image specifications. */
12996 static struct image_keyword gs_format
[GS_LAST
] =
12998 {":type", IMAGE_SYMBOL_VALUE
, 1},
12999 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
13000 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
13001 {":file", IMAGE_STRING_VALUE
, 1},
13002 {":loader", IMAGE_FUNCTION_VALUE
, 0},
13003 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
13004 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
13005 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
13006 {":relief", IMAGE_INTEGER_VALUE
, 0},
13007 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13008 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13009 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13010 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
13013 /* Structure describing the image type `ghostscript'. */
13015 static struct image_type gs_type
=
13025 /* Free X resources of Ghostscript image IMG which is used on frame F. */
13028 gs_clear_image (f
, img
)
13032 /* IMG->data.ptr_val may contain a recorded colormap. */
13033 xfree (img
->data
.ptr_val
);
13034 x_clear_image (f
, img
);
13038 /* Return non-zero if OBJECT is a valid Ghostscript image
13042 gs_image_p (object
)
13043 Lisp_Object object
;
13045 struct image_keyword fmt
[GS_LAST
];
13049 bcopy (gs_format
, fmt
, sizeof fmt
);
13051 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
13052 || (fmt
[GS_ASCENT
].count
13053 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
13056 /* Bounding box must be a list or vector containing 4 integers. */
13057 tem
= fmt
[GS_BOUNDING_BOX
].value
;
13060 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
13061 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
13066 else if (VECTORP (tem
))
13068 if (XVECTOR (tem
)->size
!= 4)
13070 for (i
= 0; i
< 4; ++i
)
13071 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
13081 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
13090 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
13091 struct gcpro gcpro1
, gcpro2
;
13093 double in_width
, in_height
;
13094 Lisp_Object pixel_colors
= Qnil
;
13096 /* Compute pixel size of pixmap needed from the given size in the
13097 image specification. Sizes in the specification are in pt. 1 pt
13098 = 1/72 in, xdpi and ydpi are stored in the frame's X display
13100 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
13101 in_width
= XFASTINT (pt_width
) / 72.0;
13102 img
->width
= in_width
* FRAME_W32_DISPLAY_INFO (f
)->resx
;
13103 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
13104 in_height
= XFASTINT (pt_height
) / 72.0;
13105 img
->height
= in_height
* FRAME_W32_DISPLAY_INFO (f
)->resy
;
13107 /* Create the pixmap. */
13109 xassert (img
->pixmap
== 0);
13110 img
->pixmap
= XCreatePixmap (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13111 img
->width
, img
->height
,
13112 one_w32_display_info
.n_cbits
);
13117 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
13121 /* Call the loader to fill the pixmap. It returns a process object
13122 if successful. We do not record_unwind_protect here because
13123 other places in redisplay like calling window scroll functions
13124 don't either. Let the Lisp loader use `unwind-protect' instead. */
13125 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
13127 sprintf (buffer
, "%lu %lu",
13128 (unsigned long) FRAME_W32_WINDOW (f
),
13129 (unsigned long) img
->pixmap
);
13130 window_and_pixmap_id
= build_string (buffer
);
13132 sprintf (buffer
, "%lu %lu",
13133 FRAME_FOREGROUND_PIXEL (f
),
13134 FRAME_BACKGROUND_PIXEL (f
));
13135 pixel_colors
= build_string (buffer
);
13137 XSETFRAME (frame
, f
);
13138 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
13140 loader
= intern ("gs-load-image");
13142 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
13143 make_number (img
->width
),
13144 make_number (img
->height
),
13145 window_and_pixmap_id
,
13148 return PROCESSP (img
->data
.lisp_val
);
13152 /* Kill the Ghostscript process that was started to fill PIXMAP on
13153 frame F. Called from XTread_socket when receiving an event
13154 telling Emacs that Ghostscript has finished drawing. */
13157 x_kill_gs_process (pixmap
, f
)
13161 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
13165 /* Find the image containing PIXMAP. */
13166 for (i
= 0; i
< c
->used
; ++i
)
13167 if (c
->images
[i
]->pixmap
== pixmap
)
13170 /* Should someone in between have cleared the image cache, for
13171 instance, give up. */
13175 /* Kill the GS process. We should have found PIXMAP in the image
13176 cache and its image should contain a process object. */
13177 img
= c
->images
[i
];
13178 xassert (PROCESSP (img
->data
.lisp_val
));
13179 Fkill_process (img
->data
.lisp_val
, Qnil
);
13180 img
->data
.lisp_val
= Qnil
;
13182 /* On displays with a mutable colormap, figure out the colors
13183 allocated for the image by looking at the pixels of an XImage for
13185 class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
13186 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
13192 /* Try to get an XImage for img->pixmep. */
13193 ximg
= XGetImage (FRAME_W32_DISPLAY (f
), img
->pixmap
,
13194 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
13199 /* Initialize the color table. */
13200 init_color_table ();
13202 /* For each pixel of the image, look its color up in the
13203 color table. After having done so, the color table will
13204 contain an entry for each color used by the image. */
13205 for (y
= 0; y
< img
->height
; ++y
)
13206 for (x
= 0; x
< img
->width
; ++x
)
13208 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
13209 lookup_pixel_color (f
, pixel
);
13212 /* Record colors in the image. Free color table and XImage. */
13213 img
->colors
= colors_in_color_table (&img
->ncolors
);
13214 free_color_table ();
13215 XDestroyImage (ximg
);
13217 #if 0 /* This doesn't seem to be the case. If we free the colors
13218 here, we get a BadAccess later in x_clear_image when
13219 freeing the colors. */
13220 /* We have allocated colors once, but Ghostscript has also
13221 allocated colors on behalf of us. So, to get the
13222 reference counts right, free them once. */
13224 x_free_colors (FRAME_W32_DISPLAY (f
), cmap
,
13225 img
->colors
, img
->ncolors
, 0);
13229 image_error ("Cannot get X image of `%s'; colors will not be freed",
13235 /* Now that we have the pixmap, compute mask and transform the
13236 image if requested. */
13238 postprocess_image (f
, img
);
13242 #endif /* HAVE_GHOSTSCRIPT */
13245 /***********************************************************************
13247 ***********************************************************************/
13249 DEFUN ("x-change-window-property", Fx_change_window_property
,
13250 Sx_change_window_property
, 2, 3, 0,
13251 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
13252 PROP and VALUE must be strings. FRAME nil or omitted means use the
13253 selected frame. Value is VALUE. */)
13254 (prop
, value
, frame
)
13255 Lisp_Object frame
, prop
, value
;
13257 #if 0 /* TODO : port window properties to W32 */
13258 struct frame
*f
= check_x_frame (frame
);
13261 CHECK_STRING (prop
);
13262 CHECK_STRING (value
);
13265 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
13266 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13267 prop_atom
, XA_STRING
, 8, PropModeReplace
,
13268 SDATA (value
), SCHARS (value
));
13270 /* Make sure the property is set when we return. */
13271 XFlush (FRAME_W32_DISPLAY (f
));
13280 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
13281 Sx_delete_window_property
, 1, 2, 0,
13282 doc
: /* Remove window property PROP from X window of FRAME.
13283 FRAME nil or omitted means use the selected frame. Value is PROP. */)
13285 Lisp_Object prop
, frame
;
13287 #if 0 /* TODO : port window properties to W32 */
13289 struct frame
*f
= check_x_frame (frame
);
13292 CHECK_STRING (prop
);
13294 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
13295 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
13297 /* Make sure the property is removed when we return. */
13298 XFlush (FRAME_W32_DISPLAY (f
));
13306 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
13308 doc
: /* Value is the value of window property PROP on FRAME.
13309 If FRAME is nil or omitted, use the selected frame. Value is nil
13310 if FRAME hasn't a property with name PROP or if PROP has no string
13313 Lisp_Object prop
, frame
;
13315 #if 0 /* TODO : port window properties to W32 */
13317 struct frame
*f
= check_x_frame (frame
);
13320 Lisp_Object prop_value
= Qnil
;
13321 char *tmp_data
= NULL
;
13324 unsigned long actual_size
, bytes_remaining
;
13326 CHECK_STRING (prop
);
13328 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
13329 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13330 prop_atom
, 0, 0, False
, XA_STRING
,
13331 &actual_type
, &actual_format
, &actual_size
,
13332 &bytes_remaining
, (unsigned char **) &tmp_data
);
13335 int size
= bytes_remaining
;
13340 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13341 prop_atom
, 0, bytes_remaining
,
13343 &actual_type
, &actual_format
,
13344 &actual_size
, &bytes_remaining
,
13345 (unsigned char **) &tmp_data
);
13347 prop_value
= make_string (tmp_data
, size
);
13362 /***********************************************************************
13364 ***********************************************************************/
13366 /* If non-null, an asynchronous timer that, when it expires, displays
13367 an hourglass cursor on all frames. */
13369 static struct atimer
*hourglass_atimer
;
13371 /* Non-zero means an hourglass cursor is currently shown. */
13373 static int hourglass_shown_p
;
13375 /* Number of seconds to wait before displaying an hourglass cursor. */
13377 static Lisp_Object Vhourglass_delay
;
13379 /* Default number of seconds to wait before displaying an hourglass
13382 #define DEFAULT_HOURGLASS_DELAY 1
13384 /* Function prototypes. */
13386 static void show_hourglass
P_ ((struct atimer
*));
13387 static void hide_hourglass
P_ ((void));
13390 /* Cancel a currently active hourglass timer, and start a new one. */
13395 #if 0 /* TODO: cursor shape changes. */
13397 int secs
, usecs
= 0;
13399 cancel_hourglass ();
13401 if (INTEGERP (Vhourglass_delay
)
13402 && XINT (Vhourglass_delay
) > 0)
13403 secs
= XFASTINT (Vhourglass_delay
);
13404 else if (FLOATP (Vhourglass_delay
)
13405 && XFLOAT_DATA (Vhourglass_delay
) > 0)
13408 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
13409 secs
= XFASTINT (tem
);
13410 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
13413 secs
= DEFAULT_HOURGLASS_DELAY
;
13415 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
13416 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
13417 show_hourglass
, NULL
);
13422 /* Cancel the hourglass cursor timer if active, hide an hourglass
13423 cursor if shown. */
13426 cancel_hourglass ()
13428 if (hourglass_atimer
)
13430 cancel_atimer (hourglass_atimer
);
13431 hourglass_atimer
= NULL
;
13434 if (hourglass_shown_p
)
13439 /* Timer function of hourglass_atimer. TIMER is equal to
13442 Display an hourglass cursor on all frames by mapping the frames'
13443 hourglass_window. Set the hourglass_p flag in the frames'
13444 output_data.x structure to indicate that an hourglass cursor is
13445 shown on the frames. */
13448 show_hourglass (timer
)
13449 struct atimer
*timer
;
13451 #if 0 /* TODO: cursor shape changes. */
13452 /* The timer implementation will cancel this timer automatically
13453 after this function has run. Set hourglass_atimer to null
13454 so that we know the timer doesn't have to be canceled. */
13455 hourglass_atimer
= NULL
;
13457 if (!hourglass_shown_p
)
13459 Lisp_Object rest
, frame
;
13463 FOR_EACH_FRAME (rest
, frame
)
13464 if (FRAME_W32_P (XFRAME (frame
)))
13466 struct frame
*f
= XFRAME (frame
);
13468 f
->output_data
.w32
->hourglass_p
= 1;
13470 if (!f
->output_data
.w32
->hourglass_window
)
13472 unsigned long mask
= CWCursor
;
13473 XSetWindowAttributes attrs
;
13475 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
13477 f
->output_data
.w32
->hourglass_window
13478 = XCreateWindow (FRAME_X_DISPLAY (f
),
13479 FRAME_OUTER_WINDOW (f
),
13480 0, 0, 32000, 32000, 0, 0,
13486 XMapRaised (FRAME_X_DISPLAY (f
),
13487 f
->output_data
.w32
->hourglass_window
);
13488 XFlush (FRAME_X_DISPLAY (f
));
13491 hourglass_shown_p
= 1;
13498 /* Hide the hourglass cursor on all frames, if it is currently shown. */
13503 #if 0 /* TODO: cursor shape changes. */
13504 if (hourglass_shown_p
)
13506 Lisp_Object rest
, frame
;
13509 FOR_EACH_FRAME (rest
, frame
)
13511 struct frame
*f
= XFRAME (frame
);
13513 if (FRAME_W32_P (f
)
13514 /* Watch out for newly created frames. */
13515 && f
->output_data
.x
->hourglass_window
)
13517 XUnmapWindow (FRAME_X_DISPLAY (f
),
13518 f
->output_data
.x
->hourglass_window
);
13519 /* Sync here because XTread_socket looks at the
13520 hourglass_p flag that is reset to zero below. */
13521 XSync (FRAME_X_DISPLAY (f
), False
);
13522 f
->output_data
.x
->hourglass_p
= 0;
13526 hourglass_shown_p
= 0;
13534 /***********************************************************************
13536 ***********************************************************************/
13538 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
13539 Lisp_Object
, Lisp_Object
));
13540 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
13541 Lisp_Object
, int, int, int *, int *));
13543 /* The frame of a currently visible tooltip. */
13545 Lisp_Object tip_frame
;
13547 /* If non-nil, a timer started that hides the last tooltip when it
13550 Lisp_Object tip_timer
;
13553 /* If non-nil, a vector of 3 elements containing the last args
13554 with which x-show-tip was called. See there. */
13556 Lisp_Object last_show_tip_args
;
13558 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
13560 Lisp_Object Vx_max_tooltip_size
;
13564 unwind_create_tip_frame (frame
)
13567 Lisp_Object deleted
;
13569 deleted
= unwind_create_frame (frame
);
13570 if (EQ (deleted
, Qt
))
13580 /* Create a frame for a tooltip on the display described by DPYINFO.
13581 PARMS is a list of frame parameters. TEXT is the string to
13582 display in the tip frame. Value is the frame.
13584 Note that functions called here, esp. x_default_parameter can
13585 signal errors, for instance when a specified color name is
13586 undefined. We have to make sure that we're in a consistent state
13587 when this happens. */
13590 x_create_tip_frame (dpyinfo
, parms
, text
)
13591 struct w32_display_info
*dpyinfo
;
13592 Lisp_Object parms
, text
;
13595 Lisp_Object frame
, tem
;
13597 long window_prompting
= 0;
13599 int count
= SPECPDL_INDEX ();
13600 struct gcpro gcpro1
, gcpro2
, gcpro3
;
13602 int face_change_count_before
= face_change_count
;
13603 Lisp_Object buffer
;
13604 struct buffer
*old_buffer
;
13608 /* Use this general default value to start with until we know if
13609 this frame has a specified name. */
13610 Vx_resource_name
= Vinvocation_name
;
13612 #ifdef MULTI_KBOARD
13613 kb
= dpyinfo
->kboard
;
13615 kb
= &the_only_kboard
;
13618 /* Get the name of the frame to use for resource lookup. */
13619 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
13620 if (!STRINGP (name
)
13621 && !EQ (name
, Qunbound
)
13623 error ("Invalid frame name--not a string or nil");
13624 Vx_resource_name
= name
;
13627 GCPRO3 (parms
, name
, frame
);
13628 /* Make a frame without minibuffer nor mode-line. */
13629 f
= make_frame (0);
13630 f
->wants_modeline
= 0;
13631 XSETFRAME (frame
, f
);
13633 buffer
= Fget_buffer_create (build_string (" *tip*"));
13634 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
13635 old_buffer
= current_buffer
;
13636 set_buffer_internal_1 (XBUFFER (buffer
));
13637 current_buffer
->truncate_lines
= Qnil
;
13639 Finsert (1, &text
);
13640 set_buffer_internal_1 (old_buffer
);
13642 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
13643 record_unwind_protect (unwind_create_tip_frame
, frame
);
13645 /* By setting the output method, we're essentially saying that
13646 the frame is live, as per FRAME_LIVE_P. If we get a signal
13647 from this point on, x_destroy_window might screw up reference
13649 f
->output_method
= output_w32
;
13650 f
->output_data
.w32
=
13651 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
13652 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
13654 FRAME_FONTSET (f
) = -1;
13655 f
->icon_name
= Qnil
;
13657 #if 0 /* GLYPH_DEBUG TODO: image support. */
13658 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
13659 dpyinfo_refcount
= dpyinfo
->reference_count
;
13660 #endif /* GLYPH_DEBUG */
13661 #ifdef MULTI_KBOARD
13662 FRAME_KBOARD (f
) = kb
;
13664 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
13665 f
->output_data
.w32
->explicit_parent
= 0;
13667 /* Set the name; the functions to which we pass f expect the name to
13669 if (EQ (name
, Qunbound
) || NILP (name
))
13671 f
->name
= build_string (dpyinfo
->w32_id_name
);
13672 f
->explicit_name
= 0;
13677 f
->explicit_name
= 1;
13678 /* use the frame's title when getting resources for this frame. */
13679 specbind (Qx_resource_name
, name
);
13682 /* Extract the window parameters from the supplied values
13683 that are needed to determine window geometry. */
13687 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
13690 /* First, try whatever font the caller has specified. */
13691 if (STRINGP (font
))
13693 tem
= Fquery_fontset (font
, Qnil
);
13695 font
= x_new_fontset (f
, SDATA (tem
));
13697 font
= x_new_font (f
, SDATA (font
));
13700 /* Try out a font which we hope has bold and italic variations. */
13701 if (!STRINGP (font
))
13702 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
13703 if (! STRINGP (font
))
13704 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
13705 /* If those didn't work, look for something which will at least work. */
13706 if (! STRINGP (font
))
13707 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
13709 if (! STRINGP (font
))
13710 font
= build_string ("Fixedsys");
13712 x_default_parameter (f
, parms
, Qfont
, font
,
13713 "font", "Font", RES_TYPE_STRING
);
13716 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
13717 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
13718 /* This defaults to 2 in order to match xterm. We recognize either
13719 internalBorderWidth or internalBorder (which is what xterm calls
13721 if (NILP (Fassq (Qinternal_border_width
, parms
)))
13725 value
= w32_get_arg (parms
, Qinternal_border_width
,
13726 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
13727 if (! EQ (value
, Qunbound
))
13728 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
13731 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
13732 "internalBorderWidth", "internalBorderWidth",
13735 /* Also do the stuff which must be set before the window exists. */
13736 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
13737 "foreground", "Foreground", RES_TYPE_STRING
);
13738 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
13739 "background", "Background", RES_TYPE_STRING
);
13740 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
13741 "pointerColor", "Foreground", RES_TYPE_STRING
);
13742 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
13743 "cursorColor", "Foreground", RES_TYPE_STRING
);
13744 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
13745 "borderColor", "BorderColor", RES_TYPE_STRING
);
13747 /* Init faces before x_default_parameter is called for scroll-bar
13748 parameters because that function calls x_set_scroll_bar_width,
13749 which calls change_frame_size, which calls Fset_window_buffer,
13750 which runs hooks, which call Fvertical_motion. At the end, we
13751 end up in init_iterator with a null face cache, which should not
13753 init_frame_faces (f
);
13755 f
->output_data
.w32
->dwStyle
= WS_BORDER
| WS_POPUP
| WS_DISABLED
;
13756 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
13758 window_prompting
= x_figure_window_size (f
, parms
);
13760 /* No fringes on tip frame. */
13761 f
->output_data
.w32
->fringes_extra
= 0;
13762 f
->output_data
.w32
->fringe_cols
= 0;
13763 f
->output_data
.w32
->left_fringe_width
= 0;
13764 f
->output_data
.w32
->right_fringe_width
= 0;
13766 if (window_prompting
& XNegative
)
13768 if (window_prompting
& YNegative
)
13769 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
13771 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
13775 if (window_prompting
& YNegative
)
13776 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
13778 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
13781 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
13784 my_create_tip_window (f
);
13789 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
13790 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
13791 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
13792 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
13793 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
13794 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
13796 /* Dimensions, especially f->height, must be done via change_frame_size.
13797 Change will not be effected unless different from the current
13800 height
= f
->height
;
13802 SET_FRAME_WIDTH (f
, 0);
13803 change_frame_size (f
, height
, width
, 1, 0, 0);
13805 /* Add `tooltip' frame parameter's default value. */
13806 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
13807 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
13810 /* Set up faces after all frame parameters are known. This call
13811 also merges in face attributes specified for new frames.
13813 Frame parameters may be changed if .Xdefaults contains
13814 specifications for the default font. For example, if there is an
13815 `Emacs.default.attributeBackground: pink', the `background-color'
13816 attribute of the frame get's set, which let's the internal border
13817 of the tooltip frame appear in pink. Prevent this. */
13819 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
13821 /* Set tip_frame here, so that */
13823 call1 (Qface_set_after_frame_default
, frame
);
13825 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
13826 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
13834 /* It is now ok to make the frame official even if we get an error
13835 below. And the frame needs to be on Vframe_list or making it
13836 visible won't work. */
13837 Vframe_list
= Fcons (frame
, Vframe_list
);
13839 /* Now that the frame is official, it counts as a reference to
13841 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
13843 /* Setting attributes of faces of the tooltip frame from resources
13844 and similar will increment face_change_count, which leads to the
13845 clearing of all current matrices. Since this isn't necessary
13846 here, avoid it by resetting face_change_count to the value it
13847 had before we created the tip frame. */
13848 face_change_count
= face_change_count_before
;
13850 /* Discard the unwind_protect. */
13851 return unbind_to (count
, frame
);
13855 /* Compute where to display tip frame F. PARMS is the list of frame
13856 parameters for F. DX and DY are specified offsets from the current
13857 location of the mouse. WIDTH and HEIGHT are the width and height
13858 of the tooltip. Return coordinates relative to the root window of
13859 the display in *ROOT_X, and *ROOT_Y. */
13862 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
13864 Lisp_Object parms
, dx
, dy
;
13866 int *root_x
, *root_y
;
13868 Lisp_Object left
, top
;
13870 /* User-specified position? */
13871 left
= Fcdr (Fassq (Qleft
, parms
));
13872 top
= Fcdr (Fassq (Qtop
, parms
));
13874 /* Move the tooltip window where the mouse pointer is. Resize and
13876 if (!INTEGERP (left
) || !INTEGERP (top
))
13881 GetCursorPos (&pt
);
13887 if (INTEGERP (top
))
13888 *root_y
= XINT (top
);
13889 else if (*root_y
+ XINT (dy
) - height
< 0)
13890 *root_y
-= XINT (dy
);
13894 *root_y
+= XINT (dy
);
13897 if (INTEGERP (left
))
13898 *root_x
= XINT (left
);
13899 else if (*root_x
+ XINT (dx
) + width
<= FRAME_W32_DISPLAY_INFO (f
)->width
)
13900 /* It fits to the right of the pointer. */
13901 *root_x
+= XINT (dx
);
13902 else if (width
+ XINT (dx
) <= *root_x
)
13903 /* It fits to the left of the pointer. */
13904 *root_x
-= width
+ XINT (dx
);
13906 /* Put it left justified on the screen -- it ought to fit that way. */
13911 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
13912 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
13913 A tooltip window is a small window displaying a string.
13915 FRAME nil or omitted means use the selected frame.
13917 PARMS is an optional list of frame parameters which can be
13918 used to change the tooltip's appearance.
13920 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
13921 means use the default timeout of 5 seconds.
13923 If the list of frame parameters PARAMS contains a `left' parameter,
13924 the tooltip is displayed at that x-position. Otherwise it is
13925 displayed at the mouse position, with offset DX added (default is 5 if
13926 DX isn't specified). Likewise for the y-position; if a `top' frame
13927 parameter is specified, it determines the y-position of the tooltip
13928 window, otherwise it is displayed at the mouse position, with offset
13929 DY added (default is -10).
13931 A tooltip's maximum size is specified by `x-max-tooltip-size'.
13932 Text larger than the specified size is clipped. */)
13933 (string
, frame
, parms
, timeout
, dx
, dy
)
13934 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
13938 int root_x
, root_y
;
13939 struct buffer
*old_buffer
;
13940 struct text_pos pos
;
13941 int i
, width
, height
;
13942 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
13943 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
13944 int count
= SPECPDL_INDEX ();
13946 specbind (Qinhibit_redisplay
, Qt
);
13948 GCPRO4 (string
, parms
, frame
, timeout
);
13950 CHECK_STRING (string
);
13951 f
= check_x_frame (frame
);
13952 if (NILP (timeout
))
13953 timeout
= make_number (5);
13955 CHECK_NATNUM (timeout
);
13958 dx
= make_number (5);
13963 dy
= make_number (-10);
13967 if (NILP (last_show_tip_args
))
13968 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
13970 if (!NILP (tip_frame
))
13972 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
13973 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
13974 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
13976 if (EQ (frame
, last_frame
)
13977 && !NILP (Fequal (last_string
, string
))
13978 && !NILP (Fequal (last_parms
, parms
)))
13980 struct frame
*f
= XFRAME (tip_frame
);
13982 /* Only DX and DY have changed. */
13983 if (!NILP (tip_timer
))
13985 Lisp_Object timer
= tip_timer
;
13987 call1 (Qcancel_timer
, timer
);
13991 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
13992 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
13994 /* Put tooltip in topmost group and in position. */
13995 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
13996 root_x
, root_y
, 0, 0,
13997 SWP_NOSIZE
| SWP_NOACTIVATE
);
13999 /* Ensure tooltip is on top of other topmost windows (eg menus). */
14000 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
14002 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
14009 /* Hide a previous tip, if any. */
14012 ASET (last_show_tip_args
, 0, string
);
14013 ASET (last_show_tip_args
, 1, frame
);
14014 ASET (last_show_tip_args
, 2, parms
);
14016 /* Add default values to frame parameters. */
14017 if (NILP (Fassq (Qname
, parms
)))
14018 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
14019 if (NILP (Fassq (Qinternal_border_width
, parms
)))
14020 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
14021 if (NILP (Fassq (Qborder_width
, parms
)))
14022 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
14023 if (NILP (Fassq (Qborder_color
, parms
)))
14024 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
14025 if (NILP (Fassq (Qbackground_color
, parms
)))
14026 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
14029 /* Block input until the tip has been fully drawn, to avoid crashes
14030 when drawing tips in menus. */
14033 /* Create a frame for the tooltip, and record it in the global
14034 variable tip_frame. */
14035 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
, string
);
14036 f
= XFRAME (frame
);
14038 /* Set up the frame's root window. */
14039 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
14040 w
->left
= w
->top
= make_number (0);
14042 if (CONSP (Vx_max_tooltip_size
)
14043 && INTEGERP (XCAR (Vx_max_tooltip_size
))
14044 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
14045 && INTEGERP (XCDR (Vx_max_tooltip_size
))
14046 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
14048 w
->width
= XCAR (Vx_max_tooltip_size
);
14049 w
->height
= XCDR (Vx_max_tooltip_size
);
14053 w
->width
= make_number (80);
14054 w
->height
= make_number (40);
14057 f
->window_width
= XINT (w
->width
);
14059 w
->pseudo_window_p
= 1;
14061 /* Display the tooltip text in a temporary buffer. */
14062 old_buffer
= current_buffer
;
14063 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
14064 current_buffer
->truncate_lines
= Qnil
;
14065 clear_glyph_matrix (w
->desired_matrix
);
14066 clear_glyph_matrix (w
->current_matrix
);
14067 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
14068 try_window (FRAME_ROOT_WINDOW (f
), pos
);
14070 /* Compute width and height of the tooltip. */
14071 width
= height
= 0;
14072 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
14074 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
14075 struct glyph
*last
;
14078 /* Stop at the first empty row at the end. */
14079 if (!row
->enabled_p
|| !row
->displays_text_p
)
14082 /* Let the row go over the full width of the frame. */
14083 row
->full_width_p
= 1;
14085 #ifdef TODO /* Investigate why some fonts need more width than is
14086 calculated for some tooltips. */
14087 /* There's a glyph at the end of rows that is use to place
14088 the cursor there. Don't include the width of this glyph. */
14089 if (row
->used
[TEXT_AREA
])
14091 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
14092 row_width
= row
->pixel_width
- last
->pixel_width
;
14096 row_width
= row
->pixel_width
;
14098 /* TODO: find why tips do not draw along baseline as instructed. */
14099 height
+= row
->height
;
14100 width
= max (width
, row_width
);
14103 /* Add the frame's internal border to the width and height the X
14104 window should have. */
14105 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
14106 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
14108 /* Move the tooltip window where the mouse pointer is. Resize and
14110 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
14113 /* Adjust Window size to take border into account. */
14115 rect
.left
= rect
.top
= 0;
14116 rect
.right
= width
;
14117 rect
.bottom
= height
;
14118 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
14119 FRAME_EXTERNAL_MENU_BAR (f
));
14121 /* Position and size tooltip, and put it in the topmost group. */
14122 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
14123 root_x
, root_y
, rect
.right
- rect
.left
,
14124 rect
.bottom
- rect
.top
, SWP_NOACTIVATE
);
14126 /* Ensure tooltip is on top of other topmost windows (eg menus). */
14127 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
14129 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
14131 /* Let redisplay know that we have made the frame visible already. */
14132 f
->async_visible
= 1;
14134 ShowWindow (FRAME_W32_WINDOW (f
), SW_SHOWNOACTIVATE
);
14137 /* Draw into the window. */
14138 w
->must_be_updated_p
= 1;
14139 update_single_window (w
, 1);
14143 /* Restore original current buffer. */
14144 set_buffer_internal_1 (old_buffer
);
14145 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
14148 /* Let the tip disappear after timeout seconds. */
14149 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
14150 intern ("x-hide-tip"));
14153 return unbind_to (count
, Qnil
);
14157 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
14158 doc
: /* Hide the current tooltip window, if there is any.
14159 Value is t if tooltip was open, nil otherwise. */)
14163 Lisp_Object deleted
, frame
, timer
;
14164 struct gcpro gcpro1
, gcpro2
;
14166 /* Return quickly if nothing to do. */
14167 if (NILP (tip_timer
) && NILP (tip_frame
))
14172 GCPRO2 (frame
, timer
);
14173 tip_frame
= tip_timer
= deleted
= Qnil
;
14175 count
= SPECPDL_INDEX ();
14176 specbind (Qinhibit_redisplay
, Qt
);
14177 specbind (Qinhibit_quit
, Qt
);
14180 call1 (Qcancel_timer
, timer
);
14182 if (FRAMEP (frame
))
14184 Fdelete_frame (frame
, Qnil
);
14189 return unbind_to (count
, deleted
);
14194 /***********************************************************************
14195 File selection dialog
14196 ***********************************************************************/
14197 extern Lisp_Object Qfile_name_history
;
14199 /* Callback for altering the behaviour of the Open File dialog.
14200 Makes the Filename text field contain "Current Directory" and be
14201 read-only when "Directories" is selected in the filter. This
14202 allows us to work around the fact that the standard Open File
14203 dialog does not support directories. */
14205 file_dialog_callback (hwnd
, msg
, wParam
, lParam
)
14211 if (msg
== WM_NOTIFY
)
14213 OFNOTIFY
* notify
= (OFNOTIFY
*)lParam
;
14214 /* Detect when the Filter dropdown is changed. */
14215 if (notify
->hdr
.code
== CDN_TYPECHANGE
)
14217 HWND dialog
= GetParent (hwnd
);
14218 HWND edit_control
= GetDlgItem (dialog
, FILE_NAME_TEXT_FIELD
);
14220 /* Directories is in index 2. */
14221 if (notify
->lpOFN
->nFilterIndex
== 2)
14223 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
14224 "Current Directory");
14225 EnableWindow (edit_control
, FALSE
);
14229 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
14231 EnableWindow (edit_control
, TRUE
);
14238 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
14239 doc
: /* Read file name, prompting with PROMPT in directory DIR.
14240 Use a file selection dialog.
14241 Select DEFAULT-FILENAME in the dialog's file selection box, if
14242 specified. Ensure that file exists if MUSTMATCH is non-nil. */)
14243 (prompt
, dir
, default_filename
, mustmatch
)
14244 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
14246 struct frame
*f
= SELECTED_FRAME ();
14247 Lisp_Object file
= Qnil
;
14248 int count
= SPECPDL_INDEX ();
14249 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
14250 char filename
[MAX_PATH
+ 1];
14251 char init_dir
[MAX_PATH
+ 1];
14253 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
14254 CHECK_STRING (prompt
);
14255 CHECK_STRING (dir
);
14257 /* Create the dialog with PROMPT as title, using DIR as initial
14258 directory and using "*" as pattern. */
14259 dir
= Fexpand_file_name (dir
, Qnil
);
14260 strncpy (init_dir
, SDATA (dir
), MAX_PATH
);
14261 init_dir
[MAX_PATH
] = '\0';
14262 unixtodos_filename (init_dir
);
14264 if (STRINGP (default_filename
))
14266 char *file_name_only
;
14267 char *full_path_name
= SDATA (default_filename
);
14269 unixtodos_filename (full_path_name
);
14271 file_name_only
= strrchr (full_path_name
, '\\');
14272 if (!file_name_only
)
14273 file_name_only
= full_path_name
;
14279 strncpy (filename
, file_name_only
, MAX_PATH
);
14280 filename
[MAX_PATH
] = '\0';
14283 filename
[0] = '\0';
14286 OPENFILENAME file_details
;
14288 /* Prevent redisplay. */
14289 specbind (Qinhibit_redisplay
, Qt
);
14292 bzero (&file_details
, sizeof (file_details
));
14293 file_details
.lStructSize
= sizeof (file_details
);
14294 file_details
.hwndOwner
= FRAME_W32_WINDOW (f
);
14295 /* Undocumented Bug in Common File Dialog:
14296 If a filter is not specified, shell links are not resolved. */
14297 file_details
.lpstrFilter
= "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
14298 file_details
.lpstrFile
= filename
;
14299 file_details
.nMaxFile
= sizeof (filename
);
14300 file_details
.lpstrInitialDir
= init_dir
;
14301 file_details
.lpstrTitle
= SDATA (prompt
);
14302 file_details
.Flags
= (OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
14303 | OFN_EXPLORER
| OFN_ENABLEHOOK
);
14304 if (!NILP (mustmatch
))
14305 file_details
.Flags
|= OFN_FILEMUSTEXIST
| OFN_PATHMUSTEXIST
;
14307 file_details
.lpfnHook
= (LPOFNHOOKPROC
) file_dialog_callback
;
14309 if (GetOpenFileName (&file_details
))
14311 dostounix_filename (filename
);
14312 if (file_details
.nFilterIndex
== 2)
14314 /* "Folder Only" selected - strip dummy file name. */
14315 char * last
= strrchr (filename
, '/');
14319 file
= DECODE_FILE(build_string (filename
));
14321 /* User cancelled the dialog without making a selection. */
14322 else if (!CommDlgExtendedError ())
14324 /* An error occurred, fallback on reading from the mini-buffer. */
14326 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
14327 dir
, mustmatch
, dir
, Qfile_name_history
,
14328 default_filename
, Qnil
);
14331 file
= unbind_to (count
, file
);
14336 /* Make "Cancel" equivalent to C-g. */
14338 Fsignal (Qquit
, Qnil
);
14340 return unbind_to (count
, file
);
14345 /***********************************************************************
14346 w32 specialized functions
14347 ***********************************************************************/
14349 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 2, 0,
14350 doc
: /* Select a font using the W32 font dialog.
14351 Returns an X font string corresponding to the selection. */)
14352 (frame
, include_proportional
)
14353 Lisp_Object frame
, include_proportional
;
14355 FRAME_PTR f
= check_x_frame (frame
);
14363 bzero (&cf
, sizeof (cf
));
14364 bzero (&lf
, sizeof (lf
));
14366 cf
.lStructSize
= sizeof (cf
);
14367 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
14368 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
14370 /* Unless include_proportional is non-nil, limit the selection to
14371 monospaced fonts. */
14372 if (NILP (include_proportional
))
14373 cf
.Flags
|= CF_FIXEDPITCHONLY
;
14375 cf
.lpLogFont
= &lf
;
14377 /* Initialize as much of the font details as we can from the current
14379 hdc
= GetDC (FRAME_W32_WINDOW (f
));
14380 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
14381 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
14382 if (GetTextMetrics (hdc
, &tm
))
14384 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
14385 lf
.lfWeight
= tm
.tmWeight
;
14386 lf
.lfItalic
= tm
.tmItalic
;
14387 lf
.lfUnderline
= tm
.tmUnderlined
;
14388 lf
.lfStrikeOut
= tm
.tmStruckOut
;
14389 lf
.lfCharSet
= tm
.tmCharSet
;
14390 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
14392 SelectObject (hdc
, oldobj
);
14393 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
14395 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
14398 return build_string (buf
);
14401 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
14402 Sw32_send_sys_command
, 1, 2, 0,
14403 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
14404 Some useful values for command are #xf030 to maximise frame (#xf020
14405 to minimize), #xf120 to restore frame to original size, and #xf100
14406 to activate the menubar for keyboard access. #xf140 activates the
14407 screen saver if defined.
14409 If optional parameter FRAME is not specified, use selected frame. */)
14411 Lisp_Object command
, frame
;
14413 FRAME_PTR f
= check_x_frame (frame
);
14415 CHECK_NUMBER (command
);
14417 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
14422 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
14423 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
14424 This is a wrapper around the ShellExecute system function, which
14425 invokes the application registered to handle OPERATION for DOCUMENT.
14426 OPERATION is typically \"open\", \"print\" or \"explore\" (but can be
14427 nil for the default action), and DOCUMENT is typically the name of a
14428 document file or URL, but can also be a program executable to run or
14429 a directory to open in the Windows Explorer.
14431 If DOCUMENT is a program executable, PARAMETERS can be a string
14432 containing command line parameters, but otherwise should be nil.
14434 SHOW-FLAG can be used to control whether the invoked application is hidden
14435 or minimized. If SHOW-FLAG is nil, the application is displayed normally,
14436 otherwise it is an integer representing a ShowWindow flag:
14440 3 - start maximized
14441 6 - start minimized */)
14442 (operation
, document
, parameters
, show_flag
)
14443 Lisp_Object operation
, document
, parameters
, show_flag
;
14445 Lisp_Object current_dir
;
14447 CHECK_STRING (document
);
14449 /* Encode filename and current directory. */
14450 current_dir
= ENCODE_FILE (current_buffer
->directory
);
14451 document
= ENCODE_FILE (document
);
14452 if ((int) ShellExecute (NULL
,
14453 (STRINGP (operation
) ?
14454 SDATA (operation
) : NULL
),
14456 (STRINGP (parameters
) ?
14457 SDATA (parameters
) : NULL
),
14458 SDATA (current_dir
),
14459 (INTEGERP (show_flag
) ?
14460 XINT (show_flag
) : SW_SHOWDEFAULT
))
14463 error ("ShellExecute failed: %s", w32_strerror (0));
14466 /* Lookup virtual keycode from string representing the name of a
14467 non-ascii keystroke into the corresponding virtual key, using
14468 lispy_function_keys. */
14470 lookup_vk_code (char *key
)
14474 for (i
= 0; i
< 256; i
++)
14475 if (lispy_function_keys
[i
] != 0
14476 && strcmp (lispy_function_keys
[i
], key
) == 0)
14482 /* Convert a one-element vector style key sequence to a hot key
14485 w32_parse_hot_key (key
)
14488 /* Copied from Fdefine_key and store_in_keymap. */
14489 register Lisp_Object c
;
14491 int lisp_modifiers
;
14493 struct gcpro gcpro1
;
14495 CHECK_VECTOR (key
);
14497 if (XFASTINT (Flength (key
)) != 1)
14502 c
= Faref (key
, make_number (0));
14504 if (CONSP (c
) && lucid_event_type_list_p (c
))
14505 c
= Fevent_convert_list (c
);
14509 if (! INTEGERP (c
) && ! SYMBOLP (c
))
14510 error ("Key definition is invalid");
14512 /* Work out the base key and the modifiers. */
14515 c
= parse_modifiers (c
);
14516 lisp_modifiers
= Fcar (Fcdr (c
));
14520 vk_code
= lookup_vk_code (SDATA (SYMBOL_NAME (c
)));
14522 else if (INTEGERP (c
))
14524 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
14525 /* Many ascii characters are their own virtual key code. */
14526 vk_code
= XINT (c
) & CHARACTERBITS
;
14529 if (vk_code
< 0 || vk_code
> 255)
14532 if ((lisp_modifiers
& meta_modifier
) != 0
14533 && !NILP (Vw32_alt_is_meta
))
14534 lisp_modifiers
|= alt_modifier
;
14536 /* Supply defs missing from mingw32. */
14538 #define MOD_ALT 0x0001
14539 #define MOD_CONTROL 0x0002
14540 #define MOD_SHIFT 0x0004
14541 #define MOD_WIN 0x0008
14544 /* Convert lisp modifiers to Windows hot-key form. */
14545 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
14546 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
14547 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
14548 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
14550 return HOTKEY (vk_code
, w32_modifiers
);
14553 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
14554 Sw32_register_hot_key
, 1, 1, 0,
14555 doc
: /* Register KEY as a hot-key combination.
14556 Certain key combinations like Alt-Tab are reserved for system use on
14557 Windows, and therefore are normally intercepted by the system. However,
14558 most of these key combinations can be received by registering them as
14559 hot-keys, overriding their special meaning.
14561 KEY must be a one element key definition in vector form that would be
14562 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
14563 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
14564 is always interpreted as the Windows modifier keys.
14566 The return value is the hotkey-id if registered, otherwise nil. */)
14570 key
= w32_parse_hot_key (key
);
14572 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
14574 /* Reuse an empty slot if possible. */
14575 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
14577 /* Safe to add new key to list, even if we have focus. */
14579 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
14581 XSETCAR (item
, key
);
14583 /* Notify input thread about new hot-key definition, so that it
14584 takes effect without needing to switch focus. */
14585 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
14592 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
14593 Sw32_unregister_hot_key
, 1, 1, 0,
14594 doc
: /* Unregister HOTKEY as a hot-key combination. */)
14600 if (!INTEGERP (key
))
14601 key
= w32_parse_hot_key (key
);
14603 item
= Fmemq (key
, w32_grabbed_keys
);
14607 /* Notify input thread about hot-key definition being removed, so
14608 that it takes effect without needing focus switch. */
14609 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
14610 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
14613 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
14620 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
14621 Sw32_registered_hot_keys
, 0, 0, 0,
14622 doc
: /* Return list of registered hot-key IDs. */)
14625 return Fcopy_sequence (w32_grabbed_keys
);
14628 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
14629 Sw32_reconstruct_hot_key
, 1, 1, 0,
14630 doc
: /* Convert hot-key ID to a lisp key combination. */)
14632 Lisp_Object hotkeyid
;
14634 int vk_code
, w32_modifiers
;
14637 CHECK_NUMBER (hotkeyid
);
14639 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
14640 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
14642 if (lispy_function_keys
[vk_code
])
14643 key
= intern (lispy_function_keys
[vk_code
]);
14645 key
= make_number (vk_code
);
14647 key
= Fcons (key
, Qnil
);
14648 if (w32_modifiers
& MOD_SHIFT
)
14649 key
= Fcons (Qshift
, key
);
14650 if (w32_modifiers
& MOD_CONTROL
)
14651 key
= Fcons (Qctrl
, key
);
14652 if (w32_modifiers
& MOD_ALT
)
14653 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
14654 if (w32_modifiers
& MOD_WIN
)
14655 key
= Fcons (Qhyper
, key
);
14660 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
14661 Sw32_toggle_lock_key
, 1, 2, 0,
14662 doc
: /* Toggle the state of the lock key KEY.
14663 KEY can be `capslock', `kp-numlock', or `scroll'.
14664 If the optional parameter NEW-STATE is a number, then the state of KEY
14665 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
14667 Lisp_Object key
, new_state
;
14671 if (EQ (key
, intern ("capslock")))
14672 vk_code
= VK_CAPITAL
;
14673 else if (EQ (key
, intern ("kp-numlock")))
14674 vk_code
= VK_NUMLOCK
;
14675 else if (EQ (key
, intern ("scroll")))
14676 vk_code
= VK_SCROLL
;
14680 if (!dwWindowsThreadId
)
14681 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
14683 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
14684 (WPARAM
) vk_code
, (LPARAM
) new_state
))
14687 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
14688 return make_number (msg
.wParam
);
14693 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
14694 doc
: /* Return storage information about the file system FILENAME is on.
14695 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
14696 storage of the file system, FREE is the free storage, and AVAIL is the
14697 storage available to a non-superuser. All 3 numbers are in bytes.
14698 If the underlying system call fails, value is nil. */)
14700 Lisp_Object filename
;
14702 Lisp_Object encoded
, value
;
14704 CHECK_STRING (filename
);
14705 filename
= Fexpand_file_name (filename
, Qnil
);
14706 encoded
= ENCODE_FILE (filename
);
14710 /* Determining the required information on Windows turns out, sadly,
14711 to be more involved than one would hope. The original Win32 api
14712 call for this will return bogus information on some systems, but we
14713 must dynamically probe for the replacement api, since that was
14714 added rather late on. */
14716 HMODULE hKernel
= GetModuleHandle ("kernel32");
14717 BOOL (*pfn_GetDiskFreeSpaceEx
)
14718 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
14719 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
14721 /* On Windows, we may need to specify the root directory of the
14722 volume holding FILENAME. */
14723 char rootname
[MAX_PATH
];
14724 char *name
= SDATA (encoded
);
14726 /* find the root name of the volume if given */
14727 if (isalpha (name
[0]) && name
[1] == ':')
14729 rootname
[0] = name
[0];
14730 rootname
[1] = name
[1];
14731 rootname
[2] = '\\';
14734 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
14736 char *str
= rootname
;
14740 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
14750 if (pfn_GetDiskFreeSpaceEx
)
14752 /* Unsigned large integers cannot be cast to double, so
14753 use signed ones instead. */
14754 LARGE_INTEGER availbytes
;
14755 LARGE_INTEGER freebytes
;
14756 LARGE_INTEGER totalbytes
;
14758 if (pfn_GetDiskFreeSpaceEx(rootname
,
14759 (ULARGE_INTEGER
*)&availbytes
,
14760 (ULARGE_INTEGER
*)&totalbytes
,
14761 (ULARGE_INTEGER
*)&freebytes
))
14762 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
14763 make_float ((double) freebytes
.QuadPart
),
14764 make_float ((double) availbytes
.QuadPart
));
14768 DWORD sectors_per_cluster
;
14769 DWORD bytes_per_sector
;
14770 DWORD free_clusters
;
14771 DWORD total_clusters
;
14773 if (GetDiskFreeSpace(rootname
,
14774 §ors_per_cluster
,
14778 value
= list3 (make_float ((double) total_clusters
14779 * sectors_per_cluster
* bytes_per_sector
),
14780 make_float ((double) free_clusters
14781 * sectors_per_cluster
* bytes_per_sector
),
14782 make_float ((double) free_clusters
14783 * sectors_per_cluster
* bytes_per_sector
));
14790 /***********************************************************************
14792 ***********************************************************************/
14797 HMODULE user32_lib
= GetModuleHandle ("user32.dll");
14799 /* This is zero if not using MS-Windows. */
14802 /* TrackMouseEvent not available in all versions of Windows, so must load
14803 it dynamically. Do it once, here, instead of every time it is used. */
14804 track_mouse_event_fn
= GetProcAddress (user32_lib
, "TrackMouseEvent");
14805 track_mouse_window
= NULL
;
14807 w32_visible_system_caret_hwnd
= NULL
;
14809 Qauto_raise
= intern ("auto-raise");
14810 staticpro (&Qauto_raise
);
14811 Qauto_lower
= intern ("auto-lower");
14812 staticpro (&Qauto_lower
);
14813 Qborder_color
= intern ("border-color");
14814 staticpro (&Qborder_color
);
14815 Qborder_width
= intern ("border-width");
14816 staticpro (&Qborder_width
);
14817 Qcursor_color
= intern ("cursor-color");
14818 staticpro (&Qcursor_color
);
14819 Qcursor_type
= intern ("cursor-type");
14820 staticpro (&Qcursor_type
);
14821 Qgeometry
= intern ("geometry");
14822 staticpro (&Qgeometry
);
14823 Qicon_left
= intern ("icon-left");
14824 staticpro (&Qicon_left
);
14825 Qicon_top
= intern ("icon-top");
14826 staticpro (&Qicon_top
);
14827 Qicon_type
= intern ("icon-type");
14828 staticpro (&Qicon_type
);
14829 Qicon_name
= intern ("icon-name");
14830 staticpro (&Qicon_name
);
14831 Qinternal_border_width
= intern ("internal-border-width");
14832 staticpro (&Qinternal_border_width
);
14833 Qleft
= intern ("left");
14834 staticpro (&Qleft
);
14835 Qright
= intern ("right");
14836 staticpro (&Qright
);
14837 Qmouse_color
= intern ("mouse-color");
14838 staticpro (&Qmouse_color
);
14839 Qnone
= intern ("none");
14840 staticpro (&Qnone
);
14841 Qparent_id
= intern ("parent-id");
14842 staticpro (&Qparent_id
);
14843 Qscroll_bar_width
= intern ("scroll-bar-width");
14844 staticpro (&Qscroll_bar_width
);
14845 Qsuppress_icon
= intern ("suppress-icon");
14846 staticpro (&Qsuppress_icon
);
14847 Qundefined_color
= intern ("undefined-color");
14848 staticpro (&Qundefined_color
);
14849 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
14850 staticpro (&Qvertical_scroll_bars
);
14851 Qvisibility
= intern ("visibility");
14852 staticpro (&Qvisibility
);
14853 Qwindow_id
= intern ("window-id");
14854 staticpro (&Qwindow_id
);
14855 Qx_frame_parameter
= intern ("x-frame-parameter");
14856 staticpro (&Qx_frame_parameter
);
14857 Qx_resource_name
= intern ("x-resource-name");
14858 staticpro (&Qx_resource_name
);
14859 Quser_position
= intern ("user-position");
14860 staticpro (&Quser_position
);
14861 Quser_size
= intern ("user-size");
14862 staticpro (&Quser_size
);
14863 Qscreen_gamma
= intern ("screen-gamma");
14864 staticpro (&Qscreen_gamma
);
14865 Qline_spacing
= intern ("line-spacing");
14866 staticpro (&Qline_spacing
);
14867 Qcenter
= intern ("center");
14868 staticpro (&Qcenter
);
14869 Qcancel_timer
= intern ("cancel-timer");
14870 staticpro (&Qcancel_timer
);
14871 Qfullscreen
= intern ("fullscreen");
14872 staticpro (&Qfullscreen
);
14873 Qfullwidth
= intern ("fullwidth");
14874 staticpro (&Qfullwidth
);
14875 Qfullheight
= intern ("fullheight");
14876 staticpro (&Qfullheight
);
14877 Qfullboth
= intern ("fullboth");
14878 staticpro (&Qfullboth
);
14880 Qhyper
= intern ("hyper");
14881 staticpro (&Qhyper
);
14882 Qsuper
= intern ("super");
14883 staticpro (&Qsuper
);
14884 Qmeta
= intern ("meta");
14885 staticpro (&Qmeta
);
14886 Qalt
= intern ("alt");
14888 Qctrl
= intern ("ctrl");
14889 staticpro (&Qctrl
);
14890 Qcontrol
= intern ("control");
14891 staticpro (&Qcontrol
);
14892 Qshift
= intern ("shift");
14893 staticpro (&Qshift
);
14894 /* This is the end of symbol initialization. */
14896 /* Text property `display' should be nonsticky by default. */
14897 Vtext_property_default_nonsticky
14898 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
14901 Qlaplace
= intern ("laplace");
14902 staticpro (&Qlaplace
);
14903 Qemboss
= intern ("emboss");
14904 staticpro (&Qemboss
);
14905 Qedge_detection
= intern ("edge-detection");
14906 staticpro (&Qedge_detection
);
14907 Qheuristic
= intern ("heuristic");
14908 staticpro (&Qheuristic
);
14909 QCmatrix
= intern (":matrix");
14910 staticpro (&QCmatrix
);
14911 QCcolor_adjustment
= intern (":color-adjustment");
14912 staticpro (&QCcolor_adjustment
);
14913 QCmask
= intern (":mask");
14914 staticpro (&QCmask
);
14916 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
14917 staticpro (&Qface_set_after_frame_default
);
14919 Fput (Qundefined_color
, Qerror_conditions
,
14920 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
14921 Fput (Qundefined_color
, Qerror_message
,
14922 build_string ("Undefined color"));
14924 staticpro (&w32_grabbed_keys
);
14925 w32_grabbed_keys
= Qnil
;
14927 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
14928 doc
: /* An array of color name mappings for windows. */);
14929 Vw32_color_map
= Qnil
;
14931 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
14932 doc
: /* Non-nil if alt key presses are passed on to Windows.
14933 When non-nil, for example, alt pressed and released and then space will
14934 open the System menu. When nil, Emacs silently swallows alt key events. */);
14935 Vw32_pass_alt_to_system
= Qnil
;
14937 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
14938 doc
: /* Non-nil if the alt key is to be considered the same as the meta key.
14939 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta. */);
14940 Vw32_alt_is_meta
= Qt
;
14942 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
14943 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
14944 XSETINT (Vw32_quit_key
, 0);
14946 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14947 &Vw32_pass_lwindow_to_system
,
14948 doc
: /* Non-nil if the left \"Windows\" key is passed on to Windows.
14949 When non-nil, the Start menu is opened by tapping the key. */);
14950 Vw32_pass_lwindow_to_system
= Qt
;
14952 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14953 &Vw32_pass_rwindow_to_system
,
14954 doc
: /* Non-nil if the right \"Windows\" key is passed on to Windows.
14955 When non-nil, the Start menu is opened by tapping the key. */);
14956 Vw32_pass_rwindow_to_system
= Qt
;
14958 DEFVAR_INT ("w32-phantom-key-code",
14959 &Vw32_phantom_key_code
,
14960 doc
: /* Virtual key code used to generate \"phantom\" key presses.
14961 Value is a number between 0 and 255.
14963 Phantom key presses are generated in order to stop the system from
14964 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
14965 `w32-pass-rwindow-to-system' is nil. */);
14966 /* Although 255 is technically not a valid key code, it works and
14967 means that this hack won't interfere with any real key code. */
14968 Vw32_phantom_key_code
= 255;
14970 DEFVAR_LISP ("w32-enable-num-lock",
14971 &Vw32_enable_num_lock
,
14972 doc
: /* Non-nil if Num Lock should act normally.
14973 Set to nil to see Num Lock as the key `kp-numlock'. */);
14974 Vw32_enable_num_lock
= Qt
;
14976 DEFVAR_LISP ("w32-enable-caps-lock",
14977 &Vw32_enable_caps_lock
,
14978 doc
: /* Non-nil if Caps Lock should act normally.
14979 Set to nil to see Caps Lock as the key `capslock'. */);
14980 Vw32_enable_caps_lock
= Qt
;
14982 DEFVAR_LISP ("w32-scroll-lock-modifier",
14983 &Vw32_scroll_lock_modifier
,
14984 doc
: /* Modifier to use for the Scroll Lock on state.
14985 The value can be hyper, super, meta, alt, control or shift for the
14986 respective modifier, or nil to see Scroll Lock as the key `scroll'.
14987 Any other value will cause the key to be ignored. */);
14988 Vw32_scroll_lock_modifier
= Qt
;
14990 DEFVAR_LISP ("w32-lwindow-modifier",
14991 &Vw32_lwindow_modifier
,
14992 doc
: /* Modifier to use for the left \"Windows\" key.
14993 The value can be hyper, super, meta, alt, control or shift for the
14994 respective modifier, or nil to appear as the key `lwindow'.
14995 Any other value will cause the key to be ignored. */);
14996 Vw32_lwindow_modifier
= Qnil
;
14998 DEFVAR_LISP ("w32-rwindow-modifier",
14999 &Vw32_rwindow_modifier
,
15000 doc
: /* Modifier to use for the right \"Windows\" key.
15001 The value can be hyper, super, meta, alt, control or shift for the
15002 respective modifier, or nil to appear as the key `rwindow'.
15003 Any other value will cause the key to be ignored. */);
15004 Vw32_rwindow_modifier
= Qnil
;
15006 DEFVAR_LISP ("w32-apps-modifier",
15007 &Vw32_apps_modifier
,
15008 doc
: /* Modifier to use for the \"Apps\" key.
15009 The value can be hyper, super, meta, alt, control or shift for the
15010 respective modifier, or nil to appear as the key `apps'.
15011 Any other value will cause the key to be ignored. */);
15012 Vw32_apps_modifier
= Qnil
;
15014 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts
,
15015 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
15016 w32_enable_synthesized_fonts
= 0;
15018 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
15019 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
15020 Vw32_enable_palette
= Qt
;
15022 DEFVAR_INT ("w32-mouse-button-tolerance",
15023 &Vw32_mouse_button_tolerance
,
15024 doc
: /* Analogue of double click interval for faking middle mouse events.
15025 The value is the minimum time in milliseconds that must elapse between
15026 left/right button down events before they are considered distinct events.
15027 If both mouse buttons are depressed within this interval, a middle mouse
15028 button down event is generated instead. */);
15029 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
15031 DEFVAR_INT ("w32-mouse-move-interval",
15032 &Vw32_mouse_move_interval
,
15033 doc
: /* Minimum interval between mouse move events.
15034 The value is the minimum time in milliseconds that must elapse between
15035 successive mouse move (or scroll bar drag) events before they are
15036 reported as lisp events. */);
15037 XSETINT (Vw32_mouse_move_interval
, 0);
15039 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
15040 &w32_pass_extra_mouse_buttons_to_system
,
15041 doc
: /* Non-nil if the fourth and fifth mouse buttons are passed to Windows.
15042 Recent versions of Windows support mice with up to five buttons.
15043 Since most applications don't support these extra buttons, most mouse
15044 drivers will allow you to map them to functions at the system level.
15045 If this variable is non-nil, Emacs will pass them on, allowing the
15046 system to handle them. */);
15047 w32_pass_extra_mouse_buttons_to_system
= 0;
15049 init_x_parm_symbols ();
15051 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
15052 doc
: /* List of directories to search for bitmap files for w32. */);
15053 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
15055 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
15056 doc
: /* The shape of the pointer when over text.
15057 Changing the value does not affect existing frames
15058 unless you set the mouse color. */);
15059 Vx_pointer_shape
= Qnil
;
15061 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
15062 doc
: /* The name Emacs uses to look up resources; for internal use only.
15063 `x-get-resource' uses this as the first component of the instance name
15064 when requesting resource values.
15065 Emacs initially sets `x-resource-name' to the name under which Emacs
15066 was invoked, or to the value specified with the `-name' or `-rn'
15067 switches, if present. */);
15068 Vx_resource_name
= Qnil
;
15070 Vx_nontext_pointer_shape
= Qnil
;
15072 Vx_mode_pointer_shape
= Qnil
;
15074 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
15075 doc
: /* The shape of the pointer when Emacs is busy.
15076 This variable takes effect when you create a new frame
15077 or when you set the mouse color. */);
15078 Vx_hourglass_pointer_shape
= Qnil
;
15080 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
15081 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
15082 display_hourglass_p
= 1;
15084 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
15085 doc
: /* *Seconds to wait before displaying an hourglass pointer.
15086 Value must be an integer or float. */);
15087 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
15089 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
15090 &Vx_sensitive_text_pointer_shape
,
15091 doc
: /* The shape of the pointer when over mouse-sensitive text.
15092 This variable takes effect when you create a new frame
15093 or when you set the mouse color. */);
15094 Vx_sensitive_text_pointer_shape
= Qnil
;
15096 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
15097 &Vx_window_horizontal_drag_shape
,
15098 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
15099 This variable takes effect when you create a new frame
15100 or when you set the mouse color. */);
15101 Vx_window_horizontal_drag_shape
= Qnil
;
15103 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
15104 doc
: /* A string indicating the foreground color of the cursor box. */);
15105 Vx_cursor_fore_pixel
= Qnil
;
15107 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
15108 doc
: /* Maximum size for tooltips.
15109 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
15110 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
15112 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
15113 doc
: /* Non-nil if no window manager is in use.
15114 Emacs doesn't try to figure this out; this is always nil
15115 unless you set it to something else. */);
15116 /* We don't have any way to find this out, so set it to nil
15117 and maybe the user would like to set it to t. */
15118 Vx_no_window_manager
= Qnil
;
15120 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
15121 &Vx_pixel_size_width_font_regexp
,
15122 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
15124 Since Emacs gets width of a font matching with this regexp from
15125 PIXEL_SIZE field of the name, font finding mechanism gets faster for
15126 such a font. This is especially effective for such large fonts as
15127 Chinese, Japanese, and Korean. */);
15128 Vx_pixel_size_width_font_regexp
= Qnil
;
15130 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
15131 doc
: /* Time after which cached images are removed from the cache.
15132 When an image has not been displayed this many seconds, remove it
15133 from the image cache. Value must be an integer or nil with nil
15134 meaning don't clear the cache. */);
15135 Vimage_cache_eviction_delay
= make_number (30 * 60);
15137 DEFVAR_LISP ("w32-bdf-filename-alist",
15138 &Vw32_bdf_filename_alist
,
15139 doc
: /* List of bdf fonts and their corresponding filenames. */);
15140 Vw32_bdf_filename_alist
= Qnil
;
15142 DEFVAR_BOOL ("w32-strict-fontnames",
15143 &w32_strict_fontnames
,
15144 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
15145 Default is nil, which allows old fontnames that are not XLFD compliant,
15146 and allows third-party CJK display to work by specifying false charset
15147 fields to trick Emacs into translating to Big5, SJIS etc.
15148 Setting this to t will prevent wrong fonts being selected when
15149 fontsets are automatically created. */);
15150 w32_strict_fontnames
= 0;
15152 DEFVAR_BOOL ("w32-strict-painting",
15153 &w32_strict_painting
,
15154 doc
: /* Non-nil means use strict rules for repainting frames.
15155 Set this to nil to get the old behaviour for repainting; this should
15156 only be necessary if the default setting causes problems. */);
15157 w32_strict_painting
= 1;
15159 DEFVAR_LISP ("w32-charset-info-alist",
15160 &Vw32_charset_info_alist
,
15161 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
15162 Each entry should be of the form:
15164 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
15166 where CHARSET_NAME is a string used in font names to identify the charset,
15167 WINDOWS_CHARSET is a symbol that can be one of:
15168 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
15169 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
15170 w32-charset-chinesebig5,
15171 #ifdef JOHAB_CHARSET
15172 w32-charset-johab, w32-charset-hebrew,
15173 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
15174 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
15175 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
15177 #ifdef UNICODE_CHARSET
15178 w32-charset-unicode,
15180 or w32-charset-oem.
15181 CODEPAGE should be an integer specifying the codepage that should be used
15182 to display the character set, t to do no translation and output as Unicode,
15183 or nil to do no translation and output as 8 bit (or multibyte on far-east
15184 versions of Windows) characters. */);
15185 Vw32_charset_info_alist
= Qnil
;
15187 staticpro (&Qw32_charset_ansi
);
15188 Qw32_charset_ansi
= intern ("w32-charset-ansi");
15189 staticpro (&Qw32_charset_symbol
);
15190 Qw32_charset_symbol
= intern ("w32-charset-symbol");
15191 staticpro (&Qw32_charset_shiftjis
);
15192 Qw32_charset_shiftjis
= intern ("w32-charset-shiftjis");
15193 staticpro (&Qw32_charset_hangeul
);
15194 Qw32_charset_hangeul
= intern ("w32-charset-hangeul");
15195 staticpro (&Qw32_charset_chinesebig5
);
15196 Qw32_charset_chinesebig5
= intern ("w32-charset-chinesebig5");
15197 staticpro (&Qw32_charset_gb2312
);
15198 Qw32_charset_gb2312
= intern ("w32-charset-gb2312");
15199 staticpro (&Qw32_charset_oem
);
15200 Qw32_charset_oem
= intern ("w32-charset-oem");
15202 #ifdef JOHAB_CHARSET
15204 static int w32_extra_charsets_defined
= 1;
15205 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
15206 doc
: /* Internal variable. */);
15208 staticpro (&Qw32_charset_johab
);
15209 Qw32_charset_johab
= intern ("w32-charset-johab");
15210 staticpro (&Qw32_charset_easteurope
);
15211 Qw32_charset_easteurope
= intern ("w32-charset-easteurope");
15212 staticpro (&Qw32_charset_turkish
);
15213 Qw32_charset_turkish
= intern ("w32-charset-turkish");
15214 staticpro (&Qw32_charset_baltic
);
15215 Qw32_charset_baltic
= intern ("w32-charset-baltic");
15216 staticpro (&Qw32_charset_russian
);
15217 Qw32_charset_russian
= intern ("w32-charset-russian");
15218 staticpro (&Qw32_charset_arabic
);
15219 Qw32_charset_arabic
= intern ("w32-charset-arabic");
15220 staticpro (&Qw32_charset_greek
);
15221 Qw32_charset_greek
= intern ("w32-charset-greek");
15222 staticpro (&Qw32_charset_hebrew
);
15223 Qw32_charset_hebrew
= intern ("w32-charset-hebrew");
15224 staticpro (&Qw32_charset_vietnamese
);
15225 Qw32_charset_vietnamese
= intern ("w32-charset-vietnamese");
15226 staticpro (&Qw32_charset_thai
);
15227 Qw32_charset_thai
= intern ("w32-charset-thai");
15228 staticpro (&Qw32_charset_mac
);
15229 Qw32_charset_mac
= intern ("w32-charset-mac");
15233 #ifdef UNICODE_CHARSET
15235 static int w32_unicode_charset_defined
= 1;
15236 DEFVAR_BOOL ("w32-unicode-charset-defined",
15237 &w32_unicode_charset_defined
,
15238 doc
: /* Internal variable. */);
15240 staticpro (&Qw32_charset_unicode
);
15241 Qw32_charset_unicode
= intern ("w32-charset-unicode");
15244 defsubr (&Sx_get_resource
);
15245 #if 0 /* TODO: Port to W32 */
15246 defsubr (&Sx_change_window_property
);
15247 defsubr (&Sx_delete_window_property
);
15248 defsubr (&Sx_window_property
);
15250 defsubr (&Sxw_display_color_p
);
15251 defsubr (&Sx_display_grayscale_p
);
15252 defsubr (&Sxw_color_defined_p
);
15253 defsubr (&Sxw_color_values
);
15254 defsubr (&Sx_server_max_request_size
);
15255 defsubr (&Sx_server_vendor
);
15256 defsubr (&Sx_server_version
);
15257 defsubr (&Sx_display_pixel_width
);
15258 defsubr (&Sx_display_pixel_height
);
15259 defsubr (&Sx_display_mm_width
);
15260 defsubr (&Sx_display_mm_height
);
15261 defsubr (&Sx_display_screens
);
15262 defsubr (&Sx_display_planes
);
15263 defsubr (&Sx_display_color_cells
);
15264 defsubr (&Sx_display_visual_class
);
15265 defsubr (&Sx_display_backing_store
);
15266 defsubr (&Sx_display_save_under
);
15267 defsubr (&Sx_parse_geometry
);
15268 defsubr (&Sx_create_frame
);
15269 defsubr (&Sx_open_connection
);
15270 defsubr (&Sx_close_connection
);
15271 defsubr (&Sx_display_list
);
15272 defsubr (&Sx_synchronize
);
15274 /* W32 specific functions */
15276 defsubr (&Sw32_focus_frame
);
15277 defsubr (&Sw32_select_font
);
15278 defsubr (&Sw32_define_rgb_color
);
15279 defsubr (&Sw32_default_color_map
);
15280 defsubr (&Sw32_load_color_file
);
15281 defsubr (&Sw32_send_sys_command
);
15282 defsubr (&Sw32_shell_execute
);
15283 defsubr (&Sw32_register_hot_key
);
15284 defsubr (&Sw32_unregister_hot_key
);
15285 defsubr (&Sw32_registered_hot_keys
);
15286 defsubr (&Sw32_reconstruct_hot_key
);
15287 defsubr (&Sw32_toggle_lock_key
);
15288 defsubr (&Sw32_find_bdf_fonts
);
15290 defsubr (&Sfile_system_info
);
15292 /* Setting callback functions for fontset handler. */
15293 get_font_info_func
= w32_get_font_info
;
15295 #if 0 /* This function pointer doesn't seem to be used anywhere.
15296 And the pointer assigned has the wrong type, anyway. */
15297 list_fonts_func
= w32_list_fonts
;
15300 load_font_func
= w32_load_font
;
15301 find_ccl_program_func
= w32_find_ccl_program
;
15302 query_font_func
= w32_query_font
;
15303 set_frame_fontset_func
= x_set_font
;
15304 check_window_system_func
= check_w32
;
15307 Qxbm
= intern ("xbm");
15309 QCconversion
= intern (":conversion");
15310 staticpro (&QCconversion
);
15311 QCheuristic_mask
= intern (":heuristic-mask");
15312 staticpro (&QCheuristic_mask
);
15313 QCcolor_symbols
= intern (":color-symbols");
15314 staticpro (&QCcolor_symbols
);
15315 QCascent
= intern (":ascent");
15316 staticpro (&QCascent
);
15317 QCmargin
= intern (":margin");
15318 staticpro (&QCmargin
);
15319 QCrelief
= intern (":relief");
15320 staticpro (&QCrelief
);
15321 Qpostscript
= intern ("postscript");
15322 staticpro (&Qpostscript
);
15323 #if 0 /* TODO: These need entries at top of file. */
15324 QCloader
= intern (":loader");
15325 staticpro (&QCloader
);
15326 QCbounding_box
= intern (":bounding-box");
15327 staticpro (&QCbounding_box
);
15328 QCpt_width
= intern (":pt-width");
15329 staticpro (&QCpt_width
);
15330 QCpt_height
= intern (":pt-height");
15331 staticpro (&QCpt_height
);
15333 QCindex
= intern (":index");
15334 staticpro (&QCindex
);
15335 Qpbm
= intern ("pbm");
15339 Qxpm
= intern ("xpm");
15344 Qjpeg
= intern ("jpeg");
15345 staticpro (&Qjpeg
);
15349 Qtiff
= intern ("tiff");
15350 staticpro (&Qtiff
);
15354 Qgif
= intern ("gif");
15359 Qpng
= intern ("png");
15363 defsubr (&Sclear_image_cache
);
15364 defsubr (&Simage_size
);
15365 defsubr (&Simage_mask_p
);
15368 defsubr (&Simagep
);
15369 defsubr (&Slookup_image
);
15372 hourglass_atimer
= NULL
;
15373 hourglass_shown_p
= 0;
15374 defsubr (&Sx_show_tip
);
15375 defsubr (&Sx_hide_tip
);
15377 staticpro (&tip_timer
);
15379 staticpro (&tip_frame
);
15381 last_show_tip_args
= Qnil
;
15382 staticpro (&last_show_tip_args
);
15384 defsubr (&Sx_file_dialog
);
15391 image_types
= NULL
;
15392 Vimage_types
= Qnil
;
15394 define_image_type (&pbm_type
);
15395 define_image_type (&xbm_type
);
15396 #if 0 /* TODO : Image support for W32 */
15397 define_image_type (&gs_type
);
15401 define_image_type (&xpm_type
);
15405 define_image_type (&jpeg_type
);
15409 define_image_type (&tiff_type
);
15413 define_image_type (&gif_type
);
15417 define_image_type (&png_type
);
15427 button
= MessageBox (NULL
,
15428 "A fatal error has occurred!\n\n"
15429 "Select Abort to exit, Retry to debug, Ignore to continue",
15430 "Emacs Abort Dialog",
15431 MB_ICONEXCLAMATION
| MB_TASKMODAL
15432 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
15447 /* For convenience when debugging. */
15451 return GetLastError ();