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 void syms_of_w32fns ();
59 void globals_of_w32fns ();
60 static void init_external_image_libraries ();
62 extern void free_frame_menubar ();
63 extern void x_compute_fringe_widths
P_ ((struct frame
*, int));
64 extern double atof ();
65 extern int w32_console_toggle_lock_key
P_ ((int, Lisp_Object
));
66 extern void w32_menu_display_help
P_ ((HWND
, HMENU
, UINT
, UINT
));
67 extern void w32_free_menu_strings
P_ ((HWND
));
71 extern char *lispy_function_keys
[];
73 /* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
74 it, and including `bitmaps/gray' more than once is a problem when
75 config.h defines `static' as an empty replacement string. */
77 int gray_bitmap_width
= gray_width
;
78 int gray_bitmap_height
= gray_height
;
79 unsigned char *gray_bitmap_bits
= gray_bits
;
81 /* The colormap for converting color names to RGB values */
82 Lisp_Object Vw32_color_map
;
84 /* Non nil if alt key presses are passed on to Windows. */
85 Lisp_Object Vw32_pass_alt_to_system
;
87 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
89 Lisp_Object Vw32_alt_is_meta
;
91 /* If non-zero, the windows virtual key code for an alternative quit key. */
92 Lisp_Object Vw32_quit_key
;
94 /* Non nil if left window key events are passed on to Windows (this only
95 affects whether "tapping" the key opens the Start menu). */
96 Lisp_Object Vw32_pass_lwindow_to_system
;
98 /* Non nil if right window key events are passed on to Windows (this
99 only affects whether "tapping" the key opens the Start menu). */
100 Lisp_Object Vw32_pass_rwindow_to_system
;
102 /* Virtual key code used to generate "phantom" key presses in order
103 to stop system from acting on Windows key events. */
104 Lisp_Object Vw32_phantom_key_code
;
106 /* Modifier associated with the left "Windows" key, or nil to act as a
108 Lisp_Object Vw32_lwindow_modifier
;
110 /* Modifier associated with the right "Windows" key, or nil to act as a
112 Lisp_Object Vw32_rwindow_modifier
;
114 /* Modifier associated with the "Apps" key, or nil to act as a normal
116 Lisp_Object Vw32_apps_modifier
;
118 /* Value is nil if Num Lock acts as a function key. */
119 Lisp_Object Vw32_enable_num_lock
;
121 /* Value is nil if Caps Lock acts as a function key. */
122 Lisp_Object Vw32_enable_caps_lock
;
124 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
125 Lisp_Object Vw32_scroll_lock_modifier
;
127 /* Switch to control whether we inhibit requests for synthesized bold
128 and italic versions of fonts. */
129 int w32_enable_synthesized_fonts
;
131 /* Enable palette management. */
132 Lisp_Object Vw32_enable_palette
;
134 /* Control how close left/right button down events must be to
135 be converted to a middle button down event. */
136 Lisp_Object Vw32_mouse_button_tolerance
;
138 /* Minimum interval between mouse movement (and scroll bar drag)
139 events that are passed on to the event loop. */
140 Lisp_Object Vw32_mouse_move_interval
;
142 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
143 int w32_pass_extra_mouse_buttons_to_system
;
145 /* The name we're using in resource queries. */
146 Lisp_Object Vx_resource_name
;
148 /* Non nil if no window manager is in use. */
149 Lisp_Object Vx_no_window_manager
;
151 /* Non-zero means we're allowed to display a hourglass pointer. */
153 int display_hourglass_p
;
155 /* The background and shape of the mouse pointer, and shape when not
156 over text or in the modeline. */
158 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
159 Lisp_Object Vx_hourglass_pointer_shape
, Vx_window_horizontal_drag_shape
, Vx_hand_shape
;
161 /* The shape when over mouse-sensitive text. */
163 Lisp_Object Vx_sensitive_text_pointer_shape
;
166 #define IDC_HAND MAKEINTRESOURCE(32649)
169 /* Color of chars displayed in cursor box. */
171 Lisp_Object Vx_cursor_fore_pixel
;
173 /* Nonzero if using Windows. */
175 static int w32_in_use
;
177 /* Search path for bitmap files. */
179 Lisp_Object Vx_bitmap_file_path
;
181 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
183 Lisp_Object Vx_pixel_size_width_font_regexp
;
185 /* Alist of bdf fonts and the files that define them. */
186 Lisp_Object Vw32_bdf_filename_alist
;
188 /* A flag to control whether fonts are matched strictly or not. */
189 int w32_strict_fontnames
;
191 /* A flag to control whether we should only repaint if GetUpdateRect
192 indicates there is an update region. */
193 int w32_strict_painting
;
195 /* Associative list linking character set strings to Windows codepages. */
196 Lisp_Object Vw32_charset_info_alist
;
198 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
199 #ifndef VIETNAMESE_CHARSET
200 #define VIETNAMESE_CHARSET 163
203 Lisp_Object Qauto_raise
;
204 Lisp_Object Qauto_lower
;
205 Lisp_Object Qborder_color
;
206 Lisp_Object Qborder_width
;
207 extern Lisp_Object Qbox
;
208 Lisp_Object Qcursor_color
;
209 Lisp_Object Qcursor_type
;
210 Lisp_Object Qgeometry
;
211 Lisp_Object Qicon_left
;
212 Lisp_Object Qicon_top
;
213 Lisp_Object Qicon_type
;
214 Lisp_Object Qicon_name
;
215 Lisp_Object Qinternal_border_width
;
218 Lisp_Object Qmouse_color
;
220 Lisp_Object Qparent_id
;
221 Lisp_Object Qscroll_bar_width
;
222 Lisp_Object Qsuppress_icon
;
223 Lisp_Object Qundefined_color
;
224 Lisp_Object Qvertical_scroll_bars
;
225 Lisp_Object Qvisibility
;
226 Lisp_Object Qwindow_id
;
227 Lisp_Object Qx_frame_parameter
;
228 Lisp_Object Qx_resource_name
;
229 Lisp_Object Quser_position
;
230 Lisp_Object Quser_size
;
231 Lisp_Object Qscreen_gamma
;
232 Lisp_Object Qline_spacing
;
234 Lisp_Object Qcancel_timer
;
240 Lisp_Object Qcontrol
;
243 Lisp_Object Qw32_charset_ansi
;
244 Lisp_Object Qw32_charset_default
;
245 Lisp_Object Qw32_charset_symbol
;
246 Lisp_Object Qw32_charset_shiftjis
;
247 Lisp_Object Qw32_charset_hangeul
;
248 Lisp_Object Qw32_charset_gb2312
;
249 Lisp_Object Qw32_charset_chinesebig5
;
250 Lisp_Object Qw32_charset_oem
;
252 #ifndef JOHAB_CHARSET
253 #define JOHAB_CHARSET 130
256 Lisp_Object Qw32_charset_easteurope
;
257 Lisp_Object Qw32_charset_turkish
;
258 Lisp_Object Qw32_charset_baltic
;
259 Lisp_Object Qw32_charset_russian
;
260 Lisp_Object Qw32_charset_arabic
;
261 Lisp_Object Qw32_charset_greek
;
262 Lisp_Object Qw32_charset_hebrew
;
263 Lisp_Object Qw32_charset_vietnamese
;
264 Lisp_Object Qw32_charset_thai
;
265 Lisp_Object Qw32_charset_johab
;
266 Lisp_Object Qw32_charset_mac
;
269 #ifdef UNICODE_CHARSET
270 Lisp_Object Qw32_charset_unicode
;
273 Lisp_Object Qfullscreen
;
274 Lisp_Object Qfullwidth
;
275 Lisp_Object Qfullheight
;
276 Lisp_Object Qfullboth
;
278 extern Lisp_Object Qtop
;
279 extern Lisp_Object Qdisplay
;
281 /* State variables for emulating a three button mouse. */
286 static int button_state
= 0;
287 static W32Msg saved_mouse_button_msg
;
288 static unsigned mouse_button_timer
= 0; /* non-zero when timer is active */
289 static W32Msg saved_mouse_move_msg
;
290 static unsigned mouse_move_timer
= 0;
292 /* Window that is tracking the mouse. */
293 static HWND track_mouse_window
;
295 typedef BOOL (WINAPI
* TrackMouseEvent_Proc
) (
296 IN OUT LPTRACKMOUSEEVENT lpEventTrack
299 TrackMouseEvent_Proc track_mouse_event_fn
=NULL
;
301 /* W95 mousewheel handler */
302 unsigned int msh_mousewheel
= 0;
305 #define MOUSE_BUTTON_ID 1
306 #define MOUSE_MOVE_ID 2
307 #define MENU_FREE_ID 3
308 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
310 #define MENU_FREE_DELAY 1000
311 static unsigned menu_free_timer
= 0;
313 /* The below are defined in frame.c. */
315 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
316 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
317 extern Lisp_Object Qtool_bar_lines
;
319 extern Lisp_Object Vwindow_system_version
;
321 Lisp_Object Qface_set_after_frame_default
;
324 int image_cache_refcount
, dpyinfo_refcount
;
328 /* From w32term.c. */
329 extern Lisp_Object Vw32_num_mouse_buttons
;
330 extern Lisp_Object Vw32_recognize_altgr
;
332 extern HWND w32_system_caret_hwnd
;
334 extern int w32_system_caret_height
;
335 extern int w32_system_caret_x
;
336 extern int w32_system_caret_y
;
337 extern int w32_use_visible_system_caret
;
339 static HWND w32_visible_system_caret_hwnd
;
342 /* Error if we are not connected to MS-Windows. */
347 error ("MS-Windows not in use or not initialized");
350 /* Nonzero if we can use mouse menus.
351 You should not call this unless HAVE_MENUS is defined. */
359 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
360 and checking validity for W32. */
363 check_x_frame (frame
)
369 frame
= selected_frame
;
370 CHECK_LIVE_FRAME (frame
);
372 if (! FRAME_W32_P (f
))
373 error ("non-w32 frame used");
377 /* Let the user specify a display with a frame.
378 nil stands for the selected frame--or, if that is not a w32 frame,
379 the first display on the list. */
381 static struct w32_display_info
*
382 check_x_display_info (frame
)
387 struct frame
*sf
= XFRAME (selected_frame
);
389 if (FRAME_W32_P (sf
) && FRAME_LIVE_P (sf
))
390 return FRAME_W32_DISPLAY_INFO (sf
);
392 return &one_w32_display_info
;
394 else if (STRINGP (frame
))
395 return x_display_info_for_name (frame
);
400 CHECK_LIVE_FRAME (frame
);
402 if (! FRAME_W32_P (f
))
403 error ("non-w32 frame used");
404 return FRAME_W32_DISPLAY_INFO (f
);
408 /* Return the Emacs frame-object corresponding to an w32 window.
409 It could be the frame's main window or an icon window. */
411 /* This function can be called during GC, so use GC_xxx type test macros. */
414 x_window_to_frame (dpyinfo
, wdesc
)
415 struct w32_display_info
*dpyinfo
;
418 Lisp_Object tail
, frame
;
421 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
424 if (!GC_FRAMEP (frame
))
427 if (!FRAME_W32_P (f
) || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
429 if (f
->output_data
.w32
->hourglass_window
== wdesc
)
432 if (FRAME_W32_WINDOW (f
) == wdesc
)
440 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
441 id, which is just an int that this section returns. Bitmaps are
442 reference counted so they can be shared among frames.
444 Bitmap indices are guaranteed to be > 0, so a negative number can
445 be used to indicate no bitmap.
447 If you use x_create_bitmap_from_data, then you must keep track of
448 the bitmaps yourself. That is, creating a bitmap from the same
449 data more than once will not be caught. */
452 /* Functions to access the contents of a bitmap, given an id. */
455 x_bitmap_height (f
, id
)
459 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
463 x_bitmap_width (f
, id
)
467 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
471 x_bitmap_pixmap (f
, id
)
475 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
479 /* Allocate a new bitmap record. Returns index of new record. */
482 x_allocate_bitmap_record (f
)
485 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
488 if (dpyinfo
->bitmaps
== NULL
)
490 dpyinfo
->bitmaps_size
= 10;
492 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
493 dpyinfo
->bitmaps_last
= 1;
497 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
498 return ++dpyinfo
->bitmaps_last
;
500 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
501 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
504 dpyinfo
->bitmaps_size
*= 2;
506 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
507 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
508 return ++dpyinfo
->bitmaps_last
;
511 /* Add one reference to the reference count of the bitmap with id ID. */
514 x_reference_bitmap (f
, id
)
518 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
521 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
524 x_create_bitmap_from_data (f
, bits
, width
, height
)
527 unsigned int width
, height
;
529 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
533 bitmap
= CreateBitmap (width
, height
,
534 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
535 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
541 id
= x_allocate_bitmap_record (f
);
542 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
543 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
544 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
545 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
546 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
547 dpyinfo
->bitmaps
[id
- 1].height
= height
;
548 dpyinfo
->bitmaps
[id
- 1].width
= width
;
553 /* Create bitmap from file FILE for frame F. */
556 x_create_bitmap_from_file (f
, file
)
561 #if 0 /* TODO : bitmap support */
562 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
563 unsigned int width
, height
;
565 int xhot
, yhot
, result
, id
;
571 /* Look for an existing bitmap with the same name. */
572 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
574 if (dpyinfo
->bitmaps
[id
].refcount
575 && dpyinfo
->bitmaps
[id
].file
576 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) SDATA (file
)))
578 ++dpyinfo
->bitmaps
[id
].refcount
;
583 /* Search bitmap-file-path for the file, if appropriate. */
584 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, Qnil
);
589 filename
= (char *) SDATA (found
);
591 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
597 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
598 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
599 if (result
!= BitmapSuccess
)
602 id
= x_allocate_bitmap_record (f
);
603 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
604 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
605 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (SCHARS (file
) + 1);
606 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
607 dpyinfo
->bitmaps
[id
- 1].height
= height
;
608 dpyinfo
->bitmaps
[id
- 1].width
= width
;
609 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, SDATA (file
));
615 /* Remove reference to bitmap with id number ID. */
618 x_destroy_bitmap (f
, id
)
622 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
626 --dpyinfo
->bitmaps
[id
- 1].refcount
;
627 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
630 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
631 if (dpyinfo
->bitmaps
[id
- 1].file
)
633 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
634 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
641 /* Free all the bitmaps for the display specified by DPYINFO. */
644 x_destroy_all_bitmaps (dpyinfo
)
645 struct w32_display_info
*dpyinfo
;
648 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
649 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
651 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
652 if (dpyinfo
->bitmaps
[i
].file
)
653 xfree (dpyinfo
->bitmaps
[i
].file
);
655 dpyinfo
->bitmaps_last
= 0;
658 /* Connect the frame-parameter names for W32 frames
659 to the ways of passing the parameter values to the window system.
661 The name of a parameter, as a Lisp symbol,
662 has an `x-frame-parameter' property which is an integer in Lisp
663 but can be interpreted as an `enum x_frame_parm' in C. */
667 X_PARM_FOREGROUND_COLOR
,
668 X_PARM_BACKGROUND_COLOR
,
675 X_PARM_INTERNAL_BORDER_WIDTH
,
679 X_PARM_VERT_SCROLL_BAR
,
681 X_PARM_MENU_BAR_LINES
685 struct x_frame_parm_table
688 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
691 BOOL my_show_window
P_ ((struct frame
*, HWND
, int));
692 void my_set_window_pos
P_ ((HWND
, HWND
, int, int, int, int, UINT
));
693 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
694 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
695 static void x_change_window_heights
P_ ((Lisp_Object
, int));
696 /* TODO: Native Input Method support; see x_create_im. */
697 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
698 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
699 static void x_set_fullscreen
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
700 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
701 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
702 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
703 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
704 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
705 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
706 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
707 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
708 static void x_set_fringe_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
709 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
710 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
712 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
713 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
714 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
715 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
717 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
718 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
719 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
720 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
721 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
722 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
723 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
724 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
727 static struct x_frame_parm_table x_frame_parms
[] =
729 {"auto-raise", x_set_autoraise
},
730 {"auto-lower", x_set_autolower
},
731 {"background-color", x_set_background_color
},
732 {"border-color", x_set_border_color
},
733 {"border-width", x_set_border_width
},
734 {"cursor-color", x_set_cursor_color
},
735 {"cursor-type", x_set_cursor_type
},
736 {"font", x_set_font
},
737 {"foreground-color", x_set_foreground_color
},
738 {"icon-name", x_set_icon_name
},
739 {"icon-type", x_set_icon_type
},
740 {"internal-border-width", x_set_internal_border_width
},
741 {"menu-bar-lines", x_set_menu_bar_lines
},
742 {"mouse-color", x_set_mouse_color
},
743 {"name", x_explicitly_set_name
},
744 {"scroll-bar-width", x_set_scroll_bar_width
},
745 {"title", x_set_title
},
746 {"unsplittable", x_set_unsplittable
},
747 {"vertical-scroll-bars", x_set_vertical_scroll_bars
},
748 {"visibility", x_set_visibility
},
749 {"tool-bar-lines", x_set_tool_bar_lines
},
750 {"screen-gamma", x_set_screen_gamma
},
751 {"line-spacing", x_set_line_spacing
},
752 {"left-fringe", x_set_fringe_width
},
753 {"right-fringe", x_set_fringe_width
},
754 {"fullscreen", x_set_fullscreen
},
757 /* Attach the `x-frame-parameter' properties to
758 the Lisp symbol names of parameters relevant to W32. */
761 init_x_parm_symbols ()
765 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
766 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
770 /* Really try to move where we want to be in case of fullscreen. Some WMs
771 moves the window where we tell them. Some (mwm, twm) moves the outer
772 window manager window there instead.
773 Try to compensate for those WM here. */
775 x_fullscreen_move (f
, new_top
, new_left
)
780 if (new_top
!= f
->output_data
.w32
->top_pos
781 || new_left
!= f
->output_data
.w32
->left_pos
)
783 int move_x
= new_left
;
784 int move_y
= new_top
;
786 f
->output_data
.w32
->want_fullscreen
|= FULLSCREEN_MOVE_WAIT
;
787 x_set_offset (f
, move_x
, move_y
, 1);
791 /* Change the parameters of frame F as specified by ALIST.
792 If a parameter is not specially recognized, do nothing;
793 otherwise call the `x_set_...' function for that parameter. */
796 x_set_frame_parameters (f
, alist
)
802 /* If both of these parameters are present, it's more efficient to
803 set them both at once. So we wait until we've looked at the
804 entire list before we set them. */
808 Lisp_Object left
, top
;
810 /* Same with these. */
811 Lisp_Object icon_left
, icon_top
;
813 /* Record in these vectors all the parms specified. */
817 int left_no_change
= 0, top_no_change
= 0;
818 int icon_left_no_change
= 0, icon_top_no_change
= 0;
819 int fullscreen_is_being_set
= 0;
821 struct gcpro gcpro1
, gcpro2
;
824 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
827 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
828 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
830 /* Extract parm names and values into those vectors. */
833 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
838 parms
[i
] = Fcar (elt
);
839 values
[i
] = Fcdr (elt
);
842 /* TAIL and ALIST are not used again below here. */
845 GCPRO2 (*parms
, *values
);
849 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
850 because their values appear in VALUES and strings are not valid. */
851 top
= left
= Qunbound
;
852 icon_left
= icon_top
= Qunbound
;
854 /* Provide default values for HEIGHT and WIDTH. */
855 if (FRAME_NEW_WIDTH (f
))
856 width
= FRAME_NEW_WIDTH (f
);
858 width
= FRAME_WIDTH (f
);
860 if (FRAME_NEW_HEIGHT (f
))
861 height
= FRAME_NEW_HEIGHT (f
);
863 height
= FRAME_HEIGHT (f
);
865 /* Process foreground_color and background_color before anything else.
866 They are independent of other properties, but other properties (e.g.,
867 cursor_color) are dependent upon them. */
868 /* Process default font as well, since fringe widths depends on it. */
869 for (p
= 0; p
< i
; p
++)
871 Lisp_Object prop
, val
;
875 if (EQ (prop
, Qforeground_color
)
876 || EQ (prop
, Qbackground_color
)
878 || EQ (prop
, Qfullscreen
))
880 register Lisp_Object param_index
, old_value
;
882 old_value
= get_frame_param (f
, prop
);
883 fullscreen_is_being_set
|= EQ (prop
, Qfullscreen
);
885 if (NILP (Fequal (val
, old_value
)))
887 store_frame_param (f
, prop
, val
);
889 param_index
= Fget (prop
, Qx_frame_parameter
);
890 if (NATNUMP (param_index
)
891 && (XFASTINT (param_index
)
892 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
893 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
898 /* Now process them in reverse of specified order. */
899 for (i
--; i
>= 0; i
--)
901 Lisp_Object prop
, val
;
906 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
907 width
= XFASTINT (val
);
908 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
909 height
= XFASTINT (val
);
910 else if (EQ (prop
, Qtop
))
912 else if (EQ (prop
, Qleft
))
914 else if (EQ (prop
, Qicon_top
))
916 else if (EQ (prop
, Qicon_left
))
918 else if (EQ (prop
, Qforeground_color
)
919 || EQ (prop
, Qbackground_color
)
921 || EQ (prop
, Qfullscreen
))
922 /* Processed above. */
926 register Lisp_Object param_index
, old_value
;
928 old_value
= get_frame_param (f
, prop
);
930 store_frame_param (f
, prop
, val
);
932 param_index
= Fget (prop
, Qx_frame_parameter
);
933 if (NATNUMP (param_index
)
934 && (XFASTINT (param_index
)
935 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
936 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
940 /* Don't die if just one of these was set. */
941 if (EQ (left
, Qunbound
))
944 if (f
->output_data
.w32
->left_pos
< 0)
945 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
947 XSETINT (left
, f
->output_data
.w32
->left_pos
);
949 if (EQ (top
, Qunbound
))
952 if (f
->output_data
.w32
->top_pos
< 0)
953 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
955 XSETINT (top
, f
->output_data
.w32
->top_pos
);
958 /* If one of the icon positions was not set, preserve or default it. */
959 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
961 icon_left_no_change
= 1;
962 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
963 if (NILP (icon_left
))
964 XSETINT (icon_left
, 0);
966 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
968 icon_top_no_change
= 1;
969 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
971 XSETINT (icon_top
, 0);
974 if (FRAME_VISIBLE_P (f
) && fullscreen_is_being_set
)
976 /* If the frame is visible already and the fullscreen parameter is
977 being set, it is too late to set WM manager hints to specify
979 Here we first get the width, height and position that applies to
980 fullscreen. We then move the frame to the appropriate
981 position. Resize of the frame is taken care of in the code after
982 this if-statement. */
983 int new_left
, new_top
;
985 x_fullscreen_adjust (f
, &width
, &height
, &new_top
, &new_left
);
986 x_fullscreen_move (f
, new_top
, new_left
);
989 /* Don't set these parameters unless they've been explicitly
990 specified. The window might be mapped or resized while we're in
991 this function, and we don't want to override that unless the lisp
992 code has asked for it.
994 Don't set these parameters unless they actually differ from the
995 window's current parameters; the window may not actually exist
1000 check_frame_size (f
, &height
, &width
);
1002 XSETFRAME (frame
, f
);
1004 if (width
!= FRAME_WIDTH (f
)
1005 || height
!= FRAME_HEIGHT (f
)
1006 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1007 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1009 if ((!NILP (left
) || !NILP (top
))
1010 && ! (left_no_change
&& top_no_change
)
1011 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
1012 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
1017 /* Record the signs. */
1018 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1019 if (EQ (left
, Qminus
))
1020 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
1021 else if (INTEGERP (left
))
1023 leftpos
= XINT (left
);
1025 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
1027 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1028 && CONSP (XCDR (left
))
1029 && INTEGERP (XCAR (XCDR (left
))))
1031 leftpos
= - XINT (XCAR (XCDR (left
)));
1032 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
1034 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1035 && CONSP (XCDR (left
))
1036 && INTEGERP (XCAR (XCDR (left
))))
1038 leftpos
= XINT (XCAR (XCDR (left
)));
1041 if (EQ (top
, Qminus
))
1042 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
1043 else if (INTEGERP (top
))
1045 toppos
= XINT (top
);
1047 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
1049 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1050 && CONSP (XCDR (top
))
1051 && INTEGERP (XCAR (XCDR (top
))))
1053 toppos
= - XINT (XCAR (XCDR (top
)));
1054 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
1056 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1057 && CONSP (XCDR (top
))
1058 && INTEGERP (XCAR (XCDR (top
))))
1060 toppos
= XINT (XCAR (XCDR (top
)));
1064 /* Store the numeric value of the position. */
1065 f
->output_data
.w32
->top_pos
= toppos
;
1066 f
->output_data
.w32
->left_pos
= leftpos
;
1068 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
1070 /* Actually set that position, and convert to absolute. */
1071 x_set_offset (f
, leftpos
, toppos
, -1);
1074 if ((!NILP (icon_left
) || !NILP (icon_top
))
1075 && ! (icon_left_no_change
&& icon_top_no_change
))
1076 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1082 /* Store the screen positions of frame F into XPTR and YPTR.
1083 These are the positions of the containing window manager window,
1084 not Emacs's own window. */
1087 x_real_positions (f
, xptr
, yptr
)
1094 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
1095 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
1100 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
1102 /* Remember x_pixels_diff and y_pixels_diff. */
1103 f
->output_data
.w32
->x_pixels_diff
= pt
.x
- rect
.left
;
1104 f
->output_data
.w32
->y_pixels_diff
= pt
.y
- rect
.top
;
1110 /* Insert a description of internally-recorded parameters of frame X
1111 into the parameter alist *ALISTPTR that is to be given to the user.
1112 Only parameters that are specific to W32
1113 and whose values are not correctly recorded in the frame's
1114 param_alist need to be considered here. */
1117 x_report_frame_params (f
, alistptr
)
1119 Lisp_Object
*alistptr
;
1124 /* Represent negative positions (off the top or left screen edge)
1125 in a way that Fmodify_frame_parameters will understand correctly. */
1126 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
1127 if (f
->output_data
.w32
->left_pos
>= 0)
1128 store_in_alist (alistptr
, Qleft
, tem
);
1130 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1132 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
1133 if (f
->output_data
.w32
->top_pos
>= 0)
1134 store_in_alist (alistptr
, Qtop
, tem
);
1136 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1138 store_in_alist (alistptr
, Qborder_width
,
1139 make_number (f
->output_data
.w32
->border_width
));
1140 store_in_alist (alistptr
, Qinternal_border_width
,
1141 make_number (f
->output_data
.w32
->internal_border_width
));
1142 store_in_alist (alistptr
, Qleft_fringe
,
1143 make_number (f
->output_data
.w32
->left_fringe_width
));
1144 store_in_alist (alistptr
, Qright_fringe
,
1145 make_number (f
->output_data
.w32
->right_fringe_width
));
1146 store_in_alist (alistptr
, Qscroll_bar_width
,
1147 make_number (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1148 ? FRAME_SCROLL_BAR_PIXEL_WIDTH(f
)
1150 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
1151 store_in_alist (alistptr
, Qwindow_id
,
1152 build_string (buf
));
1153 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1154 FRAME_SAMPLE_VISIBILITY (f
);
1155 store_in_alist (alistptr
, Qvisibility
,
1156 (FRAME_VISIBLE_P (f
) ? Qt
1157 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1158 store_in_alist (alistptr
, Qdisplay
,
1159 XCAR (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
));
1163 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
,
1164 Sw32_define_rgb_color
, 4, 4, 0,
1165 doc
: /* Convert RGB numbers to a windows color reference and associate with NAME.
1166 This adds or updates a named color to w32-color-map, making it
1167 available for use. The original entry's RGB ref is returned, or nil
1168 if the entry is new. */)
1169 (red
, green
, blue
, name
)
1170 Lisp_Object red
, green
, blue
, name
;
1173 Lisp_Object oldrgb
= Qnil
;
1177 CHECK_NUMBER (green
);
1178 CHECK_NUMBER (blue
);
1179 CHECK_STRING (name
);
1181 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
1185 /* replace existing entry in w32-color-map or add new entry. */
1186 entry
= Fassoc (name
, Vw32_color_map
);
1189 entry
= Fcons (name
, rgb
);
1190 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
1194 oldrgb
= Fcdr (entry
);
1195 Fsetcdr (entry
, rgb
);
1203 DEFUN ("w32-load-color-file", Fw32_load_color_file
,
1204 Sw32_load_color_file
, 1, 1, 0,
1205 doc
: /* Create an alist of color entries from an external file.
1206 Assign this value to w32-color-map to replace the existing color map.
1208 The file should define one named RGB color per line like so:
1210 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
1212 Lisp_Object filename
;
1215 Lisp_Object cmap
= Qnil
;
1216 Lisp_Object abspath
;
1218 CHECK_STRING (filename
);
1219 abspath
= Fexpand_file_name (filename
, Qnil
);
1221 fp
= fopen (SDATA (filename
), "rt");
1225 int red
, green
, blue
;
1230 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
1231 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
1233 char *name
= buf
+ num
;
1234 num
= strlen (name
) - 1;
1235 if (name
[num
] == '\n')
1237 cmap
= Fcons (Fcons (build_string (name
),
1238 make_number (RGB (red
, green
, blue
))),
1250 /* The default colors for the w32 color map */
1251 typedef struct colormap_t
1257 colormap_t w32_color_map
[] =
1259 {"snow" , PALETTERGB (255,250,250)},
1260 {"ghost white" , PALETTERGB (248,248,255)},
1261 {"GhostWhite" , PALETTERGB (248,248,255)},
1262 {"white smoke" , PALETTERGB (245,245,245)},
1263 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1264 {"gainsboro" , PALETTERGB (220,220,220)},
1265 {"floral white" , PALETTERGB (255,250,240)},
1266 {"FloralWhite" , PALETTERGB (255,250,240)},
1267 {"old lace" , PALETTERGB (253,245,230)},
1268 {"OldLace" , PALETTERGB (253,245,230)},
1269 {"linen" , PALETTERGB (250,240,230)},
1270 {"antique white" , PALETTERGB (250,235,215)},
1271 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1272 {"papaya whip" , PALETTERGB (255,239,213)},
1273 {"PapayaWhip" , PALETTERGB (255,239,213)},
1274 {"blanched almond" , PALETTERGB (255,235,205)},
1275 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1276 {"bisque" , PALETTERGB (255,228,196)},
1277 {"peach puff" , PALETTERGB (255,218,185)},
1278 {"PeachPuff" , PALETTERGB (255,218,185)},
1279 {"navajo white" , PALETTERGB (255,222,173)},
1280 {"NavajoWhite" , PALETTERGB (255,222,173)},
1281 {"moccasin" , PALETTERGB (255,228,181)},
1282 {"cornsilk" , PALETTERGB (255,248,220)},
1283 {"ivory" , PALETTERGB (255,255,240)},
1284 {"lemon chiffon" , PALETTERGB (255,250,205)},
1285 {"LemonChiffon" , PALETTERGB (255,250,205)},
1286 {"seashell" , PALETTERGB (255,245,238)},
1287 {"honeydew" , PALETTERGB (240,255,240)},
1288 {"mint cream" , PALETTERGB (245,255,250)},
1289 {"MintCream" , PALETTERGB (245,255,250)},
1290 {"azure" , PALETTERGB (240,255,255)},
1291 {"alice blue" , PALETTERGB (240,248,255)},
1292 {"AliceBlue" , PALETTERGB (240,248,255)},
1293 {"lavender" , PALETTERGB (230,230,250)},
1294 {"lavender blush" , PALETTERGB (255,240,245)},
1295 {"LavenderBlush" , PALETTERGB (255,240,245)},
1296 {"misty rose" , PALETTERGB (255,228,225)},
1297 {"MistyRose" , PALETTERGB (255,228,225)},
1298 {"white" , PALETTERGB (255,255,255)},
1299 {"black" , PALETTERGB ( 0, 0, 0)},
1300 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1301 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1302 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1303 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1304 {"dim gray" , PALETTERGB (105,105,105)},
1305 {"DimGray" , PALETTERGB (105,105,105)},
1306 {"dim grey" , PALETTERGB (105,105,105)},
1307 {"DimGrey" , PALETTERGB (105,105,105)},
1308 {"slate gray" , PALETTERGB (112,128,144)},
1309 {"SlateGray" , PALETTERGB (112,128,144)},
1310 {"slate grey" , PALETTERGB (112,128,144)},
1311 {"SlateGrey" , PALETTERGB (112,128,144)},
1312 {"light slate gray" , PALETTERGB (119,136,153)},
1313 {"LightSlateGray" , PALETTERGB (119,136,153)},
1314 {"light slate grey" , PALETTERGB (119,136,153)},
1315 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1316 {"gray" , PALETTERGB (190,190,190)},
1317 {"grey" , PALETTERGB (190,190,190)},
1318 {"light grey" , PALETTERGB (211,211,211)},
1319 {"LightGrey" , PALETTERGB (211,211,211)},
1320 {"light gray" , PALETTERGB (211,211,211)},
1321 {"LightGray" , PALETTERGB (211,211,211)},
1322 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1323 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1324 {"navy" , PALETTERGB ( 0, 0,128)},
1325 {"navy blue" , PALETTERGB ( 0, 0,128)},
1326 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1327 {"cornflower blue" , PALETTERGB (100,149,237)},
1328 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1329 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1330 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1331 {"slate blue" , PALETTERGB (106, 90,205)},
1332 {"SlateBlue" , PALETTERGB (106, 90,205)},
1333 {"medium slate blue" , PALETTERGB (123,104,238)},
1334 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1335 {"light slate blue" , PALETTERGB (132,112,255)},
1336 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1337 {"medium blue" , PALETTERGB ( 0, 0,205)},
1338 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1339 {"royal blue" , PALETTERGB ( 65,105,225)},
1340 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1341 {"blue" , PALETTERGB ( 0, 0,255)},
1342 {"dodger blue" , PALETTERGB ( 30,144,255)},
1343 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1344 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1345 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1346 {"sky blue" , PALETTERGB (135,206,235)},
1347 {"SkyBlue" , PALETTERGB (135,206,235)},
1348 {"light sky blue" , PALETTERGB (135,206,250)},
1349 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1350 {"steel blue" , PALETTERGB ( 70,130,180)},
1351 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1352 {"light steel blue" , PALETTERGB (176,196,222)},
1353 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1354 {"light blue" , PALETTERGB (173,216,230)},
1355 {"LightBlue" , PALETTERGB (173,216,230)},
1356 {"powder blue" , PALETTERGB (176,224,230)},
1357 {"PowderBlue" , PALETTERGB (176,224,230)},
1358 {"pale turquoise" , PALETTERGB (175,238,238)},
1359 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1360 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1361 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1362 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1363 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1364 {"turquoise" , PALETTERGB ( 64,224,208)},
1365 {"cyan" , PALETTERGB ( 0,255,255)},
1366 {"light cyan" , PALETTERGB (224,255,255)},
1367 {"LightCyan" , PALETTERGB (224,255,255)},
1368 {"cadet blue" , PALETTERGB ( 95,158,160)},
1369 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1370 {"medium aquamarine" , PALETTERGB (102,205,170)},
1371 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1372 {"aquamarine" , PALETTERGB (127,255,212)},
1373 {"dark green" , PALETTERGB ( 0,100, 0)},
1374 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1375 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1376 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1377 {"dark sea green" , PALETTERGB (143,188,143)},
1378 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1379 {"sea green" , PALETTERGB ( 46,139, 87)},
1380 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1381 {"medium sea green" , PALETTERGB ( 60,179,113)},
1382 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1383 {"light sea green" , PALETTERGB ( 32,178,170)},
1384 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1385 {"pale green" , PALETTERGB (152,251,152)},
1386 {"PaleGreen" , PALETTERGB (152,251,152)},
1387 {"spring green" , PALETTERGB ( 0,255,127)},
1388 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1389 {"lawn green" , PALETTERGB (124,252, 0)},
1390 {"LawnGreen" , PALETTERGB (124,252, 0)},
1391 {"green" , PALETTERGB ( 0,255, 0)},
1392 {"chartreuse" , PALETTERGB (127,255, 0)},
1393 {"medium spring green" , PALETTERGB ( 0,250,154)},
1394 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1395 {"green yellow" , PALETTERGB (173,255, 47)},
1396 {"GreenYellow" , PALETTERGB (173,255, 47)},
1397 {"lime green" , PALETTERGB ( 50,205, 50)},
1398 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1399 {"yellow green" , PALETTERGB (154,205, 50)},
1400 {"YellowGreen" , PALETTERGB (154,205, 50)},
1401 {"forest green" , PALETTERGB ( 34,139, 34)},
1402 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1403 {"olive drab" , PALETTERGB (107,142, 35)},
1404 {"OliveDrab" , PALETTERGB (107,142, 35)},
1405 {"dark khaki" , PALETTERGB (189,183,107)},
1406 {"DarkKhaki" , PALETTERGB (189,183,107)},
1407 {"khaki" , PALETTERGB (240,230,140)},
1408 {"pale goldenrod" , PALETTERGB (238,232,170)},
1409 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1410 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1411 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1412 {"light yellow" , PALETTERGB (255,255,224)},
1413 {"LightYellow" , PALETTERGB (255,255,224)},
1414 {"yellow" , PALETTERGB (255,255, 0)},
1415 {"gold" , PALETTERGB (255,215, 0)},
1416 {"light goldenrod" , PALETTERGB (238,221,130)},
1417 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1418 {"goldenrod" , PALETTERGB (218,165, 32)},
1419 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1420 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1421 {"rosy brown" , PALETTERGB (188,143,143)},
1422 {"RosyBrown" , PALETTERGB (188,143,143)},
1423 {"indian red" , PALETTERGB (205, 92, 92)},
1424 {"IndianRed" , PALETTERGB (205, 92, 92)},
1425 {"saddle brown" , PALETTERGB (139, 69, 19)},
1426 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1427 {"sienna" , PALETTERGB (160, 82, 45)},
1428 {"peru" , PALETTERGB (205,133, 63)},
1429 {"burlywood" , PALETTERGB (222,184,135)},
1430 {"beige" , PALETTERGB (245,245,220)},
1431 {"wheat" , PALETTERGB (245,222,179)},
1432 {"sandy brown" , PALETTERGB (244,164, 96)},
1433 {"SandyBrown" , PALETTERGB (244,164, 96)},
1434 {"tan" , PALETTERGB (210,180,140)},
1435 {"chocolate" , PALETTERGB (210,105, 30)},
1436 {"firebrick" , PALETTERGB (178,34, 34)},
1437 {"brown" , PALETTERGB (165,42, 42)},
1438 {"dark salmon" , PALETTERGB (233,150,122)},
1439 {"DarkSalmon" , PALETTERGB (233,150,122)},
1440 {"salmon" , PALETTERGB (250,128,114)},
1441 {"light salmon" , PALETTERGB (255,160,122)},
1442 {"LightSalmon" , PALETTERGB (255,160,122)},
1443 {"orange" , PALETTERGB (255,165, 0)},
1444 {"dark orange" , PALETTERGB (255,140, 0)},
1445 {"DarkOrange" , PALETTERGB (255,140, 0)},
1446 {"coral" , PALETTERGB (255,127, 80)},
1447 {"light coral" , PALETTERGB (240,128,128)},
1448 {"LightCoral" , PALETTERGB (240,128,128)},
1449 {"tomato" , PALETTERGB (255, 99, 71)},
1450 {"orange red" , PALETTERGB (255, 69, 0)},
1451 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1452 {"red" , PALETTERGB (255, 0, 0)},
1453 {"hot pink" , PALETTERGB (255,105,180)},
1454 {"HotPink" , PALETTERGB (255,105,180)},
1455 {"deep pink" , PALETTERGB (255, 20,147)},
1456 {"DeepPink" , PALETTERGB (255, 20,147)},
1457 {"pink" , PALETTERGB (255,192,203)},
1458 {"light pink" , PALETTERGB (255,182,193)},
1459 {"LightPink" , PALETTERGB (255,182,193)},
1460 {"pale violet red" , PALETTERGB (219,112,147)},
1461 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1462 {"maroon" , PALETTERGB (176, 48, 96)},
1463 {"medium violet red" , PALETTERGB (199, 21,133)},
1464 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1465 {"violet red" , PALETTERGB (208, 32,144)},
1466 {"VioletRed" , PALETTERGB (208, 32,144)},
1467 {"magenta" , PALETTERGB (255, 0,255)},
1468 {"violet" , PALETTERGB (238,130,238)},
1469 {"plum" , PALETTERGB (221,160,221)},
1470 {"orchid" , PALETTERGB (218,112,214)},
1471 {"medium orchid" , PALETTERGB (186, 85,211)},
1472 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1473 {"dark orchid" , PALETTERGB (153, 50,204)},
1474 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1475 {"dark violet" , PALETTERGB (148, 0,211)},
1476 {"DarkViolet" , PALETTERGB (148, 0,211)},
1477 {"blue violet" , PALETTERGB (138, 43,226)},
1478 {"BlueViolet" , PALETTERGB (138, 43,226)},
1479 {"purple" , PALETTERGB (160, 32,240)},
1480 {"medium purple" , PALETTERGB (147,112,219)},
1481 {"MediumPurple" , PALETTERGB (147,112,219)},
1482 {"thistle" , PALETTERGB (216,191,216)},
1483 {"gray0" , PALETTERGB ( 0, 0, 0)},
1484 {"grey0" , PALETTERGB ( 0, 0, 0)},
1485 {"dark grey" , PALETTERGB (169,169,169)},
1486 {"DarkGrey" , PALETTERGB (169,169,169)},
1487 {"dark gray" , PALETTERGB (169,169,169)},
1488 {"DarkGray" , PALETTERGB (169,169,169)},
1489 {"dark blue" , PALETTERGB ( 0, 0,139)},
1490 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1491 {"dark cyan" , PALETTERGB ( 0,139,139)},
1492 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1493 {"dark magenta" , PALETTERGB (139, 0,139)},
1494 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1495 {"dark red" , PALETTERGB (139, 0, 0)},
1496 {"DarkRed" , PALETTERGB (139, 0, 0)},
1497 {"light green" , PALETTERGB (144,238,144)},
1498 {"LightGreen" , PALETTERGB (144,238,144)},
1501 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1502 0, 0, 0, doc
: /* Return the default color map. */)
1506 colormap_t
*pc
= w32_color_map
;
1513 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1515 cmap
= Fcons (Fcons (build_string (pc
->name
),
1516 make_number (pc
->colorref
)),
1525 w32_to_x_color (rgb
)
1534 color
= Frassq (rgb
, Vw32_color_map
);
1539 return (Fcar (color
));
1545 w32_color_map_lookup (colorname
)
1548 Lisp_Object tail
, ret
= Qnil
;
1552 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1554 register Lisp_Object elt
, tem
;
1557 if (!CONSP (elt
)) continue;
1561 if (lstrcmpi (SDATA (tem
), colorname
) == 0)
1563 ret
= XUINT (Fcdr (elt
));
1577 x_to_w32_color (colorname
)
1580 register Lisp_Object ret
= Qnil
;
1584 if (colorname
[0] == '#')
1586 /* Could be an old-style RGB Device specification. */
1589 color
= colorname
+ 1;
1591 size
= strlen(color
);
1592 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1600 for (i
= 0; i
< 3; i
++)
1604 unsigned long value
;
1606 /* The check for 'x' in the following conditional takes into
1607 account the fact that strtol allows a "0x" in front of
1608 our numbers, and we don't. */
1609 if (!isxdigit(color
[0]) || color
[1] == 'x')
1613 value
= strtoul(color
, &end
, 16);
1615 if (errno
== ERANGE
|| end
- color
!= size
)
1620 value
= value
* 0x10;
1631 colorval
|= (value
<< pos
);
1642 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1650 color
= colorname
+ 4;
1651 for (i
= 0; i
< 3; i
++)
1654 unsigned long value
;
1656 /* The check for 'x' in the following conditional takes into
1657 account the fact that strtol allows a "0x" in front of
1658 our numbers, and we don't. */
1659 if (!isxdigit(color
[0]) || color
[1] == 'x')
1661 value
= strtoul(color
, &end
, 16);
1662 if (errno
== ERANGE
)
1664 switch (end
- color
)
1667 value
= value
* 0x10 + value
;
1680 if (value
== ULONG_MAX
)
1682 colorval
|= (value
<< pos
);
1696 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1698 /* This is an RGB Intensity specification. */
1705 color
= colorname
+ 5;
1706 for (i
= 0; i
< 3; i
++)
1712 value
= strtod(color
, &end
);
1713 if (errno
== ERANGE
)
1715 if (value
< 0.0 || value
> 1.0)
1717 val
= (UINT
)(0x100 * value
);
1718 /* We used 0x100 instead of 0xFF to give a continuous
1719 range between 0.0 and 1.0 inclusive. The next statement
1720 fixes the 1.0 case. */
1723 colorval
|= (val
<< pos
);
1737 /* I am not going to attempt to handle any of the CIE color schemes
1738 or TekHVC, since I don't know the algorithms for conversion to
1741 /* If we fail to lookup the color name in w32_color_map, then check the
1742 colorname to see if it can be crudely approximated: If the X color
1743 ends in a number (e.g., "darkseagreen2"), strip the number and
1744 return the result of looking up the base color name. */
1745 ret
= w32_color_map_lookup (colorname
);
1748 int len
= strlen (colorname
);
1750 if (isdigit (colorname
[len
- 1]))
1752 char *ptr
, *approx
= alloca (len
+ 1);
1754 strcpy (approx
, colorname
);
1755 ptr
= &approx
[len
- 1];
1756 while (ptr
> approx
&& isdigit (*ptr
))
1759 ret
= w32_color_map_lookup (approx
);
1769 w32_regenerate_palette (FRAME_PTR f
)
1771 struct w32_palette_entry
* list
;
1772 LOGPALETTE
* log_palette
;
1773 HPALETTE new_palette
;
1776 /* don't bother trying to create palette if not supported */
1777 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1780 log_palette
= (LOGPALETTE
*)
1781 alloca (sizeof (LOGPALETTE
) +
1782 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1783 log_palette
->palVersion
= 0x300;
1784 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1786 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1788 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1789 i
++, list
= list
->next
)
1790 log_palette
->palPalEntry
[i
] = list
->entry
;
1792 new_palette
= CreatePalette (log_palette
);
1796 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1797 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1798 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1800 /* Realize display palette and garbage all frames. */
1801 release_frame_dc (f
, get_frame_dc (f
));
1806 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1807 #define SET_W32_COLOR(pe, color) \
1810 pe.peRed = GetRValue (color); \
1811 pe.peGreen = GetGValue (color); \
1812 pe.peBlue = GetBValue (color); \
1817 /* Keep these around in case we ever want to track color usage. */
1819 w32_map_color (FRAME_PTR f
, COLORREF color
)
1821 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1823 if (NILP (Vw32_enable_palette
))
1826 /* check if color is already mapped */
1829 if (W32_COLOR (list
->entry
) == color
)
1837 /* not already mapped, so add to list and recreate Windows palette */
1838 list
= (struct w32_palette_entry
*)
1839 xmalloc (sizeof (struct w32_palette_entry
));
1840 SET_W32_COLOR (list
->entry
, color
);
1842 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1843 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1844 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1846 /* set flag that palette must be regenerated */
1847 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1851 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1853 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1854 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1856 if (NILP (Vw32_enable_palette
))
1859 /* check if color is already mapped */
1862 if (W32_COLOR (list
->entry
) == color
)
1864 if (--list
->refcount
== 0)
1868 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1878 /* set flag that palette must be regenerated */
1879 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1884 /* Gamma-correct COLOR on frame F. */
1887 gamma_correct (f
, color
)
1893 *color
= PALETTERGB (
1894 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1895 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1896 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1901 /* Decide if color named COLOR is valid for the display associated with
1902 the selected frame; if so, return the rgb values in COLOR_DEF.
1903 If ALLOC is nonzero, allocate a new colormap cell. */
1906 w32_defined_color (f
, color
, color_def
, alloc
)
1912 register Lisp_Object tem
;
1913 COLORREF w32_color_ref
;
1915 tem
= x_to_w32_color (color
);
1921 /* Apply gamma correction. */
1922 w32_color_ref
= XUINT (tem
);
1923 gamma_correct (f
, &w32_color_ref
);
1924 XSETINT (tem
, w32_color_ref
);
1927 /* Map this color to the palette if it is enabled. */
1928 if (!NILP (Vw32_enable_palette
))
1930 struct w32_palette_entry
* entry
=
1931 one_w32_display_info
.color_list
;
1932 struct w32_palette_entry
** prev
=
1933 &one_w32_display_info
.color_list
;
1935 /* check if color is already mapped */
1938 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1940 prev
= &entry
->next
;
1941 entry
= entry
->next
;
1944 if (entry
== NULL
&& alloc
)
1946 /* not already mapped, so add to list */
1947 entry
= (struct w32_palette_entry
*)
1948 xmalloc (sizeof (struct w32_palette_entry
));
1949 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1952 one_w32_display_info
.num_colors
++;
1954 /* set flag that palette must be regenerated */
1955 one_w32_display_info
.regen_palette
= TRUE
;
1958 /* Ensure COLORREF value is snapped to nearest color in (default)
1959 palette by simulating the PALETTERGB macro. This works whether
1960 or not the display device has a palette. */
1961 w32_color_ref
= XUINT (tem
) | 0x2000000;
1963 color_def
->pixel
= w32_color_ref
;
1964 color_def
->red
= GetRValue (w32_color_ref
) * 256;
1965 color_def
->green
= GetGValue (w32_color_ref
) * 256;
1966 color_def
->blue
= GetBValue (w32_color_ref
) * 256;
1976 /* Given a string ARG naming a color, compute a pixel value from it
1977 suitable for screen F.
1978 If F is not a color screen, return DEF (default) regardless of what
1982 x_decode_color (f
, arg
, def
)
1991 if (strcmp (SDATA (arg
), "black") == 0)
1992 return BLACK_PIX_DEFAULT (f
);
1993 else if (strcmp (SDATA (arg
), "white") == 0)
1994 return WHITE_PIX_DEFAULT (f
);
1996 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1999 /* w32_defined_color is responsible for coping with failures
2000 by looking for a near-miss. */
2001 if (w32_defined_color (f
, SDATA (arg
), &cdef
, 1))
2004 /* defined_color failed; return an ultimate default. */
2008 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
2009 the previous value of that parameter, NEW_VALUE is the new value. */
2012 x_set_line_spacing (f
, new_value
, old_value
)
2014 Lisp_Object new_value
, old_value
;
2016 if (NILP (new_value
))
2017 f
->extra_line_spacing
= 0;
2018 else if (NATNUMP (new_value
))
2019 f
->extra_line_spacing
= XFASTINT (new_value
);
2021 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
2022 Fcons (new_value
, Qnil
)));
2023 if (FRAME_VISIBLE_P (f
))
2028 /* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
2029 the previous value of that parameter, NEW_VALUE is the new value. */
2032 x_set_fullscreen (f
, new_value
, old_value
)
2034 Lisp_Object new_value
, old_value
;
2036 if (NILP (new_value
))
2037 f
->output_data
.w32
->want_fullscreen
= FULLSCREEN_NONE
;
2038 else if (EQ (new_value
, Qfullboth
))
2039 f
->output_data
.w32
->want_fullscreen
= FULLSCREEN_BOTH
;
2040 else if (EQ (new_value
, Qfullwidth
))
2041 f
->output_data
.w32
->want_fullscreen
= FULLSCREEN_WIDTH
;
2042 else if (EQ (new_value
, Qfullheight
))
2043 f
->output_data
.w32
->want_fullscreen
= FULLSCREEN_HEIGHT
;
2047 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
2048 the previous value of that parameter, NEW_VALUE is the new value. */
2051 x_set_screen_gamma (f
, new_value
, old_value
)
2053 Lisp_Object new_value
, old_value
;
2055 if (NILP (new_value
))
2057 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
2058 /* The value 0.4545 is the normal viewing gamma. */
2059 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
2061 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
2062 Fcons (new_value
, Qnil
)));
2064 clear_face_cache (0);
2068 /* Functions called only from `x_set_frame_param'
2069 to set individual parameters.
2071 If FRAME_W32_WINDOW (f) is 0,
2072 the frame is being created and its window does not exist yet.
2073 In that case, just record the parameter's new value
2074 in the standard place; do not attempt to change the window. */
2077 x_set_foreground_color (f
, arg
, oldval
)
2079 Lisp_Object arg
, oldval
;
2081 struct w32_output
*x
= f
->output_data
.w32
;
2082 PIX_TYPE fg
, old_fg
;
2084 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2085 old_fg
= FRAME_FOREGROUND_PIXEL (f
);
2086 FRAME_FOREGROUND_PIXEL (f
) = fg
;
2088 if (FRAME_W32_WINDOW (f
) != 0)
2090 if (x
->cursor_pixel
== old_fg
)
2091 x
->cursor_pixel
= fg
;
2093 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
2094 if (FRAME_VISIBLE_P (f
))
2100 x_set_background_color (f
, arg
, oldval
)
2102 Lisp_Object arg
, oldval
;
2104 FRAME_BACKGROUND_PIXEL (f
)
2105 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
2107 if (FRAME_W32_WINDOW (f
) != 0)
2109 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
2110 FRAME_BACKGROUND_PIXEL (f
));
2112 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
2114 if (FRAME_VISIBLE_P (f
))
2120 x_set_mouse_color (f
, arg
, oldval
)
2122 Lisp_Object arg
, oldval
;
2124 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
2128 if (!EQ (Qnil
, arg
))
2129 f
->output_data
.w32
->mouse_pixel
2130 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2131 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
2133 /* Don't let pointers be invisible. */
2134 if (mask_color
== f
->output_data
.w32
->mouse_pixel
2135 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
2136 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
2138 #if 0 /* TODO : cursor changes */
2141 /* It's not okay to crash if the user selects a screwy cursor. */
2142 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
2144 if (!EQ (Qnil
, Vx_pointer_shape
))
2146 CHECK_NUMBER (Vx_pointer_shape
);
2147 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
2150 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2151 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
2153 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
2155 CHECK_NUMBER (Vx_nontext_pointer_shape
);
2156 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2157 XINT (Vx_nontext_pointer_shape
));
2160 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
2161 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2163 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
2165 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
2166 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2167 XINT (Vx_hourglass_pointer_shape
));
2170 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
2171 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
2173 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2174 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
2176 CHECK_NUMBER (Vx_mode_pointer_shape
);
2177 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2178 XINT (Vx_mode_pointer_shape
));
2181 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2182 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
2184 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
2186 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
2188 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2189 XINT (Vx_sensitive_text_pointer_shape
));
2192 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
2194 if (!NILP (Vx_window_horizontal_drag_shape
))
2196 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
2197 horizontal_drag_cursor
2198 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
2199 XINT (Vx_window_horizontal_drag_shape
));
2202 horizontal_drag_cursor
2203 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
2204 /* TODO: hand_cursor */
2206 /* Check and report errors with the above calls. */
2207 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
2208 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
2211 XColor fore_color
, back_color
;
2213 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
2214 back_color
.pixel
= mask_color
;
2215 XQueryColor (FRAME_W32_DISPLAY (f
),
2216 DefaultColormap (FRAME_W32_DISPLAY (f
),
2217 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2219 XQueryColor (FRAME_W32_DISPLAY (f
),
2220 DefaultColormap (FRAME_W32_DISPLAY (f
),
2221 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2223 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
2224 &fore_color
, &back_color
);
2225 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
2226 &fore_color
, &back_color
);
2227 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
2228 &fore_color
, &back_color
);
2229 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
2230 &fore_color
, &back_color
);
2231 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
2232 &fore_color
, &back_color
);
2233 /* TODO: hand_cursor */
2236 if (FRAME_W32_WINDOW (f
) != 0)
2237 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
2239 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
2240 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
2241 f
->output_data
.w32
->text_cursor
= cursor
;
2243 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
2244 && f
->output_data
.w32
->nontext_cursor
!= 0)
2245 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
2246 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
2248 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
2249 && f
->output_data
.w32
->hourglass_cursor
!= 0)
2250 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
2251 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
2253 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
2254 && f
->output_data
.w32
->modeline_cursor
!= 0)
2255 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
2256 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
2258 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
2259 && f
->output_data
.w32
->cross_cursor
!= 0)
2260 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
2261 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
2262 /* TODO: hand_cursor */
2264 XFlush (FRAME_W32_DISPLAY (f
));
2267 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
2271 /* Defined in w32term.c. */
2272 void x_update_cursor (struct frame
*f
, int on_p
);
2275 x_set_cursor_color (f
, arg
, oldval
)
2277 Lisp_Object arg
, oldval
;
2279 unsigned long fore_pixel
, pixel
;
2281 if (!NILP (Vx_cursor_fore_pixel
))
2282 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
2283 WHITE_PIX_DEFAULT (f
));
2285 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2287 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2289 /* Make sure that the cursor color differs from the background color. */
2290 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
2292 pixel
= f
->output_data
.w32
->mouse_pixel
;
2293 if (pixel
== fore_pixel
)
2294 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2297 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
2298 f
->output_data
.w32
->cursor_pixel
= pixel
;
2300 if (FRAME_W32_WINDOW (f
) != 0)
2303 /* Update frame's cursor_gc. */
2304 f
->output_data
.w32
->cursor_gc
->foreground
= fore_pixel
;
2305 f
->output_data
.w32
->cursor_gc
->background
= pixel
;
2309 if (FRAME_VISIBLE_P (f
))
2311 x_update_cursor (f
, 0);
2312 x_update_cursor (f
, 1);
2316 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
2319 /* Set the border-color of frame F to pixel value PIX.
2320 Note that this does not fully take effect if done before
2323 x_set_border_pixel (f
, pix
)
2327 f
->output_data
.w32
->border_pixel
= pix
;
2329 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
2331 if (FRAME_VISIBLE_P (f
))
2336 /* Set the border-color of frame F to value described by ARG.
2337 ARG can be a string naming a color.
2338 The border-color is used for the border that is drawn by the server.
2339 Note that this does not fully take effect if done before
2340 F has a window; it must be redone when the window is created. */
2343 x_set_border_color (f
, arg
, oldval
)
2345 Lisp_Object arg
, oldval
;
2350 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2351 x_set_border_pixel (f
, pix
);
2352 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
2357 x_set_cursor_type (f
, arg
, oldval
)
2359 Lisp_Object arg
, oldval
;
2361 set_frame_cursor_types (f
, arg
);
2363 /* Make sure the cursor gets redrawn. */
2364 cursor_type_changed
= 1;
2368 x_set_icon_type (f
, arg
, oldval
)
2370 Lisp_Object arg
, oldval
;
2374 if (NILP (arg
) && NILP (oldval
))
2377 if (STRINGP (arg
) && STRINGP (oldval
)
2378 && EQ (Fstring_equal (oldval
, arg
), Qt
))
2381 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
2386 result
= x_bitmap_icon (f
, arg
);
2390 error ("No icon window available");
2396 /* Return non-nil if frame F wants a bitmap icon. */
2404 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
2412 x_set_icon_name (f
, arg
, oldval
)
2414 Lisp_Object arg
, oldval
;
2418 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2421 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2427 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2432 result
= x_text_icon (f
,
2433 (char *) SDATA ((!NILP (f
->icon_name
)
2442 error ("No icon window available");
2445 /* If the window was unmapped (and its icon was mapped),
2446 the new icon is not mapped, so map the window in its stead. */
2447 if (FRAME_VISIBLE_P (f
))
2449 #ifdef USE_X_TOOLKIT
2450 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2452 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2455 XFlush (FRAME_W32_DISPLAY (f
));
2460 extern Lisp_Object
x_new_font ();
2461 extern Lisp_Object
x_new_fontset();
2464 x_set_font (f
, arg
, oldval
)
2466 Lisp_Object arg
, oldval
;
2469 Lisp_Object fontset_name
;
2471 int old_fontset
= FRAME_FONTSET(f
);
2475 fontset_name
= Fquery_fontset (arg
, Qnil
);
2478 result
= (STRINGP (fontset_name
)
2479 ? x_new_fontset (f
, SDATA (fontset_name
))
2480 : x_new_font (f
, SDATA (arg
)));
2483 if (EQ (result
, Qnil
))
2484 error ("Font `%s' is not defined", SDATA (arg
));
2485 else if (EQ (result
, Qt
))
2486 error ("The characters of the given font have varying widths");
2487 else if (STRINGP (result
))
2489 if (STRINGP (fontset_name
))
2491 /* Fontset names are built from ASCII font names, so the
2492 names may be equal despite there was a change. */
2493 if (old_fontset
== FRAME_FONTSET (f
))
2496 else if (!NILP (Fequal (result
, oldval
)))
2499 store_frame_param (f
, Qfont
, result
);
2500 recompute_basic_faces (f
);
2505 do_pending_window_change (0);
2507 /* Don't call `face-set-after-frame-default' when faces haven't been
2508 initialized yet. This is the case when called from
2509 Fx_create_frame. In that case, the X widget or window doesn't
2510 exist either, and we can end up in x_report_frame_params with a
2511 null widget which gives a segfault. */
2512 if (FRAME_FACE_CACHE (f
))
2514 XSETFRAME (frame
, f
);
2515 call1 (Qface_set_after_frame_default
, frame
);
2520 x_set_fringe_width (f
, new_value
, old_value
)
2522 Lisp_Object new_value
, old_value
;
2524 x_compute_fringe_widths (f
, 1);
2528 x_set_border_width (f
, arg
, oldval
)
2530 Lisp_Object arg
, oldval
;
2534 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2537 if (FRAME_W32_WINDOW (f
) != 0)
2538 error ("Cannot change the border width of a window");
2540 f
->output_data
.w32
->border_width
= XINT (arg
);
2544 x_set_internal_border_width (f
, arg
, oldval
)
2546 Lisp_Object arg
, oldval
;
2548 int old
= f
->output_data
.w32
->internal_border_width
;
2551 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2552 if (f
->output_data
.w32
->internal_border_width
< 0)
2553 f
->output_data
.w32
->internal_border_width
= 0;
2555 if (f
->output_data
.w32
->internal_border_width
== old
)
2558 if (FRAME_W32_WINDOW (f
) != 0)
2560 x_set_window_size (f
, 0, f
->width
, f
->height
);
2561 SET_FRAME_GARBAGED (f
);
2562 do_pending_window_change (0);
2565 SET_FRAME_GARBAGED (f
);
2569 x_set_visibility (f
, value
, oldval
)
2571 Lisp_Object value
, oldval
;
2574 XSETFRAME (frame
, f
);
2577 Fmake_frame_invisible (frame
, Qt
);
2578 else if (EQ (value
, Qicon
))
2579 Ficonify_frame (frame
);
2581 Fmake_frame_visible (frame
);
2585 /* Change window heights in windows rooted in WINDOW by N lines. */
2588 x_change_window_heights (window
, n
)
2592 struct window
*w
= XWINDOW (window
);
2594 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2595 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2597 if (INTEGERP (w
->orig_top
))
2598 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2599 if (INTEGERP (w
->orig_height
))
2600 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2602 /* Handle just the top child in a vertical split. */
2603 if (!NILP (w
->vchild
))
2604 x_change_window_heights (w
->vchild
, n
);
2606 /* Adjust all children in a horizontal split. */
2607 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2609 w
= XWINDOW (window
);
2610 x_change_window_heights (window
, n
);
2615 x_set_menu_bar_lines (f
, value
, oldval
)
2617 Lisp_Object value
, oldval
;
2620 int olines
= FRAME_MENU_BAR_LINES (f
);
2622 /* Right now, menu bars don't work properly in minibuf-only frames;
2623 most of the commands try to apply themselves to the minibuffer
2624 frame itself, and get an error because you can't switch buffers
2625 in or split the minibuffer window. */
2626 if (FRAME_MINIBUF_ONLY_P (f
))
2629 if (INTEGERP (value
))
2630 nlines
= XINT (value
);
2634 FRAME_MENU_BAR_LINES (f
) = 0;
2636 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2639 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2640 free_frame_menubar (f
);
2641 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2643 /* Adjust the frame size so that the client (text) dimensions
2644 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2646 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2647 do_pending_window_change (0);
2653 /* Set the number of lines used for the tool bar of frame F to VALUE.
2654 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2655 is the old number of tool bar lines. This function changes the
2656 height of all windows on frame F to match the new tool bar height.
2657 The frame's height doesn't change. */
2660 x_set_tool_bar_lines (f
, value
, oldval
)
2662 Lisp_Object value
, oldval
;
2664 int delta
, nlines
, root_height
;
2665 Lisp_Object root_window
;
2667 /* Treat tool bars like menu bars. */
2668 if (FRAME_MINIBUF_ONLY_P (f
))
2671 /* Use VALUE only if an integer >= 0. */
2672 if (INTEGERP (value
) && XINT (value
) >= 0)
2673 nlines
= XFASTINT (value
);
2677 /* Make sure we redisplay all windows in this frame. */
2678 ++windows_or_buffers_changed
;
2680 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2682 /* Don't resize the tool-bar to more than we have room for. */
2683 root_window
= FRAME_ROOT_WINDOW (f
);
2684 root_height
= XINT (XWINDOW (root_window
)->height
);
2685 if (root_height
- delta
< 1)
2687 delta
= root_height
- 1;
2688 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2691 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2692 x_change_window_heights (root_window
, delta
);
2695 /* We also have to make sure that the internal border at the top of
2696 the frame, below the menu bar or tool bar, is redrawn when the
2697 tool bar disappears. This is so because the internal border is
2698 below the tool bar if one is displayed, but is below the menu bar
2699 if there isn't a tool bar. The tool bar draws into the area
2700 below the menu bar. */
2701 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2705 clear_current_matrices (f
);
2706 updating_frame
= NULL
;
2709 /* If the tool bar gets smaller, the internal border below it
2710 has to be cleared. It was formerly part of the display
2711 of the larger tool bar, and updating windows won't clear it. */
2714 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2715 int width
= PIXEL_WIDTH (f
);
2716 int y
= nlines
* CANON_Y_UNIT (f
);
2720 HDC hdc
= get_frame_dc (f
);
2721 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
2722 release_frame_dc (f
, hdc
);
2726 if (WINDOWP (f
->tool_bar_window
))
2727 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2732 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2735 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2736 name; if NAME is a string, set F's name to NAME and set
2737 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2739 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2740 suggesting a new name, which lisp code should override; if
2741 F->explicit_name is set, ignore the new name; otherwise, set it. */
2744 x_set_name (f
, name
, explicit)
2749 /* Make sure that requests from lisp code override requests from
2750 Emacs redisplay code. */
2753 /* If we're switching from explicit to implicit, we had better
2754 update the mode lines and thereby update the title. */
2755 if (f
->explicit_name
&& NILP (name
))
2756 update_mode_lines
= 1;
2758 f
->explicit_name
= ! NILP (name
);
2760 else if (f
->explicit_name
)
2763 /* If NAME is nil, set the name to the w32_id_name. */
2766 /* Check for no change needed in this very common case
2767 before we do any consing. */
2768 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2771 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2774 CHECK_STRING (name
);
2776 /* Don't change the name if it's already NAME. */
2777 if (! NILP (Fstring_equal (name
, f
->name
)))
2782 /* For setting the frame title, the title parameter should override
2783 the name parameter. */
2784 if (! NILP (f
->title
))
2787 if (FRAME_W32_WINDOW (f
))
2789 if (STRING_MULTIBYTE (name
))
2790 name
= ENCODE_SYSTEM (name
);
2793 SetWindowText(FRAME_W32_WINDOW (f
), SDATA (name
));
2798 /* This function should be called when the user's lisp code has
2799 specified a name for the frame; the name will override any set by the
2802 x_explicitly_set_name (f
, arg
, oldval
)
2804 Lisp_Object arg
, oldval
;
2806 x_set_name (f
, arg
, 1);
2809 /* This function should be called by Emacs redisplay code to set the
2810 name; names set this way will never override names set by the user's
2813 x_implicitly_set_name (f
, arg
, oldval
)
2815 Lisp_Object arg
, oldval
;
2817 x_set_name (f
, arg
, 0);
2820 /* Change the title of frame F to NAME.
2821 If NAME is nil, use the frame name as the title.
2823 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2824 name; if NAME is a string, set F's name to NAME and set
2825 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2827 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2828 suggesting a new name, which lisp code should override; if
2829 F->explicit_name is set, ignore the new name; otherwise, set it. */
2832 x_set_title (f
, name
, old_name
)
2834 Lisp_Object name
, old_name
;
2836 /* Don't change the title if it's already NAME. */
2837 if (EQ (name
, f
->title
))
2840 update_mode_lines
= 1;
2847 if (FRAME_W32_WINDOW (f
))
2849 if (STRING_MULTIBYTE (name
))
2850 name
= ENCODE_SYSTEM (name
);
2853 SetWindowText(FRAME_W32_WINDOW (f
), SDATA (name
));
2859 x_set_autoraise (f
, arg
, oldval
)
2861 Lisp_Object arg
, oldval
;
2863 f
->auto_raise
= !EQ (Qnil
, arg
);
2867 x_set_autolower (f
, arg
, oldval
)
2869 Lisp_Object arg
, oldval
;
2871 f
->auto_lower
= !EQ (Qnil
, arg
);
2875 x_set_unsplittable (f
, arg
, oldval
)
2877 Lisp_Object arg
, oldval
;
2879 f
->no_split
= !NILP (arg
);
2883 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2885 Lisp_Object arg
, oldval
;
2887 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2888 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2889 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2890 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2892 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2893 vertical_scroll_bar_none
:
2894 /* Put scroll bars on the right by default, as is conventional
2897 ? vertical_scroll_bar_left
2898 : vertical_scroll_bar_right
;
2900 /* We set this parameter before creating the window for the
2901 frame, so we can get the geometry right from the start.
2902 However, if the window hasn't been created yet, we shouldn't
2903 call x_set_window_size. */
2904 if (FRAME_W32_WINDOW (f
))
2905 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2906 do_pending_window_change (0);
2911 x_set_scroll_bar_width (f
, arg
, oldval
)
2913 Lisp_Object arg
, oldval
;
2915 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2919 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
2920 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) +
2922 if (FRAME_W32_WINDOW (f
))
2923 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2924 do_pending_window_change (0);
2926 else if (INTEGERP (arg
) && XINT (arg
) > 0
2927 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2929 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2930 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2932 if (FRAME_W32_WINDOW (f
))
2933 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2934 do_pending_window_change (0);
2936 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2937 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2938 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2941 /* Subroutines of creating a frame. */
2943 /* Make sure that Vx_resource_name is set to a reasonable value.
2944 Fix it up, or set it to `emacs' if it is too hopeless. */
2947 validate_x_resource_name ()
2950 /* Number of valid characters in the resource name. */
2952 /* Number of invalid characters in the resource name. */
2957 if (STRINGP (Vx_resource_name
))
2959 unsigned char *p
= SDATA (Vx_resource_name
);
2962 len
= SBYTES (Vx_resource_name
);
2964 /* Only letters, digits, - and _ are valid in resource names.
2965 Count the valid characters and count the invalid ones. */
2966 for (i
= 0; i
< len
; i
++)
2969 if (! ((c
>= 'a' && c
<= 'z')
2970 || (c
>= 'A' && c
<= 'Z')
2971 || (c
>= '0' && c
<= '9')
2972 || c
== '-' || c
== '_'))
2979 /* Not a string => completely invalid. */
2980 bad_count
= 5, good_count
= 0;
2982 /* If name is valid already, return. */
2986 /* If name is entirely invalid, or nearly so, use `emacs'. */
2988 || (good_count
== 1 && bad_count
> 0))
2990 Vx_resource_name
= build_string ("emacs");
2994 /* Name is partly valid. Copy it and replace the invalid characters
2995 with underscores. */
2997 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2999 for (i
= 0; i
< len
; i
++)
3001 int c
= SREF (new, i
);
3002 if (! ((c
>= 'a' && c
<= 'z')
3003 || (c
>= 'A' && c
<= 'Z')
3004 || (c
>= '0' && c
<= '9')
3005 || c
== '-' || c
== '_'))
3011 extern char *x_get_string_resource ();
3013 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
3014 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3015 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3016 class, where INSTANCE is the name under which Emacs was invoked, or
3017 the name specified by the `-name' or `-rn' command-line arguments.
3019 The optional arguments COMPONENT and SUBCLASS add to the key and the
3020 class, respectively. You must specify both of them or neither.
3021 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3022 and the class is `Emacs.CLASS.SUBCLASS'. */)
3023 (attribute
, class, component
, subclass
)
3024 Lisp_Object attribute
, class, component
, subclass
;
3026 register char *value
;
3030 CHECK_STRING (attribute
);
3031 CHECK_STRING (class);
3033 if (!NILP (component
))
3034 CHECK_STRING (component
);
3035 if (!NILP (subclass
))
3036 CHECK_STRING (subclass
);
3037 if (NILP (component
) != NILP (subclass
))
3038 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3040 validate_x_resource_name ();
3042 /* Allocate space for the components, the dots which separate them,
3043 and the final '\0'. Make them big enough for the worst case. */
3044 name_key
= (char *) alloca (SBYTES (Vx_resource_name
)
3045 + (STRINGP (component
)
3046 ? SBYTES (component
) : 0)
3047 + SBYTES (attribute
)
3050 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3052 + (STRINGP (subclass
)
3053 ? SBYTES (subclass
) : 0)
3056 /* Start with emacs.FRAMENAME for the name (the specific one)
3057 and with `Emacs' for the class key (the general one). */
3058 strcpy (name_key
, SDATA (Vx_resource_name
));
3059 strcpy (class_key
, EMACS_CLASS
);
3061 strcat (class_key
, ".");
3062 strcat (class_key
, SDATA (class));
3064 if (!NILP (component
))
3066 strcat (class_key
, ".");
3067 strcat (class_key
, SDATA (subclass
));
3069 strcat (name_key
, ".");
3070 strcat (name_key
, SDATA (component
));
3073 strcat (name_key
, ".");
3074 strcat (name_key
, SDATA (attribute
));
3076 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
3077 name_key
, class_key
);
3079 if (value
!= (char *) 0)
3080 return build_string (value
);
3085 /* Used when C code wants a resource value. */
3088 x_get_resource_string (attribute
, class)
3089 char *attribute
, *class;
3093 struct frame
*sf
= SELECTED_FRAME ();
3095 /* Allocate space for the components, the dots which separate them,
3096 and the final '\0'. */
3097 name_key
= (char *) alloca (SBYTES (Vinvocation_name
)
3098 + strlen (attribute
) + 2);
3099 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3100 + strlen (class) + 2);
3102 sprintf (name_key
, "%s.%s",
3103 SDATA (Vinvocation_name
),
3105 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3107 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
3108 name_key
, class_key
);
3111 /* Types we might convert a resource string into. */
3121 /* Return the value of parameter PARAM.
3123 First search ALIST, then Vdefault_frame_alist, then the X defaults
3124 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3126 Convert the resource to the type specified by desired_type.
3128 If no default is specified, return Qunbound. If you call
3129 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
3130 and don't let it get stored in any Lisp-visible variables! */
3133 w32_get_arg (alist
, param
, attribute
, class, type
)
3134 Lisp_Object alist
, param
;
3137 enum resource_types type
;
3139 register Lisp_Object tem
;
3141 tem
= Fassq (param
, alist
);
3143 tem
= Fassq (param
, Vdefault_frame_alist
);
3149 tem
= Fx_get_resource (build_string (attribute
),
3150 build_string (class),
3158 case RES_TYPE_NUMBER
:
3159 return make_number (atoi (SDATA (tem
)));
3161 case RES_TYPE_FLOAT
:
3162 return make_float (atof (SDATA (tem
)));
3164 case RES_TYPE_BOOLEAN
:
3165 tem
= Fdowncase (tem
);
3166 if (!strcmp (SDATA (tem
), "on")
3167 || !strcmp (SDATA (tem
), "true"))
3172 case RES_TYPE_STRING
:
3175 case RES_TYPE_SYMBOL
:
3176 /* As a special case, we map the values `true' and `on'
3177 to Qt, and `false' and `off' to Qnil. */
3180 lower
= Fdowncase (tem
);
3181 if (!strcmp (SDATA (lower
), "on")
3182 || !strcmp (SDATA (lower
), "true"))
3184 else if (!strcmp (SDATA (lower
), "off")
3185 || !strcmp (SDATA (lower
), "false"))
3188 return Fintern (tem
, Qnil
);
3201 /* Record in frame F the specified or default value according to ALIST
3202 of the parameter named PROP (a Lisp symbol).
3203 If no value is specified for PROP, look for an X default for XPROP
3204 on the frame named NAME.
3205 If that is not found either, use the value DEFLT. */
3208 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3215 enum resource_types type
;
3219 tem
= w32_get_arg (alist
, prop
, xprop
, xclass
, type
);
3220 if (EQ (tem
, Qunbound
))
3222 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3226 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3227 doc
: /* Parse an X-style geometry string STRING.
3228 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3229 The properties returned may include `top', `left', `height', and `width'.
3230 The value of `left' or `top' may be an integer,
3231 or a list (+ N) meaning N pixels relative to top/left corner,
3232 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3237 unsigned int width
, height
;
3240 CHECK_STRING (string
);
3242 geometry
= XParseGeometry ((char *) SDATA (string
),
3243 &x
, &y
, &width
, &height
);
3246 if (geometry
& XValue
)
3248 Lisp_Object element
;
3250 if (x
>= 0 && (geometry
& XNegative
))
3251 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3252 else if (x
< 0 && ! (geometry
& XNegative
))
3253 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3255 element
= Fcons (Qleft
, make_number (x
));
3256 result
= Fcons (element
, result
);
3259 if (geometry
& YValue
)
3261 Lisp_Object element
;
3263 if (y
>= 0 && (geometry
& YNegative
))
3264 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3265 else if (y
< 0 && ! (geometry
& YNegative
))
3266 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3268 element
= Fcons (Qtop
, make_number (y
));
3269 result
= Fcons (element
, result
);
3272 if (geometry
& WidthValue
)
3273 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3274 if (geometry
& HeightValue
)
3275 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3280 /* Calculate the desired size and position of this window,
3281 and return the flags saying which aspects were specified.
3283 This function does not make the coordinates positive. */
3285 #define DEFAULT_ROWS 40
3286 #define DEFAULT_COLS 80
3289 x_figure_window_size (f
, parms
)
3293 register Lisp_Object tem0
, tem1
, tem2
;
3294 long window_prompting
= 0;
3296 /* Default values if we fall through.
3297 Actually, if that happens we should get
3298 window manager prompting. */
3299 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3300 f
->height
= DEFAULT_ROWS
;
3301 /* Window managers expect that if program-specified
3302 positions are not (0,0), they're intentional, not defaults. */
3303 f
->output_data
.w32
->top_pos
= 0;
3304 f
->output_data
.w32
->left_pos
= 0;
3306 /* Ensure that old new_width and new_height will not override the
3308 FRAME_NEW_WIDTH (f
) = 0;
3309 FRAME_NEW_HEIGHT (f
) = 0;
3311 tem0
= w32_get_arg (parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3312 tem1
= w32_get_arg (parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3313 tem2
= w32_get_arg (parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3314 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3316 if (!EQ (tem0
, Qunbound
))
3318 CHECK_NUMBER (tem0
);
3319 f
->height
= XINT (tem0
);
3321 if (!EQ (tem1
, Qunbound
))
3323 CHECK_NUMBER (tem1
);
3324 SET_FRAME_WIDTH (f
, XINT (tem1
));
3326 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3327 window_prompting
|= USSize
;
3329 window_prompting
|= PSize
;
3332 f
->output_data
.w32
->vertical_scroll_bar_extra
3333 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3335 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
3336 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
3337 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
3339 x_compute_fringe_widths (f
, 0);
3341 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3342 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3344 tem0
= w32_get_arg (parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3345 tem1
= w32_get_arg (parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3346 tem2
= w32_get_arg (parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3347 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3349 if (EQ (tem0
, Qminus
))
3351 f
->output_data
.w32
->top_pos
= 0;
3352 window_prompting
|= YNegative
;
3354 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3355 && CONSP (XCDR (tem0
))
3356 && INTEGERP (XCAR (XCDR (tem0
))))
3358 f
->output_data
.w32
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3359 window_prompting
|= YNegative
;
3361 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3362 && CONSP (XCDR (tem0
))
3363 && INTEGERP (XCAR (XCDR (tem0
))))
3365 f
->output_data
.w32
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3367 else if (EQ (tem0
, Qunbound
))
3368 f
->output_data
.w32
->top_pos
= 0;
3371 CHECK_NUMBER (tem0
);
3372 f
->output_data
.w32
->top_pos
= XINT (tem0
);
3373 if (f
->output_data
.w32
->top_pos
< 0)
3374 window_prompting
|= YNegative
;
3377 if (EQ (tem1
, Qminus
))
3379 f
->output_data
.w32
->left_pos
= 0;
3380 window_prompting
|= XNegative
;
3382 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3383 && CONSP (XCDR (tem1
))
3384 && INTEGERP (XCAR (XCDR (tem1
))))
3386 f
->output_data
.w32
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3387 window_prompting
|= XNegative
;
3389 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3390 && CONSP (XCDR (tem1
))
3391 && INTEGERP (XCAR (XCDR (tem1
))))
3393 f
->output_data
.w32
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3395 else if (EQ (tem1
, Qunbound
))
3396 f
->output_data
.w32
->left_pos
= 0;
3399 CHECK_NUMBER (tem1
);
3400 f
->output_data
.w32
->left_pos
= XINT (tem1
);
3401 if (f
->output_data
.w32
->left_pos
< 0)
3402 window_prompting
|= XNegative
;
3405 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3406 window_prompting
|= USPosition
;
3408 window_prompting
|= PPosition
;
3411 if (f
->output_data
.w32
->want_fullscreen
!= FULLSCREEN_NONE
)
3416 /* It takes both for some WM:s to place it where we want */
3417 window_prompting
= USPosition
| PPosition
;
3418 x_fullscreen_adjust (f
, &width
, &height
, &top
, &left
);
3421 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3422 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3423 f
->output_data
.w32
->left_pos
= left
;
3424 f
->output_data
.w32
->top_pos
= top
;
3427 return window_prompting
;
3432 w32_load_cursor (LPCTSTR name
)
3434 /* Try first to load cursor from application resource. */
3435 Cursor cursor
= LoadImage ((HINSTANCE
) GetModuleHandle(NULL
),
3436 name
, IMAGE_CURSOR
, 0, 0,
3437 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
3440 /* Then try to load a shared predefined cursor. */
3441 cursor
= LoadImage (NULL
, name
, IMAGE_CURSOR
, 0, 0,
3442 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
3447 extern LRESULT CALLBACK
w32_wnd_proc ();
3450 w32_init_class (hinst
)
3455 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
3456 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
3458 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
3459 wc
.hInstance
= hinst
;
3460 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
3461 wc
.hCursor
= w32_load_cursor (IDC_ARROW
);
3462 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
3463 wc
.lpszMenuName
= NULL
;
3464 wc
.lpszClassName
= EMACS_CLASS
;
3466 return (RegisterClass (&wc
));
3470 w32_createscrollbar (f
, bar
)
3472 struct scroll_bar
* bar
;
3474 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
3475 /* Position and size of scroll bar. */
3476 XINT(bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
3478 XINT(bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
3480 FRAME_W32_WINDOW (f
),
3487 w32_createwindow (f
)
3493 rect
.left
= rect
.top
= 0;
3494 rect
.right
= PIXEL_WIDTH (f
);
3495 rect
.bottom
= PIXEL_HEIGHT (f
);
3497 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
3498 FRAME_EXTERNAL_MENU_BAR (f
));
3500 /* Do first time app init */
3504 w32_init_class (hinst
);
3507 FRAME_W32_WINDOW (f
) = hwnd
3508 = CreateWindow (EMACS_CLASS
,
3510 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
3511 f
->output_data
.w32
->left_pos
,
3512 f
->output_data
.w32
->top_pos
,
3513 rect
.right
- rect
.left
,
3514 rect
.bottom
- rect
.top
,
3522 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
3523 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
3524 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
3525 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
3526 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
3528 /* Enable drag-n-drop. */
3529 DragAcceptFiles (hwnd
, TRUE
);
3531 /* Do this to discard the default setting specified by our parent. */
3532 ShowWindow (hwnd
, SW_HIDE
);
3537 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
3544 wmsg
->msg
.hwnd
= hwnd
;
3545 wmsg
->msg
.message
= msg
;
3546 wmsg
->msg
.wParam
= wParam
;
3547 wmsg
->msg
.lParam
= lParam
;
3548 wmsg
->msg
.time
= GetMessageTime ();
3553 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
3554 between left and right keys as advertised. We test for this
3555 support dynamically, and set a flag when the support is absent. If
3556 absent, we keep track of the left and right control and alt keys
3557 ourselves. This is particularly necessary on keyboards that rely
3558 upon the AltGr key, which is represented as having the left control
3559 and right alt keys pressed. For these keyboards, we need to know
3560 when the left alt key has been pressed in addition to the AltGr key
3561 so that we can properly support M-AltGr-key sequences (such as M-@
3562 on Swedish keyboards). */
3564 #define EMACS_LCONTROL 0
3565 #define EMACS_RCONTROL 1
3566 #define EMACS_LMENU 2
3567 #define EMACS_RMENU 3
3569 static int modifiers
[4];
3570 static int modifiers_recorded
;
3571 static int modifier_key_support_tested
;
3574 test_modifier_support (unsigned int wparam
)
3578 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3580 if (wparam
== VK_CONTROL
)
3590 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
3591 modifiers_recorded
= 1;
3593 modifiers_recorded
= 0;
3594 modifier_key_support_tested
= 1;
3598 record_keydown (unsigned int wparam
, unsigned int lparam
)
3602 if (!modifier_key_support_tested
)
3603 test_modifier_support (wparam
);
3605 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3608 if (wparam
== VK_CONTROL
)
3609 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3611 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3617 record_keyup (unsigned int wparam
, unsigned int lparam
)
3621 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3624 if (wparam
== VK_CONTROL
)
3625 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3627 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3632 /* Emacs can lose focus while a modifier key has been pressed. When
3633 it regains focus, be conservative and clear all modifiers since
3634 we cannot reconstruct the left and right modifier state. */
3640 if (GetFocus () == NULL
)
3641 /* Emacs doesn't have keyboard focus. Do nothing. */
3644 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3645 alt
= GetAsyncKeyState (VK_MENU
);
3647 if (!(ctrl
& 0x08000))
3648 /* Clear any recorded control modifier state. */
3649 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3651 if (!(alt
& 0x08000))
3652 /* Clear any recorded alt modifier state. */
3653 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3655 /* Update the state of all modifier keys, because modifiers used in
3656 hot-key combinations can get stuck on if Emacs loses focus as a
3657 result of a hot-key being pressed. */
3661 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3663 GetKeyboardState (keystate
);
3664 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
3665 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
3666 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
3667 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
3668 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
3669 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
3670 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
3671 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
3672 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
3673 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
3674 SetKeyboardState (keystate
);
3678 /* Synchronize modifier state with what is reported with the current
3679 keystroke. Even if we cannot distinguish between left and right
3680 modifier keys, we know that, if no modifiers are set, then neither
3681 the left or right modifier should be set. */
3685 if (!modifiers_recorded
)
3688 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3689 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3691 if (!(GetKeyState (VK_MENU
) & 0x8000))
3692 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3696 modifier_set (int vkey
)
3698 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
3699 return (GetKeyState (vkey
) & 0x1);
3700 if (!modifiers_recorded
)
3701 return (GetKeyState (vkey
) & 0x8000);
3706 return modifiers
[EMACS_LCONTROL
];
3708 return modifiers
[EMACS_RCONTROL
];
3710 return modifiers
[EMACS_LMENU
];
3712 return modifiers
[EMACS_RMENU
];
3714 return (GetKeyState (vkey
) & 0x8000);
3717 /* Convert between the modifier bits W32 uses and the modifier bits
3721 w32_key_to_modifier (int key
)
3723 Lisp_Object key_mapping
;
3728 key_mapping
= Vw32_lwindow_modifier
;
3731 key_mapping
= Vw32_rwindow_modifier
;
3734 key_mapping
= Vw32_apps_modifier
;
3737 key_mapping
= Vw32_scroll_lock_modifier
;
3743 /* NB. This code runs in the input thread, asychronously to the lisp
3744 thread, so we must be careful to ensure access to lisp data is
3745 thread-safe. The following code is safe because the modifier
3746 variable values are updated atomically from lisp and symbols are
3747 not relocated by GC. Also, we don't have to worry about seeing GC
3749 if (EQ (key_mapping
, Qhyper
))
3750 return hyper_modifier
;
3751 if (EQ (key_mapping
, Qsuper
))
3752 return super_modifier
;
3753 if (EQ (key_mapping
, Qmeta
))
3754 return meta_modifier
;
3755 if (EQ (key_mapping
, Qalt
))
3756 return alt_modifier
;
3757 if (EQ (key_mapping
, Qctrl
))
3758 return ctrl_modifier
;
3759 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
3760 return ctrl_modifier
;
3761 if (EQ (key_mapping
, Qshift
))
3762 return shift_modifier
;
3764 /* Don't generate any modifier if not explicitly requested. */
3769 w32_get_modifiers ()
3771 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
3772 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
3773 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
3774 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
3775 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
3776 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
3777 (modifier_set (VK_MENU
) ?
3778 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
3781 /* We map the VK_* modifiers into console modifier constants
3782 so that we can use the same routines to handle both console
3783 and window input. */
3786 construct_console_modifiers ()
3791 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3792 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3793 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
3794 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
3795 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3796 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3797 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3798 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3799 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
3800 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
3801 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
3807 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
3811 /* Convert to emacs modifiers. */
3812 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
3818 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
3820 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
3823 if (virt_key
== VK_RETURN
)
3824 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3826 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
3827 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
3829 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
3830 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
3832 if (virt_key
== VK_CLEAR
)
3833 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
3838 /* List of special key combinations which w32 would normally capture,
3839 but emacs should grab instead. Not directly visible to lisp, to
3840 simplify synchronization. Each item is an integer encoding a virtual
3841 key code and modifier combination to capture. */
3842 Lisp_Object w32_grabbed_keys
;
3844 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3845 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3846 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3847 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3849 /* Register hot-keys for reserved key combinations when Emacs has
3850 keyboard focus, since this is the only way Emacs can receive key
3851 combinations like Alt-Tab which are used by the system. */
3854 register_hot_keys (hwnd
)
3857 Lisp_Object keylist
;
3859 /* Use GC_CONSP, since we are called asynchronously. */
3860 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3862 Lisp_Object key
= XCAR (keylist
);
3864 /* Deleted entries get set to nil. */
3865 if (!INTEGERP (key
))
3868 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
3869 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
3874 unregister_hot_keys (hwnd
)
3877 Lisp_Object keylist
;
3879 /* Use GC_CONSP, since we are called asynchronously. */
3880 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3882 Lisp_Object key
= XCAR (keylist
);
3884 if (!INTEGERP (key
))
3887 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
3891 /* Main message dispatch loop. */
3894 w32_msg_pump (deferred_msg
* msg_buf
)
3900 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3902 while (GetMessage (&msg
, NULL
, 0, 0))
3904 if (msg
.hwnd
== NULL
)
3906 switch (msg
.message
)
3909 /* Produced by complete_deferred_msg; just ignore. */
3911 case WM_EMACS_CREATEWINDOW
:
3912 w32_createwindow ((struct frame
*) msg
.wParam
);
3913 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3916 case WM_EMACS_SETLOCALE
:
3917 SetThreadLocale (msg
.wParam
);
3918 /* Reply is not expected. */
3920 case WM_EMACS_SETKEYBOARDLAYOUT
:
3921 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
3922 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3926 case WM_EMACS_REGISTER_HOT_KEY
:
3927 focus_window
= GetFocus ();
3928 if (focus_window
!= NULL
)
3929 RegisterHotKey (focus_window
,
3930 HOTKEY_ID (msg
.wParam
),
3931 HOTKEY_MODIFIERS (msg
.wParam
),
3932 HOTKEY_VK_CODE (msg
.wParam
));
3933 /* Reply is not expected. */
3935 case WM_EMACS_UNREGISTER_HOT_KEY
:
3936 focus_window
= GetFocus ();
3937 if (focus_window
!= NULL
)
3938 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
3939 /* Mark item as erased. NB: this code must be
3940 thread-safe. The next line is okay because the cons
3941 cell is never made into garbage and is not relocated by
3943 XSETCAR ((Lisp_Object
) msg
.lParam
, Qnil
);
3944 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3947 case WM_EMACS_TOGGLE_LOCK_KEY
:
3949 int vk_code
= (int) msg
.wParam
;
3950 int cur_state
= (GetKeyState (vk_code
) & 1);
3951 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
3953 /* NB: This code must be thread-safe. It is safe to
3954 call NILP because symbols are not relocated by GC,
3955 and pointer here is not touched by GC (so the markbit
3956 can't be set). Numbers are safe because they are
3957 immediate values. */
3958 if (NILP (new_state
)
3959 || (NUMBERP (new_state
)
3960 && ((XUINT (new_state
)) & 1) != cur_state
))
3962 one_w32_display_info
.faked_key
= vk_code
;
3964 keybd_event ((BYTE
) vk_code
,
3965 (BYTE
) MapVirtualKey (vk_code
, 0),
3966 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3967 keybd_event ((BYTE
) vk_code
,
3968 (BYTE
) MapVirtualKey (vk_code
, 0),
3969 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3970 keybd_event ((BYTE
) vk_code
,
3971 (BYTE
) MapVirtualKey (vk_code
, 0),
3972 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3973 cur_state
= !cur_state
;
3975 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3981 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3986 DispatchMessage (&msg
);
3989 /* Exit nested loop when our deferred message has completed. */
3990 if (msg_buf
->completed
)
3995 deferred_msg
* deferred_msg_head
;
3997 static deferred_msg
*
3998 find_deferred_msg (HWND hwnd
, UINT msg
)
4000 deferred_msg
* item
;
4002 /* Don't actually need synchronization for read access, since
4003 modification of single pointer is always atomic. */
4004 /* enter_crit (); */
4006 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
4007 if (item
->w32msg
.msg
.hwnd
== hwnd
4008 && item
->w32msg
.msg
.message
== msg
)
4011 /* leave_crit (); */
4017 send_deferred_msg (deferred_msg
* msg_buf
,
4023 /* Only input thread can send deferred messages. */
4024 if (GetCurrentThreadId () != dwWindowsThreadId
)
4027 /* It is an error to send a message that is already deferred. */
4028 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4031 /* Enforced synchronization is not needed because this is the only
4032 function that alters deferred_msg_head, and the following critical
4033 section is guaranteed to only be serially reentered (since only the
4034 input thread can call us). */
4036 /* enter_crit (); */
4038 msg_buf
->completed
= 0;
4039 msg_buf
->next
= deferred_msg_head
;
4040 deferred_msg_head
= msg_buf
;
4041 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
4043 /* leave_crit (); */
4045 /* Start a new nested message loop to process other messages until
4046 this one is completed. */
4047 w32_msg_pump (msg_buf
);
4049 deferred_msg_head
= msg_buf
->next
;
4051 return msg_buf
->result
;
4055 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
4057 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
4059 if (msg_buf
== NULL
)
4060 /* Message may have been cancelled, so don't abort(). */
4063 msg_buf
->result
= result
;
4064 msg_buf
->completed
= 1;
4066 /* Ensure input thread is woken so it notices the completion. */
4067 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
4071 cancel_all_deferred_msgs ()
4073 deferred_msg
* item
;
4075 /* Don't actually need synchronization for read access, since
4076 modification of single pointer is always atomic. */
4077 /* enter_crit (); */
4079 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
4082 item
->completed
= 1;
4085 /* leave_crit (); */
4087 /* Ensure input thread is woken so it notices the completion. */
4088 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
4096 deferred_msg dummy_buf
;
4098 /* Ensure our message queue is created */
4100 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
4102 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
4105 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
4106 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
4107 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
4109 /* This is the inital message loop which should only exit when the
4110 application quits. */
4111 w32_msg_pump (&dummy_buf
);
4117 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
4127 wmsg
.dwModifiers
= modifiers
;
4129 /* Detect quit_char and set quit-flag directly. Note that we
4130 still need to post a message to ensure the main thread will be
4131 woken up if blocked in sys_select(), but we do NOT want to post
4132 the quit_char message itself (because it will usually be as if
4133 the user had typed quit_char twice). Instead, we post a dummy
4134 message that has no particular effect. */
4137 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
4138 c
= make_ctrl_char (c
) & 0377;
4140 || (wmsg
.dwModifiers
== 0 &&
4141 XFASTINT (Vw32_quit_key
) && wParam
== XFASTINT (Vw32_quit_key
)))
4145 /* The choice of message is somewhat arbitrary, as long as
4146 the main thread handler just ignores it. */
4149 /* Interrupt any blocking system calls. */
4152 /* As a safety precaution, forcibly complete any deferred
4153 messages. This is a kludge, but I don't see any particularly
4154 clean way to handle the situation where a deferred message is
4155 "dropped" in the lisp thread, and will thus never be
4156 completed, eg. by the user trying to activate the menubar
4157 when the lisp thread is busy, and then typing C-g when the
4158 menubar doesn't open promptly (with the result that the
4159 menubar never responds at all because the deferred
4160 WM_INITMENU message is never completed). Another problem
4161 situation is when the lisp thread calls SendMessage (to send
4162 a window manager command) when a message has been deferred;
4163 the lisp thread gets blocked indefinitely waiting for the
4164 deferred message to be completed, which itself is waiting for
4165 the lisp thread to respond.
4167 Note that we don't want to block the input thread waiting for
4168 a reponse from the lisp thread (although that would at least
4169 solve the deadlock problem above), because we want to be able
4170 to receive C-g to interrupt the lisp thread. */
4171 cancel_all_deferred_msgs ();
4175 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4178 /* Main window procedure */
4181 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
4188 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
4190 int windows_translate
;
4193 /* Note that it is okay to call x_window_to_frame, even though we are
4194 not running in the main lisp thread, because frame deletion
4195 requires the lisp thread to synchronize with this thread. Thus, if
4196 a frame struct is returned, it can be used without concern that the
4197 lisp thread might make it disappear while we are using it.
4199 NB. Walking the frame list in this thread is safe (as long as
4200 writes of Lisp_Object slots are atomic, which they are on Windows).
4201 Although delete-frame can destructively modify the frame list while
4202 we are walking it, a garbage collection cannot occur until after
4203 delete-frame has synchronized with this thread.
4205 It is also safe to use functions that make GDI calls, such as
4206 w32_clear_rect, because these functions must obtain a DC handle
4207 from the frame struct using get_frame_dc which is thread-aware. */
4212 f
= x_window_to_frame (dpyinfo
, hwnd
);
4215 HDC hdc
= get_frame_dc (f
);
4216 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
4217 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
4218 release_frame_dc (f
, hdc
);
4220 #if defined (W32_DEBUG_DISPLAY)
4221 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4223 wmsg
.rect
.left
, wmsg
.rect
.top
,
4224 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4225 #endif /* W32_DEBUG_DISPLAY */
4228 case WM_PALETTECHANGED
:
4229 /* ignore our own changes */
4230 if ((HWND
)wParam
!= hwnd
)
4232 f
= x_window_to_frame (dpyinfo
, hwnd
);
4234 /* get_frame_dc will realize our palette and force all
4235 frames to be redrawn if needed. */
4236 release_frame_dc (f
, get_frame_dc (f
));
4241 PAINTSTRUCT paintStruct
;
4243 bzero (&update_rect
, sizeof (update_rect
));
4245 f
= x_window_to_frame (dpyinfo
, hwnd
);
4248 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
4252 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4253 fails. Apparently this can happen under some
4255 if (GetUpdateRect (hwnd
, &update_rect
, FALSE
) || !w32_strict_painting
)
4258 BeginPaint (hwnd
, &paintStruct
);
4260 /* The rectangles returned by GetUpdateRect and BeginPaint
4261 do not always match. Play it safe by assuming both areas
4263 UnionRect (&(wmsg
.rect
), &update_rect
, &(paintStruct
.rcPaint
));
4265 #if defined (W32_DEBUG_DISPLAY)
4266 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4268 wmsg
.rect
.left
, wmsg
.rect
.top
,
4269 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4270 DebPrint ((" [update region is %d,%d-%d,%d]\n",
4271 update_rect
.left
, update_rect
.top
,
4272 update_rect
.right
, update_rect
.bottom
));
4274 EndPaint (hwnd
, &paintStruct
);
4277 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4282 /* If GetUpdateRect returns 0 (meaning there is no update
4283 region), assume the whole window needs to be repainted. */
4284 GetClientRect(hwnd
, &wmsg
.rect
);
4285 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4289 case WM_INPUTLANGCHANGE
:
4290 /* Inform lisp thread of keyboard layout changes. */
4291 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4293 /* Clear dead keys in the keyboard state; for simplicity only
4294 preserve modifier key states. */
4299 GetKeyboardState (keystate
);
4300 for (i
= 0; i
< 256; i
++)
4317 SetKeyboardState (keystate
);
4322 /* Synchronize hot keys with normal input. */
4323 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
4328 record_keyup (wParam
, lParam
);
4333 /* Ignore keystrokes we fake ourself; see below. */
4334 if (dpyinfo
->faked_key
== wParam
)
4336 dpyinfo
->faked_key
= 0;
4337 /* Make sure TranslateMessage sees them though (as long as
4338 they don't produce WM_CHAR messages). This ensures that
4339 indicator lights are toggled promptly on Windows 9x, for
4341 if (lispy_function_keys
[wParam
] != 0)
4343 windows_translate
= 1;
4349 /* Synchronize modifiers with current keystroke. */
4351 record_keydown (wParam
, lParam
);
4352 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
4354 windows_translate
= 0;
4359 if (NILP (Vw32_pass_lwindow_to_system
))
4361 /* Prevent system from acting on keyup (which opens the
4362 Start menu if no other key was pressed) by simulating a
4363 press of Space which we will ignore. */
4364 if (GetAsyncKeyState (wParam
) & 1)
4366 if (NUMBERP (Vw32_phantom_key_code
))
4367 key
= XUINT (Vw32_phantom_key_code
) & 255;
4370 dpyinfo
->faked_key
= key
;
4371 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4374 if (!NILP (Vw32_lwindow_modifier
))
4378 if (NILP (Vw32_pass_rwindow_to_system
))
4380 if (GetAsyncKeyState (wParam
) & 1)
4382 if (NUMBERP (Vw32_phantom_key_code
))
4383 key
= XUINT (Vw32_phantom_key_code
) & 255;
4386 dpyinfo
->faked_key
= key
;
4387 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4390 if (!NILP (Vw32_rwindow_modifier
))
4394 if (!NILP (Vw32_apps_modifier
))
4398 if (NILP (Vw32_pass_alt_to_system
))
4399 /* Prevent DefWindowProc from activating the menu bar if an
4400 Alt key is pressed and released by itself. */
4402 windows_translate
= 1;
4405 /* Decide whether to treat as modifier or function key. */
4406 if (NILP (Vw32_enable_caps_lock
))
4407 goto disable_lock_key
;
4408 windows_translate
= 1;
4411 /* Decide whether to treat as modifier or function key. */
4412 if (NILP (Vw32_enable_num_lock
))
4413 goto disable_lock_key
;
4414 windows_translate
= 1;
4417 /* Decide whether to treat as modifier or function key. */
4418 if (NILP (Vw32_scroll_lock_modifier
))
4419 goto disable_lock_key
;
4420 windows_translate
= 1;
4423 /* Ensure the appropriate lock key state (and indicator light)
4424 remains in the same state. We do this by faking another
4425 press of the relevant key. Apparently, this really is the
4426 only way to toggle the state of the indicator lights. */
4427 dpyinfo
->faked_key
= wParam
;
4428 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4429 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4430 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4431 KEYEVENTF_EXTENDEDKEY
| 0, 0);
4432 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4433 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4434 /* Ensure indicator lights are updated promptly on Windows 9x
4435 (TranslateMessage apparently does this), after forwarding
4437 post_character_message (hwnd
, msg
, wParam
, lParam
,
4438 w32_get_key_modifiers (wParam
, lParam
));
4439 windows_translate
= 1;
4443 case VK_PROCESSKEY
: /* Generated by IME. */
4444 windows_translate
= 1;
4447 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4448 which is confusing for purposes of key binding; convert
4449 VK_CANCEL events into VK_PAUSE events. */
4453 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4454 for purposes of key binding; convert these back into
4455 VK_NUMLOCK events, at least when we want to see NumLock key
4456 presses. (Note that there is never any possibility that
4457 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4458 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
4459 wParam
= VK_NUMLOCK
;
4462 /* If not defined as a function key, change it to a WM_CHAR message. */
4463 if (lispy_function_keys
[wParam
] == 0)
4465 DWORD modifiers
= construct_console_modifiers ();
4467 if (!NILP (Vw32_recognize_altgr
)
4468 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
4470 /* Always let TranslateMessage handle AltGr key chords;
4471 for some reason, ToAscii doesn't always process AltGr
4472 chords correctly. */
4473 windows_translate
= 1;
4475 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
4477 /* Handle key chords including any modifiers other
4478 than shift directly, in order to preserve as much
4479 modifier information as possible. */
4480 if ('A' <= wParam
&& wParam
<= 'Z')
4482 /* Don't translate modified alphabetic keystrokes,
4483 so the user doesn't need to constantly switch
4484 layout to type control or meta keystrokes when
4485 the normal layout translates alphabetic
4486 characters to non-ascii characters. */
4487 if (!modifier_set (VK_SHIFT
))
4488 wParam
+= ('a' - 'A');
4493 /* Try to handle other keystrokes by determining the
4494 base character (ie. translating the base key plus
4498 KEY_EVENT_RECORD key
;
4500 key
.bKeyDown
= TRUE
;
4501 key
.wRepeatCount
= 1;
4502 key
.wVirtualKeyCode
= wParam
;
4503 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
4504 key
.uChar
.AsciiChar
= 0;
4505 key
.dwControlKeyState
= modifiers
;
4507 add
= w32_kbd_patch_key (&key
);
4508 /* 0 means an unrecognised keycode, negative means
4509 dead key. Ignore both. */
4512 /* Forward asciified character sequence. */
4513 post_character_message
4514 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
4515 w32_get_key_modifiers (wParam
, lParam
));
4516 w32_kbd_patch_key (&key
);
4523 /* Let TranslateMessage handle everything else. */
4524 windows_translate
= 1;
4530 if (windows_translate
)
4532 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
4534 windows_msg
.time
= GetMessageTime ();
4535 TranslateMessage (&windows_msg
);
4543 post_character_message (hwnd
, msg
, wParam
, lParam
,
4544 w32_get_key_modifiers (wParam
, lParam
));
4547 /* Simulate middle mouse button events when left and right buttons
4548 are used together, but only if user has two button mouse. */
4549 case WM_LBUTTONDOWN
:
4550 case WM_RBUTTONDOWN
:
4551 if (XINT (Vw32_num_mouse_buttons
) > 2)
4552 goto handle_plain_button
;
4555 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
4556 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
4558 if (button_state
& this)
4561 if (button_state
== 0)
4564 button_state
|= this;
4566 if (button_state
& other
)
4568 if (mouse_button_timer
)
4570 KillTimer (hwnd
, mouse_button_timer
);
4571 mouse_button_timer
= 0;
4573 /* Generate middle mouse event instead. */
4574 msg
= WM_MBUTTONDOWN
;
4575 button_state
|= MMOUSE
;
4577 else if (button_state
& MMOUSE
)
4579 /* Ignore button event if we've already generated a
4580 middle mouse down event. This happens if the
4581 user releases and press one of the two buttons
4582 after we've faked a middle mouse event. */
4587 /* Flush out saved message. */
4588 post_msg (&saved_mouse_button_msg
);
4590 wmsg
.dwModifiers
= w32_get_modifiers ();
4591 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4593 /* Clear message buffer. */
4594 saved_mouse_button_msg
.msg
.hwnd
= 0;
4598 /* Hold onto message for now. */
4599 mouse_button_timer
=
4600 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
4601 XINT (Vw32_mouse_button_tolerance
), NULL
);
4602 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
4603 saved_mouse_button_msg
.msg
.message
= msg
;
4604 saved_mouse_button_msg
.msg
.wParam
= wParam
;
4605 saved_mouse_button_msg
.msg
.lParam
= lParam
;
4606 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
4607 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
4614 if (XINT (Vw32_num_mouse_buttons
) > 2)
4615 goto handle_plain_button
;
4618 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
4619 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
4621 if ((button_state
& this) == 0)
4624 button_state
&= ~this;
4626 if (button_state
& MMOUSE
)
4628 /* Only generate event when second button is released. */
4629 if ((button_state
& other
) == 0)
4632 button_state
&= ~MMOUSE
;
4634 if (button_state
) abort ();
4641 /* Flush out saved message if necessary. */
4642 if (saved_mouse_button_msg
.msg
.hwnd
)
4644 post_msg (&saved_mouse_button_msg
);
4647 wmsg
.dwModifiers
= w32_get_modifiers ();
4648 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4650 /* Always clear message buffer and cancel timer. */
4651 saved_mouse_button_msg
.msg
.hwnd
= 0;
4652 KillTimer (hwnd
, mouse_button_timer
);
4653 mouse_button_timer
= 0;
4655 if (button_state
== 0)
4660 case WM_XBUTTONDOWN
:
4662 if (w32_pass_extra_mouse_buttons_to_system
)
4664 /* else fall through and process them. */
4665 case WM_MBUTTONDOWN
:
4667 handle_plain_button
:
4672 if (parse_button (msg
, HIWORD (wParam
), &button
, &up
))
4674 if (up
) ReleaseCapture ();
4675 else SetCapture (hwnd
);
4676 button
= (button
== 0) ? LMOUSE
:
4677 ((button
== 1) ? MMOUSE
: RMOUSE
);
4679 button_state
&= ~button
;
4681 button_state
|= button
;
4685 wmsg
.dwModifiers
= w32_get_modifiers ();
4686 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4688 /* Need to return true for XBUTTON messages, false for others,
4689 to indicate that we processed the message. */
4690 return (msg
== WM_XBUTTONDOWN
|| msg
== WM_XBUTTONUP
);
4693 /* If the mouse has just moved into the frame, start tracking
4694 it, so we will be notified when it leaves the frame. Mouse
4695 tracking only works under W98 and NT4 and later. On earlier
4696 versions, there is no way of telling when the mouse leaves the
4697 frame, so we just have to put up with help-echo and mouse
4698 highlighting remaining while the frame is not active. */
4699 if (track_mouse_event_fn
&& !track_mouse_window
)
4701 TRACKMOUSEEVENT tme
;
4702 tme
.cbSize
= sizeof (tme
);
4703 tme
.dwFlags
= TME_LEAVE
;
4704 tme
.hwndTrack
= hwnd
;
4706 track_mouse_event_fn (&tme
);
4707 track_mouse_window
= hwnd
;
4710 if (XINT (Vw32_mouse_move_interval
) <= 0
4711 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
4713 wmsg
.dwModifiers
= w32_get_modifiers ();
4714 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4718 /* Hang onto mouse move and scroll messages for a bit, to avoid
4719 sending such events to Emacs faster than it can process them.
4720 If we get more events before the timer from the first message
4721 expires, we just replace the first message. */
4723 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
4725 SetTimer (hwnd
, MOUSE_MOVE_ID
,
4726 XINT (Vw32_mouse_move_interval
), NULL
);
4728 /* Hold onto message for now. */
4729 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
4730 saved_mouse_move_msg
.msg
.message
= msg
;
4731 saved_mouse_move_msg
.msg
.wParam
= wParam
;
4732 saved_mouse_move_msg
.msg
.lParam
= lParam
;
4733 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
4734 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
4739 wmsg
.dwModifiers
= w32_get_modifiers ();
4740 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4744 wmsg
.dwModifiers
= w32_get_modifiers ();
4745 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4749 /* Flush out saved messages if necessary. */
4750 if (wParam
== mouse_button_timer
)
4752 if (saved_mouse_button_msg
.msg
.hwnd
)
4754 post_msg (&saved_mouse_button_msg
);
4755 saved_mouse_button_msg
.msg
.hwnd
= 0;
4757 KillTimer (hwnd
, mouse_button_timer
);
4758 mouse_button_timer
= 0;
4760 else if (wParam
== mouse_move_timer
)
4762 if (saved_mouse_move_msg
.msg
.hwnd
)
4764 post_msg (&saved_mouse_move_msg
);
4765 saved_mouse_move_msg
.msg
.hwnd
= 0;
4767 KillTimer (hwnd
, mouse_move_timer
);
4768 mouse_move_timer
= 0;
4770 else if (wParam
== menu_free_timer
)
4772 KillTimer (hwnd
, menu_free_timer
);
4773 menu_free_timer
= 0;
4774 f
= x_window_to_frame (dpyinfo
, hwnd
);
4775 if (!f
->output_data
.w32
->menu_command_in_progress
)
4777 /* Free memory used by owner-drawn and help-echo strings. */
4778 w32_free_menu_strings (hwnd
);
4779 f
->output_data
.w32
->menubar_active
= 0;
4785 /* Windows doesn't send us focus messages when putting up and
4786 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4787 The only indication we get that something happened is receiving
4788 this message afterwards. So this is a good time to reset our
4789 keyboard modifiers' state. */
4796 /* We must ensure menu bar is fully constructed and up to date
4797 before allowing user interaction with it. To achieve this
4798 we send this message to the lisp thread and wait for a
4799 reply (whose value is not actually needed) to indicate that
4800 the menu bar is now ready for use, so we can now return.
4802 To remain responsive in the meantime, we enter a nested message
4803 loop that can process all other messages.
4805 However, we skip all this if the message results from calling
4806 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4807 thread a message because it is blocked on us at this point. We
4808 set menubar_active before calling TrackPopupMenu to indicate
4809 this (there is no possibility of confusion with real menubar
4812 f
= x_window_to_frame (dpyinfo
, hwnd
);
4814 && (f
->output_data
.w32
->menubar_active
4815 /* We can receive this message even in the absence of a
4816 menubar (ie. when the system menu is activated) - in this
4817 case we do NOT want to forward the message, otherwise it
4818 will cause the menubar to suddenly appear when the user
4819 had requested it to be turned off! */
4820 || f
->output_data
.w32
->menubar_widget
== NULL
))
4824 deferred_msg msg_buf
;
4826 /* Detect if message has already been deferred; in this case
4827 we cannot return any sensible value to ignore this. */
4828 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4831 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
4834 case WM_EXITMENULOOP
:
4835 f
= x_window_to_frame (dpyinfo
, hwnd
);
4837 /* If a menu command is not already in progress, check again
4838 after a short delay, since Windows often (always?) sends the
4839 WM_EXITMENULOOP before the corresponding WM_COMMAND message. */
4840 if (f
&& !f
->output_data
.w32
->menu_command_in_progress
)
4841 menu_free_timer
= SetTimer (hwnd
, MENU_FREE_ID
, MENU_FREE_DELAY
, NULL
);
4845 /* Direct handling of help_echo in menus. Should be safe now
4846 that we generate the help_echo by placing a help event in the
4849 HMENU menu
= (HMENU
) lParam
;
4850 UINT menu_item
= (UINT
) LOWORD (wParam
);
4851 UINT flags
= (UINT
) HIWORD (wParam
);
4853 w32_menu_display_help (hwnd
, menu
, menu_item
, flags
);
4857 case WM_MEASUREITEM
:
4858 f
= x_window_to_frame (dpyinfo
, hwnd
);
4861 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
4863 if (pMis
->CtlType
== ODT_MENU
)
4865 /* Work out dimensions for popup menu titles. */
4866 char * title
= (char *) pMis
->itemData
;
4867 HDC hdc
= GetDC (hwnd
);
4868 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4869 LOGFONT menu_logfont
;
4873 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4874 menu_logfont
.lfWeight
= FW_BOLD
;
4875 menu_font
= CreateFontIndirect (&menu_logfont
);
4876 old_font
= SelectObject (hdc
, menu_font
);
4878 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
4881 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
4882 pMis
->itemWidth
= size
.cx
;
4883 if (pMis
->itemHeight
< size
.cy
)
4884 pMis
->itemHeight
= size
.cy
;
4887 pMis
->itemWidth
= 0;
4889 SelectObject (hdc
, old_font
);
4890 DeleteObject (menu_font
);
4891 ReleaseDC (hwnd
, hdc
);
4898 f
= x_window_to_frame (dpyinfo
, hwnd
);
4901 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
4903 if (pDis
->CtlType
== ODT_MENU
)
4905 /* Draw popup menu title. */
4906 char * title
= (char *) pDis
->itemData
;
4909 HDC hdc
= pDis
->hDC
;
4910 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4911 LOGFONT menu_logfont
;
4914 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4915 menu_logfont
.lfWeight
= FW_BOLD
;
4916 menu_font
= CreateFontIndirect (&menu_logfont
);
4917 old_font
= SelectObject (hdc
, menu_font
);
4919 /* Always draw title as if not selected. */
4922 + GetSystemMetrics (SM_CXMENUCHECK
),
4924 ETO_OPAQUE
, &pDis
->rcItem
,
4925 title
, strlen (title
), NULL
);
4927 SelectObject (hdc
, old_font
);
4928 DeleteObject (menu_font
);
4936 /* Still not right - can't distinguish between clicks in the
4937 client area of the frame from clicks forwarded from the scroll
4938 bars - may have to hook WM_NCHITTEST to remember the mouse
4939 position and then check if it is in the client area ourselves. */
4940 case WM_MOUSEACTIVATE
:
4941 /* Discard the mouse click that activates a frame, allowing the
4942 user to click anywhere without changing point (or worse!).
4943 Don't eat mouse clicks on scrollbars though!! */
4944 if (LOWORD (lParam
) == HTCLIENT
)
4945 return MA_ACTIVATEANDEAT
;
4950 /* No longer tracking mouse. */
4951 track_mouse_window
= NULL
;
4953 case WM_ACTIVATEAPP
:
4955 case WM_WINDOWPOSCHANGED
:
4957 /* Inform lisp thread that a frame might have just been obscured
4958 or exposed, so should recheck visibility of all frames. */
4959 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4963 dpyinfo
->faked_key
= 0;
4965 register_hot_keys (hwnd
);
4968 unregister_hot_keys (hwnd
);
4971 /* Relinquish the system caret. */
4972 if (w32_system_caret_hwnd
)
4974 w32_visible_system_caret_hwnd
= NULL
;
4975 w32_system_caret_hwnd
= NULL
;
4980 f
= x_window_to_frame (dpyinfo
, hwnd
);
4981 if (f
&& HIWORD (wParam
) == 0)
4983 f
->output_data
.w32
->menu_command_in_progress
= 1;
4984 if (menu_free_timer
)
4986 KillTimer (hwnd
, menu_free_timer
);
4987 menu_free_timer
= 0;
4993 wmsg
.dwModifiers
= w32_get_modifiers ();
4994 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4998 wmsg
.dwModifiers
= w32_get_modifiers ();
4999 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
5002 case WM_WINDOWPOSCHANGING
:
5003 /* Don't restrict the sizing of tip frames. */
5004 if (hwnd
== tip_window
)
5008 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
5010 wp
.length
= sizeof (WINDOWPLACEMENT
);
5011 GetWindowPlacement (hwnd
, &wp
);
5013 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
5020 DWORD internal_border
;
5021 DWORD scrollbar_extra
;
5024 wp
.length
= sizeof(wp
);
5025 GetWindowRect (hwnd
, &wr
);
5029 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
5030 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
5031 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
5032 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
5036 memset (&rect
, 0, sizeof (rect
));
5037 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
5038 GetMenu (hwnd
) != NULL
);
5040 /* Force width and height of client area to be exact
5041 multiples of the character cell dimensions. */
5042 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
5043 - 2 * internal_border
- scrollbar_extra
)
5045 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
5046 - 2 * internal_border
)
5051 /* For right/bottom sizing we can just fix the sizes.
5052 However for top/left sizing we will need to fix the X
5053 and Y positions as well. */
5058 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
5059 && (lppos
->flags
& SWP_NOMOVE
) == 0)
5061 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
5068 lppos
->flags
|= SWP_NOMOVE
;
5079 case WM_GETMINMAXINFO
:
5080 /* Hack to correct bug that allows Emacs frames to be resized
5081 below the Minimum Tracking Size. */
5082 ((LPMINMAXINFO
) lParam
)->ptMinTrackSize
.y
++;
5083 /* Hack to allow resizing the Emacs frame above the screen size.
5084 Note that Windows 9x limits coordinates to 16-bits. */
5085 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
5086 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
5090 if (LOWORD (lParam
) == HTCLIENT
)
5095 case WM_EMACS_SETCURSOR
:
5097 Cursor cursor
= (Cursor
) wParam
;
5103 case WM_EMACS_CREATESCROLLBAR
:
5104 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
5105 (struct scroll_bar
*) lParam
);
5107 case WM_EMACS_SHOWWINDOW
:
5108 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
5110 case WM_EMACS_SETFOREGROUND
:
5112 HWND foreground_window
;
5113 DWORD foreground_thread
, retval
;
5115 /* On NT 5.0, and apparently Windows 98, it is necessary to
5116 attach to the thread that currently has focus in order to
5117 pull the focus away from it. */
5118 foreground_window
= GetForegroundWindow ();
5119 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
5120 if (!foreground_window
5121 || foreground_thread
== GetCurrentThreadId ()
5122 || !AttachThreadInput (GetCurrentThreadId (),
5123 foreground_thread
, TRUE
))
5124 foreground_thread
= 0;
5126 retval
= SetForegroundWindow ((HWND
) wParam
);
5128 /* Detach from the previous foreground thread. */
5129 if (foreground_thread
)
5130 AttachThreadInput (GetCurrentThreadId (),
5131 foreground_thread
, FALSE
);
5136 case WM_EMACS_SETWINDOWPOS
:
5138 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
5139 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
5140 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
5143 case WM_EMACS_DESTROYWINDOW
:
5144 DragAcceptFiles ((HWND
) wParam
, FALSE
);
5145 return DestroyWindow ((HWND
) wParam
);
5147 case WM_EMACS_HIDE_CARET
:
5148 return HideCaret (hwnd
);
5150 case WM_EMACS_SHOW_CARET
:
5151 return ShowCaret (hwnd
);
5153 case WM_EMACS_DESTROY_CARET
:
5154 w32_system_caret_hwnd
= NULL
;
5155 w32_visible_system_caret_hwnd
= NULL
;
5156 return DestroyCaret ();
5158 case WM_EMACS_TRACK_CARET
:
5159 /* If there is currently no system caret, create one. */
5160 if (w32_system_caret_hwnd
== NULL
)
5162 /* Use the default caret width, and avoid changing it
5163 unneccesarily, as it confuses screen reader software. */
5164 w32_system_caret_hwnd
= hwnd
;
5165 CreateCaret (hwnd
, NULL
, 0,
5166 w32_system_caret_height
);
5169 if (!SetCaretPos (w32_system_caret_x
, w32_system_caret_y
))
5171 /* Ensure visible caret gets turned on when requested. */
5172 else if (w32_use_visible_system_caret
5173 && w32_visible_system_caret_hwnd
!= hwnd
)
5175 w32_visible_system_caret_hwnd
= hwnd
;
5176 return ShowCaret (hwnd
);
5178 /* Ensure visible caret gets turned off when requested. */
5179 else if (!w32_use_visible_system_caret
5180 && w32_visible_system_caret_hwnd
)
5182 w32_visible_system_caret_hwnd
= NULL
;
5183 return HideCaret (hwnd
);
5188 case WM_EMACS_TRACKPOPUPMENU
:
5193 pos
= (POINT
*)lParam
;
5194 flags
= TPM_CENTERALIGN
;
5195 if (button_state
& LMOUSE
)
5196 flags
|= TPM_LEFTBUTTON
;
5197 else if (button_state
& RMOUSE
)
5198 flags
|= TPM_RIGHTBUTTON
;
5200 /* Remember we did a SetCapture on the initial mouse down event,
5201 so for safety, we make sure the capture is cancelled now. */
5205 /* Use menubar_active to indicate that WM_INITMENU is from
5206 TrackPopupMenu below, and should be ignored. */
5207 f
= x_window_to_frame (dpyinfo
, hwnd
);
5209 f
->output_data
.w32
->menubar_active
= 1;
5211 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
5215 /* Eat any mouse messages during popupmenu */
5216 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
5218 /* Get the menu selection, if any */
5219 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
5221 retval
= LOWORD (amsg
.wParam
);
5237 /* Check for messages registered at runtime. */
5238 if (msg
== msh_mousewheel
)
5240 wmsg
.dwModifiers
= w32_get_modifiers ();
5241 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
5246 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
5250 /* The most common default return code for handled messages is 0. */
5255 my_create_window (f
)
5260 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
5262 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
5266 /* Create a tooltip window. Unlike my_create_window, we do not do this
5267 indirectly via the Window thread, as we do not need to process Window
5268 messages for the tooltip. Creating tooltips indirectly also creates
5269 deadlocks when tooltips are created for menu items. */
5271 my_create_tip_window (f
)
5276 rect
.left
= rect
.top
= 0;
5277 rect
.right
= PIXEL_WIDTH (f
);
5278 rect
.bottom
= PIXEL_HEIGHT (f
);
5280 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
5281 FRAME_EXTERNAL_MENU_BAR (f
));
5283 tip_window
= FRAME_W32_WINDOW (f
)
5284 = CreateWindow (EMACS_CLASS
,
5286 f
->output_data
.w32
->dwStyle
,
5287 f
->output_data
.w32
->left_pos
,
5288 f
->output_data
.w32
->top_pos
,
5289 rect
.right
- rect
.left
,
5290 rect
.bottom
- rect
.top
,
5291 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
5298 SetWindowLong (tip_window
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
5299 SetWindowLong (tip_window
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
5300 SetWindowLong (tip_window
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
5301 SetWindowLong (tip_window
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
5303 /* Tip frames have no scrollbars. */
5304 SetWindowLong (tip_window
, WND_SCROLLBAR_INDEX
, 0);
5306 /* Do this to discard the default setting specified by our parent. */
5307 ShowWindow (tip_window
, SW_HIDE
);
5312 /* Create and set up the w32 window for frame F. */
5315 w32_window (f
, window_prompting
, minibuffer_only
)
5317 long window_prompting
;
5318 int minibuffer_only
;
5322 /* Use the resource name as the top-level window name
5323 for looking up resources. Make a non-Lisp copy
5324 for the window manager, so GC relocation won't bother it.
5326 Elsewhere we specify the window name for the window manager. */
5329 char *str
= (char *) SDATA (Vx_resource_name
);
5330 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
5331 strcpy (f
->namebuf
, str
);
5334 my_create_window (f
);
5336 validate_x_resource_name ();
5338 /* x_set_name normally ignores requests to set the name if the
5339 requested name is the same as the current name. This is the one
5340 place where that assumption isn't correct; f->name is set, but
5341 the server hasn't been told. */
5344 int explicit = f
->explicit_name
;
5346 f
->explicit_name
= 0;
5349 x_set_name (f
, name
, explicit);
5354 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
5355 initialize_frame_menubar (f
);
5357 if (FRAME_W32_WINDOW (f
) == 0)
5358 error ("Unable to create window");
5361 /* Handle the icon stuff for this window. Perhaps later we might
5362 want an x_set_icon_position which can be called interactively as
5370 Lisp_Object icon_x
, icon_y
;
5372 /* Set the position of the icon. Note that Windows 95 groups all
5373 icons in the tray. */
5374 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
5375 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
5376 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
5378 CHECK_NUMBER (icon_x
);
5379 CHECK_NUMBER (icon_y
);
5381 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
5382 error ("Both left and top icon corners of icon must be specified");
5386 if (! EQ (icon_x
, Qunbound
))
5387 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
5390 /* Start up iconic or window? */
5391 x_wm_set_window_state
5392 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
5396 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
5409 XGCValues gc_values
;
5413 /* Create the GC's of this frame.
5414 Note that many default values are used. */
5417 gc_values
.font
= f
->output_data
.w32
->font
;
5419 /* Cursor has cursor-color background, background-color foreground. */
5420 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
5421 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
5422 f
->output_data
.w32
->cursor_gc
5423 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
5424 (GCFont
| GCForeground
| GCBackground
),
5428 f
->output_data
.w32
->white_relief
.gc
= 0;
5429 f
->output_data
.w32
->black_relief
.gc
= 0;
5435 /* Handler for signals raised during x_create_frame and
5436 x_create_top_frame. FRAME is the frame which is partially
5440 unwind_create_frame (frame
)
5443 struct frame
*f
= XFRAME (frame
);
5445 /* If frame is ``official'', nothing to do. */
5446 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
5449 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5452 x_free_frame_resources (f
);
5454 /* Check that reference counts are indeed correct. */
5455 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
5456 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
5465 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
5467 doc
: /* Make a new window, which is called a \"frame\" in Emacs terms.
5468 Returns an Emacs frame object.
5469 ALIST is an alist of frame parameters.
5470 If the parameters specify that the frame should not have a minibuffer,
5471 and do not specify a specific minibuffer window to use,
5472 then `default-minibuffer-frame' must be a frame whose minibuffer can
5473 be shared by the new frame.
5475 This function is an internal primitive--use `make-frame' instead. */)
5480 Lisp_Object frame
, tem
;
5482 int minibuffer_only
= 0;
5483 long window_prompting
= 0;
5485 int count
= SPECPDL_INDEX ();
5486 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
5487 Lisp_Object display
;
5488 struct w32_display_info
*dpyinfo
= NULL
;
5494 /* Use this general default value to start with
5495 until we know if this frame has a specified name. */
5496 Vx_resource_name
= Vinvocation_name
;
5498 display
= w32_get_arg (parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
5499 if (EQ (display
, Qunbound
))
5501 dpyinfo
= check_x_display_info (display
);
5503 kb
= dpyinfo
->kboard
;
5505 kb
= &the_only_kboard
;
5508 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
5510 && ! EQ (name
, Qunbound
)
5512 error ("Invalid frame name--not a string or nil");
5515 Vx_resource_name
= name
;
5517 /* See if parent window is specified. */
5518 parent
= w32_get_arg (parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
5519 if (EQ (parent
, Qunbound
))
5521 if (! NILP (parent
))
5522 CHECK_NUMBER (parent
);
5524 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5525 /* No need to protect DISPLAY because that's not used after passing
5526 it to make_frame_without_minibuffer. */
5528 GCPRO4 (parms
, parent
, name
, frame
);
5529 tem
= w32_get_arg (parms
, Qminibuffer
, "minibuffer", "Minibuffer",
5531 if (EQ (tem
, Qnone
) || NILP (tem
))
5532 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
5533 else if (EQ (tem
, Qonly
))
5535 f
= make_minibuffer_frame ();
5536 minibuffer_only
= 1;
5538 else if (WINDOWP (tem
))
5539 f
= make_frame_without_minibuffer (tem
, kb
, display
);
5543 XSETFRAME (frame
, f
);
5545 /* Note that Windows does support scroll bars. */
5546 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
5547 /* By default, make scrollbars the system standard width. */
5548 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
5550 f
->output_method
= output_w32
;
5551 f
->output_data
.w32
=
5552 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
5553 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
5554 FRAME_FONTSET (f
) = -1;
5555 record_unwind_protect (unwind_create_frame
, frame
);
5558 = w32_get_arg (parms
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
5559 if (! STRINGP (f
->icon_name
))
5560 f
->icon_name
= Qnil
;
5562 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
5564 FRAME_KBOARD (f
) = kb
;
5567 /* Specify the parent under which to make this window. */
5571 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
5572 f
->output_data
.w32
->explicit_parent
= 1;
5576 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5577 f
->output_data
.w32
->explicit_parent
= 0;
5580 /* Set the name; the functions to which we pass f expect the name to
5582 if (EQ (name
, Qunbound
) || NILP (name
))
5584 f
->name
= build_string (dpyinfo
->w32_id_name
);
5585 f
->explicit_name
= 0;
5590 f
->explicit_name
= 1;
5591 /* use the frame's title when getting resources for this frame. */
5592 specbind (Qx_resource_name
, name
);
5595 /* Extract the window parameters from the supplied values
5596 that are needed to determine window geometry. */
5600 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
5603 /* First, try whatever font the caller has specified. */
5606 tem
= Fquery_fontset (font
, Qnil
);
5608 font
= x_new_fontset (f
, SDATA (tem
));
5610 font
= x_new_font (f
, SDATA (font
));
5612 /* Try out a font which we hope has bold and italic variations. */
5613 if (!STRINGP (font
))
5614 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
5615 if (! STRINGP (font
))
5616 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
5617 /* If those didn't work, look for something which will at least work. */
5618 if (! STRINGP (font
))
5619 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
5621 if (! STRINGP (font
))
5622 font
= build_string ("Fixedsys");
5624 x_default_parameter (f
, parms
, Qfont
, font
,
5625 "font", "Font", RES_TYPE_STRING
);
5628 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
5629 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
5630 /* This defaults to 2 in order to match xterm. We recognize either
5631 internalBorderWidth or internalBorder (which is what xterm calls
5633 if (NILP (Fassq (Qinternal_border_width
, parms
)))
5637 value
= w32_get_arg (parms
, Qinternal_border_width
,
5638 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
5639 if (! EQ (value
, Qunbound
))
5640 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
5643 /* Default internalBorderWidth to 0 on Windows to match other programs. */
5644 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
5645 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
5646 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qright
,
5647 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
5649 /* Also do the stuff which must be set before the window exists. */
5650 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
5651 "foreground", "Foreground", RES_TYPE_STRING
);
5652 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
5653 "background", "Background", RES_TYPE_STRING
);
5654 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
5655 "pointerColor", "Foreground", RES_TYPE_STRING
);
5656 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
5657 "cursorColor", "Foreground", RES_TYPE_STRING
);
5658 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
5659 "borderColor", "BorderColor", RES_TYPE_STRING
);
5660 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
5661 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
5662 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
5663 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
5664 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
5665 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
5666 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
5667 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
5670 /* Init faces before x_default_parameter is called for scroll-bar
5671 parameters because that function calls x_set_scroll_bar_width,
5672 which calls change_frame_size, which calls Fset_window_buffer,
5673 which runs hooks, which call Fvertical_motion. At the end, we
5674 end up in init_iterator with a null face cache, which should not
5676 init_frame_faces (f
);
5678 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
5679 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
5680 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
5681 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
5683 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
5684 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
5685 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
5686 "title", "Title", RES_TYPE_STRING
);
5687 x_default_parameter (f
, parms
, Qfullscreen
, Qnil
,
5688 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
5690 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
5691 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5693 f
->output_data
.w32
->text_cursor
= w32_load_cursor (IDC_IBEAM
);
5694 f
->output_data
.w32
->nontext_cursor
= w32_load_cursor (IDC_ARROW
);
5695 f
->output_data
.w32
->modeline_cursor
= w32_load_cursor (IDC_ARROW
);
5696 f
->output_data
.w32
->cross_cursor
= w32_load_cursor (IDC_CROSS
);
5697 f
->output_data
.w32
->hourglass_cursor
= w32_load_cursor (IDC_WAIT
);
5698 f
->output_data
.w32
->horizontal_drag_cursor
= w32_load_cursor (IDC_SIZEWE
);
5699 f
->output_data
.w32
->hand_cursor
= w32_load_cursor (IDC_HAND
);
5701 /* Add the tool-bar height to the initial frame height so that the
5702 user gets a text display area of the size he specified with -g or
5703 via .Xdefaults. Later changes of the tool-bar height don't
5704 change the frame size. This is done so that users can create
5705 tall Emacs frames without having to guess how tall the tool-bar
5707 if (FRAME_TOOL_BAR_LINES (f
))
5709 int margin
, relief
, bar_height
;
5711 relief
= (tool_bar_button_relief
>= 0
5712 ? tool_bar_button_relief
5713 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
5715 if (INTEGERP (Vtool_bar_button_margin
)
5716 && XINT (Vtool_bar_button_margin
) > 0)
5717 margin
= XFASTINT (Vtool_bar_button_margin
);
5718 else if (CONSP (Vtool_bar_button_margin
)
5719 && INTEGERP (XCDR (Vtool_bar_button_margin
))
5720 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
5721 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
5725 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
5726 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
5729 window_prompting
= x_figure_window_size (f
, parms
);
5731 if (window_prompting
& XNegative
)
5733 if (window_prompting
& YNegative
)
5734 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
5736 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
5740 if (window_prompting
& YNegative
)
5741 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
5743 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
5746 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
5748 tem
= w32_get_arg (parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
5749 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
5751 w32_window (f
, window_prompting
, minibuffer_only
);
5756 /* Now consider the frame official. */
5757 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
5758 Vframe_list
= Fcons (frame
, Vframe_list
);
5760 /* We need to do this after creating the window, so that the
5761 icon-creation functions can say whose icon they're describing. */
5762 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
5763 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
5765 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
5766 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5767 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
5768 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5769 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
5770 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
5771 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
5772 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
5774 /* Dimensions, especially f->height, must be done via change_frame_size.
5775 Change will not be effected unless different from the current
5781 SET_FRAME_WIDTH (f
, 0);
5782 change_frame_size (f
, height
, width
, 1, 0, 0);
5784 /* Tell the server what size and position, etc, we want, and how
5785 badly we want them. This should be done after we have the menu
5786 bar so that its size can be taken into account. */
5788 x_wm_set_size_hint (f
, window_prompting
, 0);
5791 /* Avoid a bug that causes the new frame to never become visible if
5792 an echo area message is displayed during the following call1. */
5793 specbind(Qredisplay_dont_pause
, Qt
);
5795 /* Set up faces after all frame parameters are known. This call
5796 also merges in face attributes specified for new frames. If we
5797 don't do this, the `menu' face for instance won't have the right
5798 colors, and the menu bar won't appear in the specified colors for
5800 call1 (Qface_set_after_frame_default
, frame
);
5802 /* Make the window appear on the frame and enable display, unless
5803 the caller says not to. However, with explicit parent, Emacs
5804 cannot control visibility, so don't try. */
5805 if (! f
->output_data
.w32
->explicit_parent
)
5807 Lisp_Object visibility
;
5809 visibility
= w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
5810 if (EQ (visibility
, Qunbound
))
5813 if (EQ (visibility
, Qicon
))
5814 x_iconify_frame (f
);
5815 else if (! NILP (visibility
))
5816 x_make_frame_visible (f
);
5818 /* Must have been Qnil. */
5823 /* Make sure windows on this frame appear in calls to next-window
5824 and similar functions. */
5825 Vwindow_list
= Qnil
;
5827 return unbind_to (count
, frame
);
5830 /* FRAME is used only to get a handle on the X display. We don't pass the
5831 display info directly because we're called from frame.c, which doesn't
5832 know about that structure. */
5834 x_get_focus_frame (frame
)
5835 struct frame
*frame
;
5837 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
5839 if (! dpyinfo
->w32_focus_frame
)
5842 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
5846 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
5847 doc
: /* Give FRAME input focus, raising to foreground if necessary. */)
5851 x_focus_on_frame (check_x_frame (frame
));
5856 /* Return the charset portion of a font name. */
5857 char * xlfd_charset_of_font (char * fontname
)
5859 char *charset
, *encoding
;
5861 encoding
= strrchr(fontname
, '-');
5862 if (!encoding
|| encoding
== fontname
)
5865 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
5866 if (*charset
== '-')
5869 if (charset
== fontname
|| strcmp(charset
, "-*-*") == 0)
5875 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
5876 int size
, char* filename
);
5877 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
5878 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
5880 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
5882 static struct font_info
*
5883 w32_load_system_font (f
,fontname
,size
)
5888 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5889 Lisp_Object font_names
;
5891 /* Get a list of all the fonts that match this name. Once we
5892 have a list of matching fonts, we compare them against the fonts
5893 we already have loaded by comparing names. */
5894 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
5896 if (!NILP (font_names
))
5901 /* First check if any are already loaded, as that is cheaper
5902 than loading another one. */
5903 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5904 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
5905 if (dpyinfo
->font_table
[i
].name
5906 && (!strcmp (dpyinfo
->font_table
[i
].name
,
5907 SDATA (XCAR (tail
)))
5908 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
5909 SDATA (XCAR (tail
)))))
5910 return (dpyinfo
->font_table
+ i
);
5912 fontname
= (char *) SDATA (XCAR (font_names
));
5914 else if (w32_strict_fontnames
)
5916 /* If EnumFontFamiliesEx was available, we got a full list of
5917 fonts back so stop now to avoid the possibility of loading a
5918 random font. If we had to fall back to EnumFontFamilies, the
5919 list is incomplete, so continue whether the font we want was
5921 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5922 FARPROC enum_font_families_ex
5923 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
5924 if (enum_font_families_ex
)
5928 /* Load the font and add it to the table. */
5930 char *full_name
, *encoding
, *charset
;
5932 struct font_info
*fontp
;
5938 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
5941 if (!*lf
.lfFaceName
)
5942 /* If no name was specified for the font, we get a random font
5943 from CreateFontIndirect - this is not particularly
5944 desirable, especially since CreateFontIndirect does not
5945 fill out the missing name in lf, so we never know what we
5949 lf
.lfQuality
= DEFAULT_QUALITY
;
5951 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
5952 bzero (font
, sizeof (*font
));
5954 /* Set bdf to NULL to indicate that this is a Windows font. */
5959 font
->hfont
= CreateFontIndirect (&lf
);
5961 if (font
->hfont
== NULL
)
5970 codepage
= w32_codepage_for_font (fontname
);
5972 hdc
= GetDC (dpyinfo
->root_window
);
5973 oldobj
= SelectObject (hdc
, font
->hfont
);
5975 ok
= GetTextMetrics (hdc
, &font
->tm
);
5976 if (codepage
== CP_UNICODE
)
5977 font
->double_byte_p
= 1;
5980 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5981 don't report themselves as double byte fonts, when
5982 patently they are. So instead of trusting
5983 GetFontLanguageInfo, we check the properties of the
5984 codepage directly, since that is ultimately what we are
5985 working from anyway. */
5986 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5988 GetCPInfo (codepage
, &cpi
);
5989 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
5992 SelectObject (hdc
, oldobj
);
5993 ReleaseDC (dpyinfo
->root_window
, hdc
);
5994 /* Fill out details in lf according to the font that was
5996 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
5997 lf
.lfWidth
= font
->tm
.tmAveCharWidth
;
5998 lf
.lfWeight
= font
->tm
.tmWeight
;
5999 lf
.lfItalic
= font
->tm
.tmItalic
;
6000 lf
.lfCharSet
= font
->tm
.tmCharSet
;
6001 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
6002 ? VARIABLE_PITCH
: FIXED_PITCH
);
6003 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
6004 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
6006 w32_cache_char_metrics (font
);
6013 w32_unload_font (dpyinfo
, font
);
6017 /* Find a free slot in the font table. */
6018 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
6019 if (dpyinfo
->font_table
[i
].name
== NULL
)
6022 /* If no free slot found, maybe enlarge the font table. */
6023 if (i
== dpyinfo
->n_fonts
6024 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
6027 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
6028 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
6030 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
6033 fontp
= dpyinfo
->font_table
+ i
;
6034 if (i
== dpyinfo
->n_fonts
)
6037 /* Now fill in the slots of *FONTP. */
6040 fontp
->font_idx
= i
;
6041 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
6042 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
6044 charset
= xlfd_charset_of_font (fontname
);
6046 /* Cache the W32 codepage for a font. This makes w32_encode_char
6047 (called for every glyph during redisplay) much faster. */
6048 fontp
->codepage
= codepage
;
6050 /* Work out the font's full name. */
6051 full_name
= (char *)xmalloc (100);
6052 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
6053 fontp
->full_name
= full_name
;
6056 /* If all else fails - just use the name we used to load it. */
6058 fontp
->full_name
= fontp
->name
;
6061 fontp
->size
= FONT_WIDTH (font
);
6062 fontp
->height
= FONT_HEIGHT (font
);
6064 /* The slot `encoding' specifies how to map a character
6065 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
6066 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
6067 (0:0x20..0x7F, 1:0xA0..0xFF,
6068 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
6069 2:0xA020..0xFF7F). For the moment, we don't know which charset
6070 uses this font. So, we set information in fontp->encoding[1]
6071 which is never used by any charset. If mapping can't be
6072 decided, set FONT_ENCODING_NOT_DECIDED. */
6074 /* SJIS fonts need to be set to type 4, all others seem to work as
6075 type FONT_ENCODING_NOT_DECIDED. */
6076 encoding
= strrchr (fontp
->name
, '-');
6077 if (encoding
&& strnicmp (encoding
+1, "sjis", 4) == 0)
6078 fontp
->encoding
[1] = 4;
6080 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
6082 /* The following three values are set to 0 under W32, which is
6083 what they get set to if XGetFontProperty fails under X. */
6084 fontp
->baseline_offset
= 0;
6085 fontp
->relative_compose
= 0;
6086 fontp
->default_ascent
= 0;
6088 /* Set global flag fonts_changed_p to non-zero if the font loaded
6089 has a character with a smaller width than any other character
6090 before, or if the font loaded has a smaller height than any
6091 other font loaded before. If this happens, it will make a
6092 glyph matrix reallocation necessary. */
6093 fonts_changed_p
|= x_compute_min_glyph_bounds (f
);
6099 /* Load font named FONTNAME of size SIZE for frame F, and return a
6100 pointer to the structure font_info while allocating it dynamically.
6101 If loading fails, return NULL. */
6103 w32_load_font (f
,fontname
,size
)
6108 Lisp_Object bdf_fonts
;
6109 struct font_info
*retval
= NULL
;
6111 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
6113 while (!retval
&& CONSP (bdf_fonts
))
6115 char *bdf_name
, *bdf_file
;
6116 Lisp_Object bdf_pair
;
6118 bdf_name
= SDATA (XCAR (bdf_fonts
));
6119 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
6120 bdf_file
= SDATA (XCDR (bdf_pair
));
6122 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
6124 bdf_fonts
= XCDR (bdf_fonts
);
6130 return w32_load_system_font(f
, fontname
, size
);
6135 w32_unload_font (dpyinfo
, font
)
6136 struct w32_display_info
*dpyinfo
;
6141 if (font
->per_char
) xfree (font
->per_char
);
6142 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
6144 if (font
->hfont
) DeleteObject(font
->hfont
);
6149 /* The font conversion stuff between x and w32 */
6151 /* X font string is as follows (from faces.el)
6155 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
6156 * (weight\? "\\([^-]*\\)") ; 1
6157 * (slant "\\([ior]\\)") ; 2
6158 * (slant\? "\\([^-]?\\)") ; 2
6159 * (swidth "\\([^-]*\\)") ; 3
6160 * (adstyle "[^-]*") ; 4
6161 * (pixelsize "[0-9]+")
6162 * (pointsize "[0-9][0-9]+")
6163 * (resx "[0-9][0-9]+")
6164 * (resy "[0-9][0-9]+")
6165 * (spacing "[cmp?*]")
6166 * (avgwidth "[0-9]+")
6167 * (registry "[^-]+")
6168 * (encoding "[^-]+")
6173 x_to_w32_weight (lpw
)
6176 if (!lpw
) return (FW_DONTCARE
);
6178 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
6179 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
6180 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
6181 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
6182 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
6183 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
6184 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
6185 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
6186 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
6187 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
6194 w32_to_x_weight (fnweight
)
6197 if (fnweight
>= FW_HEAVY
) return "heavy";
6198 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
6199 if (fnweight
>= FW_BOLD
) return "bold";
6200 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
6201 if (fnweight
>= FW_MEDIUM
) return "medium";
6202 if (fnweight
>= FW_NORMAL
) return "normal";
6203 if (fnweight
>= FW_LIGHT
) return "light";
6204 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
6205 if (fnweight
>= FW_THIN
) return "thin";
6211 x_to_w32_charset (lpcs
)
6214 Lisp_Object this_entry
, w32_charset
;
6216 int len
= strlen (lpcs
);
6218 /* Support "*-#nnn" format for unknown charsets. */
6219 if (strncmp (lpcs
, "*-#", 3) == 0)
6220 return atoi (lpcs
+ 3);
6222 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
6223 charset
= alloca (len
+ 1);
6224 strcpy (charset
, lpcs
);
6225 lpcs
= strchr (charset
, '*');
6229 /* Look through w32-charset-info-alist for the character set.
6230 Format of each entry is
6231 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6233 this_entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6235 if (NILP(this_entry
))
6237 /* At startup, we want iso8859-1 fonts to come up properly. */
6238 if (stricmp(charset
, "iso8859-1") == 0)
6239 return ANSI_CHARSET
;
6241 return DEFAULT_CHARSET
;
6244 w32_charset
= Fcar (Fcdr (this_entry
));
6246 /* Translate Lisp symbol to number. */
6247 if (w32_charset
== Qw32_charset_ansi
)
6248 return ANSI_CHARSET
;
6249 if (w32_charset
== Qw32_charset_symbol
)
6250 return SYMBOL_CHARSET
;
6251 if (w32_charset
== Qw32_charset_shiftjis
)
6252 return SHIFTJIS_CHARSET
;
6253 if (w32_charset
== Qw32_charset_hangeul
)
6254 return HANGEUL_CHARSET
;
6255 if (w32_charset
== Qw32_charset_chinesebig5
)
6256 return CHINESEBIG5_CHARSET
;
6257 if (w32_charset
== Qw32_charset_gb2312
)
6258 return GB2312_CHARSET
;
6259 if (w32_charset
== Qw32_charset_oem
)
6261 #ifdef JOHAB_CHARSET
6262 if (w32_charset
== Qw32_charset_johab
)
6263 return JOHAB_CHARSET
;
6264 if (w32_charset
== Qw32_charset_easteurope
)
6265 return EASTEUROPE_CHARSET
;
6266 if (w32_charset
== Qw32_charset_turkish
)
6267 return TURKISH_CHARSET
;
6268 if (w32_charset
== Qw32_charset_baltic
)
6269 return BALTIC_CHARSET
;
6270 if (w32_charset
== Qw32_charset_russian
)
6271 return RUSSIAN_CHARSET
;
6272 if (w32_charset
== Qw32_charset_arabic
)
6273 return ARABIC_CHARSET
;
6274 if (w32_charset
== Qw32_charset_greek
)
6275 return GREEK_CHARSET
;
6276 if (w32_charset
== Qw32_charset_hebrew
)
6277 return HEBREW_CHARSET
;
6278 if (w32_charset
== Qw32_charset_vietnamese
)
6279 return VIETNAMESE_CHARSET
;
6280 if (w32_charset
== Qw32_charset_thai
)
6281 return THAI_CHARSET
;
6282 if (w32_charset
== Qw32_charset_mac
)
6284 #endif /* JOHAB_CHARSET */
6285 #ifdef UNICODE_CHARSET
6286 if (w32_charset
== Qw32_charset_unicode
)
6287 return UNICODE_CHARSET
;
6290 return DEFAULT_CHARSET
;
6295 w32_to_x_charset (fncharset
)
6298 static char buf
[32];
6299 Lisp_Object charset_type
;
6304 /* Handle startup case of w32-charset-info-alist not
6305 being set up yet. */
6306 if (NILP(Vw32_charset_info_alist
))
6308 charset_type
= Qw32_charset_ansi
;
6310 case DEFAULT_CHARSET
:
6311 charset_type
= Qw32_charset_default
;
6313 case SYMBOL_CHARSET
:
6314 charset_type
= Qw32_charset_symbol
;
6316 case SHIFTJIS_CHARSET
:
6317 charset_type
= Qw32_charset_shiftjis
;
6319 case HANGEUL_CHARSET
:
6320 charset_type
= Qw32_charset_hangeul
;
6322 case GB2312_CHARSET
:
6323 charset_type
= Qw32_charset_gb2312
;
6325 case CHINESEBIG5_CHARSET
:
6326 charset_type
= Qw32_charset_chinesebig5
;
6329 charset_type
= Qw32_charset_oem
;
6332 /* More recent versions of Windows (95 and NT4.0) define more
6334 #ifdef EASTEUROPE_CHARSET
6335 case EASTEUROPE_CHARSET
:
6336 charset_type
= Qw32_charset_easteurope
;
6338 case TURKISH_CHARSET
:
6339 charset_type
= Qw32_charset_turkish
;
6341 case BALTIC_CHARSET
:
6342 charset_type
= Qw32_charset_baltic
;
6344 case RUSSIAN_CHARSET
:
6345 charset_type
= Qw32_charset_russian
;
6347 case ARABIC_CHARSET
:
6348 charset_type
= Qw32_charset_arabic
;
6351 charset_type
= Qw32_charset_greek
;
6353 case HEBREW_CHARSET
:
6354 charset_type
= Qw32_charset_hebrew
;
6356 case VIETNAMESE_CHARSET
:
6357 charset_type
= Qw32_charset_vietnamese
;
6360 charset_type
= Qw32_charset_thai
;
6363 charset_type
= Qw32_charset_mac
;
6366 charset_type
= Qw32_charset_johab
;
6370 #ifdef UNICODE_CHARSET
6371 case UNICODE_CHARSET
:
6372 charset_type
= Qw32_charset_unicode
;
6376 /* Encode numerical value of unknown charset. */
6377 sprintf (buf
, "*-#%u", fncharset
);
6383 char * best_match
= NULL
;
6385 /* Look through w32-charset-info-alist for the character set.
6386 Prefer ISO codepages, and prefer lower numbers in the ISO
6387 range. Only return charsets for codepages which are installed.
6389 Format of each entry is
6390 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6392 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
6395 Lisp_Object w32_charset
;
6396 Lisp_Object codepage
;
6398 Lisp_Object this_entry
= XCAR (rest
);
6400 /* Skip invalid entries in alist. */
6401 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
6402 || !CONSP (XCDR (this_entry
))
6403 || !SYMBOLP (XCAR (XCDR (this_entry
))))
6406 x_charset
= SDATA (XCAR (this_entry
));
6407 w32_charset
= XCAR (XCDR (this_entry
));
6408 codepage
= XCDR (XCDR (this_entry
));
6410 /* Look for Same charset and a valid codepage (or non-int
6411 which means ignore). */
6412 if (w32_charset
== charset_type
6413 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
6414 || IsValidCodePage (XINT (codepage
))))
6416 /* If we don't have a match already, then this is the
6419 best_match
= x_charset
;
6420 /* If this is an ISO codepage, and the best so far isn't,
6421 then this is better. */
6422 else if (strnicmp (best_match
, "iso", 3) != 0
6423 && strnicmp (x_charset
, "iso", 3) == 0)
6424 best_match
= x_charset
;
6425 /* If both are ISO8859 codepages, choose the one with the
6426 lowest number in the encoding field. */
6427 else if (strnicmp (best_match
, "iso8859-", 8) == 0
6428 && strnicmp (x_charset
, "iso8859-", 8) == 0)
6430 int best_enc
= atoi (best_match
+ 8);
6431 int this_enc
= atoi (x_charset
+ 8);
6432 if (this_enc
> 0 && this_enc
< best_enc
)
6433 best_match
= x_charset
;
6438 /* If no match, encode the numeric value. */
6441 sprintf (buf
, "*-#%u", fncharset
);
6445 strncpy(buf
, best_match
, 31);
6452 /* Return all the X charsets that map to a font. */
6454 w32_to_all_x_charsets (fncharset
)
6457 static char buf
[32];
6458 Lisp_Object charset_type
;
6459 Lisp_Object retval
= Qnil
;
6464 /* Handle startup case of w32-charset-info-alist not
6465 being set up yet. */
6466 if (NILP(Vw32_charset_info_alist
))
6467 return Fcons (build_string ("iso8859-1"), Qnil
);
6469 charset_type
= Qw32_charset_ansi
;
6471 case DEFAULT_CHARSET
:
6472 charset_type
= Qw32_charset_default
;
6474 case SYMBOL_CHARSET
:
6475 charset_type
= Qw32_charset_symbol
;
6477 case SHIFTJIS_CHARSET
:
6478 charset_type
= Qw32_charset_shiftjis
;
6480 case HANGEUL_CHARSET
:
6481 charset_type
= Qw32_charset_hangeul
;
6483 case GB2312_CHARSET
:
6484 charset_type
= Qw32_charset_gb2312
;
6486 case CHINESEBIG5_CHARSET
:
6487 charset_type
= Qw32_charset_chinesebig5
;
6490 charset_type
= Qw32_charset_oem
;
6493 /* More recent versions of Windows (95 and NT4.0) define more
6495 #ifdef EASTEUROPE_CHARSET
6496 case EASTEUROPE_CHARSET
:
6497 charset_type
= Qw32_charset_easteurope
;
6499 case TURKISH_CHARSET
:
6500 charset_type
= Qw32_charset_turkish
;
6502 case BALTIC_CHARSET
:
6503 charset_type
= Qw32_charset_baltic
;
6505 case RUSSIAN_CHARSET
:
6506 charset_type
= Qw32_charset_russian
;
6508 case ARABIC_CHARSET
:
6509 charset_type
= Qw32_charset_arabic
;
6512 charset_type
= Qw32_charset_greek
;
6514 case HEBREW_CHARSET
:
6515 charset_type
= Qw32_charset_hebrew
;
6517 case VIETNAMESE_CHARSET
:
6518 charset_type
= Qw32_charset_vietnamese
;
6521 charset_type
= Qw32_charset_thai
;
6524 charset_type
= Qw32_charset_mac
;
6527 charset_type
= Qw32_charset_johab
;
6531 #ifdef UNICODE_CHARSET
6532 case UNICODE_CHARSET
:
6533 charset_type
= Qw32_charset_unicode
;
6537 /* Encode numerical value of unknown charset. */
6538 sprintf (buf
, "*-#%u", fncharset
);
6539 return Fcons (build_string (buf
), Qnil
);
6544 /* Look through w32-charset-info-alist for the character set.
6545 Only return charsets for codepages which are installed.
6547 Format of each entry in Vw32_charset_info_alist is
6548 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6550 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
6552 Lisp_Object x_charset
;
6553 Lisp_Object w32_charset
;
6554 Lisp_Object codepage
;
6556 Lisp_Object this_entry
= XCAR (rest
);
6558 /* Skip invalid entries in alist. */
6559 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
6560 || !CONSP (XCDR (this_entry
))
6561 || !SYMBOLP (XCAR (XCDR (this_entry
))))
6564 x_charset
= XCAR (this_entry
);
6565 w32_charset
= XCAR (XCDR (this_entry
));
6566 codepage
= XCDR (XCDR (this_entry
));
6568 /* Look for Same charset and a valid codepage (or non-int
6569 which means ignore). */
6570 if (w32_charset
== charset_type
6571 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
6572 || IsValidCodePage (XINT (codepage
))))
6574 retval
= Fcons (x_charset
, retval
);
6578 /* If no match, encode the numeric value. */
6581 sprintf (buf
, "*-#%u", fncharset
);
6582 return Fcons (build_string (buf
), Qnil
);
6589 /* Get the Windows codepage corresponding to the specified font. The
6590 charset info in the font name is used to look up
6591 w32-charset-to-codepage-alist. */
6593 w32_codepage_for_font (char *fontname
)
6595 Lisp_Object codepage
, entry
;
6596 char *charset_str
, *charset
, *end
;
6598 if (NILP (Vw32_charset_info_alist
))
6601 /* Extract charset part of font string. */
6602 charset
= xlfd_charset_of_font (fontname
);
6607 charset_str
= (char *) alloca (strlen (charset
) + 1);
6608 strcpy (charset_str
, charset
);
6611 /* Remove leading "*-". */
6612 if (strncmp ("*-", charset_str
, 2) == 0)
6613 charset
= charset_str
+ 2;
6616 charset
= charset_str
;
6618 /* Stop match at wildcard (including preceding '-'). */
6619 if (end
= strchr (charset
, '*'))
6621 if (end
> charset
&& *(end
-1) == '-')
6626 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6630 codepage
= Fcdr (Fcdr (entry
));
6632 if (NILP (codepage
))
6634 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
6636 else if (INTEGERP (codepage
))
6637 return XINT (codepage
);
6644 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
6645 LOGFONT
* lplogfont
;
6648 char * specific_charset
;
6652 char height_pixels
[8];
6654 char width_pixels
[8];
6655 char *fontname_dash
;
6656 int display_resy
= (int) one_w32_display_info
.resy
;
6657 int display_resx
= (int) one_w32_display_info
.resx
;
6659 struct coding_system coding
;
6661 if (!lpxstr
) abort ();
6666 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
6667 fonttype
= "raster";
6668 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
6669 fonttype
= "outline";
6671 fonttype
= "unknown";
6673 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system
),
6675 coding
.src_multibyte
= 0;
6676 coding
.dst_multibyte
= 1;
6677 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6678 /* We explicitely disable composition handling because selection
6679 data should not contain any composition sequence. */
6680 coding
.composing
= COMPOSITION_DISABLED
;
6681 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
6683 fontname
= alloca(sizeof(*fontname
) * bufsz
);
6684 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
6685 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
6686 *(fontname
+ coding
.produced
) = '\0';
6688 /* Replace dashes with underscores so the dashes are not
6690 fontname_dash
= fontname
;
6691 while (fontname_dash
= strchr (fontname_dash
, '-'))
6692 *fontname_dash
= '_';
6694 if (lplogfont
->lfHeight
)
6696 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
6697 sprintf (height_dpi
, "%u",
6698 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
6702 strcpy (height_pixels
, "*");
6703 strcpy (height_dpi
, "*");
6705 if (lplogfont
->lfWidth
)
6706 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
6708 strcpy (width_pixels
, "*");
6710 _snprintf (lpxstr
, len
- 1,
6711 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6712 fonttype
, /* foundry */
6713 fontname
, /* family */
6714 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
6715 lplogfont
->lfItalic
?'i':'r', /* slant */
6717 /* add style name */
6718 height_pixels
, /* pixel size */
6719 height_dpi
, /* point size */
6720 display_resx
, /* resx */
6721 display_resy
, /* resy */
6722 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
6723 ? 'p' : 'c', /* spacing */
6724 width_pixels
, /* avg width */
6725 specific_charset
? specific_charset
6726 : w32_to_x_charset (lplogfont
->lfCharSet
)
6727 /* charset registry and encoding */
6730 lpxstr
[len
- 1] = 0; /* just to be sure */
6735 x_to_w32_font (lpxstr
, lplogfont
)
6737 LOGFONT
* lplogfont
;
6739 struct coding_system coding
;
6741 if (!lplogfont
) return (FALSE
);
6743 memset (lplogfont
, 0, sizeof (*lplogfont
));
6745 /* Set default value for each field. */
6747 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
6748 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
6749 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
6751 /* go for maximum quality */
6752 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
6753 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
6754 lplogfont
->lfQuality
= PROOF_QUALITY
;
6757 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
6758 lplogfont
->lfWeight
= FW_DONTCARE
;
6759 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
6764 /* Provide a simple escape mechanism for specifying Windows font names
6765 * directly -- if font spec does not beginning with '-', assume this
6767 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6773 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
6774 width
[10], resy
[10], remainder
[50];
6776 int dpi
= (int) one_w32_display_info
.resy
;
6778 fields
= sscanf (lpxstr
,
6779 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
6780 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
6784 /* In the general case when wildcards cover more than one field,
6785 we don't know which field is which, so don't fill any in.
6786 However, we need to cope with this particular form, which is
6787 generated by font_list_1 (invoked by try_font_list):
6788 "-raster-6x10-*-gb2312*-*"
6789 and make sure to correctly parse the charset field. */
6792 fields
= sscanf (lpxstr
,
6793 "-%*[^-]-%49[^-]-*-%49s",
6796 else if (fields
< 9)
6802 if (fields
> 0 && name
[0] != '*')
6808 (Fcheck_coding_system (Vlocale_coding_system
), &coding
);
6809 coding
.src_multibyte
= 1;
6810 coding
.dst_multibyte
= 1;
6811 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
6812 buf
= (unsigned char *) alloca (bufsize
);
6813 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6814 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
6815 if (coding
.produced
>= LF_FACESIZE
)
6816 coding
.produced
= LF_FACESIZE
- 1;
6817 buf
[coding
.produced
] = 0;
6818 strcpy (lplogfont
->lfFaceName
, buf
);
6822 lplogfont
->lfFaceName
[0] = '\0';
6827 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6831 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
6835 if (fields
> 0 && pixels
[0] != '*')
6836 lplogfont
->lfHeight
= atoi (pixels
);
6840 if (fields
> 0 && resy
[0] != '*')
6843 if (tem
> 0) dpi
= tem
;
6846 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
6847 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
6850 lplogfont
->lfPitchAndFamily
=
6851 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
6855 if (fields
> 0 && width
[0] != '*')
6856 lplogfont
->lfWidth
= atoi (width
) / 10;
6860 /* Strip the trailing '-' if present. (it shouldn't be, as it
6861 fails the test against xlfd-tight-regexp in fontset.el). */
6863 int len
= strlen (remainder
);
6864 if (len
> 0 && remainder
[len
-1] == '-')
6865 remainder
[len
-1] = 0;
6867 encoding
= remainder
;
6869 if (strncmp (encoding
, "*-", 2) == 0)
6872 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
6877 char name
[100], height
[10], width
[10], weight
[20];
6879 fields
= sscanf (lpxstr
,
6880 "%99[^:]:%9[^:]:%9[^:]:%19s",
6881 name
, height
, width
, weight
);
6883 if (fields
== EOF
) return (FALSE
);
6887 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
6888 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
6892 lplogfont
->lfFaceName
[0] = 0;
6898 lplogfont
->lfHeight
= atoi (height
);
6903 lplogfont
->lfWidth
= atoi (width
);
6907 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6910 /* This makes TrueType fonts work better. */
6911 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
6916 /* Strip the pixel height and point height from the given xlfd, and
6917 return the pixel height. If no pixel height is specified, calculate
6918 one from the point height, or if that isn't defined either, return
6919 0 (which usually signifies a scalable font).
6922 xlfd_strip_height (char *fontname
)
6924 int pixel_height
, field_number
;
6925 char *read_from
, *write_to
;
6929 pixel_height
= field_number
= 0;
6932 /* Look for height fields. */
6933 for (read_from
= fontname
; *read_from
; read_from
++)
6935 if (*read_from
== '-')
6938 if (field_number
== 7) /* Pixel height. */
6941 write_to
= read_from
;
6943 /* Find end of field. */
6944 for (;*read_from
&& *read_from
!= '-'; read_from
++)
6947 /* Split the fontname at end of field. */
6953 pixel_height
= atoi (write_to
);
6954 /* Blank out field. */
6955 if (read_from
> write_to
)
6960 /* If the pixel height field is at the end (partial xlfd),
6963 return pixel_height
;
6965 /* If we got a pixel height, the point height can be
6966 ignored. Just blank it out and break now. */
6969 /* Find end of point size field. */
6970 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6976 /* Blank out the point size field. */
6977 if (read_from
> write_to
)
6983 return pixel_height
;
6987 /* If the point height is already blank, break now. */
6988 if (*read_from
== '-')
6994 else if (field_number
== 8)
6996 /* If we didn't get a pixel height, try to get the point
6997 height and convert that. */
6999 char *point_size_start
= read_from
++;
7001 /* Find end of field. */
7002 for (; *read_from
&& *read_from
!= '-'; read_from
++)
7011 point_size
= atoi (point_size_start
);
7013 /* Convert to pixel height. */
7014 pixel_height
= point_size
7015 * one_w32_display_info
.height_in
/ 720;
7017 /* Blank out this field and break. */
7025 /* Shift the rest of the font spec into place. */
7026 if (write_to
&& read_from
> write_to
)
7028 for (; *read_from
; read_from
++, write_to
++)
7029 *write_to
= *read_from
;
7033 return pixel_height
;
7036 /* Assume parameter 1 is fully qualified, no wildcards. */
7038 w32_font_match (fontname
, pattern
)
7042 char *regex
= alloca (strlen (pattern
) * 2 + 3);
7043 char *font_name_copy
= alloca (strlen (fontname
) + 1);
7046 /* Copy fontname so we can modify it during comparison. */
7047 strcpy (font_name_copy
, fontname
);
7052 /* Turn pattern into a regexp and do a regexp match. */
7053 for (; *pattern
; pattern
++)
7055 if (*pattern
== '?')
7057 else if (*pattern
== '*')
7068 /* Strip out font heights and compare them seperately, since
7069 rounding error can cause mismatches. This also allows a
7070 comparison between a font that declares only a pixel height and a
7071 pattern that declares the point height.
7074 int font_height
, pattern_height
;
7076 font_height
= xlfd_strip_height (font_name_copy
);
7077 pattern_height
= xlfd_strip_height (regex
);
7079 /* Compare now, and don't bother doing expensive regexp matching
7080 if the heights differ. */
7081 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
7085 return (fast_c_string_match_ignore_case (build_string (regex
),
7086 font_name_copy
) >= 0);
7089 /* Callback functions, and a structure holding info they need, for
7090 listing system fonts on W32. We need one set of functions to do the
7091 job properly, but these don't work on NT 3.51 and earlier, so we
7092 have a second set which don't handle character sets properly to
7095 In both cases, there are two passes made. The first pass gets one
7096 font from each family, the second pass lists all the fonts from
7099 typedef struct enumfont_t
7104 XFontStruct
*size_ref
;
7105 Lisp_Object pattern
;
7111 enum_font_maybe_add_to_list (enumfont_t
*, LOGFONT
*, char *, Lisp_Object
);
7115 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
7117 NEWTEXTMETRIC
* lptm
;
7121 /* Ignore struck out and underlined versions of fonts. */
7122 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
7125 /* Only return fonts with names starting with @ if they were
7126 explicitly specified, since Microsoft uses an initial @ to
7127 denote fonts for vertical writing, without providing a more
7128 convenient way of identifying them. */
7129 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
7130 && lpef
->logfont
.lfFaceName
[0] != '@')
7133 /* Check that the character set matches if it was specified */
7134 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
7135 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
7138 if (FontType
== RASTER_FONTTYPE
)
7140 /* DBCS raster fonts have problems displaying, so skip them. */
7141 int charset
= lplf
->elfLogFont
.lfCharSet
;
7142 if (charset
== SHIFTJIS_CHARSET
7143 || charset
== HANGEUL_CHARSET
7144 || charset
== CHINESEBIG5_CHARSET
7145 || charset
== GB2312_CHARSET
7146 #ifdef JOHAB_CHARSET
7147 || charset
== JOHAB_CHARSET
7155 Lisp_Object width
= Qnil
;
7156 Lisp_Object charset_list
= Qnil
;
7157 char *charset
= NULL
;
7159 /* Truetype fonts do not report their true metrics until loaded */
7160 if (FontType
!= RASTER_FONTTYPE
)
7162 if (!NILP (lpef
->pattern
))
7164 /* Scalable fonts are as big as you want them to be. */
7165 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
7166 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
7167 width
= make_number (lpef
->logfont
.lfWidth
);
7171 lplf
->elfLogFont
.lfHeight
= 0;
7172 lplf
->elfLogFont
.lfWidth
= 0;
7176 /* Make sure the height used here is the same as everywhere
7177 else (ie character height, not cell height). */
7178 if (lplf
->elfLogFont
.lfHeight
> 0)
7180 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
7181 if (FontType
== RASTER_FONTTYPE
)
7182 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
7184 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
7187 if (!NILP (lpef
->pattern
))
7189 charset
= xlfd_charset_of_font (SDATA (lpef
->pattern
));
7191 /* We already checked charsets above, but DEFAULT_CHARSET
7192 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
7194 && strncmp (charset
, "*-*", 3) != 0
7195 && lpef
->logfont
.lfCharSet
== DEFAULT_CHARSET
7196 && strcmp (charset
, w32_to_x_charset (DEFAULT_CHARSET
)) != 0)
7201 charset_list
= Fcons (build_string (charset
), Qnil
);
7203 charset_list
= w32_to_all_x_charsets (lplf
->elfLogFont
.lfCharSet
);
7205 /* Loop through the charsets. */
7206 for ( ; CONSP (charset_list
); charset_list
= Fcdr (charset_list
))
7208 Lisp_Object this_charset
= Fcar (charset_list
);
7209 charset
= SDATA (this_charset
);
7211 /* List bold and italic variations if w32-enable-synthesized-fonts
7212 is non-nil and this is a plain font. */
7213 if (w32_enable_synthesized_fonts
7214 && lplf
->elfLogFont
.lfWeight
== FW_NORMAL
7215 && lplf
->elfLogFont
.lfItalic
== FALSE
)
7217 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7220 lplf
->elfLogFont
.lfWeight
= FW_BOLD
;
7221 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7224 lplf
->elfLogFont
.lfItalic
= TRUE
;
7225 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7228 lplf
->elfLogFont
.lfWeight
= FW_NORMAL
;
7229 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7233 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7242 enum_font_maybe_add_to_list (lpef
, logfont
, match_charset
, width
)
7245 char * match_charset
;
7250 if (!w32_to_x_font (logfont
, buf
, 100, match_charset
))
7253 if (NILP (lpef
->pattern
)
7254 || w32_font_match (buf
, SDATA (lpef
->pattern
)))
7256 /* Check if we already listed this font. This may happen if
7257 w32_enable_synthesized_fonts is non-nil, and there are real
7258 bold and italic versions of the font. */
7259 Lisp_Object font_name
= build_string (buf
);
7260 if (NILP (Fmember (font_name
, lpef
->list
)))
7262 Lisp_Object entry
= Fcons (font_name
, width
);
7263 lpef
->list
= Fcons (entry
, lpef
->list
);
7271 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
7273 NEWTEXTMETRIC
* lptm
;
7277 return EnumFontFamilies (lpef
->hdc
,
7278 lplf
->elfLogFont
.lfFaceName
,
7279 (FONTENUMPROC
) enum_font_cb2
,
7285 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
7286 ENUMLOGFONTEX
* lplf
;
7287 NEWTEXTMETRICEX
* lptm
;
7291 /* We are not interested in the extra info we get back from the 'Ex
7292 version - only the fact that we get character set variations
7293 enumerated seperately. */
7294 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
7299 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
7300 ENUMLOGFONTEX
* lplf
;
7301 NEWTEXTMETRICEX
* lptm
;
7305 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
7306 FARPROC enum_font_families_ex
7307 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
7308 /* We don't really expect EnumFontFamiliesEx to disappear once we
7309 get here, so don't bother handling it gracefully. */
7310 if (enum_font_families_ex
== NULL
)
7311 error ("gdi32.dll has disappeared!");
7312 return enum_font_families_ex (lpef
->hdc
,
7314 (FONTENUMPROC
) enum_fontex_cb2
,
7318 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
7319 and xterm.c in Emacs 20.3) */
7321 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
7323 char *fontname
, *ptnstr
;
7324 Lisp_Object list
, tem
, newlist
= Qnil
;
7327 list
= Vw32_bdf_filename_alist
;
7328 ptnstr
= SDATA (pattern
);
7330 for ( ; CONSP (list
); list
= XCDR (list
))
7334 fontname
= SDATA (XCAR (tem
));
7335 else if (STRINGP (tem
))
7336 fontname
= SDATA (tem
);
7340 if (w32_font_match (fontname
, ptnstr
))
7342 newlist
= Fcons (XCAR (tem
), newlist
);
7344 if (max_names
>= 0 && n_fonts
>= max_names
)
7353 /* Return a list of names of available fonts matching PATTERN on frame
7354 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
7355 to be listed. Frame F NULL means we have not yet created any
7356 frame, which means we can't get proper size info, as we don't have
7357 a device context to use for GetTextMetrics.
7358 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
7359 negative, then all matching fonts are returned. */
7362 w32_list_fonts (f
, pattern
, size
, maxnames
)
7364 Lisp_Object pattern
;
7368 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
7369 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
7370 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
7373 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
7374 if (NILP (patterns
))
7375 patterns
= Fcons (pattern
, Qnil
);
7377 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
7382 tpat
= XCAR (patterns
);
7384 if (!STRINGP (tpat
))
7387 /* Avoid expensive EnumFontFamilies functions if we are not
7388 going to be able to output one of these anyway. */
7389 codepage
= w32_codepage_for_font (SDATA (tpat
));
7390 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
7391 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
7392 && !IsValidCodePage(codepage
))
7395 /* See if we cached the result for this particular query.
7396 The cache is an alist of the form:
7397 ((PATTERN (FONTNAME . WIDTH) ...) ...)
7399 if (tem
= XCDR (dpyinfo
->name_list_element
),
7400 !NILP (list
= Fassoc (tpat
, tem
)))
7402 list
= Fcdr_safe (list
);
7403 /* We have a cached list. Don't have to get the list again. */
7408 /* At first, put PATTERN in the cache. */
7413 /* Use EnumFontFamiliesEx where it is available, as it knows
7414 about character sets. Fall back to EnumFontFamilies for
7415 older versions of NT that don't support the 'Ex function. */
7416 x_to_w32_font (SDATA (tpat
), &ef
.logfont
);
7418 LOGFONT font_match_pattern
;
7419 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
7420 FARPROC enum_font_families_ex
7421 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
7423 /* We do our own pattern matching so we can handle wildcards. */
7424 font_match_pattern
.lfFaceName
[0] = 0;
7425 font_match_pattern
.lfPitchAndFamily
= 0;
7426 /* We can use the charset, because if it is a wildcard it will
7427 be DEFAULT_CHARSET anyway. */
7428 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
7430 ef
.hdc
= GetDC (dpyinfo
->root_window
);
7432 if (enum_font_families_ex
)
7433 enum_font_families_ex (ef
.hdc
,
7434 &font_match_pattern
,
7435 (FONTENUMPROC
) enum_fontex_cb1
,
7438 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
7441 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
7447 /* Make a list of the fonts we got back.
7448 Store that in the font cache for the display. */
7449 XSETCDR (dpyinfo
->name_list_element
,
7450 Fcons (Fcons (tpat
, list
),
7451 XCDR (dpyinfo
->name_list_element
)));
7454 if (NILP (list
)) continue; /* Try the remaining alternatives. */
7456 newlist
= second_best
= Qnil
;
7458 /* Make a list of the fonts that have the right width. */
7459 for (; CONSP (list
); list
= XCDR (list
))
7466 if (NILP (XCAR (tem
)))
7470 newlist
= Fcons (XCAR (tem
), newlist
);
7472 if (maxnames
>= 0 && n_fonts
>= maxnames
)
7477 if (!INTEGERP (XCDR (tem
)))
7479 /* Since we don't yet know the size of the font, we must
7480 load it and try GetTextMetrics. */
7481 W32FontStruct thisinfo
;
7486 if (!x_to_w32_font (SDATA (XCAR (tem
)), &lf
))
7490 thisinfo
.bdf
= NULL
;
7491 thisinfo
.hfont
= CreateFontIndirect (&lf
);
7492 if (thisinfo
.hfont
== NULL
)
7495 hdc
= GetDC (dpyinfo
->root_window
);
7496 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
7497 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
7498 XSETCDR (tem
, make_number (FONT_WIDTH (&thisinfo
)));
7500 XSETCDR (tem
, make_number (0));
7501 SelectObject (hdc
, oldobj
);
7502 ReleaseDC (dpyinfo
->root_window
, hdc
);
7503 DeleteObject(thisinfo
.hfont
);
7506 found_size
= XINT (XCDR (tem
));
7507 if (found_size
== size
)
7509 newlist
= Fcons (XCAR (tem
), newlist
);
7511 if (maxnames
>= 0 && n_fonts
>= maxnames
)
7514 /* keep track of the closest matching size in case
7515 no exact match is found. */
7516 else if (found_size
> 0)
7518 if (NILP (second_best
))
7521 else if (found_size
< size
)
7523 if (XINT (XCDR (second_best
)) > size
7524 || XINT (XCDR (second_best
)) < found_size
)
7529 if (XINT (XCDR (second_best
)) > size
7530 && XINT (XCDR (second_best
)) >
7537 if (!NILP (newlist
))
7539 else if (!NILP (second_best
))
7541 newlist
= Fcons (XCAR (second_best
), Qnil
);
7546 /* Include any bdf fonts. */
7547 if (n_fonts
< maxnames
|| maxnames
< 0)
7549 Lisp_Object combined
[2];
7550 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
7551 combined
[1] = newlist
;
7552 newlist
= Fnconc(2, combined
);
7559 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7561 w32_get_font_info (f
, font_idx
)
7565 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
7570 w32_query_font (struct frame
*f
, char *fontname
)
7573 struct font_info
*pfi
;
7575 pfi
= FRAME_W32_FONT_TABLE (f
);
7577 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
7579 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
7585 /* Find a CCL program for a font specified by FONTP, and set the member
7586 `encoder' of the structure. */
7589 w32_find_ccl_program (fontp
)
7590 struct font_info
*fontp
;
7592 Lisp_Object list
, elt
;
7594 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
7598 && STRINGP (XCAR (elt
))
7599 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
7605 struct ccl_program
*ccl
7606 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
7608 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
7611 fontp
->font_encoder
= ccl
;
7616 /* Find BDF files in a specified directory. (use GCPRO when calling,
7617 as this calls lisp to get a directory listing). */
7619 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
7621 Lisp_Object filelist
, list
= Qnil
;
7624 if (!STRINGP(directory
))
7627 filelist
= Fdirectory_files (directory
, Qt
,
7628 build_string (".*\\.[bB][dD][fF]"), Qt
);
7630 for ( ; CONSP(filelist
); filelist
= XCDR (filelist
))
7632 Lisp_Object filename
= XCAR (filelist
);
7633 if (w32_BDF_to_x_font (SDATA (filename
), fontname
, 100))
7634 store_in_alist (&list
, build_string (fontname
), filename
);
7639 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
7641 doc
: /* Return a list of BDF fonts in DIR.
7642 The list is suitable for appending to w32-bdf-filename-alist. Fonts
7643 which do not contain an xlfd description will not be included in the
7644 list. DIR may be a list of directories. */)
7646 Lisp_Object directory
;
7648 Lisp_Object list
= Qnil
;
7649 struct gcpro gcpro1
, gcpro2
;
7651 if (!CONSP (directory
))
7652 return w32_find_bdf_fonts_in_dir (directory
);
7654 for ( ; CONSP (directory
); directory
= XCDR (directory
))
7656 Lisp_Object pair
[2];
7659 GCPRO2 (directory
, list
);
7660 pair
[1] = w32_find_bdf_fonts_in_dir( XCAR (directory
) );
7661 list
= Fnconc( 2, pair
);
7668 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
7669 doc
: /* Internal function called by `color-defined-p', which see. */)
7671 Lisp_Object color
, frame
;
7674 FRAME_PTR f
= check_x_frame (frame
);
7676 CHECK_STRING (color
);
7678 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
7684 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
7685 doc
: /* Internal function called by `color-values', which see. */)
7687 Lisp_Object color
, frame
;
7690 FRAME_PTR f
= check_x_frame (frame
);
7692 CHECK_STRING (color
);
7694 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
7698 rgb
[0] = make_number ((GetRValue (foo
.pixel
) << 8)
7699 | GetRValue (foo
.pixel
));
7700 rgb
[1] = make_number ((GetGValue (foo
.pixel
) << 8)
7701 | GetGValue (foo
.pixel
));
7702 rgb
[2] = make_number ((GetBValue (foo
.pixel
) << 8)
7703 | GetBValue (foo
.pixel
));
7704 return Flist (3, rgb
);
7710 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
7711 doc
: /* Internal function called by `display-color-p', which see. */)
7713 Lisp_Object display
;
7715 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7717 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
7723 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
7724 Sx_display_grayscale_p
, 0, 1, 0,
7725 doc
: /* Return t if the X display supports shades of gray.
7726 Note that color displays do support shades of gray.
7727 The optional argument DISPLAY specifies which display to ask about.
7728 DISPLAY should be either a frame or a display name (a string).
7729 If omitted or nil, that stands for the selected frame's display. */)
7731 Lisp_Object display
;
7733 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7735 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
7741 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
7742 Sx_display_pixel_width
, 0, 1, 0,
7743 doc
: /* Returns the width in pixels of DISPLAY.
7744 The optional argument DISPLAY specifies which display to ask about.
7745 DISPLAY should be either a frame or a display name (a string).
7746 If omitted or nil, that stands for the selected frame's display. */)
7748 Lisp_Object display
;
7750 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7752 return make_number (dpyinfo
->width
);
7755 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
7756 Sx_display_pixel_height
, 0, 1, 0,
7757 doc
: /* Returns the height in pixels of DISPLAY.
7758 The optional argument DISPLAY specifies which display to ask about.
7759 DISPLAY should be either a frame or a display name (a string).
7760 If omitted or nil, that stands for the selected frame's display. */)
7762 Lisp_Object display
;
7764 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7766 return make_number (dpyinfo
->height
);
7769 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
7771 doc
: /* Returns the number of bitplanes of DISPLAY.
7772 The optional argument DISPLAY specifies which display to ask about.
7773 DISPLAY should be either a frame or a display name (a string).
7774 If omitted or nil, that stands for the selected frame's display. */)
7776 Lisp_Object display
;
7778 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7780 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7783 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
7785 doc
: /* Returns the number of color cells of DISPLAY.
7786 The optional argument DISPLAY specifies which display to ask about.
7787 DISPLAY should be either a frame or a display name (a string).
7788 If omitted or nil, that stands for the selected frame's display. */)
7790 Lisp_Object display
;
7792 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7796 hdc
= GetDC (dpyinfo
->root_window
);
7797 if (dpyinfo
->has_palette
)
7798 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
7800 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
7802 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
7803 and because probably is more meaningful on Windows anyway */
7805 cap
= 1 << min(dpyinfo
->n_planes
* dpyinfo
->n_cbits
, 24);
7807 ReleaseDC (dpyinfo
->root_window
, hdc
);
7809 return make_number (cap
);
7812 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
7813 Sx_server_max_request_size
,
7815 doc
: /* Returns the maximum request size of the server of DISPLAY.
7816 The optional argument DISPLAY specifies which display to ask about.
7817 DISPLAY should be either a frame or a display name (a string).
7818 If omitted or nil, that stands for the selected frame's display. */)
7820 Lisp_Object display
;
7822 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7824 return make_number (1);
7827 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
7828 doc
: /* Returns the vendor ID string of the W32 system (Microsoft).
7829 The optional argument DISPLAY specifies which display to ask about.
7830 DISPLAY should be either a frame or a display name (a string).
7831 If omitted or nil, that stands for the selected frame's display. */)
7833 Lisp_Object display
;
7835 return build_string ("Microsoft Corp.");
7838 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
7839 doc
: /* Returns the version numbers of the server of DISPLAY.
7840 The value is a list of three integers: the major and minor
7841 version numbers, and the vendor-specific release
7842 number. See also the function `x-server-vendor'.
7844 The optional argument DISPLAY specifies which display to ask about.
7845 DISPLAY should be either a frame or a display name (a string).
7846 If omitted or nil, that stands for the selected frame's display. */)
7848 Lisp_Object display
;
7850 return Fcons (make_number (w32_major_version
),
7851 Fcons (make_number (w32_minor_version
),
7852 Fcons (make_number (w32_build_number
), Qnil
)));
7855 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
7856 doc
: /* Returns the number of screens on the server of DISPLAY.
7857 The optional argument DISPLAY specifies which display to ask about.
7858 DISPLAY should be either a frame or a display name (a string).
7859 If omitted or nil, that stands for the selected frame's display. */)
7861 Lisp_Object display
;
7863 return make_number (1);
7866 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
7867 Sx_display_mm_height
, 0, 1, 0,
7868 doc
: /* Returns the height in millimeters of DISPLAY.
7869 The optional argument DISPLAY specifies which display to ask about.
7870 DISPLAY should be either a frame or a display name (a string).
7871 If omitted or nil, that stands for the selected frame's display. */)
7873 Lisp_Object display
;
7875 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7879 hdc
= GetDC (dpyinfo
->root_window
);
7881 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
7883 ReleaseDC (dpyinfo
->root_window
, hdc
);
7885 return make_number (cap
);
7888 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
7889 doc
: /* Returns the width in millimeters of DISPLAY.
7890 The optional argument DISPLAY specifies which display to ask about.
7891 DISPLAY should be either a frame or a display name (a string).
7892 If omitted or nil, that stands for the selected frame's display. */)
7894 Lisp_Object display
;
7896 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7901 hdc
= GetDC (dpyinfo
->root_window
);
7903 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
7905 ReleaseDC (dpyinfo
->root_window
, hdc
);
7907 return make_number (cap
);
7910 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
7911 Sx_display_backing_store
, 0, 1, 0,
7912 doc
: /* Returns an indication of whether DISPLAY does backing store.
7913 The value may be `always', `when-mapped', or `not-useful'.
7914 The optional argument DISPLAY specifies which display to ask about.
7915 DISPLAY should be either a frame or a display name (a string).
7916 If omitted or nil, that stands for the selected frame's display. */)
7918 Lisp_Object display
;
7920 return intern ("not-useful");
7923 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
7924 Sx_display_visual_class
, 0, 1, 0,
7925 doc
: /* Returns the visual class of DISPLAY.
7926 The value is one of the symbols `static-gray', `gray-scale',
7927 `static-color', `pseudo-color', `true-color', or `direct-color'.
7929 The optional argument DISPLAY specifies which display to ask about.
7930 DISPLAY should be either a frame or a display name (a string).
7931 If omitted or nil, that stands for the selected frame's display. */)
7933 Lisp_Object display
;
7935 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7936 Lisp_Object result
= Qnil
;
7938 if (dpyinfo
->has_palette
)
7939 result
= intern ("pseudo-color");
7940 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
7941 result
= intern ("static-grey");
7942 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
7943 result
= intern ("static-color");
7944 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
7945 result
= intern ("true-color");
7950 DEFUN ("x-display-save-under", Fx_display_save_under
,
7951 Sx_display_save_under
, 0, 1, 0,
7952 doc
: /* Returns t if DISPLAY supports the save-under feature.
7953 The optional argument DISPLAY specifies which display to ask about.
7954 DISPLAY should be either a frame or a display name (a string).
7955 If omitted or nil, that stands for the selected frame's display. */)
7957 Lisp_Object display
;
7964 register struct frame
*f
;
7966 return PIXEL_WIDTH (f
);
7971 register struct frame
*f
;
7973 return PIXEL_HEIGHT (f
);
7978 register struct frame
*f
;
7980 return FONT_WIDTH (f
->output_data
.w32
->font
);
7985 register struct frame
*f
;
7987 return f
->output_data
.w32
->line_height
;
7992 register struct frame
*f
;
7994 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
7997 /* Return the display structure for the display named NAME.
7998 Open a new connection if necessary. */
8000 struct w32_display_info
*
8001 x_display_info_for_name (name
)
8005 struct w32_display_info
*dpyinfo
;
8007 CHECK_STRING (name
);
8009 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
8011 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
8014 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
8019 /* Use this general default value to start with. */
8020 Vx_resource_name
= Vinvocation_name
;
8022 validate_x_resource_name ();
8024 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
8025 (char *) SDATA (Vx_resource_name
));
8028 error ("Cannot connect to server %s", SDATA (name
));
8031 XSETFASTINT (Vwindow_system_version
, 3);
8036 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
8037 1, 3, 0, doc
: /* Open a connection to a server.
8038 DISPLAY is the name of the display to connect to.
8039 Optional second arg XRM-STRING is a string of resources in xrdb format.
8040 If the optional third arg MUST-SUCCEED is non-nil,
8041 terminate Emacs if we can't open the connection. */)
8042 (display
, xrm_string
, must_succeed
)
8043 Lisp_Object display
, xrm_string
, must_succeed
;
8045 unsigned char *xrm_option
;
8046 struct w32_display_info
*dpyinfo
;
8048 /* If initialization has already been done, return now to avoid
8049 overwriting critical parts of one_w32_display_info. */
8053 CHECK_STRING (display
);
8054 if (! NILP (xrm_string
))
8055 CHECK_STRING (xrm_string
);
8057 if (! EQ (Vwindow_system
, intern ("w32")))
8058 error ("Not using Microsoft Windows");
8060 /* Allow color mapping to be defined externally; first look in user's
8061 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
8063 Lisp_Object color_file
;
8064 struct gcpro gcpro1
;
8066 color_file
= build_string("~/rgb.txt");
8068 GCPRO1 (color_file
);
8070 if (NILP (Ffile_readable_p (color_file
)))
8072 Fexpand_file_name (build_string ("rgb.txt"),
8073 Fsymbol_value (intern ("data-directory")));
8075 Vw32_color_map
= Fw32_load_color_file (color_file
);
8079 if (NILP (Vw32_color_map
))
8080 Vw32_color_map
= Fw32_default_color_map ();
8082 if (! NILP (xrm_string
))
8083 xrm_option
= (unsigned char *) SDATA (xrm_string
);
8085 xrm_option
= (unsigned char *) 0;
8087 /* Use this general default value to start with. */
8088 /* First remove .exe suffix from invocation-name - it looks ugly. */
8090 char basename
[ MAX_PATH
], *str
;
8092 strcpy (basename
, SDATA (Vinvocation_name
));
8093 str
= strrchr (basename
, '.');
8095 Vinvocation_name
= build_string (basename
);
8097 Vx_resource_name
= Vinvocation_name
;
8099 validate_x_resource_name ();
8101 /* This is what opens the connection and sets x_current_display.
8102 This also initializes many symbols, such as those used for input. */
8103 dpyinfo
= w32_term_init (display
, xrm_option
,
8104 (char *) SDATA (Vx_resource_name
));
8108 if (!NILP (must_succeed
))
8109 fatal ("Cannot connect to server %s.\n",
8112 error ("Cannot connect to server %s", SDATA (display
));
8117 XSETFASTINT (Vwindow_system_version
, 3);
8121 DEFUN ("x-close-connection", Fx_close_connection
,
8122 Sx_close_connection
, 1, 1, 0,
8123 doc
: /* Close the connection to DISPLAY's server.
8124 For DISPLAY, specify either a frame or a display name (a string).
8125 If DISPLAY is nil, that stands for the selected frame's display. */)
8127 Lisp_Object display
;
8129 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
8132 if (dpyinfo
->reference_count
> 0)
8133 error ("Display still has frames on it");
8136 /* Free the fonts in the font table. */
8137 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
8138 if (dpyinfo
->font_table
[i
].name
)
8140 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
8141 xfree (dpyinfo
->font_table
[i
].full_name
);
8142 xfree (dpyinfo
->font_table
[i
].name
);
8143 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
8145 x_destroy_all_bitmaps (dpyinfo
);
8147 x_delete_display (dpyinfo
);
8153 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
8154 doc
: /* Return the list of display names that Emacs has connections to. */)
8157 Lisp_Object tail
, result
;
8160 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
8161 result
= Fcons (XCAR (XCAR (tail
)), result
);
8166 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
8167 doc
: /* This is a noop on W32 systems. */)
8169 Lisp_Object display
, on
;
8175 /***********************************************************************
8177 ***********************************************************************/
8179 /* Value is the number of elements of vector VECTOR. */
8181 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
8183 /* List of supported image types. Use define_image_type to add new
8184 types. Use lookup_image_type to find a type for a given symbol. */
8186 static struct image_type
*image_types
;
8188 /* The symbol `image' which is the car of the lists used to represent
8191 extern Lisp_Object Qimage
;
8193 /* The symbol `xbm' which is used as the type symbol for XBM images. */
8199 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
8200 extern Lisp_Object QCdata
, QCtype
;
8201 Lisp_Object QCascent
, QCmargin
, QCrelief
;
8202 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
8203 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
8205 /* Other symbols. */
8207 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
8209 /* Time in seconds after which images should be removed from the cache
8210 if not displayed. */
8212 Lisp_Object Vimage_cache_eviction_delay
;
8214 /* Function prototypes. */
8216 static void define_image_type
P_ ((struct image_type
*type
));
8217 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
8218 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
8219 static void x_laplace
P_ ((struct frame
*, struct image
*));
8220 static void x_emboss
P_ ((struct frame
*, struct image
*));
8221 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
8225 /* Define a new image type from TYPE. This adds a copy of TYPE to
8226 image_types and adds the symbol *TYPE->type to Vimage_types. */
8229 define_image_type (type
)
8230 struct image_type
*type
;
8232 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
8233 The initialized data segment is read-only. */
8234 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
8235 bcopy (type
, p
, sizeof *p
);
8236 p
->next
= image_types
;
8238 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
8242 /* Look up image type SYMBOL, and return a pointer to its image_type
8243 structure. Value is null if SYMBOL is not a known image type. */
8245 static INLINE
struct image_type
*
8246 lookup_image_type (symbol
)
8249 struct image_type
*type
;
8251 for (type
= image_types
; type
; type
= type
->next
)
8252 if (EQ (symbol
, *type
->type
))
8259 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
8260 valid image specification is a list whose car is the symbol
8261 `image', and whose rest is a property list. The property list must
8262 contain a value for key `:type'. That value must be the name of a
8263 supported image type. The rest of the property list depends on the
8267 valid_image_p (object
)
8272 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
8276 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
8277 if (EQ (XCAR (tem
), QCtype
))
8280 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
8282 struct image_type
*type
;
8283 type
= lookup_image_type (XCAR (tem
));
8285 valid_p
= type
->valid_p (object
);
8296 /* Log error message with format string FORMAT and argument ARG.
8297 Signaling an error, e.g. when an image cannot be loaded, is not a
8298 good idea because this would interrupt redisplay, and the error
8299 message display would lead to another redisplay. This function
8300 therefore simply displays a message. */
8303 image_error (format
, arg1
, arg2
)
8305 Lisp_Object arg1
, arg2
;
8307 add_to_log (format
, arg1
, arg2
);
8312 /***********************************************************************
8313 Image specifications
8314 ***********************************************************************/
8316 enum image_value_type
8318 IMAGE_DONT_CHECK_VALUE_TYPE
,
8320 IMAGE_STRING_OR_NIL_VALUE
,
8322 IMAGE_POSITIVE_INTEGER_VALUE
,
8323 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
8324 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
8326 IMAGE_INTEGER_VALUE
,
8327 IMAGE_FUNCTION_VALUE
,
8332 /* Structure used when parsing image specifications. */
8334 struct image_keyword
8336 /* Name of keyword. */
8339 /* The type of value allowed. */
8340 enum image_value_type type
;
8342 /* Non-zero means key must be present. */
8345 /* Used to recognize duplicate keywords in a property list. */
8348 /* The value that was found. */
8353 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
8355 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
8358 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
8359 has the format (image KEYWORD VALUE ...). One of the keyword/
8360 value pairs must be `:type TYPE'. KEYWORDS is a vector of
8361 image_keywords structures of size NKEYWORDS describing other
8362 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
8365 parse_image_spec (spec
, keywords
, nkeywords
, type
)
8367 struct image_keyword
*keywords
;
8374 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
8377 plist
= XCDR (spec
);
8378 while (CONSP (plist
))
8380 Lisp_Object key
, value
;
8382 /* First element of a pair must be a symbol. */
8384 plist
= XCDR (plist
);
8388 /* There must follow a value. */
8391 value
= XCAR (plist
);
8392 plist
= XCDR (plist
);
8394 /* Find key in KEYWORDS. Error if not found. */
8395 for (i
= 0; i
< nkeywords
; ++i
)
8396 if (strcmp (keywords
[i
].name
, SDATA (SYMBOL_NAME (key
))) == 0)
8402 /* Record that we recognized the keyword. If a keywords
8403 was found more than once, it's an error. */
8404 keywords
[i
].value
= value
;
8405 ++keywords
[i
].count
;
8407 if (keywords
[i
].count
> 1)
8410 /* Check type of value against allowed type. */
8411 switch (keywords
[i
].type
)
8413 case IMAGE_STRING_VALUE
:
8414 if (!STRINGP (value
))
8418 case IMAGE_STRING_OR_NIL_VALUE
:
8419 if (!STRINGP (value
) && !NILP (value
))
8423 case IMAGE_SYMBOL_VALUE
:
8424 if (!SYMBOLP (value
))
8428 case IMAGE_POSITIVE_INTEGER_VALUE
:
8429 if (!INTEGERP (value
) || XINT (value
) <= 0)
8433 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
8434 if (INTEGERP (value
) && XINT (value
) >= 0)
8437 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
8438 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
8442 case IMAGE_ASCENT_VALUE
:
8443 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
8445 else if (INTEGERP (value
)
8446 && XINT (value
) >= 0
8447 && XINT (value
) <= 100)
8451 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
8452 if (!INTEGERP (value
) || XINT (value
) < 0)
8456 case IMAGE_DONT_CHECK_VALUE_TYPE
:
8459 case IMAGE_FUNCTION_VALUE
:
8460 value
= indirect_function (value
);
8462 || COMPILEDP (value
)
8463 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
8467 case IMAGE_NUMBER_VALUE
:
8468 if (!INTEGERP (value
) && !FLOATP (value
))
8472 case IMAGE_INTEGER_VALUE
:
8473 if (!INTEGERP (value
))
8477 case IMAGE_BOOL_VALUE
:
8478 if (!NILP (value
) && !EQ (value
, Qt
))
8487 if (EQ (key
, QCtype
) && !EQ (type
, value
))
8491 /* Check that all mandatory fields are present. */
8492 for (i
= 0; i
< nkeywords
; ++i
)
8493 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
8496 return NILP (plist
);
8500 /* Return the value of KEY in image specification SPEC. Value is nil
8501 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8502 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8505 image_spec_value (spec
, key
, found
)
8506 Lisp_Object spec
, key
;
8511 xassert (valid_image_p (spec
));
8513 for (tail
= XCDR (spec
);
8514 CONSP (tail
) && CONSP (XCDR (tail
));
8515 tail
= XCDR (XCDR (tail
)))
8517 if (EQ (XCAR (tail
), key
))
8521 return XCAR (XCDR (tail
));
8531 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
8532 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
8533 PIXELS non-nil means return the size in pixels, otherwise return the
8534 size in canonical character units.
8535 FRAME is the frame on which the image will be displayed. FRAME nil
8536 or omitted means use the selected frame. */)
8537 (spec
, pixels
, frame
)
8538 Lisp_Object spec
, pixels
, frame
;
8543 if (valid_image_p (spec
))
8545 struct frame
*f
= check_x_frame (frame
);
8546 int id
= lookup_image (f
, spec
);
8547 struct image
*img
= IMAGE_FROM_ID (f
, id
);
8548 int width
= img
->width
+ 2 * img
->hmargin
;
8549 int height
= img
->height
+ 2 * img
->vmargin
;
8552 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
8553 make_float ((double) height
/ CANON_Y_UNIT (f
)));
8555 size
= Fcons (make_number (width
), make_number (height
));
8558 error ("Invalid image specification");
8564 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
8565 doc
: /* Return t if image SPEC has a mask bitmap.
8566 FRAME is the frame on which the image will be displayed. FRAME nil
8567 or omitted means use the selected frame. */)
8569 Lisp_Object spec
, frame
;
8574 if (valid_image_p (spec
))
8576 struct frame
*f
= check_x_frame (frame
);
8577 int id
= lookup_image (f
, spec
);
8578 struct image
*img
= IMAGE_FROM_ID (f
, id
);
8583 error ("Invalid image specification");
8589 /***********************************************************************
8590 Image type independent image structures
8591 ***********************************************************************/
8593 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
8594 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
8595 static void x_destroy_x_image
P_ ((XImage
*));
8598 /* Allocate and return a new image structure for image specification
8599 SPEC. SPEC has a hash value of HASH. */
8601 static struct image
*
8602 make_image (spec
, hash
)
8606 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
8608 xassert (valid_image_p (spec
));
8609 bzero (img
, sizeof *img
);
8610 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
8611 xassert (img
->type
!= NULL
);
8613 img
->data
.lisp_val
= Qnil
;
8614 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
8620 /* Free image IMG which was used on frame F, including its resources. */
8629 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8631 /* Remove IMG from the hash table of its cache. */
8633 img
->prev
->next
= img
->next
;
8635 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
8638 img
->next
->prev
= img
->prev
;
8640 c
->images
[img
->id
] = NULL
;
8642 /* Free resources, then free IMG. */
8643 img
->type
->free (f
, img
);
8649 /* Prepare image IMG for display on frame F. Must be called before
8650 drawing an image. */
8653 prepare_image_for_display (f
, img
)
8659 /* We're about to display IMG, so set its timestamp to `now'. */
8661 img
->timestamp
= EMACS_SECS (t
);
8663 /* If IMG doesn't have a pixmap yet, load it now, using the image
8664 type dependent loader function. */
8665 if (img
->pixmap
== 0 && !img
->load_failed_p
)
8666 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8670 /* Value is the number of pixels for the ascent of image IMG when
8671 drawn in face FACE. */
8674 image_ascent (img
, face
)
8678 int height
= img
->height
+ img
->vmargin
;
8681 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
8684 ascent
= height
/ 2 - (FONT_DESCENT(face
->font
)
8685 - FONT_BASE(face
->font
)) / 2;
8687 ascent
= height
/ 2;
8690 ascent
= (int) (height
* img
->ascent
/ 100.0);
8697 /* Image background colors. */
8699 /* Find the "best" corner color of a bitmap. XIMG is assumed to a device
8700 context with the bitmap selected. */
8702 four_corners_best (img_dc
, width
, height
)
8704 unsigned long width
, height
;
8706 COLORREF corners
[4], best
;
8709 /* Get the colors at the corners of img_dc. */
8710 corners
[0] = GetPixel (img_dc
, 0, 0);
8711 corners
[1] = GetPixel (img_dc
, width
- 1, 0);
8712 corners
[2] = GetPixel (img_dc
, width
- 1, height
- 1);
8713 corners
[3] = GetPixel (img_dc
, 0, height
- 1);
8715 /* Choose the most frequently found color as background. */
8716 for (i
= best_count
= 0; i
< 4; ++i
)
8720 for (j
= n
= 0; j
< 4; ++j
)
8721 if (corners
[i
] == corners
[j
])
8725 best
= corners
[i
], best_count
= n
;
8731 /* Return the `background' field of IMG. If IMG doesn't have one yet,
8732 it is guessed heuristically. If non-zero, IMG_DC is an existing
8733 device context with the image selected to use for the heuristic. */
8736 image_background (img
, f
, img_dc
)
8741 if (! img
->background_valid
)
8742 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8744 int free_ximg
= !img_dc
;
8749 HDC frame_dc
= get_frame_dc (f
);
8750 img_dc
= CreateCompatibleDC (frame_dc
);
8751 release_frame_dc (f
, frame_dc
);
8753 prev
= SelectObject (img_dc
, img
->pixmap
);
8756 img
->background
= four_corners_best (img_dc
, img
->width
, img
->height
);
8760 SelectObject (img_dc
, prev
);
8764 img
->background_valid
= 1;
8767 return img
->background
;
8770 /* Return the `background_transparent' field of IMG. If IMG doesn't
8771 have one yet, it is guessed heuristically. If non-zero, MASK is an
8772 existing XImage object to use for the heuristic. */
8775 image_background_transparent (img
, f
, mask
)
8780 if (! img
->background_transparent_valid
)
8781 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8785 int free_mask
= !mask
;
8790 HDC frame_dc
= get_frame_dc (f
);
8791 mask
= CreateCompatibleDC (frame_dc
);
8792 release_frame_dc (f
, frame_dc
);
8794 prev
= SelectObject (mask
, img
->mask
);
8797 img
->background_transparent
8798 = !four_corners_best (mask
, img
->width
, img
->height
);
8802 SelectObject (mask
, prev
);
8807 img
->background_transparent
= 0;
8809 img
->background_transparent_valid
= 1;
8812 return img
->background_transparent
;
8816 /***********************************************************************
8817 Helper functions for X image types
8818 ***********************************************************************/
8820 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
8822 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8823 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
8825 Lisp_Object color_name
,
8826 unsigned long dflt
));
8829 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
8830 free the pixmap if any. MASK_P non-zero means clear the mask
8831 pixmap if any. COLORS_P non-zero means free colors allocated for
8832 the image, if any. */
8835 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
8838 int pixmap_p
, mask_p
, colors_p
;
8840 if (pixmap_p
&& img
->pixmap
)
8842 DeleteObject (img
->pixmap
);
8844 img
->background_valid
= 0;
8847 if (mask_p
&& img
->mask
)
8849 DeleteObject (img
->mask
);
8851 img
->background_transparent_valid
= 0;
8854 if (colors_p
&& img
->ncolors
)
8856 #if 0 /* TODO: color table support. */
8857 x_free_colors (f
, img
->colors
, img
->ncolors
);
8859 xfree (img
->colors
);
8865 /* Free X resources of image IMG which is used on frame F. */
8868 x_clear_image (f
, img
)
8875 DeleteObject (img
->pixmap
);
8882 #if 0 /* TODO: color table support */
8884 int class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
8886 /* If display has an immutable color map, freeing colors is not
8887 necessary and some servers don't allow it. So don't do it. */
8888 if (class != StaticColor
8889 && class != StaticGray
8890 && class != TrueColor
)
8894 cmap
= DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f
)->screen
);
8895 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
, img
->colors
,
8901 xfree (img
->colors
);
8908 /* Allocate color COLOR_NAME for image IMG on frame F. If color
8909 cannot be allocated, use DFLT. Add a newly allocated color to
8910 IMG->colors, so that it can be freed again. Value is the pixel
8913 static unsigned long
8914 x_alloc_image_color (f
, img
, color_name
, dflt
)
8917 Lisp_Object color_name
;
8921 unsigned long result
;
8923 xassert (STRINGP (color_name
));
8925 if (w32_defined_color (f
, SDATA (color_name
), &color
, 1))
8927 /* This isn't called frequently so we get away with simply
8928 reallocating the color vector to the needed size, here. */
8931 (unsigned long *) xrealloc (img
->colors
,
8932 img
->ncolors
* sizeof *img
->colors
);
8933 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
8934 result
= color
.pixel
;
8943 /***********************************************************************
8945 ***********************************************************************/
8947 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
8948 static void postprocess_image
P_ ((struct frame
*, struct image
*));
8949 static void x_disable_image
P_ ((struct frame
*, struct image
*));
8952 /* Return a new, initialized image cache that is allocated from the
8953 heap. Call free_image_cache to free an image cache. */
8955 struct image_cache
*
8958 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
8961 bzero (c
, sizeof *c
);
8963 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
8964 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
8965 c
->buckets
= (struct image
**) xmalloc (size
);
8966 bzero (c
->buckets
, size
);
8971 /* Free image cache of frame F. Be aware that X frames share images
8975 free_image_cache (f
)
8978 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8983 /* Cache should not be referenced by any frame when freed. */
8984 xassert (c
->refcount
== 0);
8986 for (i
= 0; i
< c
->used
; ++i
)
8987 free_image (f
, c
->images
[i
]);
8991 FRAME_X_IMAGE_CACHE (f
) = NULL
;
8996 /* Clear image cache of frame F. FORCE_P non-zero means free all
8997 images. FORCE_P zero means clear only images that haven't been
8998 displayed for some time. Should be called from time to time to
8999 reduce the number of loaded images. If image-eviction-seconds is
9000 non-nil, this frees images in the cache which weren't displayed for
9001 at least that many seconds. */
9004 clear_image_cache (f
, force_p
)
9008 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9010 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
9017 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
9019 /* Block input so that we won't be interrupted by a SIGIO
9020 while being in an inconsistent state. */
9023 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
9025 struct image
*img
= c
->images
[i
];
9027 && (force_p
|| (img
->timestamp
< old
)))
9029 free_image (f
, img
);
9034 /* We may be clearing the image cache because, for example,
9035 Emacs was iconified for a longer period of time. In that
9036 case, current matrices may still contain references to
9037 images freed above. So, clear these matrices. */
9040 Lisp_Object tail
, frame
;
9042 FOR_EACH_FRAME (tail
, frame
)
9044 struct frame
*f
= XFRAME (frame
);
9046 && FRAME_X_IMAGE_CACHE (f
) == c
)
9047 clear_current_matrices (f
);
9050 ++windows_or_buffers_changed
;
9058 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
9060 doc
: /* Clear the image cache of FRAME.
9061 FRAME nil or omitted means use the selected frame.
9062 FRAME t means clear the image caches of all frames. */)
9070 FOR_EACH_FRAME (tail
, frame
)
9071 if (FRAME_W32_P (XFRAME (frame
)))
9072 clear_image_cache (XFRAME (frame
), 1);
9075 clear_image_cache (check_x_frame (frame
), 1);
9081 /* Compute masks and transform image IMG on frame F, as specified
9082 by the image's specification, */
9085 postprocess_image (f
, img
)
9089 /* Manipulation of the image's mask. */
9092 Lisp_Object conversion
, spec
;
9097 /* `:heuristic-mask t'
9099 means build a mask heuristically.
9100 `:heuristic-mask (R G B)'
9101 `:mask (heuristic (R G B))'
9102 means build a mask from color (R G B) in the
9105 means remove a mask, if any. */
9107 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
9109 x_build_heuristic_mask (f
, img
, mask
);
9114 mask
= image_spec_value (spec
, QCmask
, &found_p
);
9116 if (EQ (mask
, Qheuristic
))
9117 x_build_heuristic_mask (f
, img
, Qt
);
9118 else if (CONSP (mask
)
9119 && EQ (XCAR (mask
), Qheuristic
))
9121 if (CONSP (XCDR (mask
)))
9122 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
9124 x_build_heuristic_mask (f
, img
, XCDR (mask
));
9126 else if (NILP (mask
) && found_p
&& img
->mask
)
9128 DeleteObject (img
->mask
);
9134 /* Should we apply an image transformation algorithm? */
9135 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
9136 if (EQ (conversion
, Qdisabled
))
9137 x_disable_image (f
, img
);
9138 else if (EQ (conversion
, Qlaplace
))
9140 else if (EQ (conversion
, Qemboss
))
9142 else if (CONSP (conversion
)
9143 && EQ (XCAR (conversion
), Qedge_detection
))
9146 tem
= XCDR (conversion
);
9148 x_edge_detection (f
, img
,
9149 Fplist_get (tem
, QCmatrix
),
9150 Fplist_get (tem
, QCcolor_adjustment
));
9156 /* Return the id of image with Lisp specification SPEC on frame F.
9157 SPEC must be a valid Lisp image specification (see valid_image_p). */
9160 lookup_image (f
, spec
)
9164 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9168 struct gcpro gcpro1
;
9171 /* F must be a window-system frame, and SPEC must be a valid image
9173 xassert (FRAME_WINDOW_P (f
));
9174 xassert (valid_image_p (spec
));
9178 /* Look up SPEC in the hash table of the image cache. */
9179 hash
= sxhash (spec
, 0);
9180 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
9182 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
9183 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
9186 /* If not found, create a new image and cache it. */
9189 extern Lisp_Object Qpostscript
;
9192 img
= make_image (spec
, hash
);
9193 cache_image (f
, img
);
9194 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
9196 /* If we can't load the image, and we don't have a width and
9197 height, use some arbitrary width and height so that we can
9198 draw a rectangle for it. */
9199 if (img
->load_failed_p
)
9203 value
= image_spec_value (spec
, QCwidth
, NULL
);
9204 img
->width
= (INTEGERP (value
)
9205 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
9206 value
= image_spec_value (spec
, QCheight
, NULL
);
9207 img
->height
= (INTEGERP (value
)
9208 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
9212 /* Handle image type independent image attributes
9213 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
9214 `:background COLOR'. */
9215 Lisp_Object ascent
, margin
, relief
, bg
;
9217 ascent
= image_spec_value (spec
, QCascent
, NULL
);
9218 if (INTEGERP (ascent
))
9219 img
->ascent
= XFASTINT (ascent
);
9220 else if (EQ (ascent
, Qcenter
))
9221 img
->ascent
= CENTERED_IMAGE_ASCENT
;
9223 margin
= image_spec_value (spec
, QCmargin
, NULL
);
9224 if (INTEGERP (margin
) && XINT (margin
) >= 0)
9225 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
9226 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
9227 && INTEGERP (XCDR (margin
)))
9229 if (XINT (XCAR (margin
)) > 0)
9230 img
->hmargin
= XFASTINT (XCAR (margin
));
9231 if (XINT (XCDR (margin
)) > 0)
9232 img
->vmargin
= XFASTINT (XCDR (margin
));
9235 relief
= image_spec_value (spec
, QCrelief
, NULL
);
9236 if (INTEGERP (relief
))
9238 img
->relief
= XINT (relief
);
9239 img
->hmargin
+= abs (img
->relief
);
9240 img
->vmargin
+= abs (img
->relief
);
9243 if (! img
->background_valid
)
9245 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
9249 = x_alloc_image_color (f
, img
, bg
,
9250 FRAME_BACKGROUND_PIXEL (f
));
9251 img
->background_valid
= 1;
9255 /* Do image transformations and compute masks, unless we
9256 don't have the image yet. */
9257 if (!EQ (*img
->type
->type
, Qpostscript
))
9258 postprocess_image (f
, img
);
9262 xassert (!interrupt_input_blocked
);
9265 /* We're using IMG, so set its timestamp to `now'. */
9266 EMACS_GET_TIME (now
);
9267 img
->timestamp
= EMACS_SECS (now
);
9271 /* Value is the image id. */
9276 /* Cache image IMG in the image cache of frame F. */
9279 cache_image (f
, img
)
9283 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9286 /* Find a free slot in c->images. */
9287 for (i
= 0; i
< c
->used
; ++i
)
9288 if (c
->images
[i
] == NULL
)
9291 /* If no free slot found, maybe enlarge c->images. */
9292 if (i
== c
->used
&& c
->used
== c
->size
)
9295 c
->images
= (struct image
**) xrealloc (c
->images
,
9296 c
->size
* sizeof *c
->images
);
9299 /* Add IMG to c->images, and assign IMG an id. */
9305 /* Add IMG to the cache's hash table. */
9306 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
9307 img
->next
= c
->buckets
[i
];
9309 img
->next
->prev
= img
;
9311 c
->buckets
[i
] = img
;
9315 /* Call FN on every image in the image cache of frame F. Used to mark
9316 Lisp Objects in the image cache. */
9319 forall_images_in_image_cache (f
, fn
)
9321 void (*fn
) P_ ((struct image
*img
));
9323 if (FRAME_LIVE_P (f
) && FRAME_W32_P (f
))
9325 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9329 for (i
= 0; i
< c
->used
; ++i
)
9338 /***********************************************************************
9340 ***********************************************************************/
9342 /* Macro for defining functions that will be loaded from image DLLs. */
9343 #define DEF_IMGLIB_FN(func) FARPROC fn_##func
9345 /* Macro for loading those image functions from the library. */
9346 #define LOAD_IMGLIB_FN(lib,func) { \
9347 fn_##func = (void *) GetProcAddress (lib, #func); \
9348 if (!fn_##func) return 0; \
9351 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
9352 XImage
**, Pixmap
*));
9353 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
9356 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
9357 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
9358 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
9359 via xmalloc. DEPTH of zero signifies a 24 bit image, otherwise
9360 DEPTH should indicate the bit depth of the image. Print error
9361 messages via image_error if an error occurs. Value is non-zero if
9365 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
9367 int width
, height
, depth
;
9371 BITMAPINFOHEADER
*header
;
9373 int scanline_width_bits
;
9375 int palette_colors
= 0;
9380 if (depth
!= 1 && depth
!= 4 && depth
!= 8
9381 && depth
!= 16 && depth
!= 24 && depth
!= 32)
9383 image_error ("Invalid image bit depth specified", Qnil
, Qnil
);
9387 scanline_width_bits
= width
* depth
;
9388 remainder
= scanline_width_bits
% 32;
9391 scanline_width_bits
+= 32 - remainder
;
9393 /* Bitmaps with a depth less than 16 need a palette. */
9394 /* BITMAPINFO structure already contains the first RGBQUAD. */
9396 palette_colors
= 1 << depth
- 1;
9398 *ximg
= xmalloc (sizeof (XImage
) + palette_colors
* sizeof (RGBQUAD
));
9401 image_error ("Unable to allocate memory for XImage", Qnil
, Qnil
);
9405 header
= &((*ximg
)->info
.bmiHeader
);
9406 bzero (&((*ximg
)->info
), sizeof (BITMAPINFO
));
9407 header
->biSize
= sizeof (*header
);
9408 header
->biWidth
= width
;
9409 header
->biHeight
= -height
; /* negative indicates a top-down bitmap. */
9410 header
->biPlanes
= 1;
9411 header
->biBitCount
= depth
;
9412 header
->biCompression
= BI_RGB
;
9413 header
->biClrUsed
= palette_colors
;
9415 /* TODO: fill in palette. */
9418 (*ximg
)->info
.bmiColors
[0].rgbBlue
= 0;
9419 (*ximg
)->info
.bmiColors
[0].rgbGreen
= 0;
9420 (*ximg
)->info
.bmiColors
[0].rgbRed
= 0;
9421 (*ximg
)->info
.bmiColors
[0].rgbReserved
= 0;
9422 (*ximg
)->info
.bmiColors
[1].rgbBlue
= 255;
9423 (*ximg
)->info
.bmiColors
[1].rgbGreen
= 255;
9424 (*ximg
)->info
.bmiColors
[1].rgbRed
= 255;
9425 (*ximg
)->info
.bmiColors
[1].rgbReserved
= 0;
9428 hdc
= get_frame_dc (f
);
9430 /* Create a DIBSection and raster array for the bitmap,
9431 and store its handle in *pixmap. */
9432 *pixmap
= CreateDIBSection (hdc
, &((*ximg
)->info
),
9433 (depth
< 16) ? DIB_PAL_COLORS
: DIB_RGB_COLORS
,
9434 &((*ximg
)->data
), NULL
, 0);
9436 /* Realize display palette and garbage all frames. */
9437 release_frame_dc (f
, hdc
);
9439 if (*pixmap
== NULL
)
9441 DWORD err
= GetLastError();
9442 Lisp_Object errcode
;
9443 /* All system errors are < 10000, so the following is safe. */
9444 XSETINT (errcode
, (int) err
);
9445 image_error ("Unable to create bitmap, error code %d", errcode
, Qnil
);
9446 x_destroy_x_image (*ximg
);
9454 /* Destroy XImage XIMG. Free XIMG->data. */
9457 x_destroy_x_image (ximg
)
9460 xassert (interrupt_input_blocked
);
9463 /* Data will be freed by DestroyObject. */
9470 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
9471 are width and height of both the image and pixmap. */
9474 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
9480 #if 0 /* I don't think this is necessary looking at where it is used. */
9481 HDC hdc
= get_frame_dc (f
);
9482 SetDIBits (hdc
, pixmap
, 0, height
, ximg
->data
, &(ximg
->info
), DIB_RGB_COLORS
);
9483 release_frame_dc (f
, hdc
);
9488 /***********************************************************************
9490 ***********************************************************************/
9492 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
9493 static char *slurp_file
P_ ((char *, int *));
9496 /* Find image file FILE. Look in data-directory, then
9497 x-bitmap-file-path. Value is the full name of the file found, or
9498 nil if not found. */
9501 x_find_image_file (file
)
9504 Lisp_Object file_found
, search_path
;
9505 struct gcpro gcpro1
, gcpro2
;
9509 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
9510 GCPRO2 (file_found
, search_path
);
9512 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
9513 fd
= openp (search_path
, file
, Qnil
, &file_found
, Qnil
);
9525 /* Read FILE into memory. Value is a pointer to a buffer allocated
9526 with xmalloc holding FILE's contents. Value is null if an error
9527 occurred. *SIZE is set to the size of the file. */
9530 slurp_file (file
, size
)
9538 if (stat (file
, &st
) == 0
9539 && (fp
= fopen (file
, "r")) != NULL
9540 && (buf
= (char *) xmalloc (st
.st_size
),
9541 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
9562 /***********************************************************************
9564 ***********************************************************************/
9566 static int xbm_scan
P_ ((char **, char *, char *, int *));
9567 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
9568 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
9570 static int xbm_image_p
P_ ((Lisp_Object object
));
9571 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
9573 static int xbm_file_p
P_ ((Lisp_Object
));
9576 /* Indices of image specification fields in xbm_format, below. */
9578 enum xbm_keyword_index
9596 /* Vector of image_keyword structures describing the format
9597 of valid XBM image specifications. */
9599 static struct image_keyword xbm_format
[XBM_LAST
] =
9601 {":type", IMAGE_SYMBOL_VALUE
, 1},
9602 {":file", IMAGE_STRING_VALUE
, 0},
9603 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9604 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9605 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9606 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
9607 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
9608 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9609 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9610 {":relief", IMAGE_INTEGER_VALUE
, 0},
9611 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9612 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9613 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9616 /* Structure describing the image type XBM. */
9618 static struct image_type xbm_type
=
9627 /* Tokens returned from xbm_scan. */
9636 /* Return non-zero if OBJECT is a valid XBM-type image specification.
9637 A valid specification is a list starting with the symbol `image'
9638 The rest of the list is a property list which must contain an
9641 If the specification specifies a file to load, it must contain
9642 an entry `:file FILENAME' where FILENAME is a string.
9644 If the specification is for a bitmap loaded from memory it must
9645 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
9646 WIDTH and HEIGHT are integers > 0. DATA may be:
9648 1. a string large enough to hold the bitmap data, i.e. it must
9649 have a size >= (WIDTH + 7) / 8 * HEIGHT
9651 2. a bool-vector of size >= WIDTH * HEIGHT
9653 3. a vector of strings or bool-vectors, one for each line of the
9656 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
9657 may not be specified in this case because they are defined in the
9660 Both the file and data forms may contain the additional entries
9661 `:background COLOR' and `:foreground COLOR'. If not present,
9662 foreground and background of the frame on which the image is
9663 displayed is used. */
9666 xbm_image_p (object
)
9669 struct image_keyword kw
[XBM_LAST
];
9671 bcopy (xbm_format
, kw
, sizeof kw
);
9672 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
9675 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
9677 if (kw
[XBM_FILE
].count
)
9679 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
9682 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
9684 /* In-memory XBM file. */
9685 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
9693 /* Entries for `:width', `:height' and `:data' must be present. */
9694 if (!kw
[XBM_WIDTH
].count
9695 || !kw
[XBM_HEIGHT
].count
9696 || !kw
[XBM_DATA
].count
)
9699 data
= kw
[XBM_DATA
].value
;
9700 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
9701 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
9703 /* Check type of data, and width and height against contents of
9709 /* Number of elements of the vector must be >= height. */
9710 if (XVECTOR (data
)->size
< height
)
9713 /* Each string or bool-vector in data must be large enough
9714 for one line of the image. */
9715 for (i
= 0; i
< height
; ++i
)
9717 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
9722 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
9725 else if (BOOL_VECTOR_P (elt
))
9727 if (XBOOL_VECTOR (elt
)->size
< width
)
9734 else if (STRINGP (data
))
9737 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
9740 else if (BOOL_VECTOR_P (data
))
9742 if (XBOOL_VECTOR (data
)->size
< width
* height
)
9753 /* Scan a bitmap file. FP is the stream to read from. Value is
9754 either an enumerator from enum xbm_token, or a character for a
9755 single-character token, or 0 at end of file. If scanning an
9756 identifier, store the lexeme of the identifier in SVAL. If
9757 scanning a number, store its value in *IVAL. */
9760 xbm_scan (s
, end
, sval
, ival
)
9769 /* Skip white space. */
9770 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
9775 else if (isdigit (c
))
9777 int value
= 0, digit
;
9779 if (c
== '0' && *s
< end
)
9782 if (c
== 'x' || c
== 'X')
9789 else if (c
>= 'a' && c
<= 'f')
9790 digit
= c
- 'a' + 10;
9791 else if (c
>= 'A' && c
<= 'F')
9792 digit
= c
- 'A' + 10;
9795 value
= 16 * value
+ digit
;
9798 else if (isdigit (c
))
9802 && (c
= *(*s
)++, isdigit (c
)))
9803 value
= 8 * value
+ c
- '0';
9810 && (c
= *(*s
)++, isdigit (c
)))
9811 value
= 10 * value
+ c
- '0';
9819 else if (isalpha (c
) || c
== '_')
9823 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
9830 else if (c
== '/' && **s
== '*')
9832 /* C-style comment. */
9834 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
9847 /* XBM bits seem to be backward within bytes compared with how
9848 Windows does things. */
9849 static unsigned char reflect_byte (unsigned char orig
)
9852 unsigned char reflected
= 0x00;
9853 for (i
= 0; i
< 8; i
++)
9855 if (orig
& (0x01 << i
))
9856 reflected
|= 0x80 >> i
;
9862 /* Create a Windows bitmap from X bitmap data. */
9864 w32_create_pixmap_from_bitmap_data (int width
, int height
, char *data
)
9870 w1
= (width
+ 7) / 8; /* nb of 8bits elt in X bitmap */
9871 w2
= ((width
+ 15) / 16) * 2; /* nb of 16bits elt in W32 bitmap */
9872 bits
= (char *) alloca (height
* w2
);
9873 bzero (bits
, height
* w2
);
9874 for (i
= 0; i
< height
; i
++)
9877 for (j
= 0; j
< w1
; j
++)
9878 *p
++ = reflect_byte(*data
++);
9880 bmp
= CreateBitmap (width
, height
, 1, 1, bits
);
9886 /* Replacement for XReadBitmapFileData which isn't available under old
9887 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9888 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9889 the image. Return in *DATA the bitmap data allocated with xmalloc.
9890 Value is non-zero if successful. DATA null means just test if
9891 CONTENTS looks like an in-memory XBM file. */
9894 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
9895 char *contents
, *end
;
9896 int *width
, *height
;
9897 unsigned char **data
;
9900 char buffer
[BUFSIZ
];
9903 int bytes_per_line
, i
, nbytes
;
9909 LA1 = xbm_scan (&s, end, buffer, &value)
9911 #define expect(TOKEN) \
9912 if (LA1 != (TOKEN)) \
9917 #define expect_ident(IDENT) \
9918 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9923 *width
= *height
= -1;
9926 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
9928 /* Parse defines for width, height and hot-spots. */
9932 expect_ident ("define");
9933 expect (XBM_TK_IDENT
);
9935 if (LA1
== XBM_TK_NUMBER
);
9937 char *p
= strrchr (buffer
, '_');
9938 p
= p
? p
+ 1 : buffer
;
9939 if (strcmp (p
, "width") == 0)
9941 else if (strcmp (p
, "height") == 0)
9944 expect (XBM_TK_NUMBER
);
9947 if (*width
< 0 || *height
< 0)
9949 else if (data
== NULL
)
9952 /* Parse bits. Must start with `static'. */
9953 expect_ident ("static");
9954 if (LA1
== XBM_TK_IDENT
)
9956 if (strcmp (buffer
, "unsigned") == 0)
9959 expect_ident ("char");
9961 else if (strcmp (buffer
, "short") == 0)
9965 if (*width
% 16 && *width
% 16 < 9)
9968 else if (strcmp (buffer
, "char") == 0)
9976 expect (XBM_TK_IDENT
);
9982 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
9983 nbytes
= bytes_per_line
* *height
;
9984 p
= *data
= (char *) xmalloc (nbytes
);
9988 for (i
= 0; i
< nbytes
; i
+= 2)
9991 expect (XBM_TK_NUMBER
);
9994 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
9995 *p
++ = ~ (value
>> 8);
9997 if (LA1
== ',' || LA1
== '}')
10005 for (i
= 0; i
< nbytes
; ++i
)
10008 expect (XBM_TK_NUMBER
);
10012 if (LA1
== ',' || LA1
== '}')
10033 #undef expect_ident
10036 static void convert_mono_to_color_image (f
, img
, foreground
, background
)
10039 COLORREF foreground
, background
;
10041 HDC hdc
, old_img_dc
, new_img_dc
;
10042 HGDIOBJ old_prev
, new_prev
;
10043 HBITMAP new_pixmap
;
10045 hdc
= get_frame_dc (f
);
10046 old_img_dc
= CreateCompatibleDC (hdc
);
10047 new_img_dc
= CreateCompatibleDC (hdc
);
10048 new_pixmap
= CreateCompatibleBitmap (hdc
, img
->width
, img
->height
);
10049 release_frame_dc (f
, hdc
);
10050 old_prev
= SelectObject (old_img_dc
, img
->pixmap
);
10051 new_prev
= SelectObject (new_img_dc
, new_pixmap
);
10052 SetTextColor (new_img_dc
, foreground
);
10053 SetBkColor (new_img_dc
, background
);
10055 BitBlt (new_img_dc
, 0, 0, img
->width
, img
->height
, old_img_dc
,
10058 SelectObject (old_img_dc
, old_prev
);
10059 SelectObject (new_img_dc
, new_prev
);
10060 DeleteDC (old_img_dc
);
10061 DeleteDC (new_img_dc
);
10062 DeleteObject (img
->pixmap
);
10063 if (new_pixmap
== 0)
10064 fprintf (stderr
, "Failed to convert image to color.\n");
10066 img
->pixmap
= new_pixmap
;
10069 /* Load XBM image IMG which will be displayed on frame F from buffer
10070 CONTENTS. END is the end of the buffer. Value is non-zero if
10074 xbm_load_image (f
, img
, contents
, end
)
10077 char *contents
, *end
;
10080 unsigned char *data
;
10083 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
10086 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
10087 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
10088 int non_default_colors
= 0;
10091 xassert (img
->width
> 0 && img
->height
> 0);
10093 /* Get foreground and background colors, maybe allocate colors. */
10094 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
10097 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
10098 non_default_colors
= 1;
10100 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
10103 background
= x_alloc_image_color (f
, img
, value
, background
);
10104 img
->background
= background
;
10105 img
->background_valid
= 1;
10106 non_default_colors
= 1;
10109 = w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
, data
);
10111 /* If colors were specified, transfer the bitmap to a color one. */
10112 if (non_default_colors
)
10113 convert_mono_to_color_image (f
, img
, foreground
, background
);
10117 if (img
->pixmap
== 0)
10119 x_clear_image (f
, img
);
10120 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
10126 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
10132 /* Value is non-zero if DATA looks like an in-memory XBM file. */
10139 return (STRINGP (data
)
10140 && xbm_read_bitmap_data (SDATA (data
),
10147 /* Fill image IMG which is used on frame F with pixmap data. Value is
10148 non-zero if successful. */
10156 Lisp_Object file_name
;
10158 xassert (xbm_image_p (img
->spec
));
10160 /* If IMG->spec specifies a file name, create a non-file spec from it. */
10161 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
10162 if (STRINGP (file_name
))
10167 struct gcpro gcpro1
;
10169 file
= x_find_image_file (file_name
);
10171 if (!STRINGP (file
))
10173 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
10178 contents
= slurp_file (SDATA (file
), &size
);
10179 if (contents
== NULL
)
10181 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
10186 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
10191 struct image_keyword fmt
[XBM_LAST
];
10193 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
10194 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
10195 int non_default_colors
= 0;
10198 int in_memory_file_p
= 0;
10200 /* See if data looks like an in-memory XBM file. */
10201 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10202 in_memory_file_p
= xbm_file_p (data
);
10204 /* Parse the image specification. */
10205 bcopy (xbm_format
, fmt
, sizeof fmt
);
10206 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
10207 xassert (parsed_p
);
10209 /* Get specified width, and height. */
10210 if (!in_memory_file_p
)
10212 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
10213 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
10214 xassert (img
->width
> 0 && img
->height
> 0);
10217 /* Get foreground and background colors, maybe allocate colors. */
10218 if (fmt
[XBM_FOREGROUND
].count
10219 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
10221 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
10223 non_default_colors
= 1;
10226 if (fmt
[XBM_BACKGROUND
].count
10227 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
10229 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
10231 non_default_colors
= 1;
10234 if (in_memory_file_p
)
10235 success_p
= xbm_load_image (f
, img
, SDATA (data
),
10240 if (VECTORP (data
))
10244 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
10246 p
= bits
= (char *) alloca (nbytes
* img
->height
);
10247 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
10249 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
10250 if (STRINGP (line
))
10251 bcopy (SDATA (line
), p
, nbytes
);
10253 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
10256 else if (STRINGP (data
))
10257 bits
= SDATA (data
);
10259 bits
= XBOOL_VECTOR (data
)->data
;
10261 /* Create the pixmap. */
10263 = w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
,
10266 /* If colors were specified, transfer the bitmap to a color one. */
10267 if (non_default_colors
)
10268 convert_mono_to_color_image (f
, img
, foreground
, background
);
10274 image_error ("Unable to create pixmap for XBM image `%s'",
10276 x_clear_image (f
, img
);
10286 /***********************************************************************
10288 ***********************************************************************/
10292 static int xpm_image_p
P_ ((Lisp_Object object
));
10293 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
10294 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
10296 /* Indicate to xpm.h that we don't have Xlib. */
10298 /* simx.h in xpm defines XColor and XImage differently than Emacs. */
10299 #define XColor xpm_XColor
10300 #define XImage xpm_XImage
10301 #define PIXEL_ALREADY_TYPEDEFED
10302 #include "X11/xpm.h"
10306 #undef PIXEL_ALREADY_TYPEDEFED
10308 /* The symbol `xpm' identifying XPM-format images. */
10312 /* Indices of image specification fields in xpm_format, below. */
10314 enum xpm_keyword_index
10323 XPM_HEURISTIC_MASK
,
10330 /* Vector of image_keyword structures describing the format
10331 of valid XPM image specifications. */
10333 static struct image_keyword xpm_format
[XPM_LAST
] =
10335 {":type", IMAGE_SYMBOL_VALUE
, 1},
10336 {":file", IMAGE_STRING_VALUE
, 0},
10337 {":data", IMAGE_STRING_VALUE
, 0},
10338 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10339 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10340 {":relief", IMAGE_INTEGER_VALUE
, 0},
10341 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10342 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10343 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10344 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10345 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10348 /* Structure describing the image type XPM. */
10350 static struct image_type xpm_type
=
10360 /* XPM library details. */
10362 DEF_IMGLIB_FN (XpmFreeAttributes
);
10363 DEF_IMGLIB_FN (XpmCreateImageFromBuffer
);
10364 DEF_IMGLIB_FN (XpmReadFileToImage
);
10365 DEF_IMGLIB_FN (XImageFree
);
10369 init_xpm_functions (library
)
10372 LOAD_IMGLIB_FN (library
, XpmFreeAttributes
);
10373 LOAD_IMGLIB_FN (library
, XpmCreateImageFromBuffer
);
10374 LOAD_IMGLIB_FN (library
, XpmReadFileToImage
);
10375 LOAD_IMGLIB_FN (library
, XImageFree
);
10380 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
10381 for XPM images. Such a list must consist of conses whose car and
10382 cdr are strings. */
10385 xpm_valid_color_symbols_p (color_symbols
)
10386 Lisp_Object color_symbols
;
10388 while (CONSP (color_symbols
))
10390 Lisp_Object sym
= XCAR (color_symbols
);
10392 || !STRINGP (XCAR (sym
))
10393 || !STRINGP (XCDR (sym
)))
10395 color_symbols
= XCDR (color_symbols
);
10398 return NILP (color_symbols
);
10402 /* Value is non-zero if OBJECT is a valid XPM image specification. */
10405 xpm_image_p (object
)
10406 Lisp_Object object
;
10408 struct image_keyword fmt
[XPM_LAST
];
10409 bcopy (xpm_format
, fmt
, sizeof fmt
);
10410 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
10411 /* Either `:file' or `:data' must be present. */
10412 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
10413 /* Either no `:color-symbols' or it's a list of conses
10414 whose car and cdr are strings. */
10415 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
10416 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
10420 /* Load image IMG which will be displayed on frame F. Value is
10421 non-zero if successful. */
10430 XpmAttributes attrs
;
10431 Lisp_Object specified_file
, color_symbols
;
10432 xpm_XImage
* xpm_image
, * xpm_mask
;
10434 /* Configure the XPM lib. Use the visual of frame F. Allocate
10435 close colors. Return colors allocated. */
10436 bzero (&attrs
, sizeof attrs
);
10437 xpm_image
= xpm_mask
= NULL
;
10440 attrs
.visual
= FRAME_X_VISUAL (f
);
10441 attrs
.colormap
= FRAME_X_COLORMAP (f
);
10442 attrs
.valuemask
|= XpmVisual
;
10443 attrs
.valuemask
|= XpmColormap
;
10445 attrs
.valuemask
|= XpmReturnAllocPixels
;
10446 #ifdef XpmAllocCloseColors
10447 attrs
.alloc_close_colors
= 1;
10448 attrs
.valuemask
|= XpmAllocCloseColors
;
10450 attrs
.closeness
= 600;
10451 attrs
.valuemask
|= XpmCloseness
;
10454 /* If image specification contains symbolic color definitions, add
10455 these to `attrs'. */
10456 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
10457 if (CONSP (color_symbols
))
10460 XpmColorSymbol
*xpm_syms
;
10463 attrs
.valuemask
|= XpmColorSymbols
;
10465 /* Count number of symbols. */
10466 attrs
.numsymbols
= 0;
10467 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
10468 ++attrs
.numsymbols
;
10470 /* Allocate an XpmColorSymbol array. */
10471 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
10472 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
10473 bzero (xpm_syms
, size
);
10474 attrs
.colorsymbols
= xpm_syms
;
10476 /* Fill the color symbol array. */
10477 for (tail
= color_symbols
, i
= 0;
10479 ++i
, tail
= XCDR (tail
))
10481 Lisp_Object name
= XCAR (XCAR (tail
));
10482 Lisp_Object color
= XCDR (XCAR (tail
));
10483 xpm_syms
[i
].name
= (char *) alloca (SCHARS (name
) + 1);
10484 strcpy (xpm_syms
[i
].name
, SDATA (name
));
10485 xpm_syms
[i
].value
= (char *) alloca (SCHARS (color
) + 1);
10486 strcpy (xpm_syms
[i
].value
, SDATA (color
));
10490 /* Create a pixmap for the image, either from a file, or from a
10491 string buffer containing data in the same format as an XPM file. */
10493 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10496 HDC frame_dc
= get_frame_dc (f
);
10497 hdc
= CreateCompatibleDC (frame_dc
);
10498 release_frame_dc (f
, frame_dc
);
10501 if (STRINGP (specified_file
))
10503 Lisp_Object file
= x_find_image_file (specified_file
);
10504 if (!STRINGP (file
))
10506 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10510 /* XpmReadFileToPixmap is not available in the Windows port of
10511 libxpm. But XpmReadFileToImage almost does what we want. */
10512 rc
= fn_XpmReadFileToImage (&hdc
, SDATA (file
),
10513 &xpm_image
, &xpm_mask
,
10518 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
10519 /* XpmCreatePixmapFromBuffer is not available in the Windows port
10520 of libxpm. But XpmCreateImageFromBuffer almost does what we want. */
10521 rc
= fn_XpmCreateImageFromBuffer (&hdc
, SDATA (buffer
),
10522 &xpm_image
, &xpm_mask
,
10526 if (rc
== XpmSuccess
)
10530 /* W32 XPM uses XImage to wrap what W32 Emacs calls a Pixmap,
10531 plus some duplicate attributes. */
10532 if (xpm_image
&& xpm_image
->bitmap
)
10534 img
->pixmap
= xpm_image
->bitmap
;
10535 /* XImageFree in libXpm frees XImage struct without destroying
10536 the bitmap, which is what we want. */
10537 fn_XImageFree (xpm_image
);
10539 if (xpm_mask
&& xpm_mask
->bitmap
)
10541 /* The mask appears to be inverted compared with what we expect.
10542 TODO: invert our expectations. See other places where we
10543 have to invert bits because our idea of masks is backwards. */
10545 old_obj
= SelectObject (hdc
, xpm_mask
->bitmap
);
10547 PatBlt (hdc
, 0, 0, xpm_mask
->width
, xpm_mask
->height
, DSTINVERT
);
10548 SelectObject (hdc
, old_obj
);
10550 img
->mask
= xpm_mask
->bitmap
;
10551 fn_XImageFree (xpm_mask
);
10557 /* Remember allocated colors. */
10558 img
->ncolors
= attrs
.nalloc_pixels
;
10559 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
10560 * sizeof *img
->colors
);
10561 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
10562 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
10564 img
->width
= attrs
.width
;
10565 img
->height
= attrs
.height
;
10566 xassert (img
->width
> 0 && img
->height
> 0);
10568 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
10569 fn_XpmFreeAttributes (&attrs
);
10577 case XpmOpenFailed
:
10578 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
10581 case XpmFileInvalid
:
10582 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
10586 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
10589 case XpmColorFailed
:
10590 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
10594 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
10599 return rc
== XpmSuccess
;
10602 #endif /* HAVE_XPM != 0 */
10605 #if 0 /* TODO : Color tables on W32. */
10606 /***********************************************************************
10608 ***********************************************************************/
10610 /* An entry in the color table mapping an RGB color to a pixel color. */
10615 unsigned long pixel
;
10617 /* Next in color table collision list. */
10618 struct ct_color
*next
;
10621 /* The bucket vector size to use. Must be prime. */
10623 #define CT_SIZE 101
10625 /* Value is a hash of the RGB color given by R, G, and B. */
10627 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
10629 /* The color hash table. */
10631 struct ct_color
**ct_table
;
10633 /* Number of entries in the color table. */
10635 int ct_colors_allocated
;
10637 /* Function prototypes. */
10639 static void init_color_table
P_ ((void));
10640 static void free_color_table
P_ ((void));
10641 static unsigned long *colors_in_color_table
P_ ((int *n
));
10642 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
10643 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
10646 /* Initialize the color table. */
10649 init_color_table ()
10651 int size
= CT_SIZE
* sizeof (*ct_table
);
10652 ct_table
= (struct ct_color
**) xmalloc (size
);
10653 bzero (ct_table
, size
);
10654 ct_colors_allocated
= 0;
10658 /* Free memory associated with the color table. */
10661 free_color_table ()
10664 struct ct_color
*p
, *next
;
10666 for (i
= 0; i
< CT_SIZE
; ++i
)
10667 for (p
= ct_table
[i
]; p
; p
= next
)
10678 /* Value is a pixel color for RGB color R, G, B on frame F. If an
10679 entry for that color already is in the color table, return the
10680 pixel color of that entry. Otherwise, allocate a new color for R,
10681 G, B, and make an entry in the color table. */
10683 static unsigned long
10684 lookup_rgb_color (f
, r
, g
, b
)
10688 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
10689 int i
= hash
% CT_SIZE
;
10690 struct ct_color
*p
;
10692 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10693 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
10702 color
= PALETTERGB (r
, g
, b
);
10704 ++ct_colors_allocated
;
10706 p
= (struct ct_color
*) xmalloc (sizeof *p
);
10711 p
->next
= ct_table
[i
];
10719 /* Look up pixel color PIXEL which is used on frame F in the color
10720 table. If not already present, allocate it. Value is PIXEL. */
10722 static unsigned long
10723 lookup_pixel_color (f
, pixel
)
10725 unsigned long pixel
;
10727 int i
= pixel
% CT_SIZE
;
10728 struct ct_color
*p
;
10730 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10731 if (p
->pixel
== pixel
)
10742 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
10743 color
.pixel
= pixel
;
10744 XQueryColor (NULL
, cmap
, &color
);
10745 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
10750 ++ct_colors_allocated
;
10752 p
= (struct ct_color
*) xmalloc (sizeof *p
);
10754 p
->g
= color
.green
;
10757 p
->next
= ct_table
[i
];
10761 return FRAME_FOREGROUND_PIXEL (f
);
10767 /* Value is a vector of all pixel colors contained in the color table,
10768 allocated via xmalloc. Set *N to the number of colors. */
10770 static unsigned long *
10771 colors_in_color_table (n
)
10775 struct ct_color
*p
;
10776 unsigned long *colors
;
10778 if (ct_colors_allocated
== 0)
10785 colors
= (unsigned long *) xmalloc (ct_colors_allocated
10787 *n
= ct_colors_allocated
;
10789 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
10790 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10791 colors
[j
++] = p
->pixel
;
10800 /***********************************************************************
10802 ***********************************************************************/
10803 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
10804 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
10805 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
10806 static void XPutPixel (XImage
*, int, int, COLORREF
);
10808 /* Non-zero means draw a cross on images having `:conversion
10811 int cross_disabled_images
;
10813 /* Edge detection matrices for different edge-detection
10816 static int emboss_matrix
[9] = {
10817 /* x - 1 x x + 1 */
10818 2, -1, 0, /* y - 1 */
10820 0, 1, -2 /* y + 1 */
10823 static int laplace_matrix
[9] = {
10824 /* x - 1 x x + 1 */
10825 1, 0, 0, /* y - 1 */
10827 0, 0, -1 /* y + 1 */
10830 /* Value is the intensity of the color whose red/green/blue values
10831 are R, G, and B. */
10833 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
10836 /* On frame F, return an array of XColor structures describing image
10837 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
10838 non-zero means also fill the red/green/blue members of the XColor
10839 structures. Value is a pointer to the array of XColors structures,
10840 allocated with xmalloc; it must be freed by the caller. */
10843 x_to_xcolors (f
, img
, rgb_p
)
10849 XColor
*colors
, *p
;
10853 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
10855 /* Load the image into a memory device context. */
10856 hdc
= get_frame_dc (f
);
10857 bmpdc
= CreateCompatibleDC (hdc
);
10858 release_frame_dc (f
, hdc
);
10859 prev
= SelectObject (bmpdc
, img
->pixmap
);
10861 /* Fill the `pixel' members of the XColor array. I wished there
10862 were an easy and portable way to circumvent XGetPixel. */
10864 for (y
= 0; y
< img
->height
; ++y
)
10868 for (x
= 0; x
< img
->width
; ++x
, ++p
)
10870 /* TODO: palette support needed here? */
10871 p
->pixel
= GetPixel (bmpdc
, x
, y
);
10875 p
->red
= 256 * GetRValue (p
->pixel
);
10876 p
->green
= 256 * GetGValue (p
->pixel
);
10877 p
->blue
= 256 * GetBValue (p
->pixel
);
10882 SelectObject (bmpdc
, prev
);
10888 /* Put a pixel of COLOR at position X, Y in XIMG. XIMG must have been
10889 created with CreateDIBSection, with the pointer to the bit values
10890 stored in ximg->data. */
10892 static void XPutPixel (ximg
, x
, y
, color
)
10897 int width
= ximg
->info
.bmiHeader
.biWidth
;
10898 int height
= ximg
->info
.bmiHeader
.biHeight
;
10899 unsigned char * pixel
;
10901 /* True color images. */
10902 if (ximg
->info
.bmiHeader
.biBitCount
== 24)
10904 int rowbytes
= width
* 3;
10905 /* Ensure scanlines are aligned on 4 byte boundaries. */
10907 rowbytes
+= 4 - (rowbytes
% 4);
10909 pixel
= ximg
->data
+ y
* rowbytes
+ x
* 3;
10910 /* Windows bitmaps are in BGR order. */
10911 *pixel
= GetBValue (color
);
10912 *(pixel
+ 1) = GetGValue (color
);
10913 *(pixel
+ 2) = GetRValue (color
);
10915 /* Monochrome images. */
10916 else if (ximg
->info
.bmiHeader
.biBitCount
== 1)
10918 int rowbytes
= width
/ 8;
10919 /* Ensure scanlines are aligned on 4 byte boundaries. */
10921 rowbytes
+= 4 - (rowbytes
% 4);
10922 pixel
= ximg
->data
+ y
* rowbytes
+ x
/ 8;
10923 /* Filter out palette info. */
10924 if (color
& 0x00ffffff)
10925 *pixel
= *pixel
| (1 << x
% 8);
10927 *pixel
= *pixel
& ~(1 << x
% 8);
10930 image_error ("XPutPixel: palette image not supported.", Qnil
, Qnil
);
10933 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
10934 RGB members are set. F is the frame on which this all happens.
10935 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
10938 x_from_xcolors (f
, img
, colors
)
10947 #if 0 /* TODO: color tables. */
10948 init_color_table ();
10950 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
10953 for (y
= 0; y
< img
->height
; ++y
)
10954 for (x
= 0; x
< img
->width
; ++x
, ++p
)
10956 unsigned long pixel
;
10957 #if 0 /* TODO: color tables. */
10958 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
10960 pixel
= PALETTERGB (p
->red
/ 256, p
->green
/ 256, p
->blue
/ 256);
10962 XPutPixel (oimg
, x
, y
, pixel
);
10966 x_clear_image_1 (f
, img
, 1, 0, 1);
10968 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
10969 x_destroy_x_image (oimg
);
10970 img
->pixmap
= pixmap
;
10971 #if 0 /* TODO: color tables. */
10972 img
->colors
= colors_in_color_table (&img
->ncolors
);
10973 free_color_table ();
10978 /* On frame F, perform edge-detection on image IMG.
10980 MATRIX is a nine-element array specifying the transformation
10981 matrix. See emboss_matrix for an example.
10983 COLOR_ADJUST is a color adjustment added to each pixel of the
10987 x_detect_edges (f
, img
, matrix
, color_adjust
)
10990 int matrix
[9], color_adjust
;
10992 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10996 for (i
= sum
= 0; i
< 9; ++i
)
10997 sum
+= abs (matrix
[i
]);
10999 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
11001 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
11003 for (y
= 0; y
< img
->height
; ++y
)
11005 p
= COLOR (new, 0, y
);
11006 p
->red
= p
->green
= p
->blue
= 0xffff/2;
11007 p
= COLOR (new, img
->width
- 1, y
);
11008 p
->red
= p
->green
= p
->blue
= 0xffff/2;
11011 for (x
= 1; x
< img
->width
- 1; ++x
)
11013 p
= COLOR (new, x
, 0);
11014 p
->red
= p
->green
= p
->blue
= 0xffff/2;
11015 p
= COLOR (new, x
, img
->height
- 1);
11016 p
->red
= p
->green
= p
->blue
= 0xffff/2;
11019 for (y
= 1; y
< img
->height
- 1; ++y
)
11021 p
= COLOR (new, 1, y
);
11023 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
11025 int r
, g
, b
, y1
, x1
;
11028 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
11029 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
11032 XColor
*t
= COLOR (colors
, x1
, y1
);
11033 r
+= matrix
[i
] * t
->red
;
11034 g
+= matrix
[i
] * t
->green
;
11035 b
+= matrix
[i
] * t
->blue
;
11038 r
= (r
/ sum
+ color_adjust
) & 0xffff;
11039 g
= (g
/ sum
+ color_adjust
) & 0xffff;
11040 b
= (b
/ sum
+ color_adjust
) & 0xffff;
11041 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
11046 x_from_xcolors (f
, img
, new);
11052 /* Perform the pre-defined `emboss' edge-detection on image IMG
11060 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
11064 /* Transform image IMG which is used on frame F with a Laplace
11065 edge-detection algorithm. The result is an image that can be used
11066 to draw disabled buttons, for example. */
11073 x_detect_edges (f
, img
, laplace_matrix
, 45000);
11077 /* Perform edge-detection on image IMG on frame F, with specified
11078 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
11080 MATRIX must be either
11082 - a list of at least 9 numbers in row-major form
11083 - a vector of at least 9 numbers
11085 COLOR_ADJUST nil means use a default; otherwise it must be a
11089 x_edge_detection (f
, img
, matrix
, color_adjust
)
11092 Lisp_Object matrix
, color_adjust
;
11097 if (CONSP (matrix
))
11100 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
11101 ++i
, matrix
= XCDR (matrix
))
11102 trans
[i
] = XFLOATINT (XCAR (matrix
));
11104 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
11106 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
11107 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
11110 if (NILP (color_adjust
))
11111 color_adjust
= make_number (0xffff / 2);
11113 if (i
== 9 && NUMBERP (color_adjust
))
11114 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
11118 /* Transform image IMG on frame F so that it looks disabled. */
11121 x_disable_image (f
, img
)
11125 struct w32_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
11127 if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
>= 2)
11129 /* Color (or grayscale). Convert to gray, and equalize. Just
11130 drawing such images with a stipple can look very odd, so
11131 we're using this method instead. */
11132 XColor
*colors
= x_to_xcolors (f
, img
, 1);
11134 const int h
= 15000;
11135 const int l
= 30000;
11137 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
11141 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
11142 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
11143 p
->red
= p
->green
= p
->blue
= i2
;
11146 x_from_xcolors (f
, img
, colors
);
11149 /* Draw a cross over the disabled image, if we must or if we
11151 if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
< 2 || cross_disabled_images
)
11156 hdc
= get_frame_dc (f
);
11157 bmpdc
= CreateCompatibleDC (hdc
);
11158 release_frame_dc (f
, hdc
);
11160 prev
= SelectObject (bmpdc
, img
->pixmap
);
11162 SetTextColor (bmpdc
, BLACK_PIX_DEFAULT (f
));
11163 MoveToEx (bmpdc
, 0, 0, NULL
);
11164 LineTo (bmpdc
, img
->width
- 1, img
->height
- 1);
11165 MoveToEx (bmpdc
, 0, img
->height
- 1, NULL
);
11166 LineTo (bmpdc
, img
->width
- 1, 0);
11170 SelectObject (bmpdc
, img
->mask
);
11171 SetTextColor (bmpdc
, WHITE_PIX_DEFAULT (f
));
11172 MoveToEx (bmpdc
, 0, 0, NULL
);
11173 LineTo (bmpdc
, img
->width
- 1, img
->height
- 1);
11174 MoveToEx (bmpdc
, 0, img
->height
- 1, NULL
);
11175 LineTo (bmpdc
, img
->width
- 1, 0);
11177 SelectObject (bmpdc
, prev
);
11183 /* Build a mask for image IMG which is used on frame F. FILE is the
11184 name of an image file, for error messages. HOW determines how to
11185 determine the background color of IMG. If it is a list '(R G B)',
11186 with R, G, and B being integers >= 0, take that as the color of the
11187 background. Otherwise, determine the background color of IMG
11188 heuristically. Value is non-zero if successful. */
11191 x_build_heuristic_mask (f
, img
, how
)
11196 HDC img_dc
, frame_dc
;
11199 int x
, y
, rc
, use_img_background
;
11200 unsigned long bg
= 0;
11205 DeleteObject (img
->mask
);
11207 img
->background_transparent_valid
= 0;
11210 /* Create the bit array serving as mask. */
11211 row_width
= (img
->width
+ 7) / 8;
11212 mask_img
= xmalloc (row_width
* img
->height
);
11213 bzero (mask_img
, row_width
* img
->height
);
11215 /* Create a memory device context for IMG->pixmap. */
11216 frame_dc
= get_frame_dc (f
);
11217 img_dc
= CreateCompatibleDC (frame_dc
);
11218 release_frame_dc (f
, frame_dc
);
11219 prev
= SelectObject (img_dc
, img
->pixmap
);
11221 /* Determine the background color of img_dc. If HOW is `(R G B)'
11222 take that as color. Otherwise, use the image's background color. */
11223 use_img_background
= 1;
11229 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
11231 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
11235 if (i
== 3 && NILP (how
))
11237 char color_name
[30];
11238 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
11239 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0)
11240 & 0x00ffffff; /* Filter out palette info. */
11241 use_img_background
= 0;
11245 if (use_img_background
)
11246 bg
= four_corners_best (img_dc
, img
->width
, img
->height
);
11248 /* Set all bits in mask_img to 1 whose color in ximg is different
11249 from the background color bg. */
11250 for (y
= 0; y
< img
->height
; ++y
)
11251 for (x
= 0; x
< img
->width
; ++x
)
11253 COLORREF p
= GetPixel (img_dc
, x
, y
);
11255 mask_img
[y
* row_width
+ x
/ 8] |= 1 << (x
% 8);
11258 /* Create the mask image. */
11259 img
->mask
= w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
,
11262 /* Fill in the background_transparent field while we have the mask handy. */
11263 SelectObject (img_dc
, img
->mask
);
11265 image_background_transparent (img
, f
, img_dc
);
11267 /* Put mask_img into img->mask. */
11268 x_destroy_x_image ((XImage
*)mask_img
);
11269 SelectObject (img_dc
, prev
);
11276 /***********************************************************************
11277 PBM (mono, gray, color)
11278 ***********************************************************************/
11280 static int pbm_image_p
P_ ((Lisp_Object object
));
11281 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
11282 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
11284 /* The symbol `pbm' identifying images of this type. */
11288 /* Indices of image specification fields in gs_format, below. */
11290 enum pbm_keyword_index
11299 PBM_HEURISTIC_MASK
,
11306 /* Vector of image_keyword structures describing the format
11307 of valid user-defined image specifications. */
11309 static struct image_keyword pbm_format
[PBM_LAST
] =
11311 {":type", IMAGE_SYMBOL_VALUE
, 1},
11312 {":file", IMAGE_STRING_VALUE
, 0},
11313 {":data", IMAGE_STRING_VALUE
, 0},
11314 {":ascent", IMAGE_ASCENT_VALUE
, 0},
11315 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11316 {":relief", IMAGE_INTEGER_VALUE
, 0},
11317 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11318 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11319 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11320 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
11321 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11324 /* Structure describing the image type `pbm'. */
11326 static struct image_type pbm_type
=
11336 /* Return non-zero if OBJECT is a valid PBM image specification. */
11339 pbm_image_p (object
)
11340 Lisp_Object object
;
11342 struct image_keyword fmt
[PBM_LAST
];
11344 bcopy (pbm_format
, fmt
, sizeof fmt
);
11346 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
11349 /* Must specify either :data or :file. */
11350 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
11354 /* Scan a decimal number from *S and return it. Advance *S while
11355 reading the number. END is the end of the string. Value is -1 at
11359 pbm_scan_number (s
, end
)
11360 unsigned char **s
, *end
;
11366 /* Skip white-space. */
11367 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
11372 /* Skip comment to end of line. */
11373 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
11376 else if (isdigit (c
))
11378 /* Read decimal number. */
11380 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
11381 val
= 10 * val
+ c
- '0';
11392 /* Read FILE into memory. Value is a pointer to a buffer allocated
11393 with xmalloc holding FILE's contents. Value is null if an error
11394 occurred. *SIZE is set to the size of the file. */
11397 pbm_read_file (file
, size
)
11405 if (stat (SDATA (file
), &st
) == 0
11406 && (fp
= fopen (SDATA (file
), "r")) != NULL
11407 && (buf
= (char *) xmalloc (st
.st_size
),
11408 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
11410 *size
= st
.st_size
;
11428 /* Load PBM image IMG for use on frame F. */
11436 int width
, height
, max_color_idx
= 0;
11438 Lisp_Object file
, specified_file
;
11439 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
11440 struct gcpro gcpro1
;
11441 unsigned char *contents
= NULL
;
11442 unsigned char *end
, *p
;
11445 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11449 if (STRINGP (specified_file
))
11451 file
= x_find_image_file (specified_file
);
11452 if (!STRINGP (file
))
11454 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11459 contents
= slurp_file (SDATA (file
), &size
);
11460 if (contents
== NULL
)
11462 image_error ("Error reading `%s'", file
, Qnil
);
11468 end
= contents
+ size
;
11473 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11475 end
= p
+ SBYTES (data
);
11478 /* Check magic number. */
11479 if (end
- p
< 2 || *p
++ != 'P')
11481 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
11491 raw_p
= 0, type
= PBM_MONO
;
11495 raw_p
= 0, type
= PBM_GRAY
;
11499 raw_p
= 0, type
= PBM_COLOR
;
11503 raw_p
= 1, type
= PBM_MONO
;
11507 raw_p
= 1, type
= PBM_GRAY
;
11511 raw_p
= 1, type
= PBM_COLOR
;
11515 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
11519 /* Read width, height, maximum color-component. Characters
11520 starting with `#' up to the end of a line are ignored. */
11521 width
= pbm_scan_number (&p
, end
);
11522 height
= pbm_scan_number (&p
, end
);
11524 if (type
!= PBM_MONO
)
11526 max_color_idx
= pbm_scan_number (&p
, end
);
11527 if (raw_p
&& max_color_idx
> 255)
11528 max_color_idx
= 255;
11533 || (type
!= PBM_MONO
&& max_color_idx
< 0))
11536 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11539 #if 0 /* TODO: color tables. */
11540 /* Initialize the color hash table. */
11541 init_color_table ();
11544 if (type
== PBM_MONO
)
11547 struct image_keyword fmt
[PBM_LAST
];
11548 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
11549 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
11551 /* Parse the image specification. */
11552 bcopy (pbm_format
, fmt
, sizeof fmt
);
11553 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
11555 /* Get foreground and background colors, maybe allocate colors. */
11556 if (fmt
[PBM_FOREGROUND
].count
11557 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
11558 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
11559 if (fmt
[PBM_BACKGROUND
].count
11560 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
11562 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
11563 img
->background
= bg
;
11564 img
->background_valid
= 1;
11567 for (y
= 0; y
< height
; ++y
)
11568 for (x
= 0; x
< width
; ++x
)
11578 g
= pbm_scan_number (&p
, end
);
11580 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
11585 for (y
= 0; y
< height
; ++y
)
11586 for (x
= 0; x
< width
; ++x
)
11590 if (type
== PBM_GRAY
)
11591 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
11600 r
= pbm_scan_number (&p
, end
);
11601 g
= pbm_scan_number (&p
, end
);
11602 b
= pbm_scan_number (&p
, end
);
11605 if (r
< 0 || g
< 0 || b
< 0)
11607 x_destroy_x_image (ximg
);
11608 image_error ("Invalid pixel value in image `%s'",
11613 /* RGB values are now in the range 0..max_color_idx.
11614 Scale this to the range 0..0xff supported by W32. */
11615 r
= (int) ((double) r
* 255 / max_color_idx
);
11616 g
= (int) ((double) g
* 255 / max_color_idx
);
11617 b
= (int) ((double) b
* 255 / max_color_idx
);
11618 XPutPixel (ximg
, x
, y
,
11619 #if 0 /* TODO: color tables. */
11620 lookup_rgb_color (f
, r
, g
, b
));
11622 PALETTERGB (r
, g
, b
));
11627 #if 0 /* TODO: color tables. */
11628 /* Store in IMG->colors the colors allocated for the image, and
11629 free the color table. */
11630 img
->colors
= colors_in_color_table (&img
->ncolors
);
11631 free_color_table ();
11633 /* Maybe fill in the background field while we have ximg handy. */
11634 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11635 IMAGE_BACKGROUND (img
, f
, ximg
);
11637 /* Put the image into a pixmap. */
11638 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11639 x_destroy_x_image (ximg
);
11641 img
->width
= width
;
11642 img
->height
= height
;
11650 /***********************************************************************
11652 ***********************************************************************/
11658 /* Function prototypes. */
11660 static int png_image_p
P_ ((Lisp_Object object
));
11661 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
11663 /* The symbol `png' identifying images of this type. */
11667 /* Indices of image specification fields in png_format, below. */
11669 enum png_keyword_index
11678 PNG_HEURISTIC_MASK
,
11684 /* Vector of image_keyword structures describing the format
11685 of valid user-defined image specifications. */
11687 static struct image_keyword png_format
[PNG_LAST
] =
11689 {":type", IMAGE_SYMBOL_VALUE
, 1},
11690 {":data", IMAGE_STRING_VALUE
, 0},
11691 {":file", IMAGE_STRING_VALUE
, 0},
11692 {":ascent", IMAGE_ASCENT_VALUE
, 0},
11693 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11694 {":relief", IMAGE_INTEGER_VALUE
, 0},
11695 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11696 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11697 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11698 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11701 /* Structure describing the image type `png'. */
11703 static struct image_type png_type
=
11712 /* PNG library details. */
11714 DEF_IMGLIB_FN (png_get_io_ptr
);
11715 DEF_IMGLIB_FN (png_check_sig
);
11716 DEF_IMGLIB_FN (png_create_read_struct
);
11717 DEF_IMGLIB_FN (png_create_info_struct
);
11718 DEF_IMGLIB_FN (png_destroy_read_struct
);
11719 DEF_IMGLIB_FN (png_set_read_fn
);
11720 DEF_IMGLIB_FN (png_init_io
);
11721 DEF_IMGLIB_FN (png_set_sig_bytes
);
11722 DEF_IMGLIB_FN (png_read_info
);
11723 DEF_IMGLIB_FN (png_get_IHDR
);
11724 DEF_IMGLIB_FN (png_get_valid
);
11725 DEF_IMGLIB_FN (png_set_strip_16
);
11726 DEF_IMGLIB_FN (png_set_expand
);
11727 DEF_IMGLIB_FN (png_set_gray_to_rgb
);
11728 DEF_IMGLIB_FN (png_set_background
);
11729 DEF_IMGLIB_FN (png_get_bKGD
);
11730 DEF_IMGLIB_FN (png_read_update_info
);
11731 DEF_IMGLIB_FN (png_get_channels
);
11732 DEF_IMGLIB_FN (png_get_rowbytes
);
11733 DEF_IMGLIB_FN (png_read_image
);
11734 DEF_IMGLIB_FN (png_read_end
);
11735 DEF_IMGLIB_FN (png_error
);
11738 init_png_functions (library
)
11741 LOAD_IMGLIB_FN (library
, png_get_io_ptr
);
11742 LOAD_IMGLIB_FN (library
, png_check_sig
);
11743 LOAD_IMGLIB_FN (library
, png_create_read_struct
);
11744 LOAD_IMGLIB_FN (library
, png_create_info_struct
);
11745 LOAD_IMGLIB_FN (library
, png_destroy_read_struct
);
11746 LOAD_IMGLIB_FN (library
, png_set_read_fn
);
11747 LOAD_IMGLIB_FN (library
, png_init_io
);
11748 LOAD_IMGLIB_FN (library
, png_set_sig_bytes
);
11749 LOAD_IMGLIB_FN (library
, png_read_info
);
11750 LOAD_IMGLIB_FN (library
, png_get_IHDR
);
11751 LOAD_IMGLIB_FN (library
, png_get_valid
);
11752 LOAD_IMGLIB_FN (library
, png_set_strip_16
);
11753 LOAD_IMGLIB_FN (library
, png_set_expand
);
11754 LOAD_IMGLIB_FN (library
, png_set_gray_to_rgb
);
11755 LOAD_IMGLIB_FN (library
, png_set_background
);
11756 LOAD_IMGLIB_FN (library
, png_get_bKGD
);
11757 LOAD_IMGLIB_FN (library
, png_read_update_info
);
11758 LOAD_IMGLIB_FN (library
, png_get_channels
);
11759 LOAD_IMGLIB_FN (library
, png_get_rowbytes
);
11760 LOAD_IMGLIB_FN (library
, png_read_image
);
11761 LOAD_IMGLIB_FN (library
, png_read_end
);
11762 LOAD_IMGLIB_FN (library
, png_error
);
11766 /* Return non-zero if OBJECT is a valid PNG image specification. */
11769 png_image_p (object
)
11770 Lisp_Object object
;
11772 struct image_keyword fmt
[PNG_LAST
];
11773 bcopy (png_format
, fmt
, sizeof fmt
);
11775 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
11778 /* Must specify either the :data or :file keyword. */
11779 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
11783 /* Error and warning handlers installed when the PNG library
11787 my_png_error (png_ptr
, msg
)
11788 png_struct
*png_ptr
;
11791 xassert (png_ptr
!= NULL
);
11792 image_error ("PNG error: %s", build_string (msg
), Qnil
);
11793 longjmp (png_ptr
->jmpbuf
, 1);
11798 my_png_warning (png_ptr
, msg
)
11799 png_struct
*png_ptr
;
11802 xassert (png_ptr
!= NULL
);
11803 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
11806 /* Memory source for PNG decoding. */
11808 struct png_memory_storage
11810 unsigned char *bytes
; /* The data */
11811 size_t len
; /* How big is it? */
11812 int index
; /* Where are we? */
11816 /* Function set as reader function when reading PNG image from memory.
11817 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
11818 bytes from the input to DATA. */
11821 png_read_from_memory (png_ptr
, data
, length
)
11822 png_structp png_ptr
;
11826 struct png_memory_storage
*tbr
11827 = (struct png_memory_storage
*) fn_png_get_io_ptr (png_ptr
);
11829 if (length
> tbr
->len
- tbr
->index
)
11830 fn_png_error (png_ptr
, "Read error");
11832 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
11833 tbr
->index
= tbr
->index
+ length
;
11836 /* Load PNG image IMG for use on frame F. Value is non-zero if
11844 Lisp_Object file
, specified_file
;
11845 Lisp_Object specified_data
;
11847 XImage
*ximg
, *mask_img
= NULL
;
11848 struct gcpro gcpro1
;
11849 png_struct
*png_ptr
= NULL
;
11850 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
11851 FILE *volatile fp
= NULL
;
11853 png_byte
* volatile pixels
= NULL
;
11854 png_byte
** volatile rows
= NULL
;
11855 png_uint_32 width
, height
;
11856 int bit_depth
, color_type
, interlace_type
;
11858 png_uint_32 row_bytes
;
11860 double screen_gamma
, image_gamma
;
11862 struct png_memory_storage tbr
; /* Data to be read */
11864 /* Find out what file to load. */
11865 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11866 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11870 if (NILP (specified_data
))
11872 file
= x_find_image_file (specified_file
);
11873 if (!STRINGP (file
))
11875 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11880 /* Open the image file. */
11881 fp
= fopen (SDATA (file
), "rb");
11884 image_error ("Cannot open image file `%s'", file
, Qnil
);
11890 /* Check PNG signature. */
11891 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
11892 || !fn_png_check_sig (sig
, sizeof sig
))
11894 image_error ("Not a PNG file: `%s'", file
, Qnil
);
11902 /* Read from memory. */
11903 tbr
.bytes
= SDATA (specified_data
);
11904 tbr
.len
= SBYTES (specified_data
);
11907 /* Check PNG signature. */
11908 if (tbr
.len
< sizeof sig
11909 || !fn_png_check_sig (tbr
.bytes
, sizeof sig
))
11911 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
11916 /* Need to skip past the signature. */
11917 tbr
.bytes
+= sizeof (sig
);
11920 /* Initialize read and info structs for PNG lib. */
11921 png_ptr
= fn_png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
11922 my_png_error
, my_png_warning
);
11925 if (fp
) fclose (fp
);
11930 info_ptr
= fn_png_create_info_struct (png_ptr
);
11933 fn_png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
11934 if (fp
) fclose (fp
);
11939 end_info
= fn_png_create_info_struct (png_ptr
);
11942 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
11943 if (fp
) fclose (fp
);
11948 /* Set error jump-back. We come back here when the PNG library
11949 detects an error. */
11950 if (setjmp (png_ptr
->jmpbuf
))
11954 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
11957 if (fp
) fclose (fp
);
11962 /* Read image info. */
11963 if (!NILP (specified_data
))
11964 fn_png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
11966 fn_png_init_io (png_ptr
, fp
);
11968 fn_png_set_sig_bytes (png_ptr
, sizeof sig
);
11969 fn_png_read_info (png_ptr
, info_ptr
);
11970 fn_png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
11971 &interlace_type
, NULL
, NULL
);
11973 /* If image contains simply transparency data, we prefer to
11974 construct a clipping mask. */
11975 if (fn_png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
11980 /* This function is easier to write if we only have to handle
11981 one data format: RGB or RGBA with 8 bits per channel. Let's
11982 transform other formats into that format. */
11984 /* Strip more than 8 bits per channel. */
11985 if (bit_depth
== 16)
11986 fn_png_set_strip_16 (png_ptr
);
11988 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
11990 fn_png_set_expand (png_ptr
);
11992 /* Convert grayscale images to RGB. */
11993 if (color_type
== PNG_COLOR_TYPE_GRAY
11994 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
11995 fn_png_set_gray_to_rgb (png_ptr
);
11997 screen_gamma
= (f
->gamma
? 1 / f
->gamma
/ 0.45455 : 2.2);
11999 #if 0 /* Avoid double gamma correction for PNG images. */
12000 /* Tell the PNG lib to handle gamma correction for us. */
12001 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
12002 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
12003 /* The libpng documentation says this is right in this case. */
12004 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
12007 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
12008 /* Image contains gamma information. */
12009 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
12011 /* Use the standard default for the image gamma. */
12012 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
12015 /* Handle alpha channel by combining the image with a background
12016 color. Do this only if a real alpha channel is supplied. For
12017 simple transparency, we prefer a clipping mask. */
12018 if (!transparent_p
)
12020 png_color_16
*image_bg
;
12021 Lisp_Object specified_bg
12022 = image_spec_value (img
->spec
, QCbackground
, NULL
);
12024 if (STRINGP (specified_bg
))
12025 /* The user specified `:background', use that. */
12028 if (w32_defined_color (f
, SDATA (specified_bg
), &color
, 0))
12030 png_color_16 user_bg
;
12032 bzero (&user_bg
, sizeof user_bg
);
12033 user_bg
.red
= 256 * GetRValue (color
);
12034 user_bg
.green
= 256 * GetGValue (color
);
12035 user_bg
.blue
= 256 * GetBValue (color
);
12037 fn_png_set_background (png_ptr
, &user_bg
,
12038 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
12041 else if (fn_png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
12042 /* Image contains a background color with which to
12043 combine the image. */
12044 fn_png_set_background (png_ptr
, image_bg
,
12045 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
12048 /* Image does not contain a background color with which
12049 to combine the image data via an alpha channel. Use
12050 the frame's background instead. */
12052 png_color_16 frame_background
;
12053 color
= FRAME_BACKGROUND_PIXEL (f
);
12054 #if 0 /* TODO : Colormap support. */
12057 cmap
= FRAME_X_COLORMAP (f
);
12058 x_query_color (f
, &color
);
12061 bzero (&frame_background
, sizeof frame_background
);
12062 frame_background
.red
= 256 * GetRValue (color
);
12063 frame_background
.green
= 256 * GetGValue (color
);
12064 frame_background
.blue
= 256 * GetBValue (color
);
12066 fn_png_set_background (png_ptr
, &frame_background
,
12067 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
12071 /* Update info structure. */
12072 fn_png_read_update_info (png_ptr
, info_ptr
);
12074 /* Get number of channels. Valid values are 1 for grayscale images
12075 and images with a palette, 2 for grayscale images with transparency
12076 information (alpha channel), 3 for RGB images, and 4 for RGB
12077 images with alpha channel, i.e. RGBA. If conversions above were
12078 sufficient we should only have 3 or 4 channels here. */
12079 channels
= fn_png_get_channels (png_ptr
, info_ptr
);
12080 xassert (channels
== 3 || channels
== 4);
12082 /* Number of bytes needed for one row of the image. */
12083 row_bytes
= fn_png_get_rowbytes (png_ptr
, info_ptr
);
12085 /* Allocate memory for the image. */
12086 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
12087 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
12088 for (i
= 0; i
< height
; ++i
)
12089 rows
[i
] = pixels
+ i
* row_bytes
;
12091 /* Read the entire image. */
12092 fn_png_read_image (png_ptr
, rows
);
12093 fn_png_read_end (png_ptr
, info_ptr
);
12100 /* Create the X image and pixmap. */
12101 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
12105 /* Create an image and pixmap serving as mask if the PNG image
12106 contains an alpha channel. */
12109 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
12110 &mask_img
, &img
->mask
))
12112 x_destroy_x_image (ximg
);
12113 DeleteObject (img
->pixmap
);
12117 /* Fill the X image and mask from PNG data. */
12118 #if 0 /* TODO: Color tables. */
12119 init_color_table ();
12122 for (y
= 0; y
< height
; ++y
)
12124 png_byte
*p
= rows
[y
];
12126 for (x
= 0; x
< width
; ++x
)
12133 #if 0 /* TODO: Color tables. */
12134 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
12136 XPutPixel (ximg
, x
, y
, PALETTERGB (r
, g
, b
));
12138 /* An alpha channel, aka mask channel, associates variable
12139 transparency with an image. Where other image formats
12140 support binary transparency---fully transparent or fully
12141 opaque---PNG allows up to 254 levels of partial transparency.
12142 The PNG library implements partial transparency by combining
12143 the image with a specified background color.
12145 I'm not sure how to handle this here nicely: because the
12146 background on which the image is displayed may change, for
12147 real alpha channel support, it would be necessary to create
12148 a new image for each possible background.
12150 What I'm doing now is that a mask is created if we have
12151 boolean transparency information. Otherwise I'm using
12152 the frame's background color to combine the image with. */
12157 XPutPixel (mask_img
, x
, y
, *p
> 0);
12163 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12164 /* Set IMG's background color from the PNG image, unless the user
12168 if (fn_png_get_bKGD (png_ptr
, info_ptr
, &bg
))
12170 #if 0 /* TODO: Color tables. */
12171 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
12173 img
->background
= PALETTERGB (bg
->red
/ 256, bg
->green
/ 256,
12176 img
->background_valid
= 1;
12180 #if 0 /* TODO: Color tables. */
12181 /* Remember colors allocated for this image. */
12182 img
->colors
= colors_in_color_table (&img
->ncolors
);
12183 free_color_table ();
12187 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
12191 img
->width
= width
;
12192 img
->height
= height
;
12194 /* Maybe fill in the background field while we have ximg handy. */
12195 IMAGE_BACKGROUND (img
, f
, ximg
);
12197 /* Put the image into the pixmap, then free the X image and its buffer. */
12198 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12199 x_destroy_x_image (ximg
);
12201 /* Same for the mask. */
12204 /* Fill in the background_transparent field while we have the mask
12206 image_background_transparent (img
, f
, mask_img
);
12208 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
12209 x_destroy_x_image (mask_img
);
12216 #endif /* HAVE_PNG != 0 */
12220 /***********************************************************************
12222 ***********************************************************************/
12226 /* Work around a warning about HAVE_STDLIB_H being redefined in
12228 #ifdef HAVE_STDLIB_H
12229 #define HAVE_STDLIB_H_1
12230 #undef HAVE_STDLIB_H
12231 #endif /* HAVE_STLIB_H */
12233 #include <jpeglib.h>
12234 #include <jerror.h>
12235 #include <setjmp.h>
12237 #ifdef HAVE_STLIB_H_1
12238 #define HAVE_STDLIB_H 1
12241 static int jpeg_image_p
P_ ((Lisp_Object object
));
12242 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
12244 /* The symbol `jpeg' identifying images of this type. */
12248 /* Indices of image specification fields in gs_format, below. */
12250 enum jpeg_keyword_index
12259 JPEG_HEURISTIC_MASK
,
12265 /* Vector of image_keyword structures describing the format
12266 of valid user-defined image specifications. */
12268 static struct image_keyword jpeg_format
[JPEG_LAST
] =
12270 {":type", IMAGE_SYMBOL_VALUE
, 1},
12271 {":data", IMAGE_STRING_VALUE
, 0},
12272 {":file", IMAGE_STRING_VALUE
, 0},
12273 {":ascent", IMAGE_ASCENT_VALUE
, 0},
12274 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12275 {":relief", IMAGE_INTEGER_VALUE
, 0},
12276 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12277 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12278 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12279 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12282 /* Structure describing the image type `jpeg'. */
12284 static struct image_type jpeg_type
=
12294 /* JPEG library details. */
12295 DEF_IMGLIB_FN (jpeg_CreateDecompress
);
12296 DEF_IMGLIB_FN (jpeg_start_decompress
);
12297 DEF_IMGLIB_FN (jpeg_finish_decompress
);
12298 DEF_IMGLIB_FN (jpeg_destroy_decompress
);
12299 DEF_IMGLIB_FN (jpeg_read_header
);
12300 DEF_IMGLIB_FN (jpeg_read_scanlines
);
12301 DEF_IMGLIB_FN (jpeg_stdio_src
);
12302 DEF_IMGLIB_FN (jpeg_std_error
);
12303 DEF_IMGLIB_FN (jpeg_resync_to_restart
);
12306 init_jpeg_functions (library
)
12309 LOAD_IMGLIB_FN (library
, jpeg_finish_decompress
);
12310 LOAD_IMGLIB_FN (library
, jpeg_read_scanlines
);
12311 LOAD_IMGLIB_FN (library
, jpeg_start_decompress
);
12312 LOAD_IMGLIB_FN (library
, jpeg_read_header
);
12313 LOAD_IMGLIB_FN (library
, jpeg_stdio_src
);
12314 LOAD_IMGLIB_FN (library
, jpeg_CreateDecompress
);
12315 LOAD_IMGLIB_FN (library
, jpeg_destroy_decompress
);
12316 LOAD_IMGLIB_FN (library
, jpeg_std_error
);
12317 LOAD_IMGLIB_FN (library
, jpeg_resync_to_restart
);
12321 /* Wrapper since we can't directly assign the function pointer
12322 to another function pointer that was declared more completely easily. */
12324 jpeg_resync_to_restart_wrapper(cinfo
, desired
)
12325 j_decompress_ptr cinfo
;
12328 return fn_jpeg_resync_to_restart (cinfo
, desired
);
12332 /* Return non-zero if OBJECT is a valid JPEG image specification. */
12335 jpeg_image_p (object
)
12336 Lisp_Object object
;
12338 struct image_keyword fmt
[JPEG_LAST
];
12340 bcopy (jpeg_format
, fmt
, sizeof fmt
);
12342 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
12345 /* Must specify either the :data or :file keyword. */
12346 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
12350 struct my_jpeg_error_mgr
12352 struct jpeg_error_mgr pub
;
12353 jmp_buf setjmp_buffer
;
12358 my_error_exit (cinfo
)
12359 j_common_ptr cinfo
;
12361 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
12362 longjmp (mgr
->setjmp_buffer
, 1);
12366 /* Init source method for JPEG data source manager. Called by
12367 jpeg_read_header() before any data is actually read. See
12368 libjpeg.doc from the JPEG lib distribution. */
12371 our_init_source (cinfo
)
12372 j_decompress_ptr cinfo
;
12377 /* Fill input buffer method for JPEG data source manager. Called
12378 whenever more data is needed. We read the whole image in one step,
12379 so this only adds a fake end of input marker at the end. */
12382 our_fill_input_buffer (cinfo
)
12383 j_decompress_ptr cinfo
;
12385 /* Insert a fake EOI marker. */
12386 struct jpeg_source_mgr
*src
= cinfo
->src
;
12387 static JOCTET buffer
[2];
12389 buffer
[0] = (JOCTET
) 0xFF;
12390 buffer
[1] = (JOCTET
) JPEG_EOI
;
12392 src
->next_input_byte
= buffer
;
12393 src
->bytes_in_buffer
= 2;
12398 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
12399 is the JPEG data source manager. */
12402 our_skip_input_data (cinfo
, num_bytes
)
12403 j_decompress_ptr cinfo
;
12406 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
12410 if (num_bytes
> src
->bytes_in_buffer
)
12411 ERREXIT (cinfo
, JERR_INPUT_EOF
);
12413 src
->bytes_in_buffer
-= num_bytes
;
12414 src
->next_input_byte
+= num_bytes
;
12419 /* Method to terminate data source. Called by
12420 jpeg_finish_decompress() after all data has been processed. */
12423 our_term_source (cinfo
)
12424 j_decompress_ptr cinfo
;
12429 /* Set up the JPEG lib for reading an image from DATA which contains
12430 LEN bytes. CINFO is the decompression info structure created for
12431 reading the image. */
12434 jpeg_memory_src (cinfo
, data
, len
)
12435 j_decompress_ptr cinfo
;
12439 struct jpeg_source_mgr
*src
;
12441 if (cinfo
->src
== NULL
)
12443 /* First time for this JPEG object? */
12444 cinfo
->src
= (struct jpeg_source_mgr
*)
12445 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
12446 sizeof (struct jpeg_source_mgr
));
12447 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
12448 src
->next_input_byte
= data
;
12451 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
12452 src
->init_source
= our_init_source
;
12453 src
->fill_input_buffer
= our_fill_input_buffer
;
12454 src
->skip_input_data
= our_skip_input_data
;
12455 src
->resync_to_restart
= jpeg_resync_to_restart_wrapper
; /* Use default method. */
12456 src
->term_source
= our_term_source
;
12457 src
->bytes_in_buffer
= len
;
12458 src
->next_input_byte
= data
;
12462 /* Load image IMG for use on frame F. Patterned after example.c
12463 from the JPEG lib. */
12470 struct jpeg_decompress_struct cinfo
;
12471 struct my_jpeg_error_mgr mgr
;
12472 Lisp_Object file
, specified_file
;
12473 Lisp_Object specified_data
;
12474 FILE * volatile fp
= NULL
;
12476 int row_stride
, x
, y
;
12477 XImage
*ximg
= NULL
;
12479 unsigned long *colors
;
12481 struct gcpro gcpro1
;
12483 /* Open the JPEG file. */
12484 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12485 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12489 if (NILP (specified_data
))
12491 file
= x_find_image_file (specified_file
);
12492 if (!STRINGP (file
))
12494 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
12499 fp
= fopen (SDATA (file
), "r");
12502 image_error ("Cannot open `%s'", file
, Qnil
);
12508 /* Customize libjpeg's error handling to call my_error_exit when an
12509 error is detected. This function will perform a longjmp. */
12510 cinfo
.err
= fn_jpeg_std_error (&mgr
.pub
);
12511 mgr
.pub
.error_exit
= my_error_exit
;
12513 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
12517 /* Called from my_error_exit. Display a JPEG error. */
12518 char buffer
[JMSG_LENGTH_MAX
];
12519 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
12520 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
12521 build_string (buffer
));
12524 /* Close the input file and destroy the JPEG object. */
12526 fclose ((FILE *) fp
);
12527 fn_jpeg_destroy_decompress (&cinfo
);
12529 /* If we already have an XImage, free that. */
12530 x_destroy_x_image (ximg
);
12532 /* Free pixmap and colors. */
12533 x_clear_image (f
, img
);
12539 /* Create the JPEG decompression object. Let it read from fp.
12540 Read the JPEG image header. */
12541 fn_jpeg_CreateDecompress (&cinfo
, JPEG_LIB_VERSION
, sizeof (cinfo
));
12543 if (NILP (specified_data
))
12544 fn_jpeg_stdio_src (&cinfo
, (FILE *) fp
);
12546 jpeg_memory_src (&cinfo
, SDATA (specified_data
),
12547 SBYTES (specified_data
));
12549 fn_jpeg_read_header (&cinfo
, TRUE
);
12551 /* Customize decompression so that color quantization will be used.
12552 Start decompression. */
12553 cinfo
.quantize_colors
= TRUE
;
12554 fn_jpeg_start_decompress (&cinfo
);
12555 width
= img
->width
= cinfo
.output_width
;
12556 height
= img
->height
= cinfo
.output_height
;
12558 /* Create X image and pixmap. */
12559 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12560 longjmp (mgr
.setjmp_buffer
, 2);
12562 /* Allocate colors. When color quantization is used,
12563 cinfo.actual_number_of_colors has been set with the number of
12564 colors generated, and cinfo.colormap is a two-dimensional array
12565 of color indices in the range 0..cinfo.actual_number_of_colors.
12566 No more than 255 colors will be generated. */
12570 if (cinfo
.out_color_components
> 2)
12571 ir
= 0, ig
= 1, ib
= 2;
12572 else if (cinfo
.out_color_components
> 1)
12573 ir
= 0, ig
= 1, ib
= 0;
12575 ir
= 0, ig
= 0, ib
= 0;
12577 #if 0 /* TODO: Color tables. */
12578 /* Use the color table mechanism because it handles colors that
12579 cannot be allocated nicely. Such colors will be replaced with
12580 a default color, and we don't have to care about which colors
12581 can be freed safely, and which can't. */
12582 init_color_table ();
12584 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
12587 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
12589 int r
= cinfo
.colormap
[ir
][i
];
12590 int g
= cinfo
.colormap
[ig
][i
];
12591 int b
= cinfo
.colormap
[ib
][i
];
12592 #if 0 /* TODO: Color tables. */
12593 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
12595 colors
[i
] = PALETTERGB (r
, g
, b
);
12599 #if 0 /* TODO: Color tables. */
12600 /* Remember those colors actually allocated. */
12601 img
->colors
= colors_in_color_table (&img
->ncolors
);
12602 free_color_table ();
12607 row_stride
= width
* cinfo
.output_components
;
12608 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
12610 for (y
= 0; y
< height
; ++y
)
12612 fn_jpeg_read_scanlines (&cinfo
, buffer
, 1);
12613 for (x
= 0; x
< cinfo
.output_width
; ++x
)
12614 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
12618 fn_jpeg_finish_decompress (&cinfo
);
12619 fn_jpeg_destroy_decompress (&cinfo
);
12621 fclose ((FILE *) fp
);
12623 /* Maybe fill in the background field while we have ximg handy. */
12624 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12625 IMAGE_BACKGROUND (img
, f
, ximg
);
12627 /* Put the image into the pixmap. */
12628 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12629 x_destroy_x_image (ximg
);
12634 #endif /* HAVE_JPEG */
12638 /***********************************************************************
12640 ***********************************************************************/
12644 #include <tiffio.h>
12646 static int tiff_image_p
P_ ((Lisp_Object object
));
12647 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
12649 /* The symbol `tiff' identifying images of this type. */
12653 /* Indices of image specification fields in tiff_format, below. */
12655 enum tiff_keyword_index
12664 TIFF_HEURISTIC_MASK
,
12670 /* Vector of image_keyword structures describing the format
12671 of valid user-defined image specifications. */
12673 static struct image_keyword tiff_format
[TIFF_LAST
] =
12675 {":type", IMAGE_SYMBOL_VALUE
, 1},
12676 {":data", IMAGE_STRING_VALUE
, 0},
12677 {":file", IMAGE_STRING_VALUE
, 0},
12678 {":ascent", IMAGE_ASCENT_VALUE
, 0},
12679 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12680 {":relief", IMAGE_INTEGER_VALUE
, 0},
12681 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12682 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12683 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12684 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12687 /* Structure describing the image type `tiff'. */
12689 static struct image_type tiff_type
=
12698 /* TIFF library details. */
12699 DEF_IMGLIB_FN (TIFFSetErrorHandler
);
12700 DEF_IMGLIB_FN (TIFFSetWarningHandler
);
12701 DEF_IMGLIB_FN (TIFFOpen
);
12702 DEF_IMGLIB_FN (TIFFClientOpen
);
12703 DEF_IMGLIB_FN (TIFFGetField
);
12704 DEF_IMGLIB_FN (TIFFReadRGBAImage
);
12705 DEF_IMGLIB_FN (TIFFClose
);
12708 init_tiff_functions (library
)
12711 LOAD_IMGLIB_FN (library
, TIFFSetErrorHandler
);
12712 LOAD_IMGLIB_FN (library
, TIFFSetWarningHandler
);
12713 LOAD_IMGLIB_FN (library
, TIFFOpen
);
12714 LOAD_IMGLIB_FN (library
, TIFFClientOpen
);
12715 LOAD_IMGLIB_FN (library
, TIFFGetField
);
12716 LOAD_IMGLIB_FN (library
, TIFFReadRGBAImage
);
12717 LOAD_IMGLIB_FN (library
, TIFFClose
);
12721 /* Return non-zero if OBJECT is a valid TIFF image specification. */
12724 tiff_image_p (object
)
12725 Lisp_Object object
;
12727 struct image_keyword fmt
[TIFF_LAST
];
12728 bcopy (tiff_format
, fmt
, sizeof fmt
);
12730 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
12733 /* Must specify either the :data or :file keyword. */
12734 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
12738 /* Reading from a memory buffer for TIFF images Based on the PNG
12739 memory source, but we have to provide a lot of extra functions.
12742 We really only need to implement read and seek, but I am not
12743 convinced that the TIFF library is smart enough not to destroy
12744 itself if we only hand it the function pointers we need to
12749 unsigned char *bytes
;
12753 tiff_memory_source
;
12756 tiff_read_from_memory (data
, buf
, size
)
12761 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
12763 if (size
> src
->len
- src
->index
)
12764 return (size_t) -1;
12765 bcopy (src
->bytes
+ src
->index
, buf
, size
);
12766 src
->index
+= size
;
12771 tiff_write_from_memory (data
, buf
, size
)
12776 return (size_t) -1;
12780 tiff_seek_in_memory (data
, off
, whence
)
12785 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
12790 case SEEK_SET
: /* Go from beginning of source. */
12794 case SEEK_END
: /* Go from end of source. */
12795 idx
= src
->len
+ off
;
12798 case SEEK_CUR
: /* Go from current position. */
12799 idx
= src
->index
+ off
;
12802 default: /* Invalid `whence'. */
12806 if (idx
> src
->len
|| idx
< 0)
12814 tiff_close_memory (data
)
12822 tiff_mmap_memory (data
, pbase
, psize
)
12827 /* It is already _IN_ memory. */
12832 tiff_unmap_memory (data
, base
, size
)
12837 /* We don't need to do this. */
12841 tiff_size_of_memory (data
)
12844 return ((tiff_memory_source
*) data
)->len
;
12849 tiff_error_handler (title
, format
, ap
)
12850 const char *title
, *format
;
12856 len
= sprintf (buf
, "TIFF error: %s ", title
);
12857 vsprintf (buf
+ len
, format
, ap
);
12858 add_to_log (buf
, Qnil
, Qnil
);
12863 tiff_warning_handler (title
, format
, ap
)
12864 const char *title
, *format
;
12870 len
= sprintf (buf
, "TIFF warning: %s ", title
);
12871 vsprintf (buf
+ len
, format
, ap
);
12872 add_to_log (buf
, Qnil
, Qnil
);
12876 /* Load TIFF image IMG for use on frame F. Value is non-zero if
12884 Lisp_Object file
, specified_file
;
12885 Lisp_Object specified_data
;
12887 int width
, height
, x
, y
;
12891 struct gcpro gcpro1
;
12892 tiff_memory_source memsrc
;
12894 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12895 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12899 fn_TIFFSetErrorHandler (tiff_error_handler
);
12900 fn_TIFFSetWarningHandler (tiff_warning_handler
);
12902 if (NILP (specified_data
))
12904 /* Read from a file */
12905 file
= x_find_image_file (specified_file
);
12906 if (!STRINGP (file
))
12908 image_error ("Cannot find image file `%s'", file
, Qnil
);
12913 /* Try to open the image file. */
12914 tiff
= fn_TIFFOpen (SDATA (file
), "r");
12917 image_error ("Cannot open `%s'", file
, Qnil
);
12924 /* Memory source! */
12925 memsrc
.bytes
= SDATA (specified_data
);
12926 memsrc
.len
= SBYTES (specified_data
);
12929 tiff
= fn_TIFFClientOpen ("memory_source", "r", &memsrc
,
12930 (TIFFReadWriteProc
) tiff_read_from_memory
,
12931 (TIFFReadWriteProc
) tiff_write_from_memory
,
12932 tiff_seek_in_memory
,
12934 tiff_size_of_memory
,
12936 tiff_unmap_memory
);
12940 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
12946 /* Get width and height of the image, and allocate a raster buffer
12947 of width x height 32-bit values. */
12948 fn_TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
12949 fn_TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
12950 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
12952 rc
= fn_TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
12953 fn_TIFFClose (tiff
);
12956 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
12962 /* Create the X image and pixmap. */
12963 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12970 #if 0 /* TODO: Color tables. */
12971 /* Initialize the color table. */
12972 init_color_table ();
12975 /* Process the pixel raster. Origin is in the lower-left corner. */
12976 for (y
= 0; y
< height
; ++y
)
12978 uint32
*row
= buf
+ y
* width
;
12980 for (x
= 0; x
< width
; ++x
)
12982 uint32 abgr
= row
[x
];
12983 int r
= TIFFGetR (abgr
);
12984 int g
= TIFFGetG (abgr
);
12985 int b
= TIFFGetB (abgr
);
12986 #if 0 /* TODO: Color tables. */
12987 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
12989 XPutPixel (ximg
, x
, height
- 1 - y
, PALETTERGB (r
, g
, b
));
12994 #if 0 /* TODO: Color tables. */
12995 /* Remember the colors allocated for the image. Free the color table. */
12996 img
->colors
= colors_in_color_table (&img
->ncolors
);
12997 free_color_table ();
13000 img
->width
= width
;
13001 img
->height
= height
;
13003 /* Maybe fill in the background field while we have ximg handy. */
13004 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
13005 IMAGE_BACKGROUND (img
, f
, ximg
);
13007 /* Put the image into the pixmap, then free the X image and its buffer. */
13008 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
13009 x_destroy_x_image (ximg
);
13016 #endif /* HAVE_TIFF != 0 */
13020 /***********************************************************************
13022 ***********************************************************************/
13026 #define DrawText gif_DrawText
13027 #include <gif_lib.h>
13030 static int gif_image_p
P_ ((Lisp_Object object
));
13031 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
13033 /* The symbol `gif' identifying images of this type. */
13037 /* Indices of image specification fields in gif_format, below. */
13039 enum gif_keyword_index
13048 GIF_HEURISTIC_MASK
,
13055 /* Vector of image_keyword structures describing the format
13056 of valid user-defined image specifications. */
13058 static struct image_keyword gif_format
[GIF_LAST
] =
13060 {":type", IMAGE_SYMBOL_VALUE
, 1},
13061 {":data", IMAGE_STRING_VALUE
, 0},
13062 {":file", IMAGE_STRING_VALUE
, 0},
13063 {":ascent", IMAGE_ASCENT_VALUE
, 0},
13064 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
13065 {":relief", IMAGE_INTEGER_VALUE
, 0},
13066 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13067 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13068 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13069 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
13070 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
13073 /* Structure describing the image type `gif'. */
13075 static struct image_type gif_type
=
13085 /* GIF library details. */
13086 DEF_IMGLIB_FN (DGifCloseFile
);
13087 DEF_IMGLIB_FN (DGifSlurp
);
13088 DEF_IMGLIB_FN (DGifOpen
);
13089 DEF_IMGLIB_FN (DGifOpenFileName
);
13092 init_gif_functions (library
)
13095 LOAD_IMGLIB_FN (library
, DGifCloseFile
);
13096 LOAD_IMGLIB_FN (library
, DGifSlurp
);
13097 LOAD_IMGLIB_FN (library
, DGifOpen
);
13098 LOAD_IMGLIB_FN (library
, DGifOpenFileName
);
13103 /* Return non-zero if OBJECT is a valid GIF image specification. */
13106 gif_image_p (object
)
13107 Lisp_Object object
;
13109 struct image_keyword fmt
[GIF_LAST
];
13110 bcopy (gif_format
, fmt
, sizeof fmt
);
13112 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
13115 /* Must specify either the :data or :file keyword. */
13116 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
13119 /* Reading a GIF image from memory
13120 Based on the PNG memory stuff to a certain extent. */
13124 unsigned char *bytes
;
13130 /* Make the current memory source available to gif_read_from_memory.
13131 It's done this way because not all versions of libungif support
13132 a UserData field in the GifFileType structure. */
13133 static gif_memory_source
*current_gif_memory_src
;
13136 gif_read_from_memory (file
, buf
, len
)
13141 gif_memory_source
*src
= current_gif_memory_src
;
13143 if (len
> src
->len
- src
->index
)
13146 bcopy (src
->bytes
+ src
->index
, buf
, len
);
13152 /* Load GIF image IMG for use on frame F. Value is non-zero if
13160 Lisp_Object file
, specified_file
;
13161 Lisp_Object specified_data
;
13162 int rc
, width
, height
, x
, y
, i
;
13164 ColorMapObject
*gif_color_map
;
13165 unsigned long pixel_colors
[256];
13167 struct gcpro gcpro1
;
13169 int ino
, image_left
, image_top
, image_width
, image_height
;
13170 gif_memory_source memsrc
;
13171 unsigned char *raster
;
13173 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
13174 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
13178 if (NILP (specified_data
))
13180 file
= x_find_image_file (specified_file
);
13181 if (!STRINGP (file
))
13183 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
13188 /* Open the GIF file. */
13189 gif
= fn_DGifOpenFileName (SDATA (file
));
13192 image_error ("Cannot open `%s'", file
, Qnil
);
13199 /* Read from memory! */
13200 current_gif_memory_src
= &memsrc
;
13201 memsrc
.bytes
= SDATA (specified_data
);
13202 memsrc
.len
= SBYTES (specified_data
);
13205 gif
= fn_DGifOpen(&memsrc
, gif_read_from_memory
);
13208 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
13214 /* Read entire contents. */
13215 rc
= fn_DGifSlurp (gif
);
13216 if (rc
== GIF_ERROR
)
13218 image_error ("Error reading `%s'", img
->spec
, Qnil
);
13219 fn_DGifCloseFile (gif
);
13224 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
13225 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
13226 if (ino
>= gif
->ImageCount
)
13228 image_error ("Invalid image number `%s' in image `%s'",
13230 fn_DGifCloseFile (gif
);
13235 width
= img
->width
= max (gif
->SWidth
, gif
->Image
.Left
+ gif
->Image
.Width
);
13236 height
= img
->height
= max (gif
->SHeight
, gif
->Image
.Top
+ gif
->Image
.Height
);
13238 /* Create the X image and pixmap. */
13239 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
13241 fn_DGifCloseFile (gif
);
13246 /* Allocate colors. */
13247 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
13248 if (!gif_color_map
)
13249 gif_color_map
= gif
->SColorMap
;
13250 #if 0 /* TODO: Color tables */
13251 init_color_table ();
13253 bzero (pixel_colors
, sizeof pixel_colors
);
13255 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
13257 int r
= gif_color_map
->Colors
[i
].Red
;
13258 int g
= gif_color_map
->Colors
[i
].Green
;
13259 int b
= gif_color_map
->Colors
[i
].Blue
;
13260 #if 0 /* TODO: Color tables */
13261 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
13263 pixel_colors
[i
] = PALETTERGB (r
, g
, b
);
13267 #if 0 /* TODO: Color tables */
13268 img
->colors
= colors_in_color_table (&img
->ncolors
);
13269 free_color_table ();
13272 /* Clear the part of the screen image that are not covered by
13273 the image from the GIF file. Full animated GIF support
13274 requires more than can be done here (see the gif89 spec,
13275 disposal methods). Let's simply assume that the part
13276 not covered by a sub-image is in the frame's background color. */
13277 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
13278 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
13279 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
13280 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
13282 for (y
= 0; y
< image_top
; ++y
)
13283 for (x
= 0; x
< width
; ++x
)
13284 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
13286 for (y
= image_top
+ image_height
; y
< height
; ++y
)
13287 for (x
= 0; x
< width
; ++x
)
13288 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
13290 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
13292 for (x
= 0; x
< image_left
; ++x
)
13293 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
13294 for (x
= image_left
+ image_width
; x
< width
; ++x
)
13295 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
13298 /* Read the GIF image into the X image. We use a local variable
13299 `raster' here because RasterBits below is a char *, and invites
13300 problems with bytes >= 0x80. */
13301 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
13303 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
13305 static int interlace_start
[] = {0, 4, 2, 1};
13306 static int interlace_increment
[] = {8, 8, 4, 2};
13308 int row
= interlace_start
[0];
13312 for (y
= 0; y
< image_height
; y
++)
13314 if (row
>= image_height
)
13316 row
= interlace_start
[++pass
];
13317 while (row
>= image_height
)
13318 row
= interlace_start
[++pass
];
13321 for (x
= 0; x
< image_width
; x
++)
13323 int i
= raster
[(y
* image_width
) + x
];
13324 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
13328 row
+= interlace_increment
[pass
];
13333 for (y
= 0; y
< image_height
; ++y
)
13334 for (x
= 0; x
< image_width
; ++x
)
13336 int i
= raster
[y
* image_width
+ x
];
13337 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
13341 fn_DGifCloseFile (gif
);
13343 /* Maybe fill in the background field while we have ximg handy. */
13344 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
13345 IMAGE_BACKGROUND (img
, f
, ximg
);
13347 /* Put the image into the pixmap, then free the X image and its buffer. */
13348 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
13349 x_destroy_x_image (ximg
);
13355 #endif /* HAVE_GIF != 0 */
13359 /***********************************************************************
13361 ***********************************************************************/
13363 Lisp_Object Qpostscript
;
13365 /* Keyword symbols. */
13367 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
13369 #ifdef HAVE_GHOSTSCRIPT
13370 static int gs_image_p
P_ ((Lisp_Object object
));
13371 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
13372 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
13374 /* The symbol `postscript' identifying images of this type. */
13376 /* Keyword symbols. */
13378 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
13380 /* Indices of image specification fields in gs_format, below. */
13382 enum gs_keyword_index
13400 /* Vector of image_keyword structures describing the format
13401 of valid user-defined image specifications. */
13403 static struct image_keyword gs_format
[GS_LAST
] =
13405 {":type", IMAGE_SYMBOL_VALUE
, 1},
13406 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
13407 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
13408 {":file", IMAGE_STRING_VALUE
, 1},
13409 {":loader", IMAGE_FUNCTION_VALUE
, 0},
13410 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
13411 {":ascent", IMAGE_ASCENT_VALUE
, 0},
13412 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
13413 {":relief", IMAGE_INTEGER_VALUE
, 0},
13414 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13415 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13416 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13417 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
13420 /* Structure describing the image type `ghostscript'. */
13422 static struct image_type gs_type
=
13432 /* Free X resources of Ghostscript image IMG which is used on frame F. */
13435 gs_clear_image (f
, img
)
13439 /* IMG->data.ptr_val may contain a recorded colormap. */
13440 xfree (img
->data
.ptr_val
);
13441 x_clear_image (f
, img
);
13445 /* Return non-zero if OBJECT is a valid Ghostscript image
13449 gs_image_p (object
)
13450 Lisp_Object object
;
13452 struct image_keyword fmt
[GS_LAST
];
13456 bcopy (gs_format
, fmt
, sizeof fmt
);
13458 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
13461 /* Bounding box must be a list or vector containing 4 integers. */
13462 tem
= fmt
[GS_BOUNDING_BOX
].value
;
13465 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
13466 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
13471 else if (VECTORP (tem
))
13473 if (XVECTOR (tem
)->size
!= 4)
13475 for (i
= 0; i
< 4; ++i
)
13476 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
13486 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
13495 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
13496 struct gcpro gcpro1
, gcpro2
;
13498 double in_width
, in_height
;
13499 Lisp_Object pixel_colors
= Qnil
;
13501 /* Compute pixel size of pixmap needed from the given size in the
13502 image specification. Sizes in the specification are in pt. 1 pt
13503 = 1/72 in, xdpi and ydpi are stored in the frame's X display
13505 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
13506 in_width
= XFASTINT (pt_width
) / 72.0;
13507 img
->width
= in_width
* FRAME_W32_DISPLAY_INFO (f
)->resx
;
13508 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
13509 in_height
= XFASTINT (pt_height
) / 72.0;
13510 img
->height
= in_height
* FRAME_W32_DISPLAY_INFO (f
)->resy
;
13512 /* Create the pixmap. */
13514 xassert (img
->pixmap
== 0);
13515 img
->pixmap
= XCreatePixmap (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13516 img
->width
, img
->height
,
13517 one_w32_display_info
.n_cbits
);
13522 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
13526 /* Call the loader to fill the pixmap. It returns a process object
13527 if successful. We do not record_unwind_protect here because
13528 other places in redisplay like calling window scroll functions
13529 don't either. Let the Lisp loader use `unwind-protect' instead. */
13530 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
13532 sprintf (buffer
, "%lu %lu",
13533 (unsigned long) FRAME_W32_WINDOW (f
),
13534 (unsigned long) img
->pixmap
);
13535 window_and_pixmap_id
= build_string (buffer
);
13537 sprintf (buffer
, "%lu %lu",
13538 FRAME_FOREGROUND_PIXEL (f
),
13539 FRAME_BACKGROUND_PIXEL (f
));
13540 pixel_colors
= build_string (buffer
);
13542 XSETFRAME (frame
, f
);
13543 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
13545 loader
= intern ("gs-load-image");
13547 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
13548 make_number (img
->width
),
13549 make_number (img
->height
),
13550 window_and_pixmap_id
,
13553 return PROCESSP (img
->data
.lisp_val
);
13557 /* Kill the Ghostscript process that was started to fill PIXMAP on
13558 frame F. Called from XTread_socket when receiving an event
13559 telling Emacs that Ghostscript has finished drawing. */
13562 x_kill_gs_process (pixmap
, f
)
13566 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
13570 /* Find the image containing PIXMAP. */
13571 for (i
= 0; i
< c
->used
; ++i
)
13572 if (c
->images
[i
]->pixmap
== pixmap
)
13575 /* Should someone in between have cleared the image cache, for
13576 instance, give up. */
13580 /* Kill the GS process. We should have found PIXMAP in the image
13581 cache and its image should contain a process object. */
13582 img
= c
->images
[i
];
13583 xassert (PROCESSP (img
->data
.lisp_val
));
13584 Fkill_process (img
->data
.lisp_val
, Qnil
);
13585 img
->data
.lisp_val
= Qnil
;
13587 /* On displays with a mutable colormap, figure out the colors
13588 allocated for the image by looking at the pixels of an XImage for
13590 class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
13591 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
13597 /* Try to get an XImage for img->pixmep. */
13598 ximg
= XGetImage (FRAME_W32_DISPLAY (f
), img
->pixmap
,
13599 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
13604 /* Initialize the color table. */
13605 init_color_table ();
13607 /* For each pixel of the image, look its color up in the
13608 color table. After having done so, the color table will
13609 contain an entry for each color used by the image. */
13610 for (y
= 0; y
< img
->height
; ++y
)
13611 for (x
= 0; x
< img
->width
; ++x
)
13613 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
13614 lookup_pixel_color (f
, pixel
);
13617 /* Record colors in the image. Free color table and XImage. */
13618 img
->colors
= colors_in_color_table (&img
->ncolors
);
13619 free_color_table ();
13620 XDestroyImage (ximg
);
13622 #if 0 /* This doesn't seem to be the case. If we free the colors
13623 here, we get a BadAccess later in x_clear_image when
13624 freeing the colors. */
13625 /* We have allocated colors once, but Ghostscript has also
13626 allocated colors on behalf of us. So, to get the
13627 reference counts right, free them once. */
13629 x_free_colors (FRAME_W32_DISPLAY (f
), cmap
,
13630 img
->colors
, img
->ncolors
, 0);
13634 image_error ("Cannot get X image of `%s'; colors will not be freed",
13640 /* Now that we have the pixmap, compute mask and transform the
13641 image if requested. */
13643 postprocess_image (f
, img
);
13647 #endif /* HAVE_GHOSTSCRIPT */
13650 /***********************************************************************
13652 ***********************************************************************/
13654 DEFUN ("x-change-window-property", Fx_change_window_property
,
13655 Sx_change_window_property
, 2, 3, 0,
13656 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
13657 PROP and VALUE must be strings. FRAME nil or omitted means use the
13658 selected frame. Value is VALUE. */)
13659 (prop
, value
, frame
)
13660 Lisp_Object frame
, prop
, value
;
13662 #if 0 /* TODO : port window properties to W32 */
13663 struct frame
*f
= check_x_frame (frame
);
13666 CHECK_STRING (prop
);
13667 CHECK_STRING (value
);
13670 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
13671 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13672 prop_atom
, XA_STRING
, 8, PropModeReplace
,
13673 SDATA (value
), SCHARS (value
));
13675 /* Make sure the property is set when we return. */
13676 XFlush (FRAME_W32_DISPLAY (f
));
13685 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
13686 Sx_delete_window_property
, 1, 2, 0,
13687 doc
: /* Remove window property PROP from X window of FRAME.
13688 FRAME nil or omitted means use the selected frame. Value is PROP. */)
13690 Lisp_Object prop
, frame
;
13692 #if 0 /* TODO : port window properties to W32 */
13694 struct frame
*f
= check_x_frame (frame
);
13697 CHECK_STRING (prop
);
13699 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
13700 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
13702 /* Make sure the property is removed when we return. */
13703 XFlush (FRAME_W32_DISPLAY (f
));
13711 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
13713 doc
: /* Value is the value of window property PROP on FRAME.
13714 If FRAME is nil or omitted, use the selected frame. Value is nil
13715 if FRAME hasn't a property with name PROP or if PROP has no string
13718 Lisp_Object prop
, frame
;
13720 #if 0 /* TODO : port window properties to W32 */
13722 struct frame
*f
= check_x_frame (frame
);
13725 Lisp_Object prop_value
= Qnil
;
13726 char *tmp_data
= NULL
;
13729 unsigned long actual_size
, bytes_remaining
;
13731 CHECK_STRING (prop
);
13733 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
13734 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13735 prop_atom
, 0, 0, False
, XA_STRING
,
13736 &actual_type
, &actual_format
, &actual_size
,
13737 &bytes_remaining
, (unsigned char **) &tmp_data
);
13740 int size
= bytes_remaining
;
13745 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13746 prop_atom
, 0, bytes_remaining
,
13748 &actual_type
, &actual_format
,
13749 &actual_size
, &bytes_remaining
,
13750 (unsigned char **) &tmp_data
);
13752 prop_value
= make_string (tmp_data
, size
);
13767 /***********************************************************************
13769 ***********************************************************************/
13771 /* If non-null, an asynchronous timer that, when it expires, displays
13772 an hourglass cursor on all frames. */
13774 static struct atimer
*hourglass_atimer
;
13776 /* Non-zero means an hourglass cursor is currently shown. */
13778 static int hourglass_shown_p
;
13780 /* Number of seconds to wait before displaying an hourglass cursor. */
13782 static Lisp_Object Vhourglass_delay
;
13784 /* Default number of seconds to wait before displaying an hourglass
13787 #define DEFAULT_HOURGLASS_DELAY 1
13789 /* Function prototypes. */
13791 static void show_hourglass
P_ ((struct atimer
*));
13792 static void hide_hourglass
P_ ((void));
13795 /* Cancel a currently active hourglass timer, and start a new one. */
13800 #if 0 /* TODO: cursor shape changes. */
13802 int secs
, usecs
= 0;
13804 cancel_hourglass ();
13806 if (INTEGERP (Vhourglass_delay
)
13807 && XINT (Vhourglass_delay
) > 0)
13808 secs
= XFASTINT (Vhourglass_delay
);
13809 else if (FLOATP (Vhourglass_delay
)
13810 && XFLOAT_DATA (Vhourglass_delay
) > 0)
13813 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
13814 secs
= XFASTINT (tem
);
13815 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
13818 secs
= DEFAULT_HOURGLASS_DELAY
;
13820 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
13821 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
13822 show_hourglass
, NULL
);
13827 /* Cancel the hourglass cursor timer if active, hide an hourglass
13828 cursor if shown. */
13831 cancel_hourglass ()
13833 if (hourglass_atimer
)
13835 cancel_atimer (hourglass_atimer
);
13836 hourglass_atimer
= NULL
;
13839 if (hourglass_shown_p
)
13844 /* Timer function of hourglass_atimer. TIMER is equal to
13847 Display an hourglass cursor on all frames by mapping the frames'
13848 hourglass_window. Set the hourglass_p flag in the frames'
13849 output_data.x structure to indicate that an hourglass cursor is
13850 shown on the frames. */
13853 show_hourglass (timer
)
13854 struct atimer
*timer
;
13856 #if 0 /* TODO: cursor shape changes. */
13857 /* The timer implementation will cancel this timer automatically
13858 after this function has run. Set hourglass_atimer to null
13859 so that we know the timer doesn't have to be canceled. */
13860 hourglass_atimer
= NULL
;
13862 if (!hourglass_shown_p
)
13864 Lisp_Object rest
, frame
;
13868 FOR_EACH_FRAME (rest
, frame
)
13869 if (FRAME_W32_P (XFRAME (frame
)))
13871 struct frame
*f
= XFRAME (frame
);
13873 f
->output_data
.w32
->hourglass_p
= 1;
13875 if (!f
->output_data
.w32
->hourglass_window
)
13877 unsigned long mask
= CWCursor
;
13878 XSetWindowAttributes attrs
;
13880 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
13882 f
->output_data
.w32
->hourglass_window
13883 = XCreateWindow (FRAME_X_DISPLAY (f
),
13884 FRAME_OUTER_WINDOW (f
),
13885 0, 0, 32000, 32000, 0, 0,
13891 XMapRaised (FRAME_X_DISPLAY (f
),
13892 f
->output_data
.w32
->hourglass_window
);
13893 XFlush (FRAME_X_DISPLAY (f
));
13896 hourglass_shown_p
= 1;
13903 /* Hide the hourglass cursor on all frames, if it is currently shown. */
13908 #if 0 /* TODO: cursor shape changes. */
13909 if (hourglass_shown_p
)
13911 Lisp_Object rest
, frame
;
13914 FOR_EACH_FRAME (rest
, frame
)
13916 struct frame
*f
= XFRAME (frame
);
13918 if (FRAME_W32_P (f
)
13919 /* Watch out for newly created frames. */
13920 && f
->output_data
.x
->hourglass_window
)
13922 XUnmapWindow (FRAME_X_DISPLAY (f
),
13923 f
->output_data
.x
->hourglass_window
);
13924 /* Sync here because XTread_socket looks at the
13925 hourglass_p flag that is reset to zero below. */
13926 XSync (FRAME_X_DISPLAY (f
), False
);
13927 f
->output_data
.x
->hourglass_p
= 0;
13931 hourglass_shown_p
= 0;
13939 /***********************************************************************
13941 ***********************************************************************/
13943 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
13944 Lisp_Object
, Lisp_Object
));
13945 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
13946 Lisp_Object
, int, int, int *, int *));
13948 /* The frame of a currently visible tooltip. */
13950 Lisp_Object tip_frame
;
13952 /* If non-nil, a timer started that hides the last tooltip when it
13955 Lisp_Object tip_timer
;
13958 /* If non-nil, a vector of 3 elements containing the last args
13959 with which x-show-tip was called. See there. */
13961 Lisp_Object last_show_tip_args
;
13963 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
13965 Lisp_Object Vx_max_tooltip_size
;
13969 unwind_create_tip_frame (frame
)
13972 Lisp_Object deleted
;
13974 deleted
= unwind_create_frame (frame
);
13975 if (EQ (deleted
, Qt
))
13985 /* Create a frame for a tooltip on the display described by DPYINFO.
13986 PARMS is a list of frame parameters. TEXT is the string to
13987 display in the tip frame. Value is the frame.
13989 Note that functions called here, esp. x_default_parameter can
13990 signal errors, for instance when a specified color name is
13991 undefined. We have to make sure that we're in a consistent state
13992 when this happens. */
13995 x_create_tip_frame (dpyinfo
, parms
, text
)
13996 struct w32_display_info
*dpyinfo
;
13997 Lisp_Object parms
, text
;
14000 Lisp_Object frame
, tem
;
14002 long window_prompting
= 0;
14004 int count
= SPECPDL_INDEX ();
14005 struct gcpro gcpro1
, gcpro2
, gcpro3
;
14007 int face_change_count_before
= face_change_count
;
14008 Lisp_Object buffer
;
14009 struct buffer
*old_buffer
;
14013 /* Use this general default value to start with until we know if
14014 this frame has a specified name. */
14015 Vx_resource_name
= Vinvocation_name
;
14017 #ifdef MULTI_KBOARD
14018 kb
= dpyinfo
->kboard
;
14020 kb
= &the_only_kboard
;
14023 /* Get the name of the frame to use for resource lookup. */
14024 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
14025 if (!STRINGP (name
)
14026 && !EQ (name
, Qunbound
)
14028 error ("Invalid frame name--not a string or nil");
14029 Vx_resource_name
= name
;
14032 GCPRO3 (parms
, name
, frame
);
14033 /* Make a frame without minibuffer nor mode-line. */
14034 f
= make_frame (0);
14035 f
->wants_modeline
= 0;
14036 XSETFRAME (frame
, f
);
14038 buffer
= Fget_buffer_create (build_string (" *tip*"));
14039 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
14040 old_buffer
= current_buffer
;
14041 set_buffer_internal_1 (XBUFFER (buffer
));
14042 current_buffer
->truncate_lines
= Qnil
;
14044 Finsert (1, &text
);
14045 set_buffer_internal_1 (old_buffer
);
14047 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
14048 record_unwind_protect (unwind_create_tip_frame
, frame
);
14050 /* By setting the output method, we're essentially saying that
14051 the frame is live, as per FRAME_LIVE_P. If we get a signal
14052 from this point on, x_destroy_window might screw up reference
14054 f
->output_method
= output_w32
;
14055 f
->output_data
.w32
=
14056 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
14057 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
14059 FRAME_FONTSET (f
) = -1;
14060 f
->icon_name
= Qnil
;
14062 #if 0 /* GLYPH_DEBUG TODO: image support. */
14063 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
14064 dpyinfo_refcount
= dpyinfo
->reference_count
;
14065 #endif /* GLYPH_DEBUG */
14066 #ifdef MULTI_KBOARD
14067 FRAME_KBOARD (f
) = kb
;
14069 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
14070 f
->output_data
.w32
->explicit_parent
= 0;
14072 /* Set the name; the functions to which we pass f expect the name to
14074 if (EQ (name
, Qunbound
) || NILP (name
))
14076 f
->name
= build_string (dpyinfo
->w32_id_name
);
14077 f
->explicit_name
= 0;
14082 f
->explicit_name
= 1;
14083 /* use the frame's title when getting resources for this frame. */
14084 specbind (Qx_resource_name
, name
);
14087 /* Extract the window parameters from the supplied values
14088 that are needed to determine window geometry. */
14092 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
14095 /* First, try whatever font the caller has specified. */
14096 if (STRINGP (font
))
14098 tem
= Fquery_fontset (font
, Qnil
);
14100 font
= x_new_fontset (f
, SDATA (tem
));
14102 font
= x_new_font (f
, SDATA (font
));
14105 /* Try out a font which we hope has bold and italic variations. */
14106 if (!STRINGP (font
))
14107 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
14108 if (! STRINGP (font
))
14109 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
14110 /* If those didn't work, look for something which will at least work. */
14111 if (! STRINGP (font
))
14112 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
14114 if (! STRINGP (font
))
14115 font
= build_string ("Fixedsys");
14117 x_default_parameter (f
, parms
, Qfont
, font
,
14118 "font", "Font", RES_TYPE_STRING
);
14121 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
14122 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
14123 /* This defaults to 2 in order to match xterm. We recognize either
14124 internalBorderWidth or internalBorder (which is what xterm calls
14126 if (NILP (Fassq (Qinternal_border_width
, parms
)))
14130 value
= w32_get_arg (parms
, Qinternal_border_width
,
14131 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
14132 if (! EQ (value
, Qunbound
))
14133 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
14136 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
14137 "internalBorderWidth", "internalBorderWidth",
14140 /* Also do the stuff which must be set before the window exists. */
14141 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
14142 "foreground", "Foreground", RES_TYPE_STRING
);
14143 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
14144 "background", "Background", RES_TYPE_STRING
);
14145 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
14146 "pointerColor", "Foreground", RES_TYPE_STRING
);
14147 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
14148 "cursorColor", "Foreground", RES_TYPE_STRING
);
14149 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
14150 "borderColor", "BorderColor", RES_TYPE_STRING
);
14152 /* Init faces before x_default_parameter is called for scroll-bar
14153 parameters because that function calls x_set_scroll_bar_width,
14154 which calls change_frame_size, which calls Fset_window_buffer,
14155 which runs hooks, which call Fvertical_motion. At the end, we
14156 end up in init_iterator with a null face cache, which should not
14158 init_frame_faces (f
);
14160 f
->output_data
.w32
->dwStyle
= WS_BORDER
| WS_POPUP
| WS_DISABLED
;
14161 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
14163 window_prompting
= x_figure_window_size (f
, parms
);
14165 /* No fringes on tip frame. */
14166 f
->output_data
.w32
->fringes_extra
= 0;
14167 f
->output_data
.w32
->fringe_cols
= 0;
14168 f
->output_data
.w32
->left_fringe_width
= 0;
14169 f
->output_data
.w32
->right_fringe_width
= 0;
14171 if (window_prompting
& XNegative
)
14173 if (window_prompting
& YNegative
)
14174 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
14176 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
14180 if (window_prompting
& YNegative
)
14181 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
14183 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
14186 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
14189 my_create_tip_window (f
);
14194 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
14195 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
14196 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
14197 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
14198 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
14199 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
14201 /* Dimensions, especially f->height, must be done via change_frame_size.
14202 Change will not be effected unless different from the current
14205 height
= f
->height
;
14207 SET_FRAME_WIDTH (f
, 0);
14208 change_frame_size (f
, height
, width
, 1, 0, 0);
14210 /* Add `tooltip' frame parameter's default value. */
14211 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
14212 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
14215 /* Set up faces after all frame parameters are known. This call
14216 also merges in face attributes specified for new frames.
14218 Frame parameters may be changed if .Xdefaults contains
14219 specifications for the default font. For example, if there is an
14220 `Emacs.default.attributeBackground: pink', the `background-color'
14221 attribute of the frame get's set, which let's the internal border
14222 of the tooltip frame appear in pink. Prevent this. */
14224 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
14226 /* Set tip_frame here, so that */
14228 call1 (Qface_set_after_frame_default
, frame
);
14230 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
14231 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
14239 /* It is now ok to make the frame official even if we get an error
14240 below. And the frame needs to be on Vframe_list or making it
14241 visible won't work. */
14242 Vframe_list
= Fcons (frame
, Vframe_list
);
14244 /* Now that the frame is official, it counts as a reference to
14246 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
14248 /* Setting attributes of faces of the tooltip frame from resources
14249 and similar will increment face_change_count, which leads to the
14250 clearing of all current matrices. Since this isn't necessary
14251 here, avoid it by resetting face_change_count to the value it
14252 had before we created the tip frame. */
14253 face_change_count
= face_change_count_before
;
14255 /* Discard the unwind_protect. */
14256 return unbind_to (count
, frame
);
14260 /* Compute where to display tip frame F. PARMS is the list of frame
14261 parameters for F. DX and DY are specified offsets from the current
14262 location of the mouse. WIDTH and HEIGHT are the width and height
14263 of the tooltip. Return coordinates relative to the root window of
14264 the display in *ROOT_X, and *ROOT_Y. */
14267 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
14269 Lisp_Object parms
, dx
, dy
;
14271 int *root_x
, *root_y
;
14273 Lisp_Object left
, top
;
14275 /* User-specified position? */
14276 left
= Fcdr (Fassq (Qleft
, parms
));
14277 top
= Fcdr (Fassq (Qtop
, parms
));
14279 /* Move the tooltip window where the mouse pointer is. Resize and
14281 if (!INTEGERP (left
) || !INTEGERP (top
))
14286 GetCursorPos (&pt
);
14292 if (INTEGERP (top
))
14293 *root_y
= XINT (top
);
14294 else if (*root_y
+ XINT (dy
) - height
< 0)
14295 *root_y
-= XINT (dy
);
14299 *root_y
+= XINT (dy
);
14302 if (INTEGERP (left
))
14303 *root_x
= XINT (left
);
14304 else if (*root_x
+ XINT (dx
) + width
<= FRAME_W32_DISPLAY_INFO (f
)->width
)
14305 /* It fits to the right of the pointer. */
14306 *root_x
+= XINT (dx
);
14307 else if (width
+ XINT (dx
) <= *root_x
)
14308 /* It fits to the left of the pointer. */
14309 *root_x
-= width
+ XINT (dx
);
14311 /* Put it left justified on the screen -- it ought to fit that way. */
14316 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
14317 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
14318 A tooltip window is a small window displaying a string.
14320 FRAME nil or omitted means use the selected frame.
14322 PARMS is an optional list of frame parameters which can be
14323 used to change the tooltip's appearance.
14325 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
14326 means use the default timeout of 5 seconds.
14328 If the list of frame parameters PARAMS contains a `left' parameter,
14329 the tooltip is displayed at that x-position. Otherwise it is
14330 displayed at the mouse position, with offset DX added (default is 5 if
14331 DX isn't specified). Likewise for the y-position; if a `top' frame
14332 parameter is specified, it determines the y-position of the tooltip
14333 window, otherwise it is displayed at the mouse position, with offset
14334 DY added (default is -10).
14336 A tooltip's maximum size is specified by `x-max-tooltip-size'.
14337 Text larger than the specified size is clipped. */)
14338 (string
, frame
, parms
, timeout
, dx
, dy
)
14339 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
14343 int root_x
, root_y
;
14344 struct buffer
*old_buffer
;
14345 struct text_pos pos
;
14346 int i
, width
, height
;
14347 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
14348 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
14349 int count
= SPECPDL_INDEX ();
14351 specbind (Qinhibit_redisplay
, Qt
);
14353 GCPRO4 (string
, parms
, frame
, timeout
);
14355 CHECK_STRING (string
);
14356 f
= check_x_frame (frame
);
14357 if (NILP (timeout
))
14358 timeout
= make_number (5);
14360 CHECK_NATNUM (timeout
);
14363 dx
= make_number (5);
14368 dy
= make_number (-10);
14372 if (NILP (last_show_tip_args
))
14373 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
14375 if (!NILP (tip_frame
))
14377 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
14378 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
14379 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
14381 if (EQ (frame
, last_frame
)
14382 && !NILP (Fequal (last_string
, string
))
14383 && !NILP (Fequal (last_parms
, parms
)))
14385 struct frame
*f
= XFRAME (tip_frame
);
14387 /* Only DX and DY have changed. */
14388 if (!NILP (tip_timer
))
14390 Lisp_Object timer
= tip_timer
;
14392 call1 (Qcancel_timer
, timer
);
14396 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
14397 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
14399 /* Put tooltip in topmost group and in position. */
14400 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
14401 root_x
, root_y
, 0, 0,
14402 SWP_NOSIZE
| SWP_NOACTIVATE
);
14404 /* Ensure tooltip is on top of other topmost windows (eg menus). */
14405 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
14407 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
14414 /* Hide a previous tip, if any. */
14417 ASET (last_show_tip_args
, 0, string
);
14418 ASET (last_show_tip_args
, 1, frame
);
14419 ASET (last_show_tip_args
, 2, parms
);
14421 /* Add default values to frame parameters. */
14422 if (NILP (Fassq (Qname
, parms
)))
14423 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
14424 if (NILP (Fassq (Qinternal_border_width
, parms
)))
14425 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
14426 if (NILP (Fassq (Qborder_width
, parms
)))
14427 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
14428 if (NILP (Fassq (Qborder_color
, parms
)))
14429 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
14430 if (NILP (Fassq (Qbackground_color
, parms
)))
14431 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
14434 /* Block input until the tip has been fully drawn, to avoid crashes
14435 when drawing tips in menus. */
14438 /* Create a frame for the tooltip, and record it in the global
14439 variable tip_frame. */
14440 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
, string
);
14441 f
= XFRAME (frame
);
14443 /* Set up the frame's root window. */
14444 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
14445 w
->left
= w
->top
= make_number (0);
14447 if (CONSP (Vx_max_tooltip_size
)
14448 && INTEGERP (XCAR (Vx_max_tooltip_size
))
14449 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
14450 && INTEGERP (XCDR (Vx_max_tooltip_size
))
14451 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
14453 w
->width
= XCAR (Vx_max_tooltip_size
);
14454 w
->height
= XCDR (Vx_max_tooltip_size
);
14458 w
->width
= make_number (80);
14459 w
->height
= make_number (40);
14462 f
->window_width
= XINT (w
->width
);
14464 w
->pseudo_window_p
= 1;
14466 /* Display the tooltip text in a temporary buffer. */
14467 old_buffer
= current_buffer
;
14468 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
14469 current_buffer
->truncate_lines
= Qnil
;
14470 clear_glyph_matrix (w
->desired_matrix
);
14471 clear_glyph_matrix (w
->current_matrix
);
14472 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
14473 try_window (FRAME_ROOT_WINDOW (f
), pos
);
14475 /* Compute width and height of the tooltip. */
14476 width
= height
= 0;
14477 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
14479 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
14480 struct glyph
*last
;
14483 /* Stop at the first empty row at the end. */
14484 if (!row
->enabled_p
|| !row
->displays_text_p
)
14487 /* Let the row go over the full width of the frame. */
14488 row
->full_width_p
= 1;
14490 #ifdef TODO /* Investigate why some fonts need more width than is
14491 calculated for some tooltips. */
14492 /* There's a glyph at the end of rows that is use to place
14493 the cursor there. Don't include the width of this glyph. */
14494 if (row
->used
[TEXT_AREA
])
14496 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
14497 row_width
= row
->pixel_width
- last
->pixel_width
;
14501 row_width
= row
->pixel_width
;
14503 /* TODO: find why tips do not draw along baseline as instructed. */
14504 height
+= row
->height
;
14505 width
= max (width
, row_width
);
14508 /* Add the frame's internal border to the width and height the X
14509 window should have. */
14510 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
14511 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
14513 /* Move the tooltip window where the mouse pointer is. Resize and
14515 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
14518 /* Adjust Window size to take border into account. */
14520 rect
.left
= rect
.top
= 0;
14521 rect
.right
= width
;
14522 rect
.bottom
= height
;
14523 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
14524 FRAME_EXTERNAL_MENU_BAR (f
));
14526 /* Position and size tooltip, and put it in the topmost group. */
14527 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
14528 root_x
, root_y
, rect
.right
- rect
.left
,
14529 rect
.bottom
- rect
.top
, SWP_NOACTIVATE
);
14531 /* Ensure tooltip is on top of other topmost windows (eg menus). */
14532 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
14534 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
14536 /* Let redisplay know that we have made the frame visible already. */
14537 f
->async_visible
= 1;
14539 ShowWindow (FRAME_W32_WINDOW (f
), SW_SHOWNOACTIVATE
);
14542 /* Draw into the window. */
14543 w
->must_be_updated_p
= 1;
14544 update_single_window (w
, 1);
14548 /* Restore original current buffer. */
14549 set_buffer_internal_1 (old_buffer
);
14550 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
14553 /* Let the tip disappear after timeout seconds. */
14554 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
14555 intern ("x-hide-tip"));
14558 return unbind_to (count
, Qnil
);
14562 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
14563 doc
: /* Hide the current tooltip window, if there is any.
14564 Value is t if tooltip was open, nil otherwise. */)
14568 Lisp_Object deleted
, frame
, timer
;
14569 struct gcpro gcpro1
, gcpro2
;
14571 /* Return quickly if nothing to do. */
14572 if (NILP (tip_timer
) && NILP (tip_frame
))
14577 GCPRO2 (frame
, timer
);
14578 tip_frame
= tip_timer
= deleted
= Qnil
;
14580 count
= SPECPDL_INDEX ();
14581 specbind (Qinhibit_redisplay
, Qt
);
14582 specbind (Qinhibit_quit
, Qt
);
14585 call1 (Qcancel_timer
, timer
);
14587 if (FRAMEP (frame
))
14589 Fdelete_frame (frame
, Qnil
);
14594 return unbind_to (count
, deleted
);
14599 /***********************************************************************
14600 File selection dialog
14601 ***********************************************************************/
14602 extern Lisp_Object Qfile_name_history
;
14604 /* Callback for altering the behaviour of the Open File dialog.
14605 Makes the Filename text field contain "Current Directory" and be
14606 read-only when "Directories" is selected in the filter. This
14607 allows us to work around the fact that the standard Open File
14608 dialog does not support directories. */
14610 file_dialog_callback (hwnd
, msg
, wParam
, lParam
)
14616 if (msg
== WM_NOTIFY
)
14618 OFNOTIFY
* notify
= (OFNOTIFY
*)lParam
;
14619 /* Detect when the Filter dropdown is changed. */
14620 if (notify
->hdr
.code
== CDN_TYPECHANGE
)
14622 HWND dialog
= GetParent (hwnd
);
14623 HWND edit_control
= GetDlgItem (dialog
, FILE_NAME_TEXT_FIELD
);
14625 /* Directories is in index 2. */
14626 if (notify
->lpOFN
->nFilterIndex
== 2)
14628 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
14629 "Current Directory");
14630 EnableWindow (edit_control
, FALSE
);
14634 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
14636 EnableWindow (edit_control
, TRUE
);
14643 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
14644 doc
: /* Read file name, prompting with PROMPT in directory DIR.
14645 Use a file selection dialog.
14646 Select DEFAULT-FILENAME in the dialog's file selection box, if
14647 specified. Ensure that file exists if MUSTMATCH is non-nil. */)
14648 (prompt
, dir
, default_filename
, mustmatch
)
14649 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
14651 struct frame
*f
= SELECTED_FRAME ();
14652 Lisp_Object file
= Qnil
;
14653 int count
= SPECPDL_INDEX ();
14654 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
14655 char filename
[MAX_PATH
+ 1];
14656 char init_dir
[MAX_PATH
+ 1];
14658 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
14659 CHECK_STRING (prompt
);
14660 CHECK_STRING (dir
);
14662 /* Create the dialog with PROMPT as title, using DIR as initial
14663 directory and using "*" as pattern. */
14664 dir
= Fexpand_file_name (dir
, Qnil
);
14665 strncpy (init_dir
, SDATA (dir
), MAX_PATH
);
14666 init_dir
[MAX_PATH
] = '\0';
14667 unixtodos_filename (init_dir
);
14669 if (STRINGP (default_filename
))
14671 char *file_name_only
;
14672 char *full_path_name
= SDATA (default_filename
);
14674 unixtodos_filename (full_path_name
);
14676 file_name_only
= strrchr (full_path_name
, '\\');
14677 if (!file_name_only
)
14678 file_name_only
= full_path_name
;
14684 strncpy (filename
, file_name_only
, MAX_PATH
);
14685 filename
[MAX_PATH
] = '\0';
14688 filename
[0] = '\0';
14691 OPENFILENAME file_details
;
14693 /* Prevent redisplay. */
14694 specbind (Qinhibit_redisplay
, Qt
);
14697 bzero (&file_details
, sizeof (file_details
));
14698 file_details
.lStructSize
= sizeof (file_details
);
14699 file_details
.hwndOwner
= FRAME_W32_WINDOW (f
);
14700 /* Undocumented Bug in Common File Dialog:
14701 If a filter is not specified, shell links are not resolved. */
14702 file_details
.lpstrFilter
= "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
14703 file_details
.lpstrFile
= filename
;
14704 file_details
.nMaxFile
= sizeof (filename
);
14705 file_details
.lpstrInitialDir
= init_dir
;
14706 file_details
.lpstrTitle
= SDATA (prompt
);
14707 file_details
.Flags
= (OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
14708 | OFN_EXPLORER
| OFN_ENABLEHOOK
);
14709 if (!NILP (mustmatch
))
14710 file_details
.Flags
|= OFN_FILEMUSTEXIST
| OFN_PATHMUSTEXIST
;
14712 file_details
.lpfnHook
= (LPOFNHOOKPROC
) file_dialog_callback
;
14714 if (GetOpenFileName (&file_details
))
14716 dostounix_filename (filename
);
14717 if (file_details
.nFilterIndex
== 2)
14719 /* "Folder Only" selected - strip dummy file name. */
14720 char * last
= strrchr (filename
, '/');
14724 file
= DECODE_FILE(build_string (filename
));
14726 /* User cancelled the dialog without making a selection. */
14727 else if (!CommDlgExtendedError ())
14729 /* An error occurred, fallback on reading from the mini-buffer. */
14731 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
14732 dir
, mustmatch
, dir
, Qfile_name_history
,
14733 default_filename
, Qnil
);
14736 file
= unbind_to (count
, file
);
14741 /* Make "Cancel" equivalent to C-g. */
14743 Fsignal (Qquit
, Qnil
);
14745 return unbind_to (count
, file
);
14750 /***********************************************************************
14751 w32 specialized functions
14752 ***********************************************************************/
14754 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 2, 0,
14755 doc
: /* Select a font using the W32 font dialog.
14756 Returns an X font string corresponding to the selection. */)
14757 (frame
, include_proportional
)
14758 Lisp_Object frame
, include_proportional
;
14760 FRAME_PTR f
= check_x_frame (frame
);
14768 bzero (&cf
, sizeof (cf
));
14769 bzero (&lf
, sizeof (lf
));
14771 cf
.lStructSize
= sizeof (cf
);
14772 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
14773 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
14775 /* Unless include_proportional is non-nil, limit the selection to
14776 monospaced fonts. */
14777 if (NILP (include_proportional
))
14778 cf
.Flags
|= CF_FIXEDPITCHONLY
;
14780 cf
.lpLogFont
= &lf
;
14782 /* Initialize as much of the font details as we can from the current
14784 hdc
= GetDC (FRAME_W32_WINDOW (f
));
14785 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
14786 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
14787 if (GetTextMetrics (hdc
, &tm
))
14789 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
14790 lf
.lfWeight
= tm
.tmWeight
;
14791 lf
.lfItalic
= tm
.tmItalic
;
14792 lf
.lfUnderline
= tm
.tmUnderlined
;
14793 lf
.lfStrikeOut
= tm
.tmStruckOut
;
14794 lf
.lfCharSet
= tm
.tmCharSet
;
14795 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
14797 SelectObject (hdc
, oldobj
);
14798 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
14800 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
14803 return build_string (buf
);
14806 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
14807 Sw32_send_sys_command
, 1, 2, 0,
14808 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
14809 Some useful values for command are #xf030 to maximise frame (#xf020
14810 to minimize), #xf120 to restore frame to original size, and #xf100
14811 to activate the menubar for keyboard access. #xf140 activates the
14812 screen saver if defined.
14814 If optional parameter FRAME is not specified, use selected frame. */)
14816 Lisp_Object command
, frame
;
14818 FRAME_PTR f
= check_x_frame (frame
);
14820 CHECK_NUMBER (command
);
14822 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
14827 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
14828 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
14829 This is a wrapper around the ShellExecute system function, which
14830 invokes the application registered to handle OPERATION for DOCUMENT.
14831 OPERATION is typically \"open\", \"print\" or \"explore\" (but can be
14832 nil for the default action), and DOCUMENT is typically the name of a
14833 document file or URL, but can also be a program executable to run or
14834 a directory to open in the Windows Explorer.
14836 If DOCUMENT is a program executable, PARAMETERS can be a string
14837 containing command line parameters, but otherwise should be nil.
14839 SHOW-FLAG can be used to control whether the invoked application is hidden
14840 or minimized. If SHOW-FLAG is nil, the application is displayed normally,
14841 otherwise it is an integer representing a ShowWindow flag:
14845 3 - start maximized
14846 6 - start minimized */)
14847 (operation
, document
, parameters
, show_flag
)
14848 Lisp_Object operation
, document
, parameters
, show_flag
;
14850 Lisp_Object current_dir
;
14852 CHECK_STRING (document
);
14854 /* Encode filename and current directory. */
14855 current_dir
= ENCODE_FILE (current_buffer
->directory
);
14856 document
= ENCODE_FILE (document
);
14857 if ((int) ShellExecute (NULL
,
14858 (STRINGP (operation
) ?
14859 SDATA (operation
) : NULL
),
14861 (STRINGP (parameters
) ?
14862 SDATA (parameters
) : NULL
),
14863 SDATA (current_dir
),
14864 (INTEGERP (show_flag
) ?
14865 XINT (show_flag
) : SW_SHOWDEFAULT
))
14868 error ("ShellExecute failed: %s", w32_strerror (0));
14871 /* Lookup virtual keycode from string representing the name of a
14872 non-ascii keystroke into the corresponding virtual key, using
14873 lispy_function_keys. */
14875 lookup_vk_code (char *key
)
14879 for (i
= 0; i
< 256; i
++)
14880 if (lispy_function_keys
[i
] != 0
14881 && strcmp (lispy_function_keys
[i
], key
) == 0)
14887 /* Convert a one-element vector style key sequence to a hot key
14890 w32_parse_hot_key (key
)
14893 /* Copied from Fdefine_key and store_in_keymap. */
14894 register Lisp_Object c
;
14896 int lisp_modifiers
;
14898 struct gcpro gcpro1
;
14900 CHECK_VECTOR (key
);
14902 if (XFASTINT (Flength (key
)) != 1)
14907 c
= Faref (key
, make_number (0));
14909 if (CONSP (c
) && lucid_event_type_list_p (c
))
14910 c
= Fevent_convert_list (c
);
14914 if (! INTEGERP (c
) && ! SYMBOLP (c
))
14915 error ("Key definition is invalid");
14917 /* Work out the base key and the modifiers. */
14920 c
= parse_modifiers (c
);
14921 lisp_modifiers
= Fcar (Fcdr (c
));
14925 vk_code
= lookup_vk_code (SDATA (SYMBOL_NAME (c
)));
14927 else if (INTEGERP (c
))
14929 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
14930 /* Many ascii characters are their own virtual key code. */
14931 vk_code
= XINT (c
) & CHARACTERBITS
;
14934 if (vk_code
< 0 || vk_code
> 255)
14937 if ((lisp_modifiers
& meta_modifier
) != 0
14938 && !NILP (Vw32_alt_is_meta
))
14939 lisp_modifiers
|= alt_modifier
;
14941 /* Supply defs missing from mingw32. */
14943 #define MOD_ALT 0x0001
14944 #define MOD_CONTROL 0x0002
14945 #define MOD_SHIFT 0x0004
14946 #define MOD_WIN 0x0008
14949 /* Convert lisp modifiers to Windows hot-key form. */
14950 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
14951 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
14952 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
14953 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
14955 return HOTKEY (vk_code
, w32_modifiers
);
14958 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
14959 Sw32_register_hot_key
, 1, 1, 0,
14960 doc
: /* Register KEY as a hot-key combination.
14961 Certain key combinations like Alt-Tab are reserved for system use on
14962 Windows, and therefore are normally intercepted by the system. However,
14963 most of these key combinations can be received by registering them as
14964 hot-keys, overriding their special meaning.
14966 KEY must be a one element key definition in vector form that would be
14967 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
14968 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
14969 is always interpreted as the Windows modifier keys.
14971 The return value is the hotkey-id if registered, otherwise nil. */)
14975 key
= w32_parse_hot_key (key
);
14977 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
14979 /* Reuse an empty slot if possible. */
14980 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
14982 /* Safe to add new key to list, even if we have focus. */
14984 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
14986 XSETCAR (item
, key
);
14988 /* Notify input thread about new hot-key definition, so that it
14989 takes effect without needing to switch focus. */
14990 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
14997 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
14998 Sw32_unregister_hot_key
, 1, 1, 0,
14999 doc
: /* Unregister HOTKEY as a hot-key combination. */)
15005 if (!INTEGERP (key
))
15006 key
= w32_parse_hot_key (key
);
15008 item
= Fmemq (key
, w32_grabbed_keys
);
15012 /* Notify input thread about hot-key definition being removed, so
15013 that it takes effect without needing focus switch. */
15014 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
15015 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
15018 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
15025 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
15026 Sw32_registered_hot_keys
, 0, 0, 0,
15027 doc
: /* Return list of registered hot-key IDs. */)
15030 return Fcopy_sequence (w32_grabbed_keys
);
15033 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
15034 Sw32_reconstruct_hot_key
, 1, 1, 0,
15035 doc
: /* Convert hot-key ID to a lisp key combination. */)
15037 Lisp_Object hotkeyid
;
15039 int vk_code
, w32_modifiers
;
15042 CHECK_NUMBER (hotkeyid
);
15044 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
15045 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
15047 if (lispy_function_keys
[vk_code
])
15048 key
= intern (lispy_function_keys
[vk_code
]);
15050 key
= make_number (vk_code
);
15052 key
= Fcons (key
, Qnil
);
15053 if (w32_modifiers
& MOD_SHIFT
)
15054 key
= Fcons (Qshift
, key
);
15055 if (w32_modifiers
& MOD_CONTROL
)
15056 key
= Fcons (Qctrl
, key
);
15057 if (w32_modifiers
& MOD_ALT
)
15058 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
15059 if (w32_modifiers
& MOD_WIN
)
15060 key
= Fcons (Qhyper
, key
);
15065 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
15066 Sw32_toggle_lock_key
, 1, 2, 0,
15067 doc
: /* Toggle the state of the lock key KEY.
15068 KEY can be `capslock', `kp-numlock', or `scroll'.
15069 If the optional parameter NEW-STATE is a number, then the state of KEY
15070 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
15072 Lisp_Object key
, new_state
;
15076 if (EQ (key
, intern ("capslock")))
15077 vk_code
= VK_CAPITAL
;
15078 else if (EQ (key
, intern ("kp-numlock")))
15079 vk_code
= VK_NUMLOCK
;
15080 else if (EQ (key
, intern ("scroll")))
15081 vk_code
= VK_SCROLL
;
15085 if (!dwWindowsThreadId
)
15086 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
15088 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
15089 (WPARAM
) vk_code
, (LPARAM
) new_state
))
15092 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
15093 return make_number (msg
.wParam
);
15098 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
15099 doc
: /* Return storage information about the file system FILENAME is on.
15100 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
15101 storage of the file system, FREE is the free storage, and AVAIL is the
15102 storage available to a non-superuser. All 3 numbers are in bytes.
15103 If the underlying system call fails, value is nil. */)
15105 Lisp_Object filename
;
15107 Lisp_Object encoded
, value
;
15109 CHECK_STRING (filename
);
15110 filename
= Fexpand_file_name (filename
, Qnil
);
15111 encoded
= ENCODE_FILE (filename
);
15115 /* Determining the required information on Windows turns out, sadly,
15116 to be more involved than one would hope. The original Win32 api
15117 call for this will return bogus information on some systems, but we
15118 must dynamically probe for the replacement api, since that was
15119 added rather late on. */
15121 HMODULE hKernel
= GetModuleHandle ("kernel32");
15122 BOOL (*pfn_GetDiskFreeSpaceEx
)
15123 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
15124 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
15126 /* On Windows, we may need to specify the root directory of the
15127 volume holding FILENAME. */
15128 char rootname
[MAX_PATH
];
15129 char *name
= SDATA (encoded
);
15131 /* find the root name of the volume if given */
15132 if (isalpha (name
[0]) && name
[1] == ':')
15134 rootname
[0] = name
[0];
15135 rootname
[1] = name
[1];
15136 rootname
[2] = '\\';
15139 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
15141 char *str
= rootname
;
15145 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
15155 if (pfn_GetDiskFreeSpaceEx
)
15157 /* Unsigned large integers cannot be cast to double, so
15158 use signed ones instead. */
15159 LARGE_INTEGER availbytes
;
15160 LARGE_INTEGER freebytes
;
15161 LARGE_INTEGER totalbytes
;
15163 if (pfn_GetDiskFreeSpaceEx(rootname
,
15164 (ULARGE_INTEGER
*)&availbytes
,
15165 (ULARGE_INTEGER
*)&totalbytes
,
15166 (ULARGE_INTEGER
*)&freebytes
))
15167 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
15168 make_float ((double) freebytes
.QuadPart
),
15169 make_float ((double) availbytes
.QuadPart
));
15173 DWORD sectors_per_cluster
;
15174 DWORD bytes_per_sector
;
15175 DWORD free_clusters
;
15176 DWORD total_clusters
;
15178 if (GetDiskFreeSpace(rootname
,
15179 §ors_per_cluster
,
15183 value
= list3 (make_float ((double) total_clusters
15184 * sectors_per_cluster
* bytes_per_sector
),
15185 make_float ((double) free_clusters
15186 * sectors_per_cluster
* bytes_per_sector
),
15187 make_float ((double) free_clusters
15188 * sectors_per_cluster
* bytes_per_sector
));
15195 /***********************************************************************
15197 ***********************************************************************/
15202 globals_of_w32fns ();
15203 /* This is zero if not using MS-Windows. */
15205 track_mouse_window
= NULL
;
15207 w32_visible_system_caret_hwnd
= NULL
;
15209 Qauto_raise
= intern ("auto-raise");
15210 staticpro (&Qauto_raise
);
15211 Qauto_lower
= intern ("auto-lower");
15212 staticpro (&Qauto_lower
);
15213 Qborder_color
= intern ("border-color");
15214 staticpro (&Qborder_color
);
15215 Qborder_width
= intern ("border-width");
15216 staticpro (&Qborder_width
);
15217 Qcursor_color
= intern ("cursor-color");
15218 staticpro (&Qcursor_color
);
15219 Qcursor_type
= intern ("cursor-type");
15220 staticpro (&Qcursor_type
);
15221 Qgeometry
= intern ("geometry");
15222 staticpro (&Qgeometry
);
15223 Qicon_left
= intern ("icon-left");
15224 staticpro (&Qicon_left
);
15225 Qicon_top
= intern ("icon-top");
15226 staticpro (&Qicon_top
);
15227 Qicon_type
= intern ("icon-type");
15228 staticpro (&Qicon_type
);
15229 Qicon_name
= intern ("icon-name");
15230 staticpro (&Qicon_name
);
15231 Qinternal_border_width
= intern ("internal-border-width");
15232 staticpro (&Qinternal_border_width
);
15233 Qleft
= intern ("left");
15234 staticpro (&Qleft
);
15235 Qright
= intern ("right");
15236 staticpro (&Qright
);
15237 Qmouse_color
= intern ("mouse-color");
15238 staticpro (&Qmouse_color
);
15239 Qnone
= intern ("none");
15240 staticpro (&Qnone
);
15241 Qparent_id
= intern ("parent-id");
15242 staticpro (&Qparent_id
);
15243 Qscroll_bar_width
= intern ("scroll-bar-width");
15244 staticpro (&Qscroll_bar_width
);
15245 Qsuppress_icon
= intern ("suppress-icon");
15246 staticpro (&Qsuppress_icon
);
15247 Qundefined_color
= intern ("undefined-color");
15248 staticpro (&Qundefined_color
);
15249 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
15250 staticpro (&Qvertical_scroll_bars
);
15251 Qvisibility
= intern ("visibility");
15252 staticpro (&Qvisibility
);
15253 Qwindow_id
= intern ("window-id");
15254 staticpro (&Qwindow_id
);
15255 Qx_frame_parameter
= intern ("x-frame-parameter");
15256 staticpro (&Qx_frame_parameter
);
15257 Qx_resource_name
= intern ("x-resource-name");
15258 staticpro (&Qx_resource_name
);
15259 Quser_position
= intern ("user-position");
15260 staticpro (&Quser_position
);
15261 Quser_size
= intern ("user-size");
15262 staticpro (&Quser_size
);
15263 Qscreen_gamma
= intern ("screen-gamma");
15264 staticpro (&Qscreen_gamma
);
15265 Qline_spacing
= intern ("line-spacing");
15266 staticpro (&Qline_spacing
);
15267 Qcenter
= intern ("center");
15268 staticpro (&Qcenter
);
15269 Qcancel_timer
= intern ("cancel-timer");
15270 staticpro (&Qcancel_timer
);
15271 Qfullscreen
= intern ("fullscreen");
15272 staticpro (&Qfullscreen
);
15273 Qfullwidth
= intern ("fullwidth");
15274 staticpro (&Qfullwidth
);
15275 Qfullheight
= intern ("fullheight");
15276 staticpro (&Qfullheight
);
15277 Qfullboth
= intern ("fullboth");
15278 staticpro (&Qfullboth
);
15280 Qhyper
= intern ("hyper");
15281 staticpro (&Qhyper
);
15282 Qsuper
= intern ("super");
15283 staticpro (&Qsuper
);
15284 Qmeta
= intern ("meta");
15285 staticpro (&Qmeta
);
15286 Qalt
= intern ("alt");
15288 Qctrl
= intern ("ctrl");
15289 staticpro (&Qctrl
);
15290 Qcontrol
= intern ("control");
15291 staticpro (&Qcontrol
);
15292 Qshift
= intern ("shift");
15293 staticpro (&Qshift
);
15294 /* This is the end of symbol initialization. */
15296 /* Text property `display' should be nonsticky by default. */
15297 Vtext_property_default_nonsticky
15298 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
15301 Qlaplace
= intern ("laplace");
15302 staticpro (&Qlaplace
);
15303 Qemboss
= intern ("emboss");
15304 staticpro (&Qemboss
);
15305 Qedge_detection
= intern ("edge-detection");
15306 staticpro (&Qedge_detection
);
15307 Qheuristic
= intern ("heuristic");
15308 staticpro (&Qheuristic
);
15309 QCmatrix
= intern (":matrix");
15310 staticpro (&QCmatrix
);
15311 QCcolor_adjustment
= intern (":color-adjustment");
15312 staticpro (&QCcolor_adjustment
);
15313 QCmask
= intern (":mask");
15314 staticpro (&QCmask
);
15316 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
15317 staticpro (&Qface_set_after_frame_default
);
15319 Fput (Qundefined_color
, Qerror_conditions
,
15320 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
15321 Fput (Qundefined_color
, Qerror_message
,
15322 build_string ("Undefined color"));
15324 staticpro (&w32_grabbed_keys
);
15325 w32_grabbed_keys
= Qnil
;
15327 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
15328 doc
: /* An array of color name mappings for windows. */);
15329 Vw32_color_map
= Qnil
;
15331 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
15332 doc
: /* Non-nil if alt key presses are passed on to Windows.
15333 When non-nil, for example, alt pressed and released and then space will
15334 open the System menu. When nil, Emacs silently swallows alt key events. */);
15335 Vw32_pass_alt_to_system
= Qnil
;
15337 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
15338 doc
: /* Non-nil if the alt key is to be considered the same as the meta key.
15339 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta. */);
15340 Vw32_alt_is_meta
= Qt
;
15342 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
15343 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
15344 XSETINT (Vw32_quit_key
, 0);
15346 DEFVAR_LISP ("w32-pass-lwindow-to-system",
15347 &Vw32_pass_lwindow_to_system
,
15348 doc
: /* Non-nil if the left \"Windows\" key is passed on to Windows.
15349 When non-nil, the Start menu is opened by tapping the key. */);
15350 Vw32_pass_lwindow_to_system
= Qt
;
15352 DEFVAR_LISP ("w32-pass-rwindow-to-system",
15353 &Vw32_pass_rwindow_to_system
,
15354 doc
: /* Non-nil if the right \"Windows\" key is passed on to Windows.
15355 When non-nil, the Start menu is opened by tapping the key. */);
15356 Vw32_pass_rwindow_to_system
= Qt
;
15358 DEFVAR_INT ("w32-phantom-key-code",
15359 &Vw32_phantom_key_code
,
15360 doc
: /* Virtual key code used to generate \"phantom\" key presses.
15361 Value is a number between 0 and 255.
15363 Phantom key presses are generated in order to stop the system from
15364 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
15365 `w32-pass-rwindow-to-system' is nil. */);
15366 /* Although 255 is technically not a valid key code, it works and
15367 means that this hack won't interfere with any real key code. */
15368 Vw32_phantom_key_code
= 255;
15370 DEFVAR_LISP ("w32-enable-num-lock",
15371 &Vw32_enable_num_lock
,
15372 doc
: /* Non-nil if Num Lock should act normally.
15373 Set to nil to see Num Lock as the key `kp-numlock'. */);
15374 Vw32_enable_num_lock
= Qt
;
15376 DEFVAR_LISP ("w32-enable-caps-lock",
15377 &Vw32_enable_caps_lock
,
15378 doc
: /* Non-nil if Caps Lock should act normally.
15379 Set to nil to see Caps Lock as the key `capslock'. */);
15380 Vw32_enable_caps_lock
= Qt
;
15382 DEFVAR_LISP ("w32-scroll-lock-modifier",
15383 &Vw32_scroll_lock_modifier
,
15384 doc
: /* Modifier to use for the Scroll Lock on state.
15385 The value can be hyper, super, meta, alt, control or shift for the
15386 respective modifier, or nil to see Scroll Lock as the key `scroll'.
15387 Any other value will cause the key to be ignored. */);
15388 Vw32_scroll_lock_modifier
= Qt
;
15390 DEFVAR_LISP ("w32-lwindow-modifier",
15391 &Vw32_lwindow_modifier
,
15392 doc
: /* Modifier to use for the left \"Windows\" key.
15393 The value can be hyper, super, meta, alt, control or shift for the
15394 respective modifier, or nil to appear as the key `lwindow'.
15395 Any other value will cause the key to be ignored. */);
15396 Vw32_lwindow_modifier
= Qnil
;
15398 DEFVAR_LISP ("w32-rwindow-modifier",
15399 &Vw32_rwindow_modifier
,
15400 doc
: /* Modifier to use for the right \"Windows\" key.
15401 The value can be hyper, super, meta, alt, control or shift for the
15402 respective modifier, or nil to appear as the key `rwindow'.
15403 Any other value will cause the key to be ignored. */);
15404 Vw32_rwindow_modifier
= Qnil
;
15406 DEFVAR_LISP ("w32-apps-modifier",
15407 &Vw32_apps_modifier
,
15408 doc
: /* Modifier to use for the \"Apps\" key.
15409 The value can be hyper, super, meta, alt, control or shift for the
15410 respective modifier, or nil to appear as the key `apps'.
15411 Any other value will cause the key to be ignored. */);
15412 Vw32_apps_modifier
= Qnil
;
15414 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts
,
15415 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
15416 w32_enable_synthesized_fonts
= 0;
15418 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
15419 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
15420 Vw32_enable_palette
= Qt
;
15422 DEFVAR_INT ("w32-mouse-button-tolerance",
15423 &Vw32_mouse_button_tolerance
,
15424 doc
: /* Analogue of double click interval for faking middle mouse events.
15425 The value is the minimum time in milliseconds that must elapse between
15426 left/right button down events before they are considered distinct events.
15427 If both mouse buttons are depressed within this interval, a middle mouse
15428 button down event is generated instead. */);
15429 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
15431 DEFVAR_INT ("w32-mouse-move-interval",
15432 &Vw32_mouse_move_interval
,
15433 doc
: /* Minimum interval between mouse move events.
15434 The value is the minimum time in milliseconds that must elapse between
15435 successive mouse move (or scroll bar drag) events before they are
15436 reported as lisp events. */);
15437 XSETINT (Vw32_mouse_move_interval
, 0);
15439 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
15440 &w32_pass_extra_mouse_buttons_to_system
,
15441 doc
: /* Non-nil if the fourth and fifth mouse buttons are passed to Windows.
15442 Recent versions of Windows support mice with up to five buttons.
15443 Since most applications don't support these extra buttons, most mouse
15444 drivers will allow you to map them to functions at the system level.
15445 If this variable is non-nil, Emacs will pass them on, allowing the
15446 system to handle them. */);
15447 w32_pass_extra_mouse_buttons_to_system
= 0;
15449 init_x_parm_symbols ();
15451 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
15452 doc
: /* List of directories to search for window system bitmap files. */);
15453 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
15455 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
15456 doc
: /* The shape of the pointer when over text.
15457 Changing the value does not affect existing frames
15458 unless you set the mouse color. */);
15459 Vx_pointer_shape
= Qnil
;
15461 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
15462 doc
: /* The name Emacs uses to look up resources; for internal use only.
15463 `x-get-resource' uses this as the first component of the instance name
15464 when requesting resource values.
15465 Emacs initially sets `x-resource-name' to the name under which Emacs
15466 was invoked, or to the value specified with the `-name' or `-rn'
15467 switches, if present. */);
15468 Vx_resource_name
= Qnil
;
15470 Vx_nontext_pointer_shape
= Qnil
;
15472 Vx_mode_pointer_shape
= Qnil
;
15474 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
15475 doc
: /* The shape of the pointer when Emacs is busy.
15476 This variable takes effect when you create a new frame
15477 or when you set the mouse color. */);
15478 Vx_hourglass_pointer_shape
= Qnil
;
15480 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
15481 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
15482 display_hourglass_p
= 1;
15484 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
15485 doc
: /* *Seconds to wait before displaying an hourglass pointer.
15486 Value must be an integer or float. */);
15487 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
15489 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
15490 &Vx_sensitive_text_pointer_shape
,
15491 doc
: /* The shape of the pointer when over mouse-sensitive text.
15492 This variable takes effect when you create a new frame
15493 or when you set the mouse color. */);
15494 Vx_sensitive_text_pointer_shape
= Qnil
;
15496 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
15497 &Vx_window_horizontal_drag_shape
,
15498 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
15499 This variable takes effect when you create a new frame
15500 or when you set the mouse color. */);
15501 Vx_window_horizontal_drag_shape
= Qnil
;
15503 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
15504 doc
: /* A string indicating the foreground color of the cursor box. */);
15505 Vx_cursor_fore_pixel
= Qnil
;
15507 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
15508 doc
: /* Maximum size for tooltips.
15509 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
15510 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
15512 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
15513 doc
: /* Non-nil if no window manager is in use.
15514 Emacs doesn't try to figure this out; this is always nil
15515 unless you set it to something else. */);
15516 /* We don't have any way to find this out, so set it to nil
15517 and maybe the user would like to set it to t. */
15518 Vx_no_window_manager
= Qnil
;
15520 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
15521 &Vx_pixel_size_width_font_regexp
,
15522 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
15524 Since Emacs gets width of a font matching with this regexp from
15525 PIXEL_SIZE field of the name, font finding mechanism gets faster for
15526 such a font. This is especially effective for such large fonts as
15527 Chinese, Japanese, and Korean. */);
15528 Vx_pixel_size_width_font_regexp
= Qnil
;
15530 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
15531 doc
: /* Time after which cached images are removed from the cache.
15532 When an image has not been displayed this many seconds, remove it
15533 from the image cache. Value must be an integer or nil with nil
15534 meaning don't clear the cache. */);
15535 Vimage_cache_eviction_delay
= make_number (30 * 60);
15537 DEFVAR_LISP ("w32-bdf-filename-alist",
15538 &Vw32_bdf_filename_alist
,
15539 doc
: /* List of bdf fonts and their corresponding filenames. */);
15540 Vw32_bdf_filename_alist
= Qnil
;
15542 DEFVAR_BOOL ("w32-strict-fontnames",
15543 &w32_strict_fontnames
,
15544 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
15545 Default is nil, which allows old fontnames that are not XLFD compliant,
15546 and allows third-party CJK display to work by specifying false charset
15547 fields to trick Emacs into translating to Big5, SJIS etc.
15548 Setting this to t will prevent wrong fonts being selected when
15549 fontsets are automatically created. */);
15550 w32_strict_fontnames
= 0;
15552 DEFVAR_BOOL ("w32-strict-painting",
15553 &w32_strict_painting
,
15554 doc
: /* Non-nil means use strict rules for repainting frames.
15555 Set this to nil to get the old behaviour for repainting; this should
15556 only be necessary if the default setting causes problems. */);
15557 w32_strict_painting
= 1;
15559 DEFVAR_LISP ("w32-charset-info-alist",
15560 &Vw32_charset_info_alist
,
15561 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
15562 Each entry should be of the form:
15564 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
15566 where CHARSET_NAME is a string used in font names to identify the charset,
15567 WINDOWS_CHARSET is a symbol that can be one of:
15568 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
15569 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
15570 w32-charset-chinesebig5,
15571 #ifdef JOHAB_CHARSET
15572 w32-charset-johab, w32-charset-hebrew,
15573 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
15574 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
15575 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
15577 #ifdef UNICODE_CHARSET
15578 w32-charset-unicode,
15580 or w32-charset-oem.
15581 CODEPAGE should be an integer specifying the codepage that should be used
15582 to display the character set, t to do no translation and output as Unicode,
15583 or nil to do no translation and output as 8 bit (or multibyte on far-east
15584 versions of Windows) characters. */);
15585 Vw32_charset_info_alist
= Qnil
;
15587 staticpro (&Qw32_charset_ansi
);
15588 Qw32_charset_ansi
= intern ("w32-charset-ansi");
15589 staticpro (&Qw32_charset_symbol
);
15590 Qw32_charset_symbol
= intern ("w32-charset-symbol");
15591 staticpro (&Qw32_charset_shiftjis
);
15592 Qw32_charset_shiftjis
= intern ("w32-charset-shiftjis");
15593 staticpro (&Qw32_charset_hangeul
);
15594 Qw32_charset_hangeul
= intern ("w32-charset-hangeul");
15595 staticpro (&Qw32_charset_chinesebig5
);
15596 Qw32_charset_chinesebig5
= intern ("w32-charset-chinesebig5");
15597 staticpro (&Qw32_charset_gb2312
);
15598 Qw32_charset_gb2312
= intern ("w32-charset-gb2312");
15599 staticpro (&Qw32_charset_oem
);
15600 Qw32_charset_oem
= intern ("w32-charset-oem");
15602 #ifdef JOHAB_CHARSET
15604 static int w32_extra_charsets_defined
= 1;
15605 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
15606 doc
: /* Internal variable. */);
15608 staticpro (&Qw32_charset_johab
);
15609 Qw32_charset_johab
= intern ("w32-charset-johab");
15610 staticpro (&Qw32_charset_easteurope
);
15611 Qw32_charset_easteurope
= intern ("w32-charset-easteurope");
15612 staticpro (&Qw32_charset_turkish
);
15613 Qw32_charset_turkish
= intern ("w32-charset-turkish");
15614 staticpro (&Qw32_charset_baltic
);
15615 Qw32_charset_baltic
= intern ("w32-charset-baltic");
15616 staticpro (&Qw32_charset_russian
);
15617 Qw32_charset_russian
= intern ("w32-charset-russian");
15618 staticpro (&Qw32_charset_arabic
);
15619 Qw32_charset_arabic
= intern ("w32-charset-arabic");
15620 staticpro (&Qw32_charset_greek
);
15621 Qw32_charset_greek
= intern ("w32-charset-greek");
15622 staticpro (&Qw32_charset_hebrew
);
15623 Qw32_charset_hebrew
= intern ("w32-charset-hebrew");
15624 staticpro (&Qw32_charset_vietnamese
);
15625 Qw32_charset_vietnamese
= intern ("w32-charset-vietnamese");
15626 staticpro (&Qw32_charset_thai
);
15627 Qw32_charset_thai
= intern ("w32-charset-thai");
15628 staticpro (&Qw32_charset_mac
);
15629 Qw32_charset_mac
= intern ("w32-charset-mac");
15633 #ifdef UNICODE_CHARSET
15635 static int w32_unicode_charset_defined
= 1;
15636 DEFVAR_BOOL ("w32-unicode-charset-defined",
15637 &w32_unicode_charset_defined
,
15638 doc
: /* Internal variable. */);
15640 staticpro (&Qw32_charset_unicode
);
15641 Qw32_charset_unicode
= intern ("w32-charset-unicode");
15644 defsubr (&Sx_get_resource
);
15645 #if 0 /* TODO: Port to W32 */
15646 defsubr (&Sx_change_window_property
);
15647 defsubr (&Sx_delete_window_property
);
15648 defsubr (&Sx_window_property
);
15650 defsubr (&Sxw_display_color_p
);
15651 defsubr (&Sx_display_grayscale_p
);
15652 defsubr (&Sxw_color_defined_p
);
15653 defsubr (&Sxw_color_values
);
15654 defsubr (&Sx_server_max_request_size
);
15655 defsubr (&Sx_server_vendor
);
15656 defsubr (&Sx_server_version
);
15657 defsubr (&Sx_display_pixel_width
);
15658 defsubr (&Sx_display_pixel_height
);
15659 defsubr (&Sx_display_mm_width
);
15660 defsubr (&Sx_display_mm_height
);
15661 defsubr (&Sx_display_screens
);
15662 defsubr (&Sx_display_planes
);
15663 defsubr (&Sx_display_color_cells
);
15664 defsubr (&Sx_display_visual_class
);
15665 defsubr (&Sx_display_backing_store
);
15666 defsubr (&Sx_display_save_under
);
15667 defsubr (&Sx_parse_geometry
);
15668 defsubr (&Sx_create_frame
);
15669 defsubr (&Sx_open_connection
);
15670 defsubr (&Sx_close_connection
);
15671 defsubr (&Sx_display_list
);
15672 defsubr (&Sx_synchronize
);
15674 /* W32 specific functions */
15676 defsubr (&Sw32_focus_frame
);
15677 defsubr (&Sw32_select_font
);
15678 defsubr (&Sw32_define_rgb_color
);
15679 defsubr (&Sw32_default_color_map
);
15680 defsubr (&Sw32_load_color_file
);
15681 defsubr (&Sw32_send_sys_command
);
15682 defsubr (&Sw32_shell_execute
);
15683 defsubr (&Sw32_register_hot_key
);
15684 defsubr (&Sw32_unregister_hot_key
);
15685 defsubr (&Sw32_registered_hot_keys
);
15686 defsubr (&Sw32_reconstruct_hot_key
);
15687 defsubr (&Sw32_toggle_lock_key
);
15688 defsubr (&Sw32_find_bdf_fonts
);
15690 defsubr (&Sfile_system_info
);
15692 /* Setting callback functions for fontset handler. */
15693 get_font_info_func
= w32_get_font_info
;
15695 #if 0 /* This function pointer doesn't seem to be used anywhere.
15696 And the pointer assigned has the wrong type, anyway. */
15697 list_fonts_func
= w32_list_fonts
;
15700 load_font_func
= w32_load_font
;
15701 find_ccl_program_func
= w32_find_ccl_program
;
15702 query_font_func
= w32_query_font
;
15703 set_frame_fontset_func
= x_set_font
;
15704 check_window_system_func
= check_w32
;
15707 Qxbm
= intern ("xbm");
15709 QCconversion
= intern (":conversion");
15710 staticpro (&QCconversion
);
15711 QCheuristic_mask
= intern (":heuristic-mask");
15712 staticpro (&QCheuristic_mask
);
15713 QCcolor_symbols
= intern (":color-symbols");
15714 staticpro (&QCcolor_symbols
);
15715 QCascent
= intern (":ascent");
15716 staticpro (&QCascent
);
15717 QCmargin
= intern (":margin");
15718 staticpro (&QCmargin
);
15719 QCrelief
= intern (":relief");
15720 staticpro (&QCrelief
);
15721 Qpostscript
= intern ("postscript");
15722 staticpro (&Qpostscript
);
15723 QCloader
= intern (":loader");
15724 staticpro (&QCloader
);
15725 QCbounding_box
= intern (":bounding-box");
15726 staticpro (&QCbounding_box
);
15727 QCpt_width
= intern (":pt-width");
15728 staticpro (&QCpt_width
);
15729 QCpt_height
= intern (":pt-height");
15730 staticpro (&QCpt_height
);
15731 QCindex
= intern (":index");
15732 staticpro (&QCindex
);
15733 Qpbm
= intern ("pbm");
15737 Qxpm
= intern ("xpm");
15742 Qjpeg
= intern ("jpeg");
15743 staticpro (&Qjpeg
);
15747 Qtiff
= intern ("tiff");
15748 staticpro (&Qtiff
);
15752 Qgif
= intern ("gif");
15757 Qpng
= intern ("png");
15761 defsubr (&Sclear_image_cache
);
15762 defsubr (&Simage_size
);
15763 defsubr (&Simage_mask_p
);
15766 defsubr (&Simagep
);
15767 defsubr (&Slookup_image
);
15770 hourglass_atimer
= NULL
;
15771 hourglass_shown_p
= 0;
15772 defsubr (&Sx_show_tip
);
15773 defsubr (&Sx_hide_tip
);
15775 staticpro (&tip_timer
);
15777 staticpro (&tip_frame
);
15779 last_show_tip_args
= Qnil
;
15780 staticpro (&last_show_tip_args
);
15782 defsubr (&Sx_file_dialog
);
15787 globals_of_w32fns is used to initialize those global variables that
15788 must always be initialized on startup even when the global variable
15789 initialized is non zero (see the function main in emacs.c).
15790 globals_of_w32fns is called from syms_of_w32fns when the global
15791 variable initialized is 0 and directly from main when initialized
15794 void globals_of_w32fns ()
15796 HMODULE user32_lib
= GetModuleHandle ("user32.dll");
15798 TrackMouseEvent not available in all versions of Windows, so must load
15799 it dynamically. Do it once, here, instead of every time it is used.
15801 track_mouse_event_fn
= (TrackMouseEvent_Proc
) GetProcAddress (user32_lib
, "TrackMouseEvent");
15804 /* Initialize image types. Based on which libraries are available. */
15806 init_external_image_libraries ()
15811 if ((library
= LoadLibrary ("libXpm.dll")))
15813 if (init_xpm_functions (library
))
15814 define_image_type (&xpm_type
);
15820 /* Try loading jpeg library under probable names. */
15821 if ((library
= LoadLibrary ("libjpeg.dll"))
15822 || (library
= LoadLibrary ("jpeg-62.dll"))
15823 || (library
= LoadLibrary ("jpeg.dll")))
15825 if (init_jpeg_functions (library
))
15826 define_image_type (&jpeg_type
);
15831 if (library
= LoadLibrary ("libtiff.dll"))
15833 if (init_tiff_functions (library
))
15834 define_image_type (&tiff_type
);
15839 if (library
= LoadLibrary ("libungif.dll"))
15841 if (init_gif_functions (library
))
15842 define_image_type (&gif_type
);
15847 /* Ensure zlib is loaded. Try debug version first. */
15848 if (!LoadLibrary ("zlibd.dll"))
15849 LoadLibrary ("zlib.dll");
15851 /* Try loading libpng under probable names. */
15852 if ((library
= LoadLibrary ("libpng13d.dll"))
15853 || (library
= LoadLibrary ("libpng13.dll"))
15854 || (library
= LoadLibrary ("libpng12d.dll"))
15855 || (library
= LoadLibrary ("libpng12.dll"))
15856 || (library
= LoadLibrary ("libpng.dll")))
15858 if (init_png_functions (library
))
15859 define_image_type (&png_type
);
15867 image_types
= NULL
;
15868 Vimage_types
= Qnil
;
15870 define_image_type (&pbm_type
);
15871 define_image_type (&xbm_type
);
15873 #if 0 /* TODO : Ghostscript support for W32 */
15874 define_image_type (&gs_type
);
15877 /* Image types that rely on external libraries are loaded dynamically
15878 if the library is available. */
15879 init_external_image_libraries ();
15888 button
= MessageBox (NULL
,
15889 "A fatal error has occurred!\n\n"
15890 "Select Abort to exit, Retry to debug, Ignore to continue",
15891 "Emacs Abort Dialog",
15892 MB_ICONEXCLAMATION
| MB_TASKMODAL
15893 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
15908 /* For convenience when debugging. */
15912 return GetLastError ();