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 (Qnil
,
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 (sf
, name_key
, class_key
);
3110 /* Types we might convert a resource string into. */
3120 /* Return the value of parameter PARAM.
3122 First search ALIST, then Vdefault_frame_alist, then the X defaults
3123 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3125 Convert the resource to the type specified by desired_type.
3127 If no default is specified, return Qunbound. If you call
3128 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
3129 and don't let it get stored in any Lisp-visible variables! */
3132 w32_get_arg (alist
, param
, attribute
, class, type
)
3133 Lisp_Object alist
, param
;
3136 enum resource_types type
;
3138 register Lisp_Object tem
;
3140 tem
= Fassq (param
, alist
);
3142 tem
= Fassq (param
, Vdefault_frame_alist
);
3148 tem
= Fx_get_resource (build_string (attribute
),
3149 build_string (class),
3157 case RES_TYPE_NUMBER
:
3158 return make_number (atoi (SDATA (tem
)));
3160 case RES_TYPE_FLOAT
:
3161 return make_float (atof (SDATA (tem
)));
3163 case RES_TYPE_BOOLEAN
:
3164 tem
= Fdowncase (tem
);
3165 if (!strcmp (SDATA (tem
), "on")
3166 || !strcmp (SDATA (tem
), "true"))
3171 case RES_TYPE_STRING
:
3174 case RES_TYPE_SYMBOL
:
3175 /* As a special case, we map the values `true' and `on'
3176 to Qt, and `false' and `off' to Qnil. */
3179 lower
= Fdowncase (tem
);
3180 if (!strcmp (SDATA (lower
), "on")
3181 || !strcmp (SDATA (lower
), "true"))
3183 else if (!strcmp (SDATA (lower
), "off")
3184 || !strcmp (SDATA (lower
), "false"))
3187 return Fintern (tem
, Qnil
);
3200 /* Record in frame F the specified or default value according to ALIST
3201 of the parameter named PROP (a Lisp symbol).
3202 If no value is specified for PROP, look for an X default for XPROP
3203 on the frame named NAME.
3204 If that is not found either, use the value DEFLT. */
3207 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3214 enum resource_types type
;
3218 tem
= w32_get_arg (alist
, prop
, xprop
, xclass
, type
);
3219 if (EQ (tem
, Qunbound
))
3221 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3225 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3226 doc
: /* Parse an X-style geometry string STRING.
3227 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3228 The properties returned may include `top', `left', `height', and `width'.
3229 The value of `left' or `top' may be an integer,
3230 or a list (+ N) meaning N pixels relative to top/left corner,
3231 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3236 unsigned int width
, height
;
3239 CHECK_STRING (string
);
3241 geometry
= XParseGeometry ((char *) SDATA (string
),
3242 &x
, &y
, &width
, &height
);
3245 if (geometry
& XValue
)
3247 Lisp_Object element
;
3249 if (x
>= 0 && (geometry
& XNegative
))
3250 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3251 else if (x
< 0 && ! (geometry
& XNegative
))
3252 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3254 element
= Fcons (Qleft
, make_number (x
));
3255 result
= Fcons (element
, result
);
3258 if (geometry
& YValue
)
3260 Lisp_Object element
;
3262 if (y
>= 0 && (geometry
& YNegative
))
3263 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3264 else if (y
< 0 && ! (geometry
& YNegative
))
3265 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3267 element
= Fcons (Qtop
, make_number (y
));
3268 result
= Fcons (element
, result
);
3271 if (geometry
& WidthValue
)
3272 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3273 if (geometry
& HeightValue
)
3274 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3279 /* Calculate the desired size and position of this window,
3280 and return the flags saying which aspects were specified.
3282 This function does not make the coordinates positive. */
3284 #define DEFAULT_ROWS 40
3285 #define DEFAULT_COLS 80
3288 x_figure_window_size (f
, parms
)
3292 register Lisp_Object tem0
, tem1
, tem2
;
3293 long window_prompting
= 0;
3295 /* Default values if we fall through.
3296 Actually, if that happens we should get
3297 window manager prompting. */
3298 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3299 f
->height
= DEFAULT_ROWS
;
3300 /* Window managers expect that if program-specified
3301 positions are not (0,0), they're intentional, not defaults. */
3302 f
->output_data
.w32
->top_pos
= 0;
3303 f
->output_data
.w32
->left_pos
= 0;
3305 /* Ensure that old new_width and new_height will not override the
3307 FRAME_NEW_WIDTH (f
) = 0;
3308 FRAME_NEW_HEIGHT (f
) = 0;
3310 tem0
= w32_get_arg (parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3311 tem1
= w32_get_arg (parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3312 tem2
= w32_get_arg (parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3313 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3315 if (!EQ (tem0
, Qunbound
))
3317 CHECK_NUMBER (tem0
);
3318 f
->height
= XINT (tem0
);
3320 if (!EQ (tem1
, Qunbound
))
3322 CHECK_NUMBER (tem1
);
3323 SET_FRAME_WIDTH (f
, XINT (tem1
));
3325 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3326 window_prompting
|= USSize
;
3328 window_prompting
|= PSize
;
3331 f
->output_data
.w32
->vertical_scroll_bar_extra
3332 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3334 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
3335 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
3336 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
3338 x_compute_fringe_widths (f
, 0);
3340 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3341 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3343 tem0
= w32_get_arg (parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3344 tem1
= w32_get_arg (parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3345 tem2
= w32_get_arg (parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3346 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3348 if (EQ (tem0
, Qminus
))
3350 f
->output_data
.w32
->top_pos
= 0;
3351 window_prompting
|= YNegative
;
3353 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3354 && CONSP (XCDR (tem0
))
3355 && INTEGERP (XCAR (XCDR (tem0
))))
3357 f
->output_data
.w32
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3358 window_prompting
|= YNegative
;
3360 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3361 && CONSP (XCDR (tem0
))
3362 && INTEGERP (XCAR (XCDR (tem0
))))
3364 f
->output_data
.w32
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3366 else if (EQ (tem0
, Qunbound
))
3367 f
->output_data
.w32
->top_pos
= 0;
3370 CHECK_NUMBER (tem0
);
3371 f
->output_data
.w32
->top_pos
= XINT (tem0
);
3372 if (f
->output_data
.w32
->top_pos
< 0)
3373 window_prompting
|= YNegative
;
3376 if (EQ (tem1
, Qminus
))
3378 f
->output_data
.w32
->left_pos
= 0;
3379 window_prompting
|= XNegative
;
3381 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3382 && CONSP (XCDR (tem1
))
3383 && INTEGERP (XCAR (XCDR (tem1
))))
3385 f
->output_data
.w32
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3386 window_prompting
|= XNegative
;
3388 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3389 && CONSP (XCDR (tem1
))
3390 && INTEGERP (XCAR (XCDR (tem1
))))
3392 f
->output_data
.w32
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3394 else if (EQ (tem1
, Qunbound
))
3395 f
->output_data
.w32
->left_pos
= 0;
3398 CHECK_NUMBER (tem1
);
3399 f
->output_data
.w32
->left_pos
= XINT (tem1
);
3400 if (f
->output_data
.w32
->left_pos
< 0)
3401 window_prompting
|= XNegative
;
3404 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3405 window_prompting
|= USPosition
;
3407 window_prompting
|= PPosition
;
3410 if (f
->output_data
.w32
->want_fullscreen
!= FULLSCREEN_NONE
)
3415 /* It takes both for some WM:s to place it where we want */
3416 window_prompting
= USPosition
| PPosition
;
3417 x_fullscreen_adjust (f
, &width
, &height
, &top
, &left
);
3420 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3421 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3422 f
->output_data
.w32
->left_pos
= left
;
3423 f
->output_data
.w32
->top_pos
= top
;
3426 return window_prompting
;
3431 w32_load_cursor (LPCTSTR name
)
3433 /* Try first to load cursor from application resource. */
3434 Cursor cursor
= LoadImage ((HINSTANCE
) GetModuleHandle(NULL
),
3435 name
, IMAGE_CURSOR
, 0, 0,
3436 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
3439 /* Then try to load a shared predefined cursor. */
3440 cursor
= LoadImage (NULL
, name
, IMAGE_CURSOR
, 0, 0,
3441 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
3446 extern LRESULT CALLBACK
w32_wnd_proc ();
3449 w32_init_class (hinst
)
3454 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
3455 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
3457 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
3458 wc
.hInstance
= hinst
;
3459 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
3460 wc
.hCursor
= w32_load_cursor (IDC_ARROW
);
3461 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
3462 wc
.lpszMenuName
= NULL
;
3463 wc
.lpszClassName
= EMACS_CLASS
;
3465 return (RegisterClass (&wc
));
3469 w32_createscrollbar (f
, bar
)
3471 struct scroll_bar
* bar
;
3473 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
3474 /* Position and size of scroll bar. */
3475 XINT(bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
3477 XINT(bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
3479 FRAME_W32_WINDOW (f
),
3486 w32_createwindow (f
)
3492 rect
.left
= rect
.top
= 0;
3493 rect
.right
= PIXEL_WIDTH (f
);
3494 rect
.bottom
= PIXEL_HEIGHT (f
);
3496 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
3497 FRAME_EXTERNAL_MENU_BAR (f
));
3499 /* Do first time app init */
3503 w32_init_class (hinst
);
3506 FRAME_W32_WINDOW (f
) = hwnd
3507 = CreateWindow (EMACS_CLASS
,
3509 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
3510 f
->output_data
.w32
->left_pos
,
3511 f
->output_data
.w32
->top_pos
,
3512 rect
.right
- rect
.left
,
3513 rect
.bottom
- rect
.top
,
3521 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
3522 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
3523 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
3524 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
3525 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
3527 /* Enable drag-n-drop. */
3528 DragAcceptFiles (hwnd
, TRUE
);
3530 /* Do this to discard the default setting specified by our parent. */
3531 ShowWindow (hwnd
, SW_HIDE
);
3536 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
3543 wmsg
->msg
.hwnd
= hwnd
;
3544 wmsg
->msg
.message
= msg
;
3545 wmsg
->msg
.wParam
= wParam
;
3546 wmsg
->msg
.lParam
= lParam
;
3547 wmsg
->msg
.time
= GetMessageTime ();
3552 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
3553 between left and right keys as advertised. We test for this
3554 support dynamically, and set a flag when the support is absent. If
3555 absent, we keep track of the left and right control and alt keys
3556 ourselves. This is particularly necessary on keyboards that rely
3557 upon the AltGr key, which is represented as having the left control
3558 and right alt keys pressed. For these keyboards, we need to know
3559 when the left alt key has been pressed in addition to the AltGr key
3560 so that we can properly support M-AltGr-key sequences (such as M-@
3561 on Swedish keyboards). */
3563 #define EMACS_LCONTROL 0
3564 #define EMACS_RCONTROL 1
3565 #define EMACS_LMENU 2
3566 #define EMACS_RMENU 3
3568 static int modifiers
[4];
3569 static int modifiers_recorded
;
3570 static int modifier_key_support_tested
;
3573 test_modifier_support (unsigned int wparam
)
3577 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3579 if (wparam
== VK_CONTROL
)
3589 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
3590 modifiers_recorded
= 1;
3592 modifiers_recorded
= 0;
3593 modifier_key_support_tested
= 1;
3597 record_keydown (unsigned int wparam
, unsigned int lparam
)
3601 if (!modifier_key_support_tested
)
3602 test_modifier_support (wparam
);
3604 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3607 if (wparam
== VK_CONTROL
)
3608 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3610 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3616 record_keyup (unsigned int wparam
, unsigned int lparam
)
3620 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3623 if (wparam
== VK_CONTROL
)
3624 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3626 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3631 /* Emacs can lose focus while a modifier key has been pressed. When
3632 it regains focus, be conservative and clear all modifiers since
3633 we cannot reconstruct the left and right modifier state. */
3639 if (GetFocus () == NULL
)
3640 /* Emacs doesn't have keyboard focus. Do nothing. */
3643 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3644 alt
= GetAsyncKeyState (VK_MENU
);
3646 if (!(ctrl
& 0x08000))
3647 /* Clear any recorded control modifier state. */
3648 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3650 if (!(alt
& 0x08000))
3651 /* Clear any recorded alt modifier state. */
3652 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3654 /* Update the state of all modifier keys, because modifiers used in
3655 hot-key combinations can get stuck on if Emacs loses focus as a
3656 result of a hot-key being pressed. */
3660 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3662 GetKeyboardState (keystate
);
3663 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
3664 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
3665 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
3666 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
3667 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
3668 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
3669 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
3670 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
3671 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
3672 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
3673 SetKeyboardState (keystate
);
3677 /* Synchronize modifier state with what is reported with the current
3678 keystroke. Even if we cannot distinguish between left and right
3679 modifier keys, we know that, if no modifiers are set, then neither
3680 the left or right modifier should be set. */
3684 if (!modifiers_recorded
)
3687 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3688 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3690 if (!(GetKeyState (VK_MENU
) & 0x8000))
3691 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3695 modifier_set (int vkey
)
3697 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
3698 return (GetKeyState (vkey
) & 0x1);
3699 if (!modifiers_recorded
)
3700 return (GetKeyState (vkey
) & 0x8000);
3705 return modifiers
[EMACS_LCONTROL
];
3707 return modifiers
[EMACS_RCONTROL
];
3709 return modifiers
[EMACS_LMENU
];
3711 return modifiers
[EMACS_RMENU
];
3713 return (GetKeyState (vkey
) & 0x8000);
3716 /* Convert between the modifier bits W32 uses and the modifier bits
3720 w32_key_to_modifier (int key
)
3722 Lisp_Object key_mapping
;
3727 key_mapping
= Vw32_lwindow_modifier
;
3730 key_mapping
= Vw32_rwindow_modifier
;
3733 key_mapping
= Vw32_apps_modifier
;
3736 key_mapping
= Vw32_scroll_lock_modifier
;
3742 /* NB. This code runs in the input thread, asychronously to the lisp
3743 thread, so we must be careful to ensure access to lisp data is
3744 thread-safe. The following code is safe because the modifier
3745 variable values are updated atomically from lisp and symbols are
3746 not relocated by GC. Also, we don't have to worry about seeing GC
3748 if (EQ (key_mapping
, Qhyper
))
3749 return hyper_modifier
;
3750 if (EQ (key_mapping
, Qsuper
))
3751 return super_modifier
;
3752 if (EQ (key_mapping
, Qmeta
))
3753 return meta_modifier
;
3754 if (EQ (key_mapping
, Qalt
))
3755 return alt_modifier
;
3756 if (EQ (key_mapping
, Qctrl
))
3757 return ctrl_modifier
;
3758 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
3759 return ctrl_modifier
;
3760 if (EQ (key_mapping
, Qshift
))
3761 return shift_modifier
;
3763 /* Don't generate any modifier if not explicitly requested. */
3768 w32_get_modifiers ()
3770 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
3771 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
3772 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
3773 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
3774 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
3775 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
3776 (modifier_set (VK_MENU
) ?
3777 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
3780 /* We map the VK_* modifiers into console modifier constants
3781 so that we can use the same routines to handle both console
3782 and window input. */
3785 construct_console_modifiers ()
3790 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3791 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3792 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
3793 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
3794 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3795 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3796 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3797 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3798 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
3799 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
3800 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
3806 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
3810 /* Convert to emacs modifiers. */
3811 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
3817 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
3819 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
3822 if (virt_key
== VK_RETURN
)
3823 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3825 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
3826 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
3828 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
3829 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
3831 if (virt_key
== VK_CLEAR
)
3832 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
3837 /* List of special key combinations which w32 would normally capture,
3838 but emacs should grab instead. Not directly visible to lisp, to
3839 simplify synchronization. Each item is an integer encoding a virtual
3840 key code and modifier combination to capture. */
3841 Lisp_Object w32_grabbed_keys
;
3843 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3844 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3845 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3846 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3848 /* Register hot-keys for reserved key combinations when Emacs has
3849 keyboard focus, since this is the only way Emacs can receive key
3850 combinations like Alt-Tab which are used by the system. */
3853 register_hot_keys (hwnd
)
3856 Lisp_Object keylist
;
3858 /* Use GC_CONSP, since we are called asynchronously. */
3859 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3861 Lisp_Object key
= XCAR (keylist
);
3863 /* Deleted entries get set to nil. */
3864 if (!INTEGERP (key
))
3867 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
3868 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
3873 unregister_hot_keys (hwnd
)
3876 Lisp_Object keylist
;
3878 /* Use GC_CONSP, since we are called asynchronously. */
3879 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3881 Lisp_Object key
= XCAR (keylist
);
3883 if (!INTEGERP (key
))
3886 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
3890 /* Main message dispatch loop. */
3893 w32_msg_pump (deferred_msg
* msg_buf
)
3899 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3901 while (GetMessage (&msg
, NULL
, 0, 0))
3903 if (msg
.hwnd
== NULL
)
3905 switch (msg
.message
)
3908 /* Produced by complete_deferred_msg; just ignore. */
3910 case WM_EMACS_CREATEWINDOW
:
3911 w32_createwindow ((struct frame
*) msg
.wParam
);
3912 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3915 case WM_EMACS_SETLOCALE
:
3916 SetThreadLocale (msg
.wParam
);
3917 /* Reply is not expected. */
3919 case WM_EMACS_SETKEYBOARDLAYOUT
:
3920 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
3921 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3925 case WM_EMACS_REGISTER_HOT_KEY
:
3926 focus_window
= GetFocus ();
3927 if (focus_window
!= NULL
)
3928 RegisterHotKey (focus_window
,
3929 HOTKEY_ID (msg
.wParam
),
3930 HOTKEY_MODIFIERS (msg
.wParam
),
3931 HOTKEY_VK_CODE (msg
.wParam
));
3932 /* Reply is not expected. */
3934 case WM_EMACS_UNREGISTER_HOT_KEY
:
3935 focus_window
= GetFocus ();
3936 if (focus_window
!= NULL
)
3937 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
3938 /* Mark item as erased. NB: this code must be
3939 thread-safe. The next line is okay because the cons
3940 cell is never made into garbage and is not relocated by
3942 XSETCAR ((Lisp_Object
) msg
.lParam
, Qnil
);
3943 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3946 case WM_EMACS_TOGGLE_LOCK_KEY
:
3948 int vk_code
= (int) msg
.wParam
;
3949 int cur_state
= (GetKeyState (vk_code
) & 1);
3950 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
3952 /* NB: This code must be thread-safe. It is safe to
3953 call NILP because symbols are not relocated by GC,
3954 and pointer here is not touched by GC (so the markbit
3955 can't be set). Numbers are safe because they are
3956 immediate values. */
3957 if (NILP (new_state
)
3958 || (NUMBERP (new_state
)
3959 && ((XUINT (new_state
)) & 1) != cur_state
))
3961 one_w32_display_info
.faked_key
= vk_code
;
3963 keybd_event ((BYTE
) vk_code
,
3964 (BYTE
) MapVirtualKey (vk_code
, 0),
3965 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3966 keybd_event ((BYTE
) vk_code
,
3967 (BYTE
) MapVirtualKey (vk_code
, 0),
3968 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3969 keybd_event ((BYTE
) vk_code
,
3970 (BYTE
) MapVirtualKey (vk_code
, 0),
3971 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3972 cur_state
= !cur_state
;
3974 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3980 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3985 DispatchMessage (&msg
);
3988 /* Exit nested loop when our deferred message has completed. */
3989 if (msg_buf
->completed
)
3994 deferred_msg
* deferred_msg_head
;
3996 static deferred_msg
*
3997 find_deferred_msg (HWND hwnd
, UINT msg
)
3999 deferred_msg
* item
;
4001 /* Don't actually need synchronization for read access, since
4002 modification of single pointer is always atomic. */
4003 /* enter_crit (); */
4005 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
4006 if (item
->w32msg
.msg
.hwnd
== hwnd
4007 && item
->w32msg
.msg
.message
== msg
)
4010 /* leave_crit (); */
4016 send_deferred_msg (deferred_msg
* msg_buf
,
4022 /* Only input thread can send deferred messages. */
4023 if (GetCurrentThreadId () != dwWindowsThreadId
)
4026 /* It is an error to send a message that is already deferred. */
4027 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4030 /* Enforced synchronization is not needed because this is the only
4031 function that alters deferred_msg_head, and the following critical
4032 section is guaranteed to only be serially reentered (since only the
4033 input thread can call us). */
4035 /* enter_crit (); */
4037 msg_buf
->completed
= 0;
4038 msg_buf
->next
= deferred_msg_head
;
4039 deferred_msg_head
= msg_buf
;
4040 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
4042 /* leave_crit (); */
4044 /* Start a new nested message loop to process other messages until
4045 this one is completed. */
4046 w32_msg_pump (msg_buf
);
4048 deferred_msg_head
= msg_buf
->next
;
4050 return msg_buf
->result
;
4054 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
4056 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
4058 if (msg_buf
== NULL
)
4059 /* Message may have been cancelled, so don't abort(). */
4062 msg_buf
->result
= result
;
4063 msg_buf
->completed
= 1;
4065 /* Ensure input thread is woken so it notices the completion. */
4066 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
4070 cancel_all_deferred_msgs ()
4072 deferred_msg
* item
;
4074 /* Don't actually need synchronization for read access, since
4075 modification of single pointer is always atomic. */
4076 /* enter_crit (); */
4078 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
4081 item
->completed
= 1;
4084 /* leave_crit (); */
4086 /* Ensure input thread is woken so it notices the completion. */
4087 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
4095 deferred_msg dummy_buf
;
4097 /* Ensure our message queue is created */
4099 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
4101 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
4104 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
4105 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
4106 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
4108 /* This is the inital message loop which should only exit when the
4109 application quits. */
4110 w32_msg_pump (&dummy_buf
);
4116 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
4126 wmsg
.dwModifiers
= modifiers
;
4128 /* Detect quit_char and set quit-flag directly. Note that we
4129 still need to post a message to ensure the main thread will be
4130 woken up if blocked in sys_select(), but we do NOT want to post
4131 the quit_char message itself (because it will usually be as if
4132 the user had typed quit_char twice). Instead, we post a dummy
4133 message that has no particular effect. */
4136 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
4137 c
= make_ctrl_char (c
) & 0377;
4139 || (wmsg
.dwModifiers
== 0 &&
4140 XFASTINT (Vw32_quit_key
) && wParam
== XFASTINT (Vw32_quit_key
)))
4144 /* The choice of message is somewhat arbitrary, as long as
4145 the main thread handler just ignores it. */
4148 /* Interrupt any blocking system calls. */
4151 /* As a safety precaution, forcibly complete any deferred
4152 messages. This is a kludge, but I don't see any particularly
4153 clean way to handle the situation where a deferred message is
4154 "dropped" in the lisp thread, and will thus never be
4155 completed, eg. by the user trying to activate the menubar
4156 when the lisp thread is busy, and then typing C-g when the
4157 menubar doesn't open promptly (with the result that the
4158 menubar never responds at all because the deferred
4159 WM_INITMENU message is never completed). Another problem
4160 situation is when the lisp thread calls SendMessage (to send
4161 a window manager command) when a message has been deferred;
4162 the lisp thread gets blocked indefinitely waiting for the
4163 deferred message to be completed, which itself is waiting for
4164 the lisp thread to respond.
4166 Note that we don't want to block the input thread waiting for
4167 a reponse from the lisp thread (although that would at least
4168 solve the deadlock problem above), because we want to be able
4169 to receive C-g to interrupt the lisp thread. */
4170 cancel_all_deferred_msgs ();
4174 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4177 /* Main window procedure */
4180 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
4187 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
4189 int windows_translate
;
4192 /* Note that it is okay to call x_window_to_frame, even though we are
4193 not running in the main lisp thread, because frame deletion
4194 requires the lisp thread to synchronize with this thread. Thus, if
4195 a frame struct is returned, it can be used without concern that the
4196 lisp thread might make it disappear while we are using it.
4198 NB. Walking the frame list in this thread is safe (as long as
4199 writes of Lisp_Object slots are atomic, which they are on Windows).
4200 Although delete-frame can destructively modify the frame list while
4201 we are walking it, a garbage collection cannot occur until after
4202 delete-frame has synchronized with this thread.
4204 It is also safe to use functions that make GDI calls, such as
4205 w32_clear_rect, because these functions must obtain a DC handle
4206 from the frame struct using get_frame_dc which is thread-aware. */
4211 f
= x_window_to_frame (dpyinfo
, hwnd
);
4214 HDC hdc
= get_frame_dc (f
);
4215 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
4216 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
4217 release_frame_dc (f
, hdc
);
4219 #if defined (W32_DEBUG_DISPLAY)
4220 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4222 wmsg
.rect
.left
, wmsg
.rect
.top
,
4223 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4224 #endif /* W32_DEBUG_DISPLAY */
4227 case WM_PALETTECHANGED
:
4228 /* ignore our own changes */
4229 if ((HWND
)wParam
!= hwnd
)
4231 f
= x_window_to_frame (dpyinfo
, hwnd
);
4233 /* get_frame_dc will realize our palette and force all
4234 frames to be redrawn if needed. */
4235 release_frame_dc (f
, get_frame_dc (f
));
4240 PAINTSTRUCT paintStruct
;
4242 bzero (&update_rect
, sizeof (update_rect
));
4244 f
= x_window_to_frame (dpyinfo
, hwnd
);
4247 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
4251 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4252 fails. Apparently this can happen under some
4254 if (GetUpdateRect (hwnd
, &update_rect
, FALSE
) || !w32_strict_painting
)
4257 BeginPaint (hwnd
, &paintStruct
);
4259 /* The rectangles returned by GetUpdateRect and BeginPaint
4260 do not always match. Play it safe by assuming both areas
4262 UnionRect (&(wmsg
.rect
), &update_rect
, &(paintStruct
.rcPaint
));
4264 #if defined (W32_DEBUG_DISPLAY)
4265 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4267 wmsg
.rect
.left
, wmsg
.rect
.top
,
4268 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4269 DebPrint ((" [update region is %d,%d-%d,%d]\n",
4270 update_rect
.left
, update_rect
.top
,
4271 update_rect
.right
, update_rect
.bottom
));
4273 EndPaint (hwnd
, &paintStruct
);
4276 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4281 /* If GetUpdateRect returns 0 (meaning there is no update
4282 region), assume the whole window needs to be repainted. */
4283 GetClientRect(hwnd
, &wmsg
.rect
);
4284 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4288 case WM_INPUTLANGCHANGE
:
4289 /* Inform lisp thread of keyboard layout changes. */
4290 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4292 /* Clear dead keys in the keyboard state; for simplicity only
4293 preserve modifier key states. */
4298 GetKeyboardState (keystate
);
4299 for (i
= 0; i
< 256; i
++)
4316 SetKeyboardState (keystate
);
4321 /* Synchronize hot keys with normal input. */
4322 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
4327 record_keyup (wParam
, lParam
);
4332 /* Ignore keystrokes we fake ourself; see below. */
4333 if (dpyinfo
->faked_key
== wParam
)
4335 dpyinfo
->faked_key
= 0;
4336 /* Make sure TranslateMessage sees them though (as long as
4337 they don't produce WM_CHAR messages). This ensures that
4338 indicator lights are toggled promptly on Windows 9x, for
4340 if (lispy_function_keys
[wParam
] != 0)
4342 windows_translate
= 1;
4348 /* Synchronize modifiers with current keystroke. */
4350 record_keydown (wParam
, lParam
);
4351 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
4353 windows_translate
= 0;
4358 if (NILP (Vw32_pass_lwindow_to_system
))
4360 /* Prevent system from acting on keyup (which opens the
4361 Start menu if no other key was pressed) by simulating a
4362 press of Space which we will ignore. */
4363 if (GetAsyncKeyState (wParam
) & 1)
4365 if (NUMBERP (Vw32_phantom_key_code
))
4366 key
= XUINT (Vw32_phantom_key_code
) & 255;
4369 dpyinfo
->faked_key
= key
;
4370 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4373 if (!NILP (Vw32_lwindow_modifier
))
4377 if (NILP (Vw32_pass_rwindow_to_system
))
4379 if (GetAsyncKeyState (wParam
) & 1)
4381 if (NUMBERP (Vw32_phantom_key_code
))
4382 key
= XUINT (Vw32_phantom_key_code
) & 255;
4385 dpyinfo
->faked_key
= key
;
4386 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4389 if (!NILP (Vw32_rwindow_modifier
))
4393 if (!NILP (Vw32_apps_modifier
))
4397 if (NILP (Vw32_pass_alt_to_system
))
4398 /* Prevent DefWindowProc from activating the menu bar if an
4399 Alt key is pressed and released by itself. */
4401 windows_translate
= 1;
4404 /* Decide whether to treat as modifier or function key. */
4405 if (NILP (Vw32_enable_caps_lock
))
4406 goto disable_lock_key
;
4407 windows_translate
= 1;
4410 /* Decide whether to treat as modifier or function key. */
4411 if (NILP (Vw32_enable_num_lock
))
4412 goto disable_lock_key
;
4413 windows_translate
= 1;
4416 /* Decide whether to treat as modifier or function key. */
4417 if (NILP (Vw32_scroll_lock_modifier
))
4418 goto disable_lock_key
;
4419 windows_translate
= 1;
4422 /* Ensure the appropriate lock key state (and indicator light)
4423 remains in the same state. We do this by faking another
4424 press of the relevant key. Apparently, this really is the
4425 only way to toggle the state of the indicator lights. */
4426 dpyinfo
->faked_key
= wParam
;
4427 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4428 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4429 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4430 KEYEVENTF_EXTENDEDKEY
| 0, 0);
4431 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4432 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4433 /* Ensure indicator lights are updated promptly on Windows 9x
4434 (TranslateMessage apparently does this), after forwarding
4436 post_character_message (hwnd
, msg
, wParam
, lParam
,
4437 w32_get_key_modifiers (wParam
, lParam
));
4438 windows_translate
= 1;
4442 case VK_PROCESSKEY
: /* Generated by IME. */
4443 windows_translate
= 1;
4446 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4447 which is confusing for purposes of key binding; convert
4448 VK_CANCEL events into VK_PAUSE events. */
4452 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4453 for purposes of key binding; convert these back into
4454 VK_NUMLOCK events, at least when we want to see NumLock key
4455 presses. (Note that there is never any possibility that
4456 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4457 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
4458 wParam
= VK_NUMLOCK
;
4461 /* If not defined as a function key, change it to a WM_CHAR message. */
4462 if (lispy_function_keys
[wParam
] == 0)
4464 DWORD modifiers
= construct_console_modifiers ();
4466 if (!NILP (Vw32_recognize_altgr
)
4467 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
4469 /* Always let TranslateMessage handle AltGr key chords;
4470 for some reason, ToAscii doesn't always process AltGr
4471 chords correctly. */
4472 windows_translate
= 1;
4474 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
4476 /* Handle key chords including any modifiers other
4477 than shift directly, in order to preserve as much
4478 modifier information as possible. */
4479 if ('A' <= wParam
&& wParam
<= 'Z')
4481 /* Don't translate modified alphabetic keystrokes,
4482 so the user doesn't need to constantly switch
4483 layout to type control or meta keystrokes when
4484 the normal layout translates alphabetic
4485 characters to non-ascii characters. */
4486 if (!modifier_set (VK_SHIFT
))
4487 wParam
+= ('a' - 'A');
4492 /* Try to handle other keystrokes by determining the
4493 base character (ie. translating the base key plus
4497 KEY_EVENT_RECORD key
;
4499 key
.bKeyDown
= TRUE
;
4500 key
.wRepeatCount
= 1;
4501 key
.wVirtualKeyCode
= wParam
;
4502 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
4503 key
.uChar
.AsciiChar
= 0;
4504 key
.dwControlKeyState
= modifiers
;
4506 add
= w32_kbd_patch_key (&key
);
4507 /* 0 means an unrecognised keycode, negative means
4508 dead key. Ignore both. */
4511 /* Forward asciified character sequence. */
4512 post_character_message
4513 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
4514 w32_get_key_modifiers (wParam
, lParam
));
4515 w32_kbd_patch_key (&key
);
4522 /* Let TranslateMessage handle everything else. */
4523 windows_translate
= 1;
4529 if (windows_translate
)
4531 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
4533 windows_msg
.time
= GetMessageTime ();
4534 TranslateMessage (&windows_msg
);
4542 post_character_message (hwnd
, msg
, wParam
, lParam
,
4543 w32_get_key_modifiers (wParam
, lParam
));
4546 /* Simulate middle mouse button events when left and right buttons
4547 are used together, but only if user has two button mouse. */
4548 case WM_LBUTTONDOWN
:
4549 case WM_RBUTTONDOWN
:
4550 if (XINT (Vw32_num_mouse_buttons
) > 2)
4551 goto handle_plain_button
;
4554 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
4555 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
4557 if (button_state
& this)
4560 if (button_state
== 0)
4563 button_state
|= this;
4565 if (button_state
& other
)
4567 if (mouse_button_timer
)
4569 KillTimer (hwnd
, mouse_button_timer
);
4570 mouse_button_timer
= 0;
4572 /* Generate middle mouse event instead. */
4573 msg
= WM_MBUTTONDOWN
;
4574 button_state
|= MMOUSE
;
4576 else if (button_state
& MMOUSE
)
4578 /* Ignore button event if we've already generated a
4579 middle mouse down event. This happens if the
4580 user releases and press one of the two buttons
4581 after we've faked a middle mouse event. */
4586 /* Flush out saved message. */
4587 post_msg (&saved_mouse_button_msg
);
4589 wmsg
.dwModifiers
= w32_get_modifiers ();
4590 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4592 /* Clear message buffer. */
4593 saved_mouse_button_msg
.msg
.hwnd
= 0;
4597 /* Hold onto message for now. */
4598 mouse_button_timer
=
4599 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
4600 XINT (Vw32_mouse_button_tolerance
), NULL
);
4601 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
4602 saved_mouse_button_msg
.msg
.message
= msg
;
4603 saved_mouse_button_msg
.msg
.wParam
= wParam
;
4604 saved_mouse_button_msg
.msg
.lParam
= lParam
;
4605 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
4606 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
4613 if (XINT (Vw32_num_mouse_buttons
) > 2)
4614 goto handle_plain_button
;
4617 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
4618 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
4620 if ((button_state
& this) == 0)
4623 button_state
&= ~this;
4625 if (button_state
& MMOUSE
)
4627 /* Only generate event when second button is released. */
4628 if ((button_state
& other
) == 0)
4631 button_state
&= ~MMOUSE
;
4633 if (button_state
) abort ();
4640 /* Flush out saved message if necessary. */
4641 if (saved_mouse_button_msg
.msg
.hwnd
)
4643 post_msg (&saved_mouse_button_msg
);
4646 wmsg
.dwModifiers
= w32_get_modifiers ();
4647 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4649 /* Always clear message buffer and cancel timer. */
4650 saved_mouse_button_msg
.msg
.hwnd
= 0;
4651 KillTimer (hwnd
, mouse_button_timer
);
4652 mouse_button_timer
= 0;
4654 if (button_state
== 0)
4659 case WM_XBUTTONDOWN
:
4661 if (w32_pass_extra_mouse_buttons_to_system
)
4663 /* else fall through and process them. */
4664 case WM_MBUTTONDOWN
:
4666 handle_plain_button
:
4671 if (parse_button (msg
, HIWORD (wParam
), &button
, &up
))
4673 if (up
) ReleaseCapture ();
4674 else SetCapture (hwnd
);
4675 button
= (button
== 0) ? LMOUSE
:
4676 ((button
== 1) ? MMOUSE
: RMOUSE
);
4678 button_state
&= ~button
;
4680 button_state
|= button
;
4684 wmsg
.dwModifiers
= w32_get_modifiers ();
4685 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4687 /* Need to return true for XBUTTON messages, false for others,
4688 to indicate that we processed the message. */
4689 return (msg
== WM_XBUTTONDOWN
|| msg
== WM_XBUTTONUP
);
4692 /* If the mouse has just moved into the frame, start tracking
4693 it, so we will be notified when it leaves the frame. Mouse
4694 tracking only works under W98 and NT4 and later. On earlier
4695 versions, there is no way of telling when the mouse leaves the
4696 frame, so we just have to put up with help-echo and mouse
4697 highlighting remaining while the frame is not active. */
4698 if (track_mouse_event_fn
&& !track_mouse_window
)
4700 TRACKMOUSEEVENT tme
;
4701 tme
.cbSize
= sizeof (tme
);
4702 tme
.dwFlags
= TME_LEAVE
;
4703 tme
.hwndTrack
= hwnd
;
4705 track_mouse_event_fn (&tme
);
4706 track_mouse_window
= hwnd
;
4709 if (XINT (Vw32_mouse_move_interval
) <= 0
4710 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
4712 wmsg
.dwModifiers
= w32_get_modifiers ();
4713 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4717 /* Hang onto mouse move and scroll messages for a bit, to avoid
4718 sending such events to Emacs faster than it can process them.
4719 If we get more events before the timer from the first message
4720 expires, we just replace the first message. */
4722 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
4724 SetTimer (hwnd
, MOUSE_MOVE_ID
,
4725 XINT (Vw32_mouse_move_interval
), NULL
);
4727 /* Hold onto message for now. */
4728 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
4729 saved_mouse_move_msg
.msg
.message
= msg
;
4730 saved_mouse_move_msg
.msg
.wParam
= wParam
;
4731 saved_mouse_move_msg
.msg
.lParam
= lParam
;
4732 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
4733 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
4738 wmsg
.dwModifiers
= w32_get_modifiers ();
4739 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4743 wmsg
.dwModifiers
= w32_get_modifiers ();
4744 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4748 /* Flush out saved messages if necessary. */
4749 if (wParam
== mouse_button_timer
)
4751 if (saved_mouse_button_msg
.msg
.hwnd
)
4753 post_msg (&saved_mouse_button_msg
);
4754 saved_mouse_button_msg
.msg
.hwnd
= 0;
4756 KillTimer (hwnd
, mouse_button_timer
);
4757 mouse_button_timer
= 0;
4759 else if (wParam
== mouse_move_timer
)
4761 if (saved_mouse_move_msg
.msg
.hwnd
)
4763 post_msg (&saved_mouse_move_msg
);
4764 saved_mouse_move_msg
.msg
.hwnd
= 0;
4766 KillTimer (hwnd
, mouse_move_timer
);
4767 mouse_move_timer
= 0;
4769 else if (wParam
== menu_free_timer
)
4771 KillTimer (hwnd
, menu_free_timer
);
4772 menu_free_timer
= 0;
4773 f
= x_window_to_frame (dpyinfo
, hwnd
);
4774 if (!f
->output_data
.w32
->menu_command_in_progress
)
4776 /* Free memory used by owner-drawn and help-echo strings. */
4777 w32_free_menu_strings (hwnd
);
4778 f
->output_data
.w32
->menubar_active
= 0;
4784 /* Windows doesn't send us focus messages when putting up and
4785 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4786 The only indication we get that something happened is receiving
4787 this message afterwards. So this is a good time to reset our
4788 keyboard modifiers' state. */
4795 /* We must ensure menu bar is fully constructed and up to date
4796 before allowing user interaction with it. To achieve this
4797 we send this message to the lisp thread and wait for a
4798 reply (whose value is not actually needed) to indicate that
4799 the menu bar is now ready for use, so we can now return.
4801 To remain responsive in the meantime, we enter a nested message
4802 loop that can process all other messages.
4804 However, we skip all this if the message results from calling
4805 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4806 thread a message because it is blocked on us at this point. We
4807 set menubar_active before calling TrackPopupMenu to indicate
4808 this (there is no possibility of confusion with real menubar
4811 f
= x_window_to_frame (dpyinfo
, hwnd
);
4813 && (f
->output_data
.w32
->menubar_active
4814 /* We can receive this message even in the absence of a
4815 menubar (ie. when the system menu is activated) - in this
4816 case we do NOT want to forward the message, otherwise it
4817 will cause the menubar to suddenly appear when the user
4818 had requested it to be turned off! */
4819 || f
->output_data
.w32
->menubar_widget
== NULL
))
4823 deferred_msg msg_buf
;
4825 /* Detect if message has already been deferred; in this case
4826 we cannot return any sensible value to ignore this. */
4827 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4830 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
4833 case WM_EXITMENULOOP
:
4834 f
= x_window_to_frame (dpyinfo
, hwnd
);
4836 /* If a menu command is not already in progress, check again
4837 after a short delay, since Windows often (always?) sends the
4838 WM_EXITMENULOOP before the corresponding WM_COMMAND message. */
4839 if (f
&& !f
->output_data
.w32
->menu_command_in_progress
)
4840 menu_free_timer
= SetTimer (hwnd
, MENU_FREE_ID
, MENU_FREE_DELAY
, NULL
);
4844 /* Direct handling of help_echo in menus. Should be safe now
4845 that we generate the help_echo by placing a help event in the
4848 HMENU menu
= (HMENU
) lParam
;
4849 UINT menu_item
= (UINT
) LOWORD (wParam
);
4850 UINT flags
= (UINT
) HIWORD (wParam
);
4852 w32_menu_display_help (hwnd
, menu
, menu_item
, flags
);
4856 case WM_MEASUREITEM
:
4857 f
= x_window_to_frame (dpyinfo
, hwnd
);
4860 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
4862 if (pMis
->CtlType
== ODT_MENU
)
4864 /* Work out dimensions for popup menu titles. */
4865 char * title
= (char *) pMis
->itemData
;
4866 HDC hdc
= GetDC (hwnd
);
4867 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4868 LOGFONT menu_logfont
;
4872 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4873 menu_logfont
.lfWeight
= FW_BOLD
;
4874 menu_font
= CreateFontIndirect (&menu_logfont
);
4875 old_font
= SelectObject (hdc
, menu_font
);
4877 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
4880 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
4881 pMis
->itemWidth
= size
.cx
;
4882 if (pMis
->itemHeight
< size
.cy
)
4883 pMis
->itemHeight
= size
.cy
;
4886 pMis
->itemWidth
= 0;
4888 SelectObject (hdc
, old_font
);
4889 DeleteObject (menu_font
);
4890 ReleaseDC (hwnd
, hdc
);
4897 f
= x_window_to_frame (dpyinfo
, hwnd
);
4900 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
4902 if (pDis
->CtlType
== ODT_MENU
)
4904 /* Draw popup menu title. */
4905 char * title
= (char *) pDis
->itemData
;
4908 HDC hdc
= pDis
->hDC
;
4909 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4910 LOGFONT menu_logfont
;
4913 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4914 menu_logfont
.lfWeight
= FW_BOLD
;
4915 menu_font
= CreateFontIndirect (&menu_logfont
);
4916 old_font
= SelectObject (hdc
, menu_font
);
4918 /* Always draw title as if not selected. */
4921 + GetSystemMetrics (SM_CXMENUCHECK
),
4923 ETO_OPAQUE
, &pDis
->rcItem
,
4924 title
, strlen (title
), NULL
);
4926 SelectObject (hdc
, old_font
);
4927 DeleteObject (menu_font
);
4935 /* Still not right - can't distinguish between clicks in the
4936 client area of the frame from clicks forwarded from the scroll
4937 bars - may have to hook WM_NCHITTEST to remember the mouse
4938 position and then check if it is in the client area ourselves. */
4939 case WM_MOUSEACTIVATE
:
4940 /* Discard the mouse click that activates a frame, allowing the
4941 user to click anywhere without changing point (or worse!).
4942 Don't eat mouse clicks on scrollbars though!! */
4943 if (LOWORD (lParam
) == HTCLIENT
)
4944 return MA_ACTIVATEANDEAT
;
4949 /* No longer tracking mouse. */
4950 track_mouse_window
= NULL
;
4952 case WM_ACTIVATEAPP
:
4954 case WM_WINDOWPOSCHANGED
:
4956 /* Inform lisp thread that a frame might have just been obscured
4957 or exposed, so should recheck visibility of all frames. */
4958 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4962 dpyinfo
->faked_key
= 0;
4964 register_hot_keys (hwnd
);
4967 unregister_hot_keys (hwnd
);
4970 /* Relinquish the system caret. */
4971 if (w32_system_caret_hwnd
)
4973 w32_visible_system_caret_hwnd
= NULL
;
4974 w32_system_caret_hwnd
= NULL
;
4979 f
= x_window_to_frame (dpyinfo
, hwnd
);
4980 if (f
&& HIWORD (wParam
) == 0)
4982 f
->output_data
.w32
->menu_command_in_progress
= 1;
4983 if (menu_free_timer
)
4985 KillTimer (hwnd
, menu_free_timer
);
4986 menu_free_timer
= 0;
4992 wmsg
.dwModifiers
= w32_get_modifiers ();
4993 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4997 wmsg
.dwModifiers
= w32_get_modifiers ();
4998 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
5001 case WM_WINDOWPOSCHANGING
:
5002 /* Don't restrict the sizing of tip frames. */
5003 if (hwnd
== tip_window
)
5007 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
5009 wp
.length
= sizeof (WINDOWPLACEMENT
);
5010 GetWindowPlacement (hwnd
, &wp
);
5012 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
5019 DWORD internal_border
;
5020 DWORD scrollbar_extra
;
5023 wp
.length
= sizeof(wp
);
5024 GetWindowRect (hwnd
, &wr
);
5028 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
5029 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
5030 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
5031 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
5035 memset (&rect
, 0, sizeof (rect
));
5036 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
5037 GetMenu (hwnd
) != NULL
);
5039 /* Force width and height of client area to be exact
5040 multiples of the character cell dimensions. */
5041 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
5042 - 2 * internal_border
- scrollbar_extra
)
5044 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
5045 - 2 * internal_border
)
5050 /* For right/bottom sizing we can just fix the sizes.
5051 However for top/left sizing we will need to fix the X
5052 and Y positions as well. */
5057 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
5058 && (lppos
->flags
& SWP_NOMOVE
) == 0)
5060 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
5067 lppos
->flags
|= SWP_NOMOVE
;
5078 case WM_GETMINMAXINFO
:
5079 /* Hack to correct bug that allows Emacs frames to be resized
5080 below the Minimum Tracking Size. */
5081 ((LPMINMAXINFO
) lParam
)->ptMinTrackSize
.y
++;
5082 /* Hack to allow resizing the Emacs frame above the screen size.
5083 Note that Windows 9x limits coordinates to 16-bits. */
5084 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
5085 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
5089 if (LOWORD (lParam
) == HTCLIENT
)
5094 case WM_EMACS_SETCURSOR
:
5096 Cursor cursor
= (Cursor
) wParam
;
5102 case WM_EMACS_CREATESCROLLBAR
:
5103 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
5104 (struct scroll_bar
*) lParam
);
5106 case WM_EMACS_SHOWWINDOW
:
5107 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
5109 case WM_EMACS_SETFOREGROUND
:
5111 HWND foreground_window
;
5112 DWORD foreground_thread
, retval
;
5114 /* On NT 5.0, and apparently Windows 98, it is necessary to
5115 attach to the thread that currently has focus in order to
5116 pull the focus away from it. */
5117 foreground_window
= GetForegroundWindow ();
5118 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
5119 if (!foreground_window
5120 || foreground_thread
== GetCurrentThreadId ()
5121 || !AttachThreadInput (GetCurrentThreadId (),
5122 foreground_thread
, TRUE
))
5123 foreground_thread
= 0;
5125 retval
= SetForegroundWindow ((HWND
) wParam
);
5127 /* Detach from the previous foreground thread. */
5128 if (foreground_thread
)
5129 AttachThreadInput (GetCurrentThreadId (),
5130 foreground_thread
, FALSE
);
5135 case WM_EMACS_SETWINDOWPOS
:
5137 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
5138 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
5139 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
5142 case WM_EMACS_DESTROYWINDOW
:
5143 DragAcceptFiles ((HWND
) wParam
, FALSE
);
5144 return DestroyWindow ((HWND
) wParam
);
5146 case WM_EMACS_HIDE_CARET
:
5147 return HideCaret (hwnd
);
5149 case WM_EMACS_SHOW_CARET
:
5150 return ShowCaret (hwnd
);
5152 case WM_EMACS_DESTROY_CARET
:
5153 w32_system_caret_hwnd
= NULL
;
5154 w32_visible_system_caret_hwnd
= NULL
;
5155 return DestroyCaret ();
5157 case WM_EMACS_TRACK_CARET
:
5158 /* If there is currently no system caret, create one. */
5159 if (w32_system_caret_hwnd
== NULL
)
5161 /* Use the default caret width, and avoid changing it
5162 unneccesarily, as it confuses screen reader software. */
5163 w32_system_caret_hwnd
= hwnd
;
5164 CreateCaret (hwnd
, NULL
, 0,
5165 w32_system_caret_height
);
5168 if (!SetCaretPos (w32_system_caret_x
, w32_system_caret_y
))
5170 /* Ensure visible caret gets turned on when requested. */
5171 else if (w32_use_visible_system_caret
5172 && w32_visible_system_caret_hwnd
!= hwnd
)
5174 w32_visible_system_caret_hwnd
= hwnd
;
5175 return ShowCaret (hwnd
);
5177 /* Ensure visible caret gets turned off when requested. */
5178 else if (!w32_use_visible_system_caret
5179 && w32_visible_system_caret_hwnd
)
5181 w32_visible_system_caret_hwnd
= NULL
;
5182 return HideCaret (hwnd
);
5187 case WM_EMACS_TRACKPOPUPMENU
:
5192 pos
= (POINT
*)lParam
;
5193 flags
= TPM_CENTERALIGN
;
5194 if (button_state
& LMOUSE
)
5195 flags
|= TPM_LEFTBUTTON
;
5196 else if (button_state
& RMOUSE
)
5197 flags
|= TPM_RIGHTBUTTON
;
5199 /* Remember we did a SetCapture on the initial mouse down event,
5200 so for safety, we make sure the capture is cancelled now. */
5204 /* Use menubar_active to indicate that WM_INITMENU is from
5205 TrackPopupMenu below, and should be ignored. */
5206 f
= x_window_to_frame (dpyinfo
, hwnd
);
5208 f
->output_data
.w32
->menubar_active
= 1;
5210 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
5214 /* Eat any mouse messages during popupmenu */
5215 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
5217 /* Get the menu selection, if any */
5218 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
5220 retval
= LOWORD (amsg
.wParam
);
5236 /* Check for messages registered at runtime. */
5237 if (msg
== msh_mousewheel
)
5239 wmsg
.dwModifiers
= w32_get_modifiers ();
5240 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
5245 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
5249 /* The most common default return code for handled messages is 0. */
5254 my_create_window (f
)
5259 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
5261 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
5265 /* Create a tooltip window. Unlike my_create_window, we do not do this
5266 indirectly via the Window thread, as we do not need to process Window
5267 messages for the tooltip. Creating tooltips indirectly also creates
5268 deadlocks when tooltips are created for menu items. */
5270 my_create_tip_window (f
)
5275 rect
.left
= rect
.top
= 0;
5276 rect
.right
= PIXEL_WIDTH (f
);
5277 rect
.bottom
= PIXEL_HEIGHT (f
);
5279 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
5280 FRAME_EXTERNAL_MENU_BAR (f
));
5282 tip_window
= FRAME_W32_WINDOW (f
)
5283 = CreateWindow (EMACS_CLASS
,
5285 f
->output_data
.w32
->dwStyle
,
5286 f
->output_data
.w32
->left_pos
,
5287 f
->output_data
.w32
->top_pos
,
5288 rect
.right
- rect
.left
,
5289 rect
.bottom
- rect
.top
,
5290 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
5297 SetWindowLong (tip_window
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
5298 SetWindowLong (tip_window
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
5299 SetWindowLong (tip_window
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
5300 SetWindowLong (tip_window
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
5302 /* Tip frames have no scrollbars. */
5303 SetWindowLong (tip_window
, WND_SCROLLBAR_INDEX
, 0);
5305 /* Do this to discard the default setting specified by our parent. */
5306 ShowWindow (tip_window
, SW_HIDE
);
5311 /* Create and set up the w32 window for frame F. */
5314 w32_window (f
, window_prompting
, minibuffer_only
)
5316 long window_prompting
;
5317 int minibuffer_only
;
5321 /* Use the resource name as the top-level window name
5322 for looking up resources. Make a non-Lisp copy
5323 for the window manager, so GC relocation won't bother it.
5325 Elsewhere we specify the window name for the window manager. */
5328 char *str
= (char *) SDATA (Vx_resource_name
);
5329 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
5330 strcpy (f
->namebuf
, str
);
5333 my_create_window (f
);
5335 validate_x_resource_name ();
5337 /* x_set_name normally ignores requests to set the name if the
5338 requested name is the same as the current name. This is the one
5339 place where that assumption isn't correct; f->name is set, but
5340 the server hasn't been told. */
5343 int explicit = f
->explicit_name
;
5345 f
->explicit_name
= 0;
5348 x_set_name (f
, name
, explicit);
5353 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
5354 initialize_frame_menubar (f
);
5356 if (FRAME_W32_WINDOW (f
) == 0)
5357 error ("Unable to create window");
5360 /* Handle the icon stuff for this window. Perhaps later we might
5361 want an x_set_icon_position which can be called interactively as
5369 Lisp_Object icon_x
, icon_y
;
5371 /* Set the position of the icon. Note that Windows 95 groups all
5372 icons in the tray. */
5373 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
5374 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
5375 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
5377 CHECK_NUMBER (icon_x
);
5378 CHECK_NUMBER (icon_y
);
5380 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
5381 error ("Both left and top icon corners of icon must be specified");
5385 if (! EQ (icon_x
, Qunbound
))
5386 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
5389 /* Start up iconic or window? */
5390 x_wm_set_window_state
5391 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
5395 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
5408 XGCValues gc_values
;
5412 /* Create the GC's of this frame.
5413 Note that many default values are used. */
5416 gc_values
.font
= f
->output_data
.w32
->font
;
5418 /* Cursor has cursor-color background, background-color foreground. */
5419 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
5420 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
5421 f
->output_data
.w32
->cursor_gc
5422 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
5423 (GCFont
| GCForeground
| GCBackground
),
5427 f
->output_data
.w32
->white_relief
.gc
= 0;
5428 f
->output_data
.w32
->black_relief
.gc
= 0;
5434 /* Handler for signals raised during x_create_frame and
5435 x_create_top_frame. FRAME is the frame which is partially
5439 unwind_create_frame (frame
)
5442 struct frame
*f
= XFRAME (frame
);
5444 /* If frame is ``official'', nothing to do. */
5445 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
5448 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5451 x_free_frame_resources (f
);
5453 /* Check that reference counts are indeed correct. */
5454 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
5455 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
5464 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
5466 doc
: /* Make a new window, which is called a \"frame\" in Emacs terms.
5467 Returns an Emacs frame object.
5468 ALIST is an alist of frame parameters.
5469 If the parameters specify that the frame should not have a minibuffer,
5470 and do not specify a specific minibuffer window to use,
5471 then `default-minibuffer-frame' must be a frame whose minibuffer can
5472 be shared by the new frame.
5474 This function is an internal primitive--use `make-frame' instead. */)
5479 Lisp_Object frame
, tem
;
5481 int minibuffer_only
= 0;
5482 long window_prompting
= 0;
5484 int count
= SPECPDL_INDEX ();
5485 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
5486 Lisp_Object display
;
5487 struct w32_display_info
*dpyinfo
= NULL
;
5493 /* Use this general default value to start with
5494 until we know if this frame has a specified name. */
5495 Vx_resource_name
= Vinvocation_name
;
5497 display
= w32_get_arg (parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
5498 if (EQ (display
, Qunbound
))
5500 dpyinfo
= check_x_display_info (display
);
5502 kb
= dpyinfo
->kboard
;
5504 kb
= &the_only_kboard
;
5507 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
5509 && ! EQ (name
, Qunbound
)
5511 error ("Invalid frame name--not a string or nil");
5514 Vx_resource_name
= name
;
5516 /* See if parent window is specified. */
5517 parent
= w32_get_arg (parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
5518 if (EQ (parent
, Qunbound
))
5520 if (! NILP (parent
))
5521 CHECK_NUMBER (parent
);
5523 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5524 /* No need to protect DISPLAY because that's not used after passing
5525 it to make_frame_without_minibuffer. */
5527 GCPRO4 (parms
, parent
, name
, frame
);
5528 tem
= w32_get_arg (parms
, Qminibuffer
, "minibuffer", "Minibuffer",
5530 if (EQ (tem
, Qnone
) || NILP (tem
))
5531 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
5532 else if (EQ (tem
, Qonly
))
5534 f
= make_minibuffer_frame ();
5535 minibuffer_only
= 1;
5537 else if (WINDOWP (tem
))
5538 f
= make_frame_without_minibuffer (tem
, kb
, display
);
5542 XSETFRAME (frame
, f
);
5544 /* Note that Windows does support scroll bars. */
5545 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
5546 /* By default, make scrollbars the system standard width. */
5547 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
5549 f
->output_method
= output_w32
;
5550 f
->output_data
.w32
=
5551 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
5552 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
5553 FRAME_FONTSET (f
) = -1;
5554 record_unwind_protect (unwind_create_frame
, frame
);
5557 = w32_get_arg (parms
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
5558 if (! STRINGP (f
->icon_name
))
5559 f
->icon_name
= Qnil
;
5561 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
5563 FRAME_KBOARD (f
) = kb
;
5566 /* Specify the parent under which to make this window. */
5570 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
5571 f
->output_data
.w32
->explicit_parent
= 1;
5575 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5576 f
->output_data
.w32
->explicit_parent
= 0;
5579 /* Set the name; the functions to which we pass f expect the name to
5581 if (EQ (name
, Qunbound
) || NILP (name
))
5583 f
->name
= build_string (dpyinfo
->w32_id_name
);
5584 f
->explicit_name
= 0;
5589 f
->explicit_name
= 1;
5590 /* use the frame's title when getting resources for this frame. */
5591 specbind (Qx_resource_name
, name
);
5594 /* Extract the window parameters from the supplied values
5595 that are needed to determine window geometry. */
5599 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
5602 /* First, try whatever font the caller has specified. */
5605 tem
= Fquery_fontset (font
, Qnil
);
5607 font
= x_new_fontset (f
, SDATA (tem
));
5609 font
= x_new_font (f
, SDATA (font
));
5611 /* Try out a font which we hope has bold and italic variations. */
5612 if (!STRINGP (font
))
5613 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
5614 if (! STRINGP (font
))
5615 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
5616 /* If those didn't work, look for something which will at least work. */
5617 if (! STRINGP (font
))
5618 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
5620 if (! STRINGP (font
))
5621 font
= build_string ("Fixedsys");
5623 x_default_parameter (f
, parms
, Qfont
, font
,
5624 "font", "Font", RES_TYPE_STRING
);
5627 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
5628 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
5629 /* This defaults to 2 in order to match xterm. We recognize either
5630 internalBorderWidth or internalBorder (which is what xterm calls
5632 if (NILP (Fassq (Qinternal_border_width
, parms
)))
5636 value
= w32_get_arg (parms
, Qinternal_border_width
,
5637 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
5638 if (! EQ (value
, Qunbound
))
5639 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
5642 /* Default internalBorderWidth to 0 on Windows to match other programs. */
5643 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
5644 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
5645 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qright
,
5646 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
5648 /* Also do the stuff which must be set before the window exists. */
5649 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
5650 "foreground", "Foreground", RES_TYPE_STRING
);
5651 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
5652 "background", "Background", RES_TYPE_STRING
);
5653 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
5654 "pointerColor", "Foreground", RES_TYPE_STRING
);
5655 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
5656 "cursorColor", "Foreground", RES_TYPE_STRING
);
5657 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
5658 "borderColor", "BorderColor", RES_TYPE_STRING
);
5659 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
5660 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
5661 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
5662 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
5663 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
5664 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
5665 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
5666 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
5669 /* Init faces before x_default_parameter is called for scroll-bar
5670 parameters because that function calls x_set_scroll_bar_width,
5671 which calls change_frame_size, which calls Fset_window_buffer,
5672 which runs hooks, which call Fvertical_motion. At the end, we
5673 end up in init_iterator with a null face cache, which should not
5675 init_frame_faces (f
);
5677 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
5678 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
5679 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
5680 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
5682 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
5683 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
5684 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
5685 "title", "Title", RES_TYPE_STRING
);
5686 x_default_parameter (f
, parms
, Qfullscreen
, Qnil
,
5687 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
5689 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
5690 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5692 f
->output_data
.w32
->text_cursor
= w32_load_cursor (IDC_IBEAM
);
5693 f
->output_data
.w32
->nontext_cursor
= w32_load_cursor (IDC_ARROW
);
5694 f
->output_data
.w32
->modeline_cursor
= w32_load_cursor (IDC_ARROW
);
5695 f
->output_data
.w32
->cross_cursor
= w32_load_cursor (IDC_CROSS
);
5696 f
->output_data
.w32
->hourglass_cursor
= w32_load_cursor (IDC_WAIT
);
5697 f
->output_data
.w32
->horizontal_drag_cursor
= w32_load_cursor (IDC_SIZEWE
);
5698 f
->output_data
.w32
->hand_cursor
= w32_load_cursor (IDC_HAND
);
5700 /* Add the tool-bar height to the initial frame height so that the
5701 user gets a text display area of the size he specified with -g or
5702 via .Xdefaults. Later changes of the tool-bar height don't
5703 change the frame size. This is done so that users can create
5704 tall Emacs frames without having to guess how tall the tool-bar
5706 if (FRAME_TOOL_BAR_LINES (f
))
5708 int margin
, relief
, bar_height
;
5710 relief
= (tool_bar_button_relief
>= 0
5711 ? tool_bar_button_relief
5712 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
5714 if (INTEGERP (Vtool_bar_button_margin
)
5715 && XINT (Vtool_bar_button_margin
) > 0)
5716 margin
= XFASTINT (Vtool_bar_button_margin
);
5717 else if (CONSP (Vtool_bar_button_margin
)
5718 && INTEGERP (XCDR (Vtool_bar_button_margin
))
5719 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
5720 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
5724 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
5725 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
5728 window_prompting
= x_figure_window_size (f
, parms
);
5730 if (window_prompting
& XNegative
)
5732 if (window_prompting
& YNegative
)
5733 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
5735 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
5739 if (window_prompting
& YNegative
)
5740 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
5742 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
5745 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
5747 tem
= w32_get_arg (parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
5748 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
5750 w32_window (f
, window_prompting
, minibuffer_only
);
5755 /* Now consider the frame official. */
5756 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
5757 Vframe_list
= Fcons (frame
, Vframe_list
);
5759 /* We need to do this after creating the window, so that the
5760 icon-creation functions can say whose icon they're describing. */
5761 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
5762 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
5764 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
5765 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5766 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
5767 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5768 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
5769 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
5770 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
5771 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
5773 /* Dimensions, especially f->height, must be done via change_frame_size.
5774 Change will not be effected unless different from the current
5780 SET_FRAME_WIDTH (f
, 0);
5781 change_frame_size (f
, height
, width
, 1, 0, 0);
5783 /* Tell the server what size and position, etc, we want, and how
5784 badly we want them. This should be done after we have the menu
5785 bar so that its size can be taken into account. */
5787 x_wm_set_size_hint (f
, window_prompting
, 0);
5790 /* Avoid a bug that causes the new frame to never become visible if
5791 an echo area message is displayed during the following call1. */
5792 specbind(Qredisplay_dont_pause
, Qt
);
5794 /* Set up faces after all frame parameters are known. This call
5795 also merges in face attributes specified for new frames. If we
5796 don't do this, the `menu' face for instance won't have the right
5797 colors, and the menu bar won't appear in the specified colors for
5799 call1 (Qface_set_after_frame_default
, frame
);
5801 /* Make the window appear on the frame and enable display, unless
5802 the caller says not to. However, with explicit parent, Emacs
5803 cannot control visibility, so don't try. */
5804 if (! f
->output_data
.w32
->explicit_parent
)
5806 Lisp_Object visibility
;
5808 visibility
= w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
5809 if (EQ (visibility
, Qunbound
))
5812 if (EQ (visibility
, Qicon
))
5813 x_iconify_frame (f
);
5814 else if (! NILP (visibility
))
5815 x_make_frame_visible (f
);
5817 /* Must have been Qnil. */
5822 /* Make sure windows on this frame appear in calls to next-window
5823 and similar functions. */
5824 Vwindow_list
= Qnil
;
5826 return unbind_to (count
, frame
);
5829 /* FRAME is used only to get a handle on the X display. We don't pass the
5830 display info directly because we're called from frame.c, which doesn't
5831 know about that structure. */
5833 x_get_focus_frame (frame
)
5834 struct frame
*frame
;
5836 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
5838 if (! dpyinfo
->w32_focus_frame
)
5841 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
5845 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
5846 doc
: /* Give FRAME input focus, raising to foreground if necessary. */)
5850 x_focus_on_frame (check_x_frame (frame
));
5855 /* Return the charset portion of a font name. */
5856 char * xlfd_charset_of_font (char * fontname
)
5858 char *charset
, *encoding
;
5860 encoding
= strrchr(fontname
, '-');
5861 if (!encoding
|| encoding
== fontname
)
5864 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
5865 if (*charset
== '-')
5868 if (charset
== fontname
|| strcmp(charset
, "-*-*") == 0)
5874 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
5875 int size
, char* filename
);
5876 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
5877 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
5879 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
5881 static struct font_info
*
5882 w32_load_system_font (f
,fontname
,size
)
5887 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5888 Lisp_Object font_names
;
5890 /* Get a list of all the fonts that match this name. Once we
5891 have a list of matching fonts, we compare them against the fonts
5892 we already have loaded by comparing names. */
5893 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
5895 if (!NILP (font_names
))
5900 /* First check if any are already loaded, as that is cheaper
5901 than loading another one. */
5902 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5903 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
5904 if (dpyinfo
->font_table
[i
].name
5905 && (!strcmp (dpyinfo
->font_table
[i
].name
,
5906 SDATA (XCAR (tail
)))
5907 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
5908 SDATA (XCAR (tail
)))))
5909 return (dpyinfo
->font_table
+ i
);
5911 fontname
= (char *) SDATA (XCAR (font_names
));
5913 else if (w32_strict_fontnames
)
5915 /* If EnumFontFamiliesEx was available, we got a full list of
5916 fonts back so stop now to avoid the possibility of loading a
5917 random font. If we had to fall back to EnumFontFamilies, the
5918 list is incomplete, so continue whether the font we want was
5920 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5921 FARPROC enum_font_families_ex
5922 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
5923 if (enum_font_families_ex
)
5927 /* Load the font and add it to the table. */
5929 char *full_name
, *encoding
, *charset
;
5931 struct font_info
*fontp
;
5937 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
5940 if (!*lf
.lfFaceName
)
5941 /* If no name was specified for the font, we get a random font
5942 from CreateFontIndirect - this is not particularly
5943 desirable, especially since CreateFontIndirect does not
5944 fill out the missing name in lf, so we never know what we
5948 lf
.lfQuality
= DEFAULT_QUALITY
;
5950 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
5951 bzero (font
, sizeof (*font
));
5953 /* Set bdf to NULL to indicate that this is a Windows font. */
5958 font
->hfont
= CreateFontIndirect (&lf
);
5960 if (font
->hfont
== NULL
)
5969 codepage
= w32_codepage_for_font (fontname
);
5971 hdc
= GetDC (dpyinfo
->root_window
);
5972 oldobj
= SelectObject (hdc
, font
->hfont
);
5974 ok
= GetTextMetrics (hdc
, &font
->tm
);
5975 if (codepage
== CP_UNICODE
)
5976 font
->double_byte_p
= 1;
5979 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5980 don't report themselves as double byte fonts, when
5981 patently they are. So instead of trusting
5982 GetFontLanguageInfo, we check the properties of the
5983 codepage directly, since that is ultimately what we are
5984 working from anyway. */
5985 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5987 GetCPInfo (codepage
, &cpi
);
5988 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
5991 SelectObject (hdc
, oldobj
);
5992 ReleaseDC (dpyinfo
->root_window
, hdc
);
5993 /* Fill out details in lf according to the font that was
5995 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
5996 lf
.lfWidth
= font
->tm
.tmAveCharWidth
;
5997 lf
.lfWeight
= font
->tm
.tmWeight
;
5998 lf
.lfItalic
= font
->tm
.tmItalic
;
5999 lf
.lfCharSet
= font
->tm
.tmCharSet
;
6000 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
6001 ? VARIABLE_PITCH
: FIXED_PITCH
);
6002 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
6003 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
6005 w32_cache_char_metrics (font
);
6012 w32_unload_font (dpyinfo
, font
);
6016 /* Find a free slot in the font table. */
6017 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
6018 if (dpyinfo
->font_table
[i
].name
== NULL
)
6021 /* If no free slot found, maybe enlarge the font table. */
6022 if (i
== dpyinfo
->n_fonts
6023 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
6026 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
6027 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
6029 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
6032 fontp
= dpyinfo
->font_table
+ i
;
6033 if (i
== dpyinfo
->n_fonts
)
6036 /* Now fill in the slots of *FONTP. */
6039 fontp
->font_idx
= i
;
6040 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
6041 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
6043 charset
= xlfd_charset_of_font (fontname
);
6045 /* Cache the W32 codepage for a font. This makes w32_encode_char
6046 (called for every glyph during redisplay) much faster. */
6047 fontp
->codepage
= codepage
;
6049 /* Work out the font's full name. */
6050 full_name
= (char *)xmalloc (100);
6051 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
6052 fontp
->full_name
= full_name
;
6055 /* If all else fails - just use the name we used to load it. */
6057 fontp
->full_name
= fontp
->name
;
6060 fontp
->size
= FONT_WIDTH (font
);
6061 fontp
->height
= FONT_HEIGHT (font
);
6063 /* The slot `encoding' specifies how to map a character
6064 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
6065 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
6066 (0:0x20..0x7F, 1:0xA0..0xFF,
6067 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
6068 2:0xA020..0xFF7F). For the moment, we don't know which charset
6069 uses this font. So, we set information in fontp->encoding[1]
6070 which is never used by any charset. If mapping can't be
6071 decided, set FONT_ENCODING_NOT_DECIDED. */
6073 /* SJIS fonts need to be set to type 4, all others seem to work as
6074 type FONT_ENCODING_NOT_DECIDED. */
6075 encoding
= strrchr (fontp
->name
, '-');
6076 if (encoding
&& strnicmp (encoding
+1, "sjis", 4) == 0)
6077 fontp
->encoding
[1] = 4;
6079 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
6081 /* The following three values are set to 0 under W32, which is
6082 what they get set to if XGetFontProperty fails under X. */
6083 fontp
->baseline_offset
= 0;
6084 fontp
->relative_compose
= 0;
6085 fontp
->default_ascent
= 0;
6087 /* Set global flag fonts_changed_p to non-zero if the font loaded
6088 has a character with a smaller width than any other character
6089 before, or if the font loaded has a smaller height than any
6090 other font loaded before. If this happens, it will make a
6091 glyph matrix reallocation necessary. */
6092 fonts_changed_p
|= x_compute_min_glyph_bounds (f
);
6098 /* Load font named FONTNAME of size SIZE for frame F, and return a
6099 pointer to the structure font_info while allocating it dynamically.
6100 If loading fails, return NULL. */
6102 w32_load_font (f
,fontname
,size
)
6107 Lisp_Object bdf_fonts
;
6108 struct font_info
*retval
= NULL
;
6110 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
6112 while (!retval
&& CONSP (bdf_fonts
))
6114 char *bdf_name
, *bdf_file
;
6115 Lisp_Object bdf_pair
;
6117 bdf_name
= SDATA (XCAR (bdf_fonts
));
6118 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
6119 bdf_file
= SDATA (XCDR (bdf_pair
));
6121 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
6123 bdf_fonts
= XCDR (bdf_fonts
);
6129 return w32_load_system_font(f
, fontname
, size
);
6134 w32_unload_font (dpyinfo
, font
)
6135 struct w32_display_info
*dpyinfo
;
6140 if (font
->per_char
) xfree (font
->per_char
);
6141 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
6143 if (font
->hfont
) DeleteObject(font
->hfont
);
6148 /* The font conversion stuff between x and w32 */
6150 /* X font string is as follows (from faces.el)
6154 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
6155 * (weight\? "\\([^-]*\\)") ; 1
6156 * (slant "\\([ior]\\)") ; 2
6157 * (slant\? "\\([^-]?\\)") ; 2
6158 * (swidth "\\([^-]*\\)") ; 3
6159 * (adstyle "[^-]*") ; 4
6160 * (pixelsize "[0-9]+")
6161 * (pointsize "[0-9][0-9]+")
6162 * (resx "[0-9][0-9]+")
6163 * (resy "[0-9][0-9]+")
6164 * (spacing "[cmp?*]")
6165 * (avgwidth "[0-9]+")
6166 * (registry "[^-]+")
6167 * (encoding "[^-]+")
6172 x_to_w32_weight (lpw
)
6175 if (!lpw
) return (FW_DONTCARE
);
6177 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
6178 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
6179 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
6180 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
6181 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
6182 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
6183 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
6184 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
6185 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
6186 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
6193 w32_to_x_weight (fnweight
)
6196 if (fnweight
>= FW_HEAVY
) return "heavy";
6197 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
6198 if (fnweight
>= FW_BOLD
) return "bold";
6199 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
6200 if (fnweight
>= FW_MEDIUM
) return "medium";
6201 if (fnweight
>= FW_NORMAL
) return "normal";
6202 if (fnweight
>= FW_LIGHT
) return "light";
6203 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
6204 if (fnweight
>= FW_THIN
) return "thin";
6210 x_to_w32_charset (lpcs
)
6213 Lisp_Object this_entry
, w32_charset
;
6215 int len
= strlen (lpcs
);
6217 /* Support "*-#nnn" format for unknown charsets. */
6218 if (strncmp (lpcs
, "*-#", 3) == 0)
6219 return atoi (lpcs
+ 3);
6221 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
6222 charset
= alloca (len
+ 1);
6223 strcpy (charset
, lpcs
);
6224 lpcs
= strchr (charset
, '*');
6228 /* Look through w32-charset-info-alist for the character set.
6229 Format of each entry is
6230 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6232 this_entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6234 if (NILP(this_entry
))
6236 /* At startup, we want iso8859-1 fonts to come up properly. */
6237 if (stricmp(charset
, "iso8859-1") == 0)
6238 return ANSI_CHARSET
;
6240 return DEFAULT_CHARSET
;
6243 w32_charset
= Fcar (Fcdr (this_entry
));
6245 /* Translate Lisp symbol to number. */
6246 if (w32_charset
== Qw32_charset_ansi
)
6247 return ANSI_CHARSET
;
6248 if (w32_charset
== Qw32_charset_symbol
)
6249 return SYMBOL_CHARSET
;
6250 if (w32_charset
== Qw32_charset_shiftjis
)
6251 return SHIFTJIS_CHARSET
;
6252 if (w32_charset
== Qw32_charset_hangeul
)
6253 return HANGEUL_CHARSET
;
6254 if (w32_charset
== Qw32_charset_chinesebig5
)
6255 return CHINESEBIG5_CHARSET
;
6256 if (w32_charset
== Qw32_charset_gb2312
)
6257 return GB2312_CHARSET
;
6258 if (w32_charset
== Qw32_charset_oem
)
6260 #ifdef JOHAB_CHARSET
6261 if (w32_charset
== Qw32_charset_johab
)
6262 return JOHAB_CHARSET
;
6263 if (w32_charset
== Qw32_charset_easteurope
)
6264 return EASTEUROPE_CHARSET
;
6265 if (w32_charset
== Qw32_charset_turkish
)
6266 return TURKISH_CHARSET
;
6267 if (w32_charset
== Qw32_charset_baltic
)
6268 return BALTIC_CHARSET
;
6269 if (w32_charset
== Qw32_charset_russian
)
6270 return RUSSIAN_CHARSET
;
6271 if (w32_charset
== Qw32_charset_arabic
)
6272 return ARABIC_CHARSET
;
6273 if (w32_charset
== Qw32_charset_greek
)
6274 return GREEK_CHARSET
;
6275 if (w32_charset
== Qw32_charset_hebrew
)
6276 return HEBREW_CHARSET
;
6277 if (w32_charset
== Qw32_charset_vietnamese
)
6278 return VIETNAMESE_CHARSET
;
6279 if (w32_charset
== Qw32_charset_thai
)
6280 return THAI_CHARSET
;
6281 if (w32_charset
== Qw32_charset_mac
)
6283 #endif /* JOHAB_CHARSET */
6284 #ifdef UNICODE_CHARSET
6285 if (w32_charset
== Qw32_charset_unicode
)
6286 return UNICODE_CHARSET
;
6289 return DEFAULT_CHARSET
;
6294 w32_to_x_charset (fncharset
)
6297 static char buf
[32];
6298 Lisp_Object charset_type
;
6303 /* Handle startup case of w32-charset-info-alist not
6304 being set up yet. */
6305 if (NILP(Vw32_charset_info_alist
))
6307 charset_type
= Qw32_charset_ansi
;
6309 case DEFAULT_CHARSET
:
6310 charset_type
= Qw32_charset_default
;
6312 case SYMBOL_CHARSET
:
6313 charset_type
= Qw32_charset_symbol
;
6315 case SHIFTJIS_CHARSET
:
6316 charset_type
= Qw32_charset_shiftjis
;
6318 case HANGEUL_CHARSET
:
6319 charset_type
= Qw32_charset_hangeul
;
6321 case GB2312_CHARSET
:
6322 charset_type
= Qw32_charset_gb2312
;
6324 case CHINESEBIG5_CHARSET
:
6325 charset_type
= Qw32_charset_chinesebig5
;
6328 charset_type
= Qw32_charset_oem
;
6331 /* More recent versions of Windows (95 and NT4.0) define more
6333 #ifdef EASTEUROPE_CHARSET
6334 case EASTEUROPE_CHARSET
:
6335 charset_type
= Qw32_charset_easteurope
;
6337 case TURKISH_CHARSET
:
6338 charset_type
= Qw32_charset_turkish
;
6340 case BALTIC_CHARSET
:
6341 charset_type
= Qw32_charset_baltic
;
6343 case RUSSIAN_CHARSET
:
6344 charset_type
= Qw32_charset_russian
;
6346 case ARABIC_CHARSET
:
6347 charset_type
= Qw32_charset_arabic
;
6350 charset_type
= Qw32_charset_greek
;
6352 case HEBREW_CHARSET
:
6353 charset_type
= Qw32_charset_hebrew
;
6355 case VIETNAMESE_CHARSET
:
6356 charset_type
= Qw32_charset_vietnamese
;
6359 charset_type
= Qw32_charset_thai
;
6362 charset_type
= Qw32_charset_mac
;
6365 charset_type
= Qw32_charset_johab
;
6369 #ifdef UNICODE_CHARSET
6370 case UNICODE_CHARSET
:
6371 charset_type
= Qw32_charset_unicode
;
6375 /* Encode numerical value of unknown charset. */
6376 sprintf (buf
, "*-#%u", fncharset
);
6382 char * best_match
= NULL
;
6384 /* Look through w32-charset-info-alist for the character set.
6385 Prefer ISO codepages, and prefer lower numbers in the ISO
6386 range. Only return charsets for codepages which are installed.
6388 Format of each entry is
6389 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6391 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
6394 Lisp_Object w32_charset
;
6395 Lisp_Object codepage
;
6397 Lisp_Object this_entry
= XCAR (rest
);
6399 /* Skip invalid entries in alist. */
6400 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
6401 || !CONSP (XCDR (this_entry
))
6402 || !SYMBOLP (XCAR (XCDR (this_entry
))))
6405 x_charset
= SDATA (XCAR (this_entry
));
6406 w32_charset
= XCAR (XCDR (this_entry
));
6407 codepage
= XCDR (XCDR (this_entry
));
6409 /* Look for Same charset and a valid codepage (or non-int
6410 which means ignore). */
6411 if (w32_charset
== charset_type
6412 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
6413 || IsValidCodePage (XINT (codepage
))))
6415 /* If we don't have a match already, then this is the
6418 best_match
= x_charset
;
6419 /* If this is an ISO codepage, and the best so far isn't,
6420 then this is better. */
6421 else if (strnicmp (best_match
, "iso", 3) != 0
6422 && strnicmp (x_charset
, "iso", 3) == 0)
6423 best_match
= x_charset
;
6424 /* If both are ISO8859 codepages, choose the one with the
6425 lowest number in the encoding field. */
6426 else if (strnicmp (best_match
, "iso8859-", 8) == 0
6427 && strnicmp (x_charset
, "iso8859-", 8) == 0)
6429 int best_enc
= atoi (best_match
+ 8);
6430 int this_enc
= atoi (x_charset
+ 8);
6431 if (this_enc
> 0 && this_enc
< best_enc
)
6432 best_match
= x_charset
;
6437 /* If no match, encode the numeric value. */
6440 sprintf (buf
, "*-#%u", fncharset
);
6444 strncpy(buf
, best_match
, 31);
6451 /* Return all the X charsets that map to a font. */
6453 w32_to_all_x_charsets (fncharset
)
6456 static char buf
[32];
6457 Lisp_Object charset_type
;
6458 Lisp_Object retval
= Qnil
;
6463 /* Handle startup case of w32-charset-info-alist not
6464 being set up yet. */
6465 if (NILP(Vw32_charset_info_alist
))
6466 return Fcons (build_string ("iso8859-1"), Qnil
);
6468 charset_type
= Qw32_charset_ansi
;
6470 case DEFAULT_CHARSET
:
6471 charset_type
= Qw32_charset_default
;
6473 case SYMBOL_CHARSET
:
6474 charset_type
= Qw32_charset_symbol
;
6476 case SHIFTJIS_CHARSET
:
6477 charset_type
= Qw32_charset_shiftjis
;
6479 case HANGEUL_CHARSET
:
6480 charset_type
= Qw32_charset_hangeul
;
6482 case GB2312_CHARSET
:
6483 charset_type
= Qw32_charset_gb2312
;
6485 case CHINESEBIG5_CHARSET
:
6486 charset_type
= Qw32_charset_chinesebig5
;
6489 charset_type
= Qw32_charset_oem
;
6492 /* More recent versions of Windows (95 and NT4.0) define more
6494 #ifdef EASTEUROPE_CHARSET
6495 case EASTEUROPE_CHARSET
:
6496 charset_type
= Qw32_charset_easteurope
;
6498 case TURKISH_CHARSET
:
6499 charset_type
= Qw32_charset_turkish
;
6501 case BALTIC_CHARSET
:
6502 charset_type
= Qw32_charset_baltic
;
6504 case RUSSIAN_CHARSET
:
6505 charset_type
= Qw32_charset_russian
;
6507 case ARABIC_CHARSET
:
6508 charset_type
= Qw32_charset_arabic
;
6511 charset_type
= Qw32_charset_greek
;
6513 case HEBREW_CHARSET
:
6514 charset_type
= Qw32_charset_hebrew
;
6516 case VIETNAMESE_CHARSET
:
6517 charset_type
= Qw32_charset_vietnamese
;
6520 charset_type
= Qw32_charset_thai
;
6523 charset_type
= Qw32_charset_mac
;
6526 charset_type
= Qw32_charset_johab
;
6530 #ifdef UNICODE_CHARSET
6531 case UNICODE_CHARSET
:
6532 charset_type
= Qw32_charset_unicode
;
6536 /* Encode numerical value of unknown charset. */
6537 sprintf (buf
, "*-#%u", fncharset
);
6538 return Fcons (build_string (buf
), Qnil
);
6543 /* Look through w32-charset-info-alist for the character set.
6544 Only return charsets for codepages which are installed.
6546 Format of each entry in Vw32_charset_info_alist is
6547 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6549 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
6551 Lisp_Object x_charset
;
6552 Lisp_Object w32_charset
;
6553 Lisp_Object codepage
;
6555 Lisp_Object this_entry
= XCAR (rest
);
6557 /* Skip invalid entries in alist. */
6558 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
6559 || !CONSP (XCDR (this_entry
))
6560 || !SYMBOLP (XCAR (XCDR (this_entry
))))
6563 x_charset
= XCAR (this_entry
);
6564 w32_charset
= XCAR (XCDR (this_entry
));
6565 codepage
= XCDR (XCDR (this_entry
));
6567 /* Look for Same charset and a valid codepage (or non-int
6568 which means ignore). */
6569 if (w32_charset
== charset_type
6570 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
6571 || IsValidCodePage (XINT (codepage
))))
6573 retval
= Fcons (x_charset
, retval
);
6577 /* If no match, encode the numeric value. */
6580 sprintf (buf
, "*-#%u", fncharset
);
6581 return Fcons (build_string (buf
), Qnil
);
6588 /* Get the Windows codepage corresponding to the specified font. The
6589 charset info in the font name is used to look up
6590 w32-charset-to-codepage-alist. */
6592 w32_codepage_for_font (char *fontname
)
6594 Lisp_Object codepage
, entry
;
6595 char *charset_str
, *charset
, *end
;
6597 if (NILP (Vw32_charset_info_alist
))
6600 /* Extract charset part of font string. */
6601 charset
= xlfd_charset_of_font (fontname
);
6606 charset_str
= (char *) alloca (strlen (charset
) + 1);
6607 strcpy (charset_str
, charset
);
6610 /* Remove leading "*-". */
6611 if (strncmp ("*-", charset_str
, 2) == 0)
6612 charset
= charset_str
+ 2;
6615 charset
= charset_str
;
6617 /* Stop match at wildcard (including preceding '-'). */
6618 if (end
= strchr (charset
, '*'))
6620 if (end
> charset
&& *(end
-1) == '-')
6625 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6629 codepage
= Fcdr (Fcdr (entry
));
6631 if (NILP (codepage
))
6633 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
6635 else if (INTEGERP (codepage
))
6636 return XINT (codepage
);
6643 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
6644 LOGFONT
* lplogfont
;
6647 char * specific_charset
;
6651 char height_pixels
[8];
6653 char width_pixels
[8];
6654 char *fontname_dash
;
6655 int display_resy
= (int) one_w32_display_info
.resy
;
6656 int display_resx
= (int) one_w32_display_info
.resx
;
6658 struct coding_system coding
;
6660 if (!lpxstr
) abort ();
6665 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
6666 fonttype
= "raster";
6667 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
6668 fonttype
= "outline";
6670 fonttype
= "unknown";
6672 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system
),
6674 coding
.src_multibyte
= 0;
6675 coding
.dst_multibyte
= 1;
6676 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6677 /* We explicitely disable composition handling because selection
6678 data should not contain any composition sequence. */
6679 coding
.composing
= COMPOSITION_DISABLED
;
6680 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
6682 fontname
= alloca(sizeof(*fontname
) * bufsz
);
6683 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
6684 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
6685 *(fontname
+ coding
.produced
) = '\0';
6687 /* Replace dashes with underscores so the dashes are not
6689 fontname_dash
= fontname
;
6690 while (fontname_dash
= strchr (fontname_dash
, '-'))
6691 *fontname_dash
= '_';
6693 if (lplogfont
->lfHeight
)
6695 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
6696 sprintf (height_dpi
, "%u",
6697 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
6701 strcpy (height_pixels
, "*");
6702 strcpy (height_dpi
, "*");
6704 if (lplogfont
->lfWidth
)
6705 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
6707 strcpy (width_pixels
, "*");
6709 _snprintf (lpxstr
, len
- 1,
6710 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6711 fonttype
, /* foundry */
6712 fontname
, /* family */
6713 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
6714 lplogfont
->lfItalic
?'i':'r', /* slant */
6716 /* add style name */
6717 height_pixels
, /* pixel size */
6718 height_dpi
, /* point size */
6719 display_resx
, /* resx */
6720 display_resy
, /* resy */
6721 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
6722 ? 'p' : 'c', /* spacing */
6723 width_pixels
, /* avg width */
6724 specific_charset
? specific_charset
6725 : w32_to_x_charset (lplogfont
->lfCharSet
)
6726 /* charset registry and encoding */
6729 lpxstr
[len
- 1] = 0; /* just to be sure */
6734 x_to_w32_font (lpxstr
, lplogfont
)
6736 LOGFONT
* lplogfont
;
6738 struct coding_system coding
;
6740 if (!lplogfont
) return (FALSE
);
6742 memset (lplogfont
, 0, sizeof (*lplogfont
));
6744 /* Set default value for each field. */
6746 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
6747 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
6748 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
6750 /* go for maximum quality */
6751 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
6752 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
6753 lplogfont
->lfQuality
= PROOF_QUALITY
;
6756 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
6757 lplogfont
->lfWeight
= FW_DONTCARE
;
6758 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
6763 /* Provide a simple escape mechanism for specifying Windows font names
6764 * directly -- if font spec does not beginning with '-', assume this
6766 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6772 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
6773 width
[10], resy
[10], remainder
[50];
6775 int dpi
= (int) one_w32_display_info
.resy
;
6777 fields
= sscanf (lpxstr
,
6778 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
6779 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
6783 /* In the general case when wildcards cover more than one field,
6784 we don't know which field is which, so don't fill any in.
6785 However, we need to cope with this particular form, which is
6786 generated by font_list_1 (invoked by try_font_list):
6787 "-raster-6x10-*-gb2312*-*"
6788 and make sure to correctly parse the charset field. */
6791 fields
= sscanf (lpxstr
,
6792 "-%*[^-]-%49[^-]-*-%49s",
6795 else if (fields
< 9)
6801 if (fields
> 0 && name
[0] != '*')
6807 (Fcheck_coding_system (Vlocale_coding_system
), &coding
);
6808 coding
.src_multibyte
= 1;
6809 coding
.dst_multibyte
= 1;
6810 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
6811 buf
= (unsigned char *) alloca (bufsize
);
6812 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6813 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
6814 if (coding
.produced
>= LF_FACESIZE
)
6815 coding
.produced
= LF_FACESIZE
- 1;
6816 buf
[coding
.produced
] = 0;
6817 strcpy (lplogfont
->lfFaceName
, buf
);
6821 lplogfont
->lfFaceName
[0] = '\0';
6826 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6830 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
6834 if (fields
> 0 && pixels
[0] != '*')
6835 lplogfont
->lfHeight
= atoi (pixels
);
6839 if (fields
> 0 && resy
[0] != '*')
6842 if (tem
> 0) dpi
= tem
;
6845 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
6846 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
6849 lplogfont
->lfPitchAndFamily
=
6850 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
6854 if (fields
> 0 && width
[0] != '*')
6855 lplogfont
->lfWidth
= atoi (width
) / 10;
6859 /* Strip the trailing '-' if present. (it shouldn't be, as it
6860 fails the test against xlfd-tight-regexp in fontset.el). */
6862 int len
= strlen (remainder
);
6863 if (len
> 0 && remainder
[len
-1] == '-')
6864 remainder
[len
-1] = 0;
6866 encoding
= remainder
;
6868 if (strncmp (encoding
, "*-", 2) == 0)
6871 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
6876 char name
[100], height
[10], width
[10], weight
[20];
6878 fields
= sscanf (lpxstr
,
6879 "%99[^:]:%9[^:]:%9[^:]:%19s",
6880 name
, height
, width
, weight
);
6882 if (fields
== EOF
) return (FALSE
);
6886 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
6887 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
6891 lplogfont
->lfFaceName
[0] = 0;
6897 lplogfont
->lfHeight
= atoi (height
);
6902 lplogfont
->lfWidth
= atoi (width
);
6906 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6909 /* This makes TrueType fonts work better. */
6910 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
6915 /* Strip the pixel height and point height from the given xlfd, and
6916 return the pixel height. If no pixel height is specified, calculate
6917 one from the point height, or if that isn't defined either, return
6918 0 (which usually signifies a scalable font).
6921 xlfd_strip_height (char *fontname
)
6923 int pixel_height
, field_number
;
6924 char *read_from
, *write_to
;
6928 pixel_height
= field_number
= 0;
6931 /* Look for height fields. */
6932 for (read_from
= fontname
; *read_from
; read_from
++)
6934 if (*read_from
== '-')
6937 if (field_number
== 7) /* Pixel height. */
6940 write_to
= read_from
;
6942 /* Find end of field. */
6943 for (;*read_from
&& *read_from
!= '-'; read_from
++)
6946 /* Split the fontname at end of field. */
6952 pixel_height
= atoi (write_to
);
6953 /* Blank out field. */
6954 if (read_from
> write_to
)
6959 /* If the pixel height field is at the end (partial xlfd),
6962 return pixel_height
;
6964 /* If we got a pixel height, the point height can be
6965 ignored. Just blank it out and break now. */
6968 /* Find end of point size field. */
6969 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6975 /* Blank out the point size field. */
6976 if (read_from
> write_to
)
6982 return pixel_height
;
6986 /* If the point height is already blank, break now. */
6987 if (*read_from
== '-')
6993 else if (field_number
== 8)
6995 /* If we didn't get a pixel height, try to get the point
6996 height and convert that. */
6998 char *point_size_start
= read_from
++;
7000 /* Find end of field. */
7001 for (; *read_from
&& *read_from
!= '-'; read_from
++)
7010 point_size
= atoi (point_size_start
);
7012 /* Convert to pixel height. */
7013 pixel_height
= point_size
7014 * one_w32_display_info
.height_in
/ 720;
7016 /* Blank out this field and break. */
7024 /* Shift the rest of the font spec into place. */
7025 if (write_to
&& read_from
> write_to
)
7027 for (; *read_from
; read_from
++, write_to
++)
7028 *write_to
= *read_from
;
7032 return pixel_height
;
7035 /* Assume parameter 1 is fully qualified, no wildcards. */
7037 w32_font_match (fontname
, pattern
)
7041 char *regex
= alloca (strlen (pattern
) * 2 + 3);
7042 char *font_name_copy
= alloca (strlen (fontname
) + 1);
7045 /* Copy fontname so we can modify it during comparison. */
7046 strcpy (font_name_copy
, fontname
);
7051 /* Turn pattern into a regexp and do a regexp match. */
7052 for (; *pattern
; pattern
++)
7054 if (*pattern
== '?')
7056 else if (*pattern
== '*')
7067 /* Strip out font heights and compare them seperately, since
7068 rounding error can cause mismatches. This also allows a
7069 comparison between a font that declares only a pixel height and a
7070 pattern that declares the point height.
7073 int font_height
, pattern_height
;
7075 font_height
= xlfd_strip_height (font_name_copy
);
7076 pattern_height
= xlfd_strip_height (regex
);
7078 /* Compare now, and don't bother doing expensive regexp matching
7079 if the heights differ. */
7080 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
7084 return (fast_c_string_match_ignore_case (build_string (regex
),
7085 font_name_copy
) >= 0);
7088 /* Callback functions, and a structure holding info they need, for
7089 listing system fonts on W32. We need one set of functions to do the
7090 job properly, but these don't work on NT 3.51 and earlier, so we
7091 have a second set which don't handle character sets properly to
7094 In both cases, there are two passes made. The first pass gets one
7095 font from each family, the second pass lists all the fonts from
7098 typedef struct enumfont_t
7103 XFontStruct
*size_ref
;
7104 Lisp_Object pattern
;
7110 enum_font_maybe_add_to_list (enumfont_t
*, LOGFONT
*, char *, Lisp_Object
);
7114 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
7116 NEWTEXTMETRIC
* lptm
;
7120 /* Ignore struck out and underlined versions of fonts. */
7121 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
7124 /* Only return fonts with names starting with @ if they were
7125 explicitly specified, since Microsoft uses an initial @ to
7126 denote fonts for vertical writing, without providing a more
7127 convenient way of identifying them. */
7128 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
7129 && lpef
->logfont
.lfFaceName
[0] != '@')
7132 /* Check that the character set matches if it was specified */
7133 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
7134 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
7137 if (FontType
== RASTER_FONTTYPE
)
7139 /* DBCS raster fonts have problems displaying, so skip them. */
7140 int charset
= lplf
->elfLogFont
.lfCharSet
;
7141 if (charset
== SHIFTJIS_CHARSET
7142 || charset
== HANGEUL_CHARSET
7143 || charset
== CHINESEBIG5_CHARSET
7144 || charset
== GB2312_CHARSET
7145 #ifdef JOHAB_CHARSET
7146 || charset
== JOHAB_CHARSET
7154 Lisp_Object width
= Qnil
;
7155 Lisp_Object charset_list
= Qnil
;
7156 char *charset
= NULL
;
7158 /* Truetype fonts do not report their true metrics until loaded */
7159 if (FontType
!= RASTER_FONTTYPE
)
7161 if (!NILP (lpef
->pattern
))
7163 /* Scalable fonts are as big as you want them to be. */
7164 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
7165 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
7166 width
= make_number (lpef
->logfont
.lfWidth
);
7170 lplf
->elfLogFont
.lfHeight
= 0;
7171 lplf
->elfLogFont
.lfWidth
= 0;
7175 /* Make sure the height used here is the same as everywhere
7176 else (ie character height, not cell height). */
7177 if (lplf
->elfLogFont
.lfHeight
> 0)
7179 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
7180 if (FontType
== RASTER_FONTTYPE
)
7181 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
7183 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
7186 if (!NILP (lpef
->pattern
))
7188 charset
= xlfd_charset_of_font (SDATA (lpef
->pattern
));
7190 /* We already checked charsets above, but DEFAULT_CHARSET
7191 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
7193 && strncmp (charset
, "*-*", 3) != 0
7194 && lpef
->logfont
.lfCharSet
== DEFAULT_CHARSET
7195 && strcmp (charset
, w32_to_x_charset (DEFAULT_CHARSET
)) != 0)
7200 charset_list
= Fcons (build_string (charset
), Qnil
);
7202 charset_list
= w32_to_all_x_charsets (lplf
->elfLogFont
.lfCharSet
);
7204 /* Loop through the charsets. */
7205 for ( ; CONSP (charset_list
); charset_list
= Fcdr (charset_list
))
7207 Lisp_Object this_charset
= Fcar (charset_list
);
7208 charset
= SDATA (this_charset
);
7210 /* List bold and italic variations if w32-enable-synthesized-fonts
7211 is non-nil and this is a plain font. */
7212 if (w32_enable_synthesized_fonts
7213 && lplf
->elfLogFont
.lfWeight
== FW_NORMAL
7214 && lplf
->elfLogFont
.lfItalic
== FALSE
)
7216 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7219 lplf
->elfLogFont
.lfWeight
= FW_BOLD
;
7220 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7223 lplf
->elfLogFont
.lfItalic
= TRUE
;
7224 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7227 lplf
->elfLogFont
.lfWeight
= FW_NORMAL
;
7228 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7232 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
7241 enum_font_maybe_add_to_list (lpef
, logfont
, match_charset
, width
)
7244 char * match_charset
;
7249 if (!w32_to_x_font (logfont
, buf
, 100, match_charset
))
7252 if (NILP (lpef
->pattern
)
7253 || w32_font_match (buf
, SDATA (lpef
->pattern
)))
7255 /* Check if we already listed this font. This may happen if
7256 w32_enable_synthesized_fonts is non-nil, and there are real
7257 bold and italic versions of the font. */
7258 Lisp_Object font_name
= build_string (buf
);
7259 if (NILP (Fmember (font_name
, lpef
->list
)))
7261 Lisp_Object entry
= Fcons (font_name
, width
);
7262 lpef
->list
= Fcons (entry
, lpef
->list
);
7270 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
7272 NEWTEXTMETRIC
* lptm
;
7276 return EnumFontFamilies (lpef
->hdc
,
7277 lplf
->elfLogFont
.lfFaceName
,
7278 (FONTENUMPROC
) enum_font_cb2
,
7284 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
7285 ENUMLOGFONTEX
* lplf
;
7286 NEWTEXTMETRICEX
* lptm
;
7290 /* We are not interested in the extra info we get back from the 'Ex
7291 version - only the fact that we get character set variations
7292 enumerated seperately. */
7293 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
7298 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
7299 ENUMLOGFONTEX
* lplf
;
7300 NEWTEXTMETRICEX
* lptm
;
7304 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
7305 FARPROC enum_font_families_ex
7306 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
7307 /* We don't really expect EnumFontFamiliesEx to disappear once we
7308 get here, so don't bother handling it gracefully. */
7309 if (enum_font_families_ex
== NULL
)
7310 error ("gdi32.dll has disappeared!");
7311 return enum_font_families_ex (lpef
->hdc
,
7313 (FONTENUMPROC
) enum_fontex_cb2
,
7317 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
7318 and xterm.c in Emacs 20.3) */
7320 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
7322 char *fontname
, *ptnstr
;
7323 Lisp_Object list
, tem
, newlist
= Qnil
;
7326 list
= Vw32_bdf_filename_alist
;
7327 ptnstr
= SDATA (pattern
);
7329 for ( ; CONSP (list
); list
= XCDR (list
))
7333 fontname
= SDATA (XCAR (tem
));
7334 else if (STRINGP (tem
))
7335 fontname
= SDATA (tem
);
7339 if (w32_font_match (fontname
, ptnstr
))
7341 newlist
= Fcons (XCAR (tem
), newlist
);
7343 if (max_names
>= 0 && n_fonts
>= max_names
)
7352 /* Return a list of names of available fonts matching PATTERN on frame
7353 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
7354 to be listed. Frame F NULL means we have not yet created any
7355 frame, which means we can't get proper size info, as we don't have
7356 a device context to use for GetTextMetrics.
7357 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
7358 negative, then all matching fonts are returned. */
7361 w32_list_fonts (f
, pattern
, size
, maxnames
)
7363 Lisp_Object pattern
;
7367 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
7368 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
7369 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
7372 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
7373 if (NILP (patterns
))
7374 patterns
= Fcons (pattern
, Qnil
);
7376 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
7381 tpat
= XCAR (patterns
);
7383 if (!STRINGP (tpat
))
7386 /* Avoid expensive EnumFontFamilies functions if we are not
7387 going to be able to output one of these anyway. */
7388 codepage
= w32_codepage_for_font (SDATA (tpat
));
7389 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
7390 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
7391 && !IsValidCodePage(codepage
))
7394 /* See if we cached the result for this particular query.
7395 The cache is an alist of the form:
7396 ((PATTERN (FONTNAME . WIDTH) ...) ...)
7398 if (tem
= XCDR (dpyinfo
->name_list_element
),
7399 !NILP (list
= Fassoc (tpat
, tem
)))
7401 list
= Fcdr_safe (list
);
7402 /* We have a cached list. Don't have to get the list again. */
7407 /* At first, put PATTERN in the cache. */
7412 /* Use EnumFontFamiliesEx where it is available, as it knows
7413 about character sets. Fall back to EnumFontFamilies for
7414 older versions of NT that don't support the 'Ex function. */
7415 x_to_w32_font (SDATA (tpat
), &ef
.logfont
);
7417 LOGFONT font_match_pattern
;
7418 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
7419 FARPROC enum_font_families_ex
7420 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
7422 /* We do our own pattern matching so we can handle wildcards. */
7423 font_match_pattern
.lfFaceName
[0] = 0;
7424 font_match_pattern
.lfPitchAndFamily
= 0;
7425 /* We can use the charset, because if it is a wildcard it will
7426 be DEFAULT_CHARSET anyway. */
7427 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
7429 ef
.hdc
= GetDC (dpyinfo
->root_window
);
7431 if (enum_font_families_ex
)
7432 enum_font_families_ex (ef
.hdc
,
7433 &font_match_pattern
,
7434 (FONTENUMPROC
) enum_fontex_cb1
,
7437 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
7440 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
7446 /* Make a list of the fonts we got back.
7447 Store that in the font cache for the display. */
7448 XSETCDR (dpyinfo
->name_list_element
,
7449 Fcons (Fcons (tpat
, list
),
7450 XCDR (dpyinfo
->name_list_element
)));
7453 if (NILP (list
)) continue; /* Try the remaining alternatives. */
7455 newlist
= second_best
= Qnil
;
7457 /* Make a list of the fonts that have the right width. */
7458 for (; CONSP (list
); list
= XCDR (list
))
7465 if (NILP (XCAR (tem
)))
7469 newlist
= Fcons (XCAR (tem
), newlist
);
7471 if (maxnames
>= 0 && n_fonts
>= maxnames
)
7476 if (!INTEGERP (XCDR (tem
)))
7478 /* Since we don't yet know the size of the font, we must
7479 load it and try GetTextMetrics. */
7480 W32FontStruct thisinfo
;
7485 if (!x_to_w32_font (SDATA (XCAR (tem
)), &lf
))
7489 thisinfo
.bdf
= NULL
;
7490 thisinfo
.hfont
= CreateFontIndirect (&lf
);
7491 if (thisinfo
.hfont
== NULL
)
7494 hdc
= GetDC (dpyinfo
->root_window
);
7495 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
7496 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
7497 XSETCDR (tem
, make_number (FONT_WIDTH (&thisinfo
)));
7499 XSETCDR (tem
, make_number (0));
7500 SelectObject (hdc
, oldobj
);
7501 ReleaseDC (dpyinfo
->root_window
, hdc
);
7502 DeleteObject(thisinfo
.hfont
);
7505 found_size
= XINT (XCDR (tem
));
7506 if (found_size
== size
)
7508 newlist
= Fcons (XCAR (tem
), newlist
);
7510 if (maxnames
>= 0 && n_fonts
>= maxnames
)
7513 /* keep track of the closest matching size in case
7514 no exact match is found. */
7515 else if (found_size
> 0)
7517 if (NILP (second_best
))
7520 else if (found_size
< size
)
7522 if (XINT (XCDR (second_best
)) > size
7523 || XINT (XCDR (second_best
)) < found_size
)
7528 if (XINT (XCDR (second_best
)) > size
7529 && XINT (XCDR (second_best
)) >
7536 if (!NILP (newlist
))
7538 else if (!NILP (second_best
))
7540 newlist
= Fcons (XCAR (second_best
), Qnil
);
7545 /* Include any bdf fonts. */
7546 if (n_fonts
< maxnames
|| maxnames
< 0)
7548 Lisp_Object combined
[2];
7549 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
7550 combined
[1] = newlist
;
7551 newlist
= Fnconc(2, combined
);
7558 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7560 w32_get_font_info (f
, font_idx
)
7564 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
7569 w32_query_font (struct frame
*f
, char *fontname
)
7572 struct font_info
*pfi
;
7574 pfi
= FRAME_W32_FONT_TABLE (f
);
7576 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
7578 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
7584 /* Find a CCL program for a font specified by FONTP, and set the member
7585 `encoder' of the structure. */
7588 w32_find_ccl_program (fontp
)
7589 struct font_info
*fontp
;
7591 Lisp_Object list
, elt
;
7593 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
7597 && STRINGP (XCAR (elt
))
7598 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
7604 struct ccl_program
*ccl
7605 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
7607 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
7610 fontp
->font_encoder
= ccl
;
7615 /* Find BDF files in a specified directory. (use GCPRO when calling,
7616 as this calls lisp to get a directory listing). */
7618 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
7620 Lisp_Object filelist
, list
= Qnil
;
7623 if (!STRINGP(directory
))
7626 filelist
= Fdirectory_files (directory
, Qt
,
7627 build_string (".*\\.[bB][dD][fF]"), Qt
);
7629 for ( ; CONSP(filelist
); filelist
= XCDR (filelist
))
7631 Lisp_Object filename
= XCAR (filelist
);
7632 if (w32_BDF_to_x_font (SDATA (filename
), fontname
, 100))
7633 store_in_alist (&list
, build_string (fontname
), filename
);
7638 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
7640 doc
: /* Return a list of BDF fonts in DIR.
7641 The list is suitable for appending to w32-bdf-filename-alist. Fonts
7642 which do not contain an xlfd description will not be included in the
7643 list. DIR may be a list of directories. */)
7645 Lisp_Object directory
;
7647 Lisp_Object list
= Qnil
;
7648 struct gcpro gcpro1
, gcpro2
;
7650 if (!CONSP (directory
))
7651 return w32_find_bdf_fonts_in_dir (directory
);
7653 for ( ; CONSP (directory
); directory
= XCDR (directory
))
7655 Lisp_Object pair
[2];
7658 GCPRO2 (directory
, list
);
7659 pair
[1] = w32_find_bdf_fonts_in_dir( XCAR (directory
) );
7660 list
= Fnconc( 2, pair
);
7667 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
7668 doc
: /* Internal function called by `color-defined-p', which see. */)
7670 Lisp_Object color
, frame
;
7673 FRAME_PTR f
= check_x_frame (frame
);
7675 CHECK_STRING (color
);
7677 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
7683 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
7684 doc
: /* Internal function called by `color-values', which see. */)
7686 Lisp_Object color
, frame
;
7689 FRAME_PTR f
= check_x_frame (frame
);
7691 CHECK_STRING (color
);
7693 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
7697 rgb
[0] = make_number ((GetRValue (foo
.pixel
) << 8)
7698 | GetRValue (foo
.pixel
));
7699 rgb
[1] = make_number ((GetGValue (foo
.pixel
) << 8)
7700 | GetGValue (foo
.pixel
));
7701 rgb
[2] = make_number ((GetBValue (foo
.pixel
) << 8)
7702 | GetBValue (foo
.pixel
));
7703 return Flist (3, rgb
);
7709 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
7710 doc
: /* Internal function called by `display-color-p', which see. */)
7712 Lisp_Object display
;
7714 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7716 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
7722 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
7723 Sx_display_grayscale_p
, 0, 1, 0,
7724 doc
: /* Return t if the X display supports shades of gray.
7725 Note that color displays do support shades of gray.
7726 The optional argument DISPLAY specifies which display to ask about.
7727 DISPLAY should be either a frame or a display name (a string).
7728 If omitted or nil, that stands for the selected frame's display. */)
7730 Lisp_Object display
;
7732 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7734 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
7740 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
7741 Sx_display_pixel_width
, 0, 1, 0,
7742 doc
: /* Returns the width in pixels of DISPLAY.
7743 The optional argument DISPLAY specifies which display to ask about.
7744 DISPLAY should be either a frame or a display name (a string).
7745 If omitted or nil, that stands for the selected frame's display. */)
7747 Lisp_Object display
;
7749 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7751 return make_number (dpyinfo
->width
);
7754 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
7755 Sx_display_pixel_height
, 0, 1, 0,
7756 doc
: /* Returns the height in pixels of DISPLAY.
7757 The optional argument DISPLAY specifies which display to ask about.
7758 DISPLAY should be either a frame or a display name (a string).
7759 If omitted or nil, that stands for the selected frame's display. */)
7761 Lisp_Object display
;
7763 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7765 return make_number (dpyinfo
->height
);
7768 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
7770 doc
: /* Returns the number of bitplanes of DISPLAY.
7771 The optional argument DISPLAY specifies which display to ask about.
7772 DISPLAY should be either a frame or a display name (a string).
7773 If omitted or nil, that stands for the selected frame's display. */)
7775 Lisp_Object display
;
7777 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7779 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7782 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
7784 doc
: /* Returns the number of color cells of DISPLAY.
7785 The optional argument DISPLAY specifies which display to ask about.
7786 DISPLAY should be either a frame or a display name (a string).
7787 If omitted or nil, that stands for the selected frame's display. */)
7789 Lisp_Object display
;
7791 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7795 hdc
= GetDC (dpyinfo
->root_window
);
7796 if (dpyinfo
->has_palette
)
7797 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
7799 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
7801 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
7802 and because probably is more meaningful on Windows anyway */
7804 cap
= 1 << min(dpyinfo
->n_planes
* dpyinfo
->n_cbits
, 24);
7806 ReleaseDC (dpyinfo
->root_window
, hdc
);
7808 return make_number (cap
);
7811 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
7812 Sx_server_max_request_size
,
7814 doc
: /* Returns the maximum request size of the server of DISPLAY.
7815 The optional argument DISPLAY specifies which display to ask about.
7816 DISPLAY should be either a frame or a display name (a string).
7817 If omitted or nil, that stands for the selected frame's display. */)
7819 Lisp_Object display
;
7821 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7823 return make_number (1);
7826 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
7827 doc
: /* Returns the vendor ID string of the W32 system (Microsoft).
7828 The optional argument DISPLAY specifies which display to ask about.
7829 DISPLAY should be either a frame or a display name (a string).
7830 If omitted or nil, that stands for the selected frame's display. */)
7832 Lisp_Object display
;
7834 return build_string ("Microsoft Corp.");
7837 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
7838 doc
: /* Returns the version numbers of the server of DISPLAY.
7839 The value is a list of three integers: the major and minor
7840 version numbers, and the vendor-specific release
7841 number. See also the function `x-server-vendor'.
7843 The optional argument DISPLAY specifies which display to ask about.
7844 DISPLAY should be either a frame or a display name (a string).
7845 If omitted or nil, that stands for the selected frame's display. */)
7847 Lisp_Object display
;
7849 return Fcons (make_number (w32_major_version
),
7850 Fcons (make_number (w32_minor_version
),
7851 Fcons (make_number (w32_build_number
), Qnil
)));
7854 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
7855 doc
: /* Returns the number of screens on the server of DISPLAY.
7856 The optional argument DISPLAY specifies which display to ask about.
7857 DISPLAY should be either a frame or a display name (a string).
7858 If omitted or nil, that stands for the selected frame's display. */)
7860 Lisp_Object display
;
7862 return make_number (1);
7865 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
7866 Sx_display_mm_height
, 0, 1, 0,
7867 doc
: /* Returns the height in millimeters of DISPLAY.
7868 The optional argument DISPLAY specifies which display to ask about.
7869 DISPLAY should be either a frame or a display name (a string).
7870 If omitted or nil, that stands for the selected frame's display. */)
7872 Lisp_Object display
;
7874 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7878 hdc
= GetDC (dpyinfo
->root_window
);
7880 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
7882 ReleaseDC (dpyinfo
->root_window
, hdc
);
7884 return make_number (cap
);
7887 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
7888 doc
: /* Returns the width in millimeters of DISPLAY.
7889 The optional argument DISPLAY specifies which display to ask about.
7890 DISPLAY should be either a frame or a display name (a string).
7891 If omitted or nil, that stands for the selected frame's display. */)
7893 Lisp_Object display
;
7895 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7900 hdc
= GetDC (dpyinfo
->root_window
);
7902 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
7904 ReleaseDC (dpyinfo
->root_window
, hdc
);
7906 return make_number (cap
);
7909 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
7910 Sx_display_backing_store
, 0, 1, 0,
7911 doc
: /* Returns an indication of whether DISPLAY does backing store.
7912 The value may be `always', `when-mapped', or `not-useful'.
7913 The optional argument DISPLAY specifies which display to ask about.
7914 DISPLAY should be either a frame or a display name (a string).
7915 If omitted or nil, that stands for the selected frame's display. */)
7917 Lisp_Object display
;
7919 return intern ("not-useful");
7922 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
7923 Sx_display_visual_class
, 0, 1, 0,
7924 doc
: /* Returns the visual class of DISPLAY.
7925 The value is one of the symbols `static-gray', `gray-scale',
7926 `static-color', `pseudo-color', `true-color', or `direct-color'.
7928 The optional argument DISPLAY specifies which display to ask about.
7929 DISPLAY should be either a frame or a display name (a string).
7930 If omitted or nil, that stands for the selected frame's display. */)
7932 Lisp_Object display
;
7934 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7935 Lisp_Object result
= Qnil
;
7937 if (dpyinfo
->has_palette
)
7938 result
= intern ("pseudo-color");
7939 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
7940 result
= intern ("static-grey");
7941 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
7942 result
= intern ("static-color");
7943 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
7944 result
= intern ("true-color");
7949 DEFUN ("x-display-save-under", Fx_display_save_under
,
7950 Sx_display_save_under
, 0, 1, 0,
7951 doc
: /* Returns t if DISPLAY supports the save-under feature.
7952 The optional argument DISPLAY specifies which display to ask about.
7953 DISPLAY should be either a frame or a display name (a string).
7954 If omitted or nil, that stands for the selected frame's display. */)
7956 Lisp_Object display
;
7963 register struct frame
*f
;
7965 return PIXEL_WIDTH (f
);
7970 register struct frame
*f
;
7972 return PIXEL_HEIGHT (f
);
7977 register struct frame
*f
;
7979 return FONT_WIDTH (f
->output_data
.w32
->font
);
7984 register struct frame
*f
;
7986 return f
->output_data
.w32
->line_height
;
7991 register struct frame
*f
;
7993 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
7996 /* Return the display structure for the display named NAME.
7997 Open a new connection if necessary. */
7999 struct w32_display_info
*
8000 x_display_info_for_name (name
)
8004 struct w32_display_info
*dpyinfo
;
8006 CHECK_STRING (name
);
8008 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
8010 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
8013 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
8018 /* Use this general default value to start with. */
8019 Vx_resource_name
= Vinvocation_name
;
8021 validate_x_resource_name ();
8023 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
8024 (char *) SDATA (Vx_resource_name
));
8027 error ("Cannot connect to server %s", SDATA (name
));
8030 XSETFASTINT (Vwindow_system_version
, 3);
8035 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
8036 1, 3, 0, doc
: /* Open a connection to a server.
8037 DISPLAY is the name of the display to connect to.
8038 Optional second arg XRM-STRING is a string of resources in xrdb format.
8039 If the optional third arg MUST-SUCCEED is non-nil,
8040 terminate Emacs if we can't open the connection. */)
8041 (display
, xrm_string
, must_succeed
)
8042 Lisp_Object display
, xrm_string
, must_succeed
;
8044 unsigned char *xrm_option
;
8045 struct w32_display_info
*dpyinfo
;
8047 /* If initialization has already been done, return now to avoid
8048 overwriting critical parts of one_w32_display_info. */
8052 CHECK_STRING (display
);
8053 if (! NILP (xrm_string
))
8054 CHECK_STRING (xrm_string
);
8056 if (! EQ (Vwindow_system
, intern ("w32")))
8057 error ("Not using Microsoft Windows");
8059 /* Allow color mapping to be defined externally; first look in user's
8060 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
8062 Lisp_Object color_file
;
8063 struct gcpro gcpro1
;
8065 color_file
= build_string("~/rgb.txt");
8067 GCPRO1 (color_file
);
8069 if (NILP (Ffile_readable_p (color_file
)))
8071 Fexpand_file_name (build_string ("rgb.txt"),
8072 Fsymbol_value (intern ("data-directory")));
8074 Vw32_color_map
= Fw32_load_color_file (color_file
);
8078 if (NILP (Vw32_color_map
))
8079 Vw32_color_map
= Fw32_default_color_map ();
8081 if (! NILP (xrm_string
))
8082 xrm_option
= (unsigned char *) SDATA (xrm_string
);
8084 xrm_option
= (unsigned char *) 0;
8086 /* Use this general default value to start with. */
8087 /* First remove .exe suffix from invocation-name - it looks ugly. */
8089 char basename
[ MAX_PATH
], *str
;
8091 strcpy (basename
, SDATA (Vinvocation_name
));
8092 str
= strrchr (basename
, '.');
8094 Vinvocation_name
= build_string (basename
);
8096 Vx_resource_name
= Vinvocation_name
;
8098 validate_x_resource_name ();
8100 /* This is what opens the connection and sets x_current_display.
8101 This also initializes many symbols, such as those used for input. */
8102 dpyinfo
= w32_term_init (display
, xrm_option
,
8103 (char *) SDATA (Vx_resource_name
));
8107 if (!NILP (must_succeed
))
8108 fatal ("Cannot connect to server %s.\n",
8111 error ("Cannot connect to server %s", SDATA (display
));
8116 XSETFASTINT (Vwindow_system_version
, 3);
8120 DEFUN ("x-close-connection", Fx_close_connection
,
8121 Sx_close_connection
, 1, 1, 0,
8122 doc
: /* Close the connection to DISPLAY's server.
8123 For DISPLAY, specify either a frame or a display name (a string).
8124 If DISPLAY is nil, that stands for the selected frame's display. */)
8126 Lisp_Object display
;
8128 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
8131 if (dpyinfo
->reference_count
> 0)
8132 error ("Display still has frames on it");
8135 /* Free the fonts in the font table. */
8136 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
8137 if (dpyinfo
->font_table
[i
].name
)
8139 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
8140 xfree (dpyinfo
->font_table
[i
].full_name
);
8141 xfree (dpyinfo
->font_table
[i
].name
);
8142 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
8144 x_destroy_all_bitmaps (dpyinfo
);
8146 x_delete_display (dpyinfo
);
8152 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
8153 doc
: /* Return the list of display names that Emacs has connections to. */)
8156 Lisp_Object tail
, result
;
8159 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
8160 result
= Fcons (XCAR (XCAR (tail
)), result
);
8165 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
8166 doc
: /* This is a noop on W32 systems. */)
8168 Lisp_Object display
, on
;
8174 /***********************************************************************
8176 ***********************************************************************/
8178 /* Value is the number of elements of vector VECTOR. */
8180 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
8182 /* List of supported image types. Use define_image_type to add new
8183 types. Use lookup_image_type to find a type for a given symbol. */
8185 static struct image_type
*image_types
;
8187 /* The symbol `image' which is the car of the lists used to represent
8190 extern Lisp_Object Qimage
;
8192 /* The symbol `xbm' which is used as the type symbol for XBM images. */
8198 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
8199 extern Lisp_Object QCdata
, QCtype
;
8200 Lisp_Object QCascent
, QCmargin
, QCrelief
;
8201 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
8202 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
8204 /* Other symbols. */
8206 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
8208 /* Time in seconds after which images should be removed from the cache
8209 if not displayed. */
8211 Lisp_Object Vimage_cache_eviction_delay
;
8213 /* Function prototypes. */
8215 static void define_image_type
P_ ((struct image_type
*type
));
8216 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
8217 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
8218 static void x_laplace
P_ ((struct frame
*, struct image
*));
8219 static void x_emboss
P_ ((struct frame
*, struct image
*));
8220 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
8224 /* Define a new image type from TYPE. This adds a copy of TYPE to
8225 image_types and adds the symbol *TYPE->type to Vimage_types. */
8228 define_image_type (type
)
8229 struct image_type
*type
;
8231 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
8232 The initialized data segment is read-only. */
8233 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
8234 bcopy (type
, p
, sizeof *p
);
8235 p
->next
= image_types
;
8237 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
8241 /* Look up image type SYMBOL, and return a pointer to its image_type
8242 structure. Value is null if SYMBOL is not a known image type. */
8244 static INLINE
struct image_type
*
8245 lookup_image_type (symbol
)
8248 struct image_type
*type
;
8250 for (type
= image_types
; type
; type
= type
->next
)
8251 if (EQ (symbol
, *type
->type
))
8258 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
8259 valid image specification is a list whose car is the symbol
8260 `image', and whose rest is a property list. The property list must
8261 contain a value for key `:type'. That value must be the name of a
8262 supported image type. The rest of the property list depends on the
8266 valid_image_p (object
)
8271 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
8275 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
8276 if (EQ (XCAR (tem
), QCtype
))
8279 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
8281 struct image_type
*type
;
8282 type
= lookup_image_type (XCAR (tem
));
8284 valid_p
= type
->valid_p (object
);
8295 /* Log error message with format string FORMAT and argument ARG.
8296 Signaling an error, e.g. when an image cannot be loaded, is not a
8297 good idea because this would interrupt redisplay, and the error
8298 message display would lead to another redisplay. This function
8299 therefore simply displays a message. */
8302 image_error (format
, arg1
, arg2
)
8304 Lisp_Object arg1
, arg2
;
8306 add_to_log (format
, arg1
, arg2
);
8311 /***********************************************************************
8312 Image specifications
8313 ***********************************************************************/
8315 enum image_value_type
8317 IMAGE_DONT_CHECK_VALUE_TYPE
,
8319 IMAGE_STRING_OR_NIL_VALUE
,
8321 IMAGE_POSITIVE_INTEGER_VALUE
,
8322 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
8323 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
8325 IMAGE_INTEGER_VALUE
,
8326 IMAGE_FUNCTION_VALUE
,
8331 /* Structure used when parsing image specifications. */
8333 struct image_keyword
8335 /* Name of keyword. */
8338 /* The type of value allowed. */
8339 enum image_value_type type
;
8341 /* Non-zero means key must be present. */
8344 /* Used to recognize duplicate keywords in a property list. */
8347 /* The value that was found. */
8352 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
8354 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
8357 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
8358 has the format (image KEYWORD VALUE ...). One of the keyword/
8359 value pairs must be `:type TYPE'. KEYWORDS is a vector of
8360 image_keywords structures of size NKEYWORDS describing other
8361 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
8364 parse_image_spec (spec
, keywords
, nkeywords
, type
)
8366 struct image_keyword
*keywords
;
8373 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
8376 plist
= XCDR (spec
);
8377 while (CONSP (plist
))
8379 Lisp_Object key
, value
;
8381 /* First element of a pair must be a symbol. */
8383 plist
= XCDR (plist
);
8387 /* There must follow a value. */
8390 value
= XCAR (plist
);
8391 plist
= XCDR (plist
);
8393 /* Find key in KEYWORDS. Error if not found. */
8394 for (i
= 0; i
< nkeywords
; ++i
)
8395 if (strcmp (keywords
[i
].name
, SDATA (SYMBOL_NAME (key
))) == 0)
8401 /* Record that we recognized the keyword. If a keywords
8402 was found more than once, it's an error. */
8403 keywords
[i
].value
= value
;
8404 ++keywords
[i
].count
;
8406 if (keywords
[i
].count
> 1)
8409 /* Check type of value against allowed type. */
8410 switch (keywords
[i
].type
)
8412 case IMAGE_STRING_VALUE
:
8413 if (!STRINGP (value
))
8417 case IMAGE_STRING_OR_NIL_VALUE
:
8418 if (!STRINGP (value
) && !NILP (value
))
8422 case IMAGE_SYMBOL_VALUE
:
8423 if (!SYMBOLP (value
))
8427 case IMAGE_POSITIVE_INTEGER_VALUE
:
8428 if (!INTEGERP (value
) || XINT (value
) <= 0)
8432 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
8433 if (INTEGERP (value
) && XINT (value
) >= 0)
8436 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
8437 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
8441 case IMAGE_ASCENT_VALUE
:
8442 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
8444 else if (INTEGERP (value
)
8445 && XINT (value
) >= 0
8446 && XINT (value
) <= 100)
8450 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
8451 if (!INTEGERP (value
) || XINT (value
) < 0)
8455 case IMAGE_DONT_CHECK_VALUE_TYPE
:
8458 case IMAGE_FUNCTION_VALUE
:
8459 value
= indirect_function (value
);
8461 || COMPILEDP (value
)
8462 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
8466 case IMAGE_NUMBER_VALUE
:
8467 if (!INTEGERP (value
) && !FLOATP (value
))
8471 case IMAGE_INTEGER_VALUE
:
8472 if (!INTEGERP (value
))
8476 case IMAGE_BOOL_VALUE
:
8477 if (!NILP (value
) && !EQ (value
, Qt
))
8486 if (EQ (key
, QCtype
) && !EQ (type
, value
))
8490 /* Check that all mandatory fields are present. */
8491 for (i
= 0; i
< nkeywords
; ++i
)
8492 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
8495 return NILP (plist
);
8499 /* Return the value of KEY in image specification SPEC. Value is nil
8500 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8501 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8504 image_spec_value (spec
, key
, found
)
8505 Lisp_Object spec
, key
;
8510 xassert (valid_image_p (spec
));
8512 for (tail
= XCDR (spec
);
8513 CONSP (tail
) && CONSP (XCDR (tail
));
8514 tail
= XCDR (XCDR (tail
)))
8516 if (EQ (XCAR (tail
), key
))
8520 return XCAR (XCDR (tail
));
8530 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
8531 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
8532 PIXELS non-nil means return the size in pixels, otherwise return the
8533 size in canonical character units.
8534 FRAME is the frame on which the image will be displayed. FRAME nil
8535 or omitted means use the selected frame. */)
8536 (spec
, pixels
, frame
)
8537 Lisp_Object spec
, pixels
, frame
;
8542 if (valid_image_p (spec
))
8544 struct frame
*f
= check_x_frame (frame
);
8545 int id
= lookup_image (f
, spec
);
8546 struct image
*img
= IMAGE_FROM_ID (f
, id
);
8547 int width
= img
->width
+ 2 * img
->hmargin
;
8548 int height
= img
->height
+ 2 * img
->vmargin
;
8551 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
8552 make_float ((double) height
/ CANON_Y_UNIT (f
)));
8554 size
= Fcons (make_number (width
), make_number (height
));
8557 error ("Invalid image specification");
8563 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
8564 doc
: /* Return t if image SPEC has a mask bitmap.
8565 FRAME is the frame on which the image will be displayed. FRAME nil
8566 or omitted means use the selected frame. */)
8568 Lisp_Object spec
, frame
;
8573 if (valid_image_p (spec
))
8575 struct frame
*f
= check_x_frame (frame
);
8576 int id
= lookup_image (f
, spec
);
8577 struct image
*img
= IMAGE_FROM_ID (f
, id
);
8582 error ("Invalid image specification");
8588 /***********************************************************************
8589 Image type independent image structures
8590 ***********************************************************************/
8592 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
8593 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
8594 static void x_destroy_x_image
P_ ((XImage
*));
8597 /* Allocate and return a new image structure for image specification
8598 SPEC. SPEC has a hash value of HASH. */
8600 static struct image
*
8601 make_image (spec
, hash
)
8605 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
8607 xassert (valid_image_p (spec
));
8608 bzero (img
, sizeof *img
);
8609 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
8610 xassert (img
->type
!= NULL
);
8612 img
->data
.lisp_val
= Qnil
;
8613 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
8619 /* Free image IMG which was used on frame F, including its resources. */
8628 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8630 /* Remove IMG from the hash table of its cache. */
8632 img
->prev
->next
= img
->next
;
8634 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
8637 img
->next
->prev
= img
->prev
;
8639 c
->images
[img
->id
] = NULL
;
8641 /* Free resources, then free IMG. */
8642 img
->type
->free (f
, img
);
8648 /* Prepare image IMG for display on frame F. Must be called before
8649 drawing an image. */
8652 prepare_image_for_display (f
, img
)
8658 /* We're about to display IMG, so set its timestamp to `now'. */
8660 img
->timestamp
= EMACS_SECS (t
);
8662 /* If IMG doesn't have a pixmap yet, load it now, using the image
8663 type dependent loader function. */
8664 if (img
->pixmap
== 0 && !img
->load_failed_p
)
8665 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8669 /* Value is the number of pixels for the ascent of image IMG when
8670 drawn in face FACE. */
8673 image_ascent (img
, face
)
8677 int height
= img
->height
+ img
->vmargin
;
8680 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
8683 ascent
= height
/ 2 - (FONT_DESCENT(face
->font
)
8684 - FONT_BASE(face
->font
)) / 2;
8686 ascent
= height
/ 2;
8689 ascent
= (int) (height
* img
->ascent
/ 100.0);
8696 /* Image background colors. */
8698 /* Find the "best" corner color of a bitmap. XIMG is assumed to a device
8699 context with the bitmap selected. */
8701 four_corners_best (img_dc
, width
, height
)
8703 unsigned long width
, height
;
8705 COLORREF corners
[4], best
;
8708 /* Get the colors at the corners of img_dc. */
8709 corners
[0] = GetPixel (img_dc
, 0, 0);
8710 corners
[1] = GetPixel (img_dc
, width
- 1, 0);
8711 corners
[2] = GetPixel (img_dc
, width
- 1, height
- 1);
8712 corners
[3] = GetPixel (img_dc
, 0, height
- 1);
8714 /* Choose the most frequently found color as background. */
8715 for (i
= best_count
= 0; i
< 4; ++i
)
8719 for (j
= n
= 0; j
< 4; ++j
)
8720 if (corners
[i
] == corners
[j
])
8724 best
= corners
[i
], best_count
= n
;
8730 /* Return the `background' field of IMG. If IMG doesn't have one yet,
8731 it is guessed heuristically. If non-zero, IMG_DC is an existing
8732 device context with the image selected to use for the heuristic. */
8735 image_background (img
, f
, img_dc
)
8740 if (! img
->background_valid
)
8741 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8743 int free_ximg
= !img_dc
;
8748 HDC frame_dc
= get_frame_dc (f
);
8749 img_dc
= CreateCompatibleDC (frame_dc
);
8750 release_frame_dc (f
, frame_dc
);
8752 prev
= SelectObject (img_dc
, img
->pixmap
);
8755 img
->background
= four_corners_best (img_dc
, img
->width
, img
->height
);
8759 SelectObject (img_dc
, prev
);
8763 img
->background_valid
= 1;
8766 return img
->background
;
8769 /* Return the `background_transparent' field of IMG. If IMG doesn't
8770 have one yet, it is guessed heuristically. If non-zero, MASK is an
8771 existing XImage object to use for the heuristic. */
8774 image_background_transparent (img
, f
, mask
)
8779 if (! img
->background_transparent_valid
)
8780 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8784 int free_mask
= !mask
;
8789 HDC frame_dc
= get_frame_dc (f
);
8790 mask
= CreateCompatibleDC (frame_dc
);
8791 release_frame_dc (f
, frame_dc
);
8793 prev
= SelectObject (mask
, img
->mask
);
8796 img
->background_transparent
8797 = !four_corners_best (mask
, img
->width
, img
->height
);
8801 SelectObject (mask
, prev
);
8806 img
->background_transparent
= 0;
8808 img
->background_transparent_valid
= 1;
8811 return img
->background_transparent
;
8815 /***********************************************************************
8816 Helper functions for X image types
8817 ***********************************************************************/
8819 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
8821 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8822 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
8824 Lisp_Object color_name
,
8825 unsigned long dflt
));
8828 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
8829 free the pixmap if any. MASK_P non-zero means clear the mask
8830 pixmap if any. COLORS_P non-zero means free colors allocated for
8831 the image, if any. */
8834 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
8837 int pixmap_p
, mask_p
, colors_p
;
8839 if (pixmap_p
&& img
->pixmap
)
8841 DeleteObject (img
->pixmap
);
8843 img
->background_valid
= 0;
8846 if (mask_p
&& img
->mask
)
8848 DeleteObject (img
->mask
);
8850 img
->background_transparent_valid
= 0;
8853 if (colors_p
&& img
->ncolors
)
8855 #if 0 /* TODO: color table support. */
8856 x_free_colors (f
, img
->colors
, img
->ncolors
);
8858 xfree (img
->colors
);
8864 /* Free X resources of image IMG which is used on frame F. */
8867 x_clear_image (f
, img
)
8874 DeleteObject (img
->pixmap
);
8881 #if 0 /* TODO: color table support */
8883 int class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
8885 /* If display has an immutable color map, freeing colors is not
8886 necessary and some servers don't allow it. So don't do it. */
8887 if (class != StaticColor
8888 && class != StaticGray
8889 && class != TrueColor
)
8893 cmap
= DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f
)->screen
);
8894 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
, img
->colors
,
8900 xfree (img
->colors
);
8907 /* Allocate color COLOR_NAME for image IMG on frame F. If color
8908 cannot be allocated, use DFLT. Add a newly allocated color to
8909 IMG->colors, so that it can be freed again. Value is the pixel
8912 static unsigned long
8913 x_alloc_image_color (f
, img
, color_name
, dflt
)
8916 Lisp_Object color_name
;
8920 unsigned long result
;
8922 xassert (STRINGP (color_name
));
8924 if (w32_defined_color (f
, SDATA (color_name
), &color
, 1))
8926 /* This isn't called frequently so we get away with simply
8927 reallocating the color vector to the needed size, here. */
8930 (unsigned long *) xrealloc (img
->colors
,
8931 img
->ncolors
* sizeof *img
->colors
);
8932 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
8933 result
= color
.pixel
;
8942 /***********************************************************************
8944 ***********************************************************************/
8946 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
8947 static void postprocess_image
P_ ((struct frame
*, struct image
*));
8948 static void x_disable_image
P_ ((struct frame
*, struct image
*));
8951 /* Return a new, initialized image cache that is allocated from the
8952 heap. Call free_image_cache to free an image cache. */
8954 struct image_cache
*
8957 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
8960 bzero (c
, sizeof *c
);
8962 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
8963 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
8964 c
->buckets
= (struct image
**) xmalloc (size
);
8965 bzero (c
->buckets
, size
);
8970 /* Free image cache of frame F. Be aware that X frames share images
8974 free_image_cache (f
)
8977 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8982 /* Cache should not be referenced by any frame when freed. */
8983 xassert (c
->refcount
== 0);
8985 for (i
= 0; i
< c
->used
; ++i
)
8986 free_image (f
, c
->images
[i
]);
8990 FRAME_X_IMAGE_CACHE (f
) = NULL
;
8995 /* Clear image cache of frame F. FORCE_P non-zero means free all
8996 images. FORCE_P zero means clear only images that haven't been
8997 displayed for some time. Should be called from time to time to
8998 reduce the number of loaded images. If image-eviction-seconds is
8999 non-nil, this frees images in the cache which weren't displayed for
9000 at least that many seconds. */
9003 clear_image_cache (f
, force_p
)
9007 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9009 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
9016 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
9018 /* Block input so that we won't be interrupted by a SIGIO
9019 while being in an inconsistent state. */
9022 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
9024 struct image
*img
= c
->images
[i
];
9026 && (force_p
|| (img
->timestamp
< old
)))
9028 free_image (f
, img
);
9033 /* We may be clearing the image cache because, for example,
9034 Emacs was iconified for a longer period of time. In that
9035 case, current matrices may still contain references to
9036 images freed above. So, clear these matrices. */
9039 Lisp_Object tail
, frame
;
9041 FOR_EACH_FRAME (tail
, frame
)
9043 struct frame
*f
= XFRAME (frame
);
9045 && FRAME_X_IMAGE_CACHE (f
) == c
)
9046 clear_current_matrices (f
);
9049 ++windows_or_buffers_changed
;
9057 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
9059 doc
: /* Clear the image cache of FRAME.
9060 FRAME nil or omitted means use the selected frame.
9061 FRAME t means clear the image caches of all frames. */)
9069 FOR_EACH_FRAME (tail
, frame
)
9070 if (FRAME_W32_P (XFRAME (frame
)))
9071 clear_image_cache (XFRAME (frame
), 1);
9074 clear_image_cache (check_x_frame (frame
), 1);
9080 /* Compute masks and transform image IMG on frame F, as specified
9081 by the image's specification, */
9084 postprocess_image (f
, img
)
9088 /* Manipulation of the image's mask. */
9091 Lisp_Object conversion
, spec
;
9096 /* `:heuristic-mask t'
9098 means build a mask heuristically.
9099 `:heuristic-mask (R G B)'
9100 `:mask (heuristic (R G B))'
9101 means build a mask from color (R G B) in the
9104 means remove a mask, if any. */
9106 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
9108 x_build_heuristic_mask (f
, img
, mask
);
9113 mask
= image_spec_value (spec
, QCmask
, &found_p
);
9115 if (EQ (mask
, Qheuristic
))
9116 x_build_heuristic_mask (f
, img
, Qt
);
9117 else if (CONSP (mask
)
9118 && EQ (XCAR (mask
), Qheuristic
))
9120 if (CONSP (XCDR (mask
)))
9121 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
9123 x_build_heuristic_mask (f
, img
, XCDR (mask
));
9125 else if (NILP (mask
) && found_p
&& img
->mask
)
9127 DeleteObject (img
->mask
);
9133 /* Should we apply an image transformation algorithm? */
9134 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
9135 if (EQ (conversion
, Qdisabled
))
9136 x_disable_image (f
, img
);
9137 else if (EQ (conversion
, Qlaplace
))
9139 else if (EQ (conversion
, Qemboss
))
9141 else if (CONSP (conversion
)
9142 && EQ (XCAR (conversion
), Qedge_detection
))
9145 tem
= XCDR (conversion
);
9147 x_edge_detection (f
, img
,
9148 Fplist_get (tem
, QCmatrix
),
9149 Fplist_get (tem
, QCcolor_adjustment
));
9155 /* Return the id of image with Lisp specification SPEC on frame F.
9156 SPEC must be a valid Lisp image specification (see valid_image_p). */
9159 lookup_image (f
, spec
)
9163 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9167 struct gcpro gcpro1
;
9170 /* F must be a window-system frame, and SPEC must be a valid image
9172 xassert (FRAME_WINDOW_P (f
));
9173 xassert (valid_image_p (spec
));
9177 /* Look up SPEC in the hash table of the image cache. */
9178 hash
= sxhash (spec
, 0);
9179 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
9181 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
9182 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
9185 /* If not found, create a new image and cache it. */
9188 extern Lisp_Object Qpostscript
;
9191 img
= make_image (spec
, hash
);
9192 cache_image (f
, img
);
9193 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
9195 /* If we can't load the image, and we don't have a width and
9196 height, use some arbitrary width and height so that we can
9197 draw a rectangle for it. */
9198 if (img
->load_failed_p
)
9202 value
= image_spec_value (spec
, QCwidth
, NULL
);
9203 img
->width
= (INTEGERP (value
)
9204 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
9205 value
= image_spec_value (spec
, QCheight
, NULL
);
9206 img
->height
= (INTEGERP (value
)
9207 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
9211 /* Handle image type independent image attributes
9212 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
9213 `:background COLOR'. */
9214 Lisp_Object ascent
, margin
, relief
, bg
;
9216 ascent
= image_spec_value (spec
, QCascent
, NULL
);
9217 if (INTEGERP (ascent
))
9218 img
->ascent
= XFASTINT (ascent
);
9219 else if (EQ (ascent
, Qcenter
))
9220 img
->ascent
= CENTERED_IMAGE_ASCENT
;
9222 margin
= image_spec_value (spec
, QCmargin
, NULL
);
9223 if (INTEGERP (margin
) && XINT (margin
) >= 0)
9224 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
9225 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
9226 && INTEGERP (XCDR (margin
)))
9228 if (XINT (XCAR (margin
)) > 0)
9229 img
->hmargin
= XFASTINT (XCAR (margin
));
9230 if (XINT (XCDR (margin
)) > 0)
9231 img
->vmargin
= XFASTINT (XCDR (margin
));
9234 relief
= image_spec_value (spec
, QCrelief
, NULL
);
9235 if (INTEGERP (relief
))
9237 img
->relief
= XINT (relief
);
9238 img
->hmargin
+= abs (img
->relief
);
9239 img
->vmargin
+= abs (img
->relief
);
9242 if (! img
->background_valid
)
9244 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
9248 = x_alloc_image_color (f
, img
, bg
,
9249 FRAME_BACKGROUND_PIXEL (f
));
9250 img
->background_valid
= 1;
9254 /* Do image transformations and compute masks, unless we
9255 don't have the image yet. */
9256 if (!EQ (*img
->type
->type
, Qpostscript
))
9257 postprocess_image (f
, img
);
9261 xassert (!interrupt_input_blocked
);
9264 /* We're using IMG, so set its timestamp to `now'. */
9265 EMACS_GET_TIME (now
);
9266 img
->timestamp
= EMACS_SECS (now
);
9270 /* Value is the image id. */
9275 /* Cache image IMG in the image cache of frame F. */
9278 cache_image (f
, img
)
9282 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9285 /* Find a free slot in c->images. */
9286 for (i
= 0; i
< c
->used
; ++i
)
9287 if (c
->images
[i
] == NULL
)
9290 /* If no free slot found, maybe enlarge c->images. */
9291 if (i
== c
->used
&& c
->used
== c
->size
)
9294 c
->images
= (struct image
**) xrealloc (c
->images
,
9295 c
->size
* sizeof *c
->images
);
9298 /* Add IMG to c->images, and assign IMG an id. */
9304 /* Add IMG to the cache's hash table. */
9305 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
9306 img
->next
= c
->buckets
[i
];
9308 img
->next
->prev
= img
;
9310 c
->buckets
[i
] = img
;
9314 /* Call FN on every image in the image cache of frame F. Used to mark
9315 Lisp Objects in the image cache. */
9318 forall_images_in_image_cache (f
, fn
)
9320 void (*fn
) P_ ((struct image
*img
));
9322 if (FRAME_LIVE_P (f
) && FRAME_W32_P (f
))
9324 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9328 for (i
= 0; i
< c
->used
; ++i
)
9337 /***********************************************************************
9339 ***********************************************************************/
9341 /* Macro for defining functions that will be loaded from image DLLs. */
9342 #define DEF_IMGLIB_FN(func) FARPROC fn_##func
9344 /* Macro for loading those image functions from the library. */
9345 #define LOAD_IMGLIB_FN(lib,func) { \
9346 fn_##func = (void *) GetProcAddress (lib, #func); \
9347 if (!fn_##func) return 0; \
9350 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
9351 XImage
**, Pixmap
*));
9352 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
9355 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
9356 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
9357 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
9358 via xmalloc. DEPTH of zero signifies a 24 bit image, otherwise
9359 DEPTH should indicate the bit depth of the image. Print error
9360 messages via image_error if an error occurs. Value is non-zero if
9364 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
9366 int width
, height
, depth
;
9370 BITMAPINFOHEADER
*header
;
9372 int scanline_width_bits
;
9374 int palette_colors
= 0;
9379 if (depth
!= 1 && depth
!= 4 && depth
!= 8
9380 && depth
!= 16 && depth
!= 24 && depth
!= 32)
9382 image_error ("Invalid image bit depth specified", Qnil
, Qnil
);
9386 scanline_width_bits
= width
* depth
;
9387 remainder
= scanline_width_bits
% 32;
9390 scanline_width_bits
+= 32 - remainder
;
9392 /* Bitmaps with a depth less than 16 need a palette. */
9393 /* BITMAPINFO structure already contains the first RGBQUAD. */
9395 palette_colors
= 1 << depth
- 1;
9397 *ximg
= xmalloc (sizeof (XImage
) + palette_colors
* sizeof (RGBQUAD
));
9400 image_error ("Unable to allocate memory for XImage", Qnil
, Qnil
);
9404 header
= &((*ximg
)->info
.bmiHeader
);
9405 bzero (&((*ximg
)->info
), sizeof (BITMAPINFO
));
9406 header
->biSize
= sizeof (*header
);
9407 header
->biWidth
= width
;
9408 header
->biHeight
= -height
; /* negative indicates a top-down bitmap. */
9409 header
->biPlanes
= 1;
9410 header
->biBitCount
= depth
;
9411 header
->biCompression
= BI_RGB
;
9412 header
->biClrUsed
= palette_colors
;
9414 /* TODO: fill in palette. */
9417 (*ximg
)->info
.bmiColors
[0].rgbBlue
= 0;
9418 (*ximg
)->info
.bmiColors
[0].rgbGreen
= 0;
9419 (*ximg
)->info
.bmiColors
[0].rgbRed
= 0;
9420 (*ximg
)->info
.bmiColors
[0].rgbReserved
= 0;
9421 (*ximg
)->info
.bmiColors
[1].rgbBlue
= 255;
9422 (*ximg
)->info
.bmiColors
[1].rgbGreen
= 255;
9423 (*ximg
)->info
.bmiColors
[1].rgbRed
= 255;
9424 (*ximg
)->info
.bmiColors
[1].rgbReserved
= 0;
9427 hdc
= get_frame_dc (f
);
9429 /* Create a DIBSection and raster array for the bitmap,
9430 and store its handle in *pixmap. */
9431 *pixmap
= CreateDIBSection (hdc
, &((*ximg
)->info
),
9432 (depth
< 16) ? DIB_PAL_COLORS
: DIB_RGB_COLORS
,
9433 &((*ximg
)->data
), NULL
, 0);
9435 /* Realize display palette and garbage all frames. */
9436 release_frame_dc (f
, hdc
);
9438 if (*pixmap
== NULL
)
9440 DWORD err
= GetLastError();
9441 Lisp_Object errcode
;
9442 /* All system errors are < 10000, so the following is safe. */
9443 XSETINT (errcode
, (int) err
);
9444 image_error ("Unable to create bitmap, error code %d", errcode
, Qnil
);
9445 x_destroy_x_image (*ximg
);
9453 /* Destroy XImage XIMG. Free XIMG->data. */
9456 x_destroy_x_image (ximg
)
9459 xassert (interrupt_input_blocked
);
9462 /* Data will be freed by DestroyObject. */
9469 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
9470 are width and height of both the image and pixmap. */
9473 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
9479 #if 0 /* I don't think this is necessary looking at where it is used. */
9480 HDC hdc
= get_frame_dc (f
);
9481 SetDIBits (hdc
, pixmap
, 0, height
, ximg
->data
, &(ximg
->info
), DIB_RGB_COLORS
);
9482 release_frame_dc (f
, hdc
);
9487 /***********************************************************************
9489 ***********************************************************************/
9491 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
9492 static char *slurp_file
P_ ((char *, int *));
9495 /* Find image file FILE. Look in data-directory, then
9496 x-bitmap-file-path. Value is the full name of the file found, or
9497 nil if not found. */
9500 x_find_image_file (file
)
9503 Lisp_Object file_found
, search_path
;
9504 struct gcpro gcpro1
, gcpro2
;
9508 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
9509 GCPRO2 (file_found
, search_path
);
9511 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
9512 fd
= openp (search_path
, file
, Qnil
, &file_found
, Qnil
);
9524 /* Read FILE into memory. Value is a pointer to a buffer allocated
9525 with xmalloc holding FILE's contents. Value is null if an error
9526 occurred. *SIZE is set to the size of the file. */
9529 slurp_file (file
, size
)
9537 if (stat (file
, &st
) == 0
9538 && (fp
= fopen (file
, "r")) != NULL
9539 && (buf
= (char *) xmalloc (st
.st_size
),
9540 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
9561 /***********************************************************************
9563 ***********************************************************************/
9565 static int xbm_scan
P_ ((char **, char *, char *, int *));
9566 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
9567 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
9569 static int xbm_image_p
P_ ((Lisp_Object object
));
9570 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
9572 static int xbm_file_p
P_ ((Lisp_Object
));
9575 /* Indices of image specification fields in xbm_format, below. */
9577 enum xbm_keyword_index
9595 /* Vector of image_keyword structures describing the format
9596 of valid XBM image specifications. */
9598 static struct image_keyword xbm_format
[XBM_LAST
] =
9600 {":type", IMAGE_SYMBOL_VALUE
, 1},
9601 {":file", IMAGE_STRING_VALUE
, 0},
9602 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9603 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9604 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9605 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
9606 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
9607 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9608 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9609 {":relief", IMAGE_INTEGER_VALUE
, 0},
9610 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9611 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9612 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9615 /* Structure describing the image type XBM. */
9617 static struct image_type xbm_type
=
9626 /* Tokens returned from xbm_scan. */
9635 /* Return non-zero if OBJECT is a valid XBM-type image specification.
9636 A valid specification is a list starting with the symbol `image'
9637 The rest of the list is a property list which must contain an
9640 If the specification specifies a file to load, it must contain
9641 an entry `:file FILENAME' where FILENAME is a string.
9643 If the specification is for a bitmap loaded from memory it must
9644 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
9645 WIDTH and HEIGHT are integers > 0. DATA may be:
9647 1. a string large enough to hold the bitmap data, i.e. it must
9648 have a size >= (WIDTH + 7) / 8 * HEIGHT
9650 2. a bool-vector of size >= WIDTH * HEIGHT
9652 3. a vector of strings or bool-vectors, one for each line of the
9655 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
9656 may not be specified in this case because they are defined in the
9659 Both the file and data forms may contain the additional entries
9660 `:background COLOR' and `:foreground COLOR'. If not present,
9661 foreground and background of the frame on which the image is
9662 displayed is used. */
9665 xbm_image_p (object
)
9668 struct image_keyword kw
[XBM_LAST
];
9670 bcopy (xbm_format
, kw
, sizeof kw
);
9671 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
9674 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
9676 if (kw
[XBM_FILE
].count
)
9678 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
9681 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
9683 /* In-memory XBM file. */
9684 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
9692 /* Entries for `:width', `:height' and `:data' must be present. */
9693 if (!kw
[XBM_WIDTH
].count
9694 || !kw
[XBM_HEIGHT
].count
9695 || !kw
[XBM_DATA
].count
)
9698 data
= kw
[XBM_DATA
].value
;
9699 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
9700 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
9702 /* Check type of data, and width and height against contents of
9708 /* Number of elements of the vector must be >= height. */
9709 if (XVECTOR (data
)->size
< height
)
9712 /* Each string or bool-vector in data must be large enough
9713 for one line of the image. */
9714 for (i
= 0; i
< height
; ++i
)
9716 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
9721 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
9724 else if (BOOL_VECTOR_P (elt
))
9726 if (XBOOL_VECTOR (elt
)->size
< width
)
9733 else if (STRINGP (data
))
9736 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
9739 else if (BOOL_VECTOR_P (data
))
9741 if (XBOOL_VECTOR (data
)->size
< width
* height
)
9752 /* Scan a bitmap file. FP is the stream to read from. Value is
9753 either an enumerator from enum xbm_token, or a character for a
9754 single-character token, or 0 at end of file. If scanning an
9755 identifier, store the lexeme of the identifier in SVAL. If
9756 scanning a number, store its value in *IVAL. */
9759 xbm_scan (s
, end
, sval
, ival
)
9768 /* Skip white space. */
9769 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
9774 else if (isdigit (c
))
9776 int value
= 0, digit
;
9778 if (c
== '0' && *s
< end
)
9781 if (c
== 'x' || c
== 'X')
9788 else if (c
>= 'a' && c
<= 'f')
9789 digit
= c
- 'a' + 10;
9790 else if (c
>= 'A' && c
<= 'F')
9791 digit
= c
- 'A' + 10;
9794 value
= 16 * value
+ digit
;
9797 else if (isdigit (c
))
9801 && (c
= *(*s
)++, isdigit (c
)))
9802 value
= 8 * value
+ c
- '0';
9809 && (c
= *(*s
)++, isdigit (c
)))
9810 value
= 10 * value
+ c
- '0';
9818 else if (isalpha (c
) || c
== '_')
9822 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
9829 else if (c
== '/' && **s
== '*')
9831 /* C-style comment. */
9833 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
9846 /* XBM bits seem to be backward within bytes compared with how
9847 Windows does things. */
9848 static unsigned char reflect_byte (unsigned char orig
)
9851 unsigned char reflected
= 0x00;
9852 for (i
= 0; i
< 8; i
++)
9854 if (orig
& (0x01 << i
))
9855 reflected
|= 0x80 >> i
;
9861 /* Create a Windows bitmap from X bitmap data. */
9863 w32_create_pixmap_from_bitmap_data (int width
, int height
, char *data
)
9869 w1
= (width
+ 7) / 8; /* nb of 8bits elt in X bitmap */
9870 w2
= ((width
+ 15) / 16) * 2; /* nb of 16bits elt in W32 bitmap */
9871 bits
= (char *) alloca (height
* w2
);
9872 bzero (bits
, height
* w2
);
9873 for (i
= 0; i
< height
; i
++)
9876 for (j
= 0; j
< w1
; j
++)
9877 *p
++ = reflect_byte(*data
++);
9879 bmp
= CreateBitmap (width
, height
, 1, 1, bits
);
9885 /* Replacement for XReadBitmapFileData which isn't available under old
9886 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9887 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9888 the image. Return in *DATA the bitmap data allocated with xmalloc.
9889 Value is non-zero if successful. DATA null means just test if
9890 CONTENTS looks like an in-memory XBM file. */
9893 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
9894 char *contents
, *end
;
9895 int *width
, *height
;
9896 unsigned char **data
;
9899 char buffer
[BUFSIZ
];
9902 int bytes_per_line
, i
, nbytes
;
9908 LA1 = xbm_scan (&s, end, buffer, &value)
9910 #define expect(TOKEN) \
9911 if (LA1 != (TOKEN)) \
9916 #define expect_ident(IDENT) \
9917 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9922 *width
= *height
= -1;
9925 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
9927 /* Parse defines for width, height and hot-spots. */
9931 expect_ident ("define");
9932 expect (XBM_TK_IDENT
);
9934 if (LA1
== XBM_TK_NUMBER
);
9936 char *p
= strrchr (buffer
, '_');
9937 p
= p
? p
+ 1 : buffer
;
9938 if (strcmp (p
, "width") == 0)
9940 else if (strcmp (p
, "height") == 0)
9943 expect (XBM_TK_NUMBER
);
9946 if (*width
< 0 || *height
< 0)
9948 else if (data
== NULL
)
9951 /* Parse bits. Must start with `static'. */
9952 expect_ident ("static");
9953 if (LA1
== XBM_TK_IDENT
)
9955 if (strcmp (buffer
, "unsigned") == 0)
9958 expect_ident ("char");
9960 else if (strcmp (buffer
, "short") == 0)
9964 if (*width
% 16 && *width
% 16 < 9)
9967 else if (strcmp (buffer
, "char") == 0)
9975 expect (XBM_TK_IDENT
);
9981 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
9982 nbytes
= bytes_per_line
* *height
;
9983 p
= *data
= (char *) xmalloc (nbytes
);
9987 for (i
= 0; i
< nbytes
; i
+= 2)
9990 expect (XBM_TK_NUMBER
);
9993 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
9994 *p
++ = ~ (value
>> 8);
9996 if (LA1
== ',' || LA1
== '}')
10004 for (i
= 0; i
< nbytes
; ++i
)
10007 expect (XBM_TK_NUMBER
);
10011 if (LA1
== ',' || LA1
== '}')
10032 #undef expect_ident
10035 static void convert_mono_to_color_image (f
, img
, foreground
, background
)
10038 COLORREF foreground
, background
;
10040 HDC hdc
, old_img_dc
, new_img_dc
;
10041 HGDIOBJ old_prev
, new_prev
;
10042 HBITMAP new_pixmap
;
10044 hdc
= get_frame_dc (f
);
10045 old_img_dc
= CreateCompatibleDC (hdc
);
10046 new_img_dc
= CreateCompatibleDC (hdc
);
10047 new_pixmap
= CreateCompatibleBitmap (hdc
, img
->width
, img
->height
);
10048 release_frame_dc (f
, hdc
);
10049 old_prev
= SelectObject (old_img_dc
, img
->pixmap
);
10050 new_prev
= SelectObject (new_img_dc
, new_pixmap
);
10051 SetTextColor (new_img_dc
, foreground
);
10052 SetBkColor (new_img_dc
, background
);
10054 BitBlt (new_img_dc
, 0, 0, img
->width
, img
->height
, old_img_dc
,
10057 SelectObject (old_img_dc
, old_prev
);
10058 SelectObject (new_img_dc
, new_prev
);
10059 DeleteDC (old_img_dc
);
10060 DeleteDC (new_img_dc
);
10061 DeleteObject (img
->pixmap
);
10062 if (new_pixmap
== 0)
10063 fprintf (stderr
, "Failed to convert image to color.\n");
10065 img
->pixmap
= new_pixmap
;
10068 /* Load XBM image IMG which will be displayed on frame F from buffer
10069 CONTENTS. END is the end of the buffer. Value is non-zero if
10073 xbm_load_image (f
, img
, contents
, end
)
10076 char *contents
, *end
;
10079 unsigned char *data
;
10082 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
10085 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
10086 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
10087 int non_default_colors
= 0;
10090 xassert (img
->width
> 0 && img
->height
> 0);
10092 /* Get foreground and background colors, maybe allocate colors. */
10093 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
10096 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
10097 non_default_colors
= 1;
10099 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
10102 background
= x_alloc_image_color (f
, img
, value
, background
);
10103 img
->background
= background
;
10104 img
->background_valid
= 1;
10105 non_default_colors
= 1;
10108 = w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
, data
);
10110 /* If colors were specified, transfer the bitmap to a color one. */
10111 if (non_default_colors
)
10112 convert_mono_to_color_image (f
, img
, foreground
, background
);
10116 if (img
->pixmap
== 0)
10118 x_clear_image (f
, img
);
10119 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
10125 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
10131 /* Value is non-zero if DATA looks like an in-memory XBM file. */
10138 return (STRINGP (data
)
10139 && xbm_read_bitmap_data (SDATA (data
),
10146 /* Fill image IMG which is used on frame F with pixmap data. Value is
10147 non-zero if successful. */
10155 Lisp_Object file_name
;
10157 xassert (xbm_image_p (img
->spec
));
10159 /* If IMG->spec specifies a file name, create a non-file spec from it. */
10160 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
10161 if (STRINGP (file_name
))
10166 struct gcpro gcpro1
;
10168 file
= x_find_image_file (file_name
);
10170 if (!STRINGP (file
))
10172 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
10177 contents
= slurp_file (SDATA (file
), &size
);
10178 if (contents
== NULL
)
10180 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
10185 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
10190 struct image_keyword fmt
[XBM_LAST
];
10192 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
10193 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
10194 int non_default_colors
= 0;
10197 int in_memory_file_p
= 0;
10199 /* See if data looks like an in-memory XBM file. */
10200 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10201 in_memory_file_p
= xbm_file_p (data
);
10203 /* Parse the image specification. */
10204 bcopy (xbm_format
, fmt
, sizeof fmt
);
10205 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
10206 xassert (parsed_p
);
10208 /* Get specified width, and height. */
10209 if (!in_memory_file_p
)
10211 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
10212 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
10213 xassert (img
->width
> 0 && img
->height
> 0);
10216 /* Get foreground and background colors, maybe allocate colors. */
10217 if (fmt
[XBM_FOREGROUND
].count
10218 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
10220 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
10222 non_default_colors
= 1;
10225 if (fmt
[XBM_BACKGROUND
].count
10226 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
10228 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
10230 non_default_colors
= 1;
10233 if (in_memory_file_p
)
10234 success_p
= xbm_load_image (f
, img
, SDATA (data
),
10239 if (VECTORP (data
))
10243 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
10245 p
= bits
= (char *) alloca (nbytes
* img
->height
);
10246 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
10248 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
10249 if (STRINGP (line
))
10250 bcopy (SDATA (line
), p
, nbytes
);
10252 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
10255 else if (STRINGP (data
))
10256 bits
= SDATA (data
);
10258 bits
= XBOOL_VECTOR (data
)->data
;
10260 /* Create the pixmap. */
10262 = w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
,
10265 /* If colors were specified, transfer the bitmap to a color one. */
10266 if (non_default_colors
)
10267 convert_mono_to_color_image (f
, img
, foreground
, background
);
10273 image_error ("Unable to create pixmap for XBM image `%s'",
10275 x_clear_image (f
, img
);
10285 /***********************************************************************
10287 ***********************************************************************/
10291 static int xpm_image_p
P_ ((Lisp_Object object
));
10292 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
10293 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
10295 /* Indicate to xpm.h that we don't have Xlib. */
10297 /* simx.h in xpm defines XColor and XImage differently than Emacs. */
10298 #define XColor xpm_XColor
10299 #define XImage xpm_XImage
10300 #define PIXEL_ALREADY_TYPEDEFED
10301 #include "X11/xpm.h"
10305 #undef PIXEL_ALREADY_TYPEDEFED
10307 /* The symbol `xpm' identifying XPM-format images. */
10311 /* Indices of image specification fields in xpm_format, below. */
10313 enum xpm_keyword_index
10322 XPM_HEURISTIC_MASK
,
10329 /* Vector of image_keyword structures describing the format
10330 of valid XPM image specifications. */
10332 static struct image_keyword xpm_format
[XPM_LAST
] =
10334 {":type", IMAGE_SYMBOL_VALUE
, 1},
10335 {":file", IMAGE_STRING_VALUE
, 0},
10336 {":data", IMAGE_STRING_VALUE
, 0},
10337 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10338 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10339 {":relief", IMAGE_INTEGER_VALUE
, 0},
10340 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10341 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10342 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10343 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10344 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10347 /* Structure describing the image type XPM. */
10349 static struct image_type xpm_type
=
10359 /* XPM library details. */
10361 DEF_IMGLIB_FN (XpmFreeAttributes
);
10362 DEF_IMGLIB_FN (XpmCreateImageFromBuffer
);
10363 DEF_IMGLIB_FN (XpmReadFileToImage
);
10364 DEF_IMGLIB_FN (XImageFree
);
10368 init_xpm_functions (library
)
10371 LOAD_IMGLIB_FN (library
, XpmFreeAttributes
);
10372 LOAD_IMGLIB_FN (library
, XpmCreateImageFromBuffer
);
10373 LOAD_IMGLIB_FN (library
, XpmReadFileToImage
);
10374 LOAD_IMGLIB_FN (library
, XImageFree
);
10379 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
10380 for XPM images. Such a list must consist of conses whose car and
10381 cdr are strings. */
10384 xpm_valid_color_symbols_p (color_symbols
)
10385 Lisp_Object color_symbols
;
10387 while (CONSP (color_symbols
))
10389 Lisp_Object sym
= XCAR (color_symbols
);
10391 || !STRINGP (XCAR (sym
))
10392 || !STRINGP (XCDR (sym
)))
10394 color_symbols
= XCDR (color_symbols
);
10397 return NILP (color_symbols
);
10401 /* Value is non-zero if OBJECT is a valid XPM image specification. */
10404 xpm_image_p (object
)
10405 Lisp_Object object
;
10407 struct image_keyword fmt
[XPM_LAST
];
10408 bcopy (xpm_format
, fmt
, sizeof fmt
);
10409 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
10410 /* Either `:file' or `:data' must be present. */
10411 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
10412 /* Either no `:color-symbols' or it's a list of conses
10413 whose car and cdr are strings. */
10414 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
10415 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
10419 /* Load image IMG which will be displayed on frame F. Value is
10420 non-zero if successful. */
10429 XpmAttributes attrs
;
10430 Lisp_Object specified_file
, color_symbols
;
10431 xpm_XImage
* xpm_image
, * xpm_mask
;
10433 /* Configure the XPM lib. Use the visual of frame F. Allocate
10434 close colors. Return colors allocated. */
10435 bzero (&attrs
, sizeof attrs
);
10436 xpm_image
= xpm_mask
= NULL
;
10439 attrs
.visual
= FRAME_X_VISUAL (f
);
10440 attrs
.colormap
= FRAME_X_COLORMAP (f
);
10441 attrs
.valuemask
|= XpmVisual
;
10442 attrs
.valuemask
|= XpmColormap
;
10444 attrs
.valuemask
|= XpmReturnAllocPixels
;
10445 #ifdef XpmAllocCloseColors
10446 attrs
.alloc_close_colors
= 1;
10447 attrs
.valuemask
|= XpmAllocCloseColors
;
10449 attrs
.closeness
= 600;
10450 attrs
.valuemask
|= XpmCloseness
;
10453 /* If image specification contains symbolic color definitions, add
10454 these to `attrs'. */
10455 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
10456 if (CONSP (color_symbols
))
10459 XpmColorSymbol
*xpm_syms
;
10462 attrs
.valuemask
|= XpmColorSymbols
;
10464 /* Count number of symbols. */
10465 attrs
.numsymbols
= 0;
10466 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
10467 ++attrs
.numsymbols
;
10469 /* Allocate an XpmColorSymbol array. */
10470 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
10471 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
10472 bzero (xpm_syms
, size
);
10473 attrs
.colorsymbols
= xpm_syms
;
10475 /* Fill the color symbol array. */
10476 for (tail
= color_symbols
, i
= 0;
10478 ++i
, tail
= XCDR (tail
))
10480 Lisp_Object name
= XCAR (XCAR (tail
));
10481 Lisp_Object color
= XCDR (XCAR (tail
));
10482 xpm_syms
[i
].name
= (char *) alloca (SCHARS (name
) + 1);
10483 strcpy (xpm_syms
[i
].name
, SDATA (name
));
10484 xpm_syms
[i
].value
= (char *) alloca (SCHARS (color
) + 1);
10485 strcpy (xpm_syms
[i
].value
, SDATA (color
));
10489 /* Create a pixmap for the image, either from a file, or from a
10490 string buffer containing data in the same format as an XPM file. */
10492 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10495 HDC frame_dc
= get_frame_dc (f
);
10496 hdc
= CreateCompatibleDC (frame_dc
);
10497 release_frame_dc (f
, frame_dc
);
10500 if (STRINGP (specified_file
))
10502 Lisp_Object file
= x_find_image_file (specified_file
);
10503 if (!STRINGP (file
))
10505 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10509 /* XpmReadFileToPixmap is not available in the Windows port of
10510 libxpm. But XpmReadFileToImage almost does what we want. */
10511 rc
= fn_XpmReadFileToImage (&hdc
, SDATA (file
),
10512 &xpm_image
, &xpm_mask
,
10517 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
10518 /* XpmCreatePixmapFromBuffer is not available in the Windows port
10519 of libxpm. But XpmCreateImageFromBuffer almost does what we want. */
10520 rc
= fn_XpmCreateImageFromBuffer (&hdc
, SDATA (buffer
),
10521 &xpm_image
, &xpm_mask
,
10525 if (rc
== XpmSuccess
)
10529 /* W32 XPM uses XImage to wrap what W32 Emacs calls a Pixmap,
10530 plus some duplicate attributes. */
10531 if (xpm_image
&& xpm_image
->bitmap
)
10533 img
->pixmap
= xpm_image
->bitmap
;
10534 /* XImageFree in libXpm frees XImage struct without destroying
10535 the bitmap, which is what we want. */
10536 fn_XImageFree (xpm_image
);
10538 if (xpm_mask
&& xpm_mask
->bitmap
)
10540 /* The mask appears to be inverted compared with what we expect.
10541 TODO: invert our expectations. See other places where we
10542 have to invert bits because our idea of masks is backwards. */
10544 old_obj
= SelectObject (hdc
, xpm_mask
->bitmap
);
10546 PatBlt (hdc
, 0, 0, xpm_mask
->width
, xpm_mask
->height
, DSTINVERT
);
10547 SelectObject (hdc
, old_obj
);
10549 img
->mask
= xpm_mask
->bitmap
;
10550 fn_XImageFree (xpm_mask
);
10556 /* Remember allocated colors. */
10557 img
->ncolors
= attrs
.nalloc_pixels
;
10558 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
10559 * sizeof *img
->colors
);
10560 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
10561 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
10563 img
->width
= attrs
.width
;
10564 img
->height
= attrs
.height
;
10565 xassert (img
->width
> 0 && img
->height
> 0);
10567 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
10568 fn_XpmFreeAttributes (&attrs
);
10576 case XpmOpenFailed
:
10577 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
10580 case XpmFileInvalid
:
10581 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
10585 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
10588 case XpmColorFailed
:
10589 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
10593 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
10598 return rc
== XpmSuccess
;
10601 #endif /* HAVE_XPM != 0 */
10604 #if 0 /* TODO : Color tables on W32. */
10605 /***********************************************************************
10607 ***********************************************************************/
10609 /* An entry in the color table mapping an RGB color to a pixel color. */
10614 unsigned long pixel
;
10616 /* Next in color table collision list. */
10617 struct ct_color
*next
;
10620 /* The bucket vector size to use. Must be prime. */
10622 #define CT_SIZE 101
10624 /* Value is a hash of the RGB color given by R, G, and B. */
10626 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
10628 /* The color hash table. */
10630 struct ct_color
**ct_table
;
10632 /* Number of entries in the color table. */
10634 int ct_colors_allocated
;
10636 /* Function prototypes. */
10638 static void init_color_table
P_ ((void));
10639 static void free_color_table
P_ ((void));
10640 static unsigned long *colors_in_color_table
P_ ((int *n
));
10641 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
10642 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
10645 /* Initialize the color table. */
10648 init_color_table ()
10650 int size
= CT_SIZE
* sizeof (*ct_table
);
10651 ct_table
= (struct ct_color
**) xmalloc (size
);
10652 bzero (ct_table
, size
);
10653 ct_colors_allocated
= 0;
10657 /* Free memory associated with the color table. */
10660 free_color_table ()
10663 struct ct_color
*p
, *next
;
10665 for (i
= 0; i
< CT_SIZE
; ++i
)
10666 for (p
= ct_table
[i
]; p
; p
= next
)
10677 /* Value is a pixel color for RGB color R, G, B on frame F. If an
10678 entry for that color already is in the color table, return the
10679 pixel color of that entry. Otherwise, allocate a new color for R,
10680 G, B, and make an entry in the color table. */
10682 static unsigned long
10683 lookup_rgb_color (f
, r
, g
, b
)
10687 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
10688 int i
= hash
% CT_SIZE
;
10689 struct ct_color
*p
;
10691 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10692 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
10701 color
= PALETTERGB (r
, g
, b
);
10703 ++ct_colors_allocated
;
10705 p
= (struct ct_color
*) xmalloc (sizeof *p
);
10710 p
->next
= ct_table
[i
];
10718 /* Look up pixel color PIXEL which is used on frame F in the color
10719 table. If not already present, allocate it. Value is PIXEL. */
10721 static unsigned long
10722 lookup_pixel_color (f
, pixel
)
10724 unsigned long pixel
;
10726 int i
= pixel
% CT_SIZE
;
10727 struct ct_color
*p
;
10729 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10730 if (p
->pixel
== pixel
)
10741 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
10742 color
.pixel
= pixel
;
10743 XQueryColor (NULL
, cmap
, &color
);
10744 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
10749 ++ct_colors_allocated
;
10751 p
= (struct ct_color
*) xmalloc (sizeof *p
);
10753 p
->g
= color
.green
;
10756 p
->next
= ct_table
[i
];
10760 return FRAME_FOREGROUND_PIXEL (f
);
10766 /* Value is a vector of all pixel colors contained in the color table,
10767 allocated via xmalloc. Set *N to the number of colors. */
10769 static unsigned long *
10770 colors_in_color_table (n
)
10774 struct ct_color
*p
;
10775 unsigned long *colors
;
10777 if (ct_colors_allocated
== 0)
10784 colors
= (unsigned long *) xmalloc (ct_colors_allocated
10786 *n
= ct_colors_allocated
;
10788 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
10789 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10790 colors
[j
++] = p
->pixel
;
10799 /***********************************************************************
10801 ***********************************************************************/
10802 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
10803 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
10804 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
10805 static void XPutPixel (XImage
*, int, int, COLORREF
);
10807 /* Non-zero means draw a cross on images having `:conversion
10810 int cross_disabled_images
;
10812 /* Edge detection matrices for different edge-detection
10815 static int emboss_matrix
[9] = {
10816 /* x - 1 x x + 1 */
10817 2, -1, 0, /* y - 1 */
10819 0, 1, -2 /* y + 1 */
10822 static int laplace_matrix
[9] = {
10823 /* x - 1 x x + 1 */
10824 1, 0, 0, /* y - 1 */
10826 0, 0, -1 /* y + 1 */
10829 /* Value is the intensity of the color whose red/green/blue values
10830 are R, G, and B. */
10832 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
10835 /* On frame F, return an array of XColor structures describing image
10836 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
10837 non-zero means also fill the red/green/blue members of the XColor
10838 structures. Value is a pointer to the array of XColors structures,
10839 allocated with xmalloc; it must be freed by the caller. */
10842 x_to_xcolors (f
, img
, rgb_p
)
10848 XColor
*colors
, *p
;
10852 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
10854 /* Load the image into a memory device context. */
10855 hdc
= get_frame_dc (f
);
10856 bmpdc
= CreateCompatibleDC (hdc
);
10857 release_frame_dc (f
, hdc
);
10858 prev
= SelectObject (bmpdc
, img
->pixmap
);
10860 /* Fill the `pixel' members of the XColor array. I wished there
10861 were an easy and portable way to circumvent XGetPixel. */
10863 for (y
= 0; y
< img
->height
; ++y
)
10867 for (x
= 0; x
< img
->width
; ++x
, ++p
)
10869 /* TODO: palette support needed here? */
10870 p
->pixel
= GetPixel (bmpdc
, x
, y
);
10874 p
->red
= 256 * GetRValue (p
->pixel
);
10875 p
->green
= 256 * GetGValue (p
->pixel
);
10876 p
->blue
= 256 * GetBValue (p
->pixel
);
10881 SelectObject (bmpdc
, prev
);
10887 /* Put a pixel of COLOR at position X, Y in XIMG. XIMG must have been
10888 created with CreateDIBSection, with the pointer to the bit values
10889 stored in ximg->data. */
10891 static void XPutPixel (ximg
, x
, y
, color
)
10896 int width
= ximg
->info
.bmiHeader
.biWidth
;
10897 int height
= ximg
->info
.bmiHeader
.biHeight
;
10898 unsigned char * pixel
;
10900 /* True color images. */
10901 if (ximg
->info
.bmiHeader
.biBitCount
== 24)
10903 int rowbytes
= width
* 3;
10904 /* Ensure scanlines are aligned on 4 byte boundaries. */
10906 rowbytes
+= 4 - (rowbytes
% 4);
10908 pixel
= ximg
->data
+ y
* rowbytes
+ x
* 3;
10909 /* Windows bitmaps are in BGR order. */
10910 *pixel
= GetBValue (color
);
10911 *(pixel
+ 1) = GetGValue (color
);
10912 *(pixel
+ 2) = GetRValue (color
);
10914 /* Monochrome images. */
10915 else if (ximg
->info
.bmiHeader
.biBitCount
== 1)
10917 int rowbytes
= width
/ 8;
10918 /* Ensure scanlines are aligned on 4 byte boundaries. */
10920 rowbytes
+= 4 - (rowbytes
% 4);
10921 pixel
= ximg
->data
+ y
* rowbytes
+ x
/ 8;
10922 /* Filter out palette info. */
10923 if (color
& 0x00ffffff)
10924 *pixel
= *pixel
| (1 << x
% 8);
10926 *pixel
= *pixel
& ~(1 << x
% 8);
10929 image_error ("XPutPixel: palette image not supported.", Qnil
, Qnil
);
10932 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
10933 RGB members are set. F is the frame on which this all happens.
10934 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
10937 x_from_xcolors (f
, img
, colors
)
10946 #if 0 /* TODO: color tables. */
10947 init_color_table ();
10949 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
10952 for (y
= 0; y
< img
->height
; ++y
)
10953 for (x
= 0; x
< img
->width
; ++x
, ++p
)
10955 unsigned long pixel
;
10956 #if 0 /* TODO: color tables. */
10957 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
10959 pixel
= PALETTERGB (p
->red
/ 256, p
->green
/ 256, p
->blue
/ 256);
10961 XPutPixel (oimg
, x
, y
, pixel
);
10965 x_clear_image_1 (f
, img
, 1, 0, 1);
10967 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
10968 x_destroy_x_image (oimg
);
10969 img
->pixmap
= pixmap
;
10970 #if 0 /* TODO: color tables. */
10971 img
->colors
= colors_in_color_table (&img
->ncolors
);
10972 free_color_table ();
10977 /* On frame F, perform edge-detection on image IMG.
10979 MATRIX is a nine-element array specifying the transformation
10980 matrix. See emboss_matrix for an example.
10982 COLOR_ADJUST is a color adjustment added to each pixel of the
10986 x_detect_edges (f
, img
, matrix
, color_adjust
)
10989 int matrix
[9], color_adjust
;
10991 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10995 for (i
= sum
= 0; i
< 9; ++i
)
10996 sum
+= abs (matrix
[i
]);
10998 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
11000 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
11002 for (y
= 0; y
< img
->height
; ++y
)
11004 p
= COLOR (new, 0, y
);
11005 p
->red
= p
->green
= p
->blue
= 0xffff/2;
11006 p
= COLOR (new, img
->width
- 1, y
);
11007 p
->red
= p
->green
= p
->blue
= 0xffff/2;
11010 for (x
= 1; x
< img
->width
- 1; ++x
)
11012 p
= COLOR (new, x
, 0);
11013 p
->red
= p
->green
= p
->blue
= 0xffff/2;
11014 p
= COLOR (new, x
, img
->height
- 1);
11015 p
->red
= p
->green
= p
->blue
= 0xffff/2;
11018 for (y
= 1; y
< img
->height
- 1; ++y
)
11020 p
= COLOR (new, 1, y
);
11022 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
11024 int r
, g
, b
, y1
, x1
;
11027 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
11028 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
11031 XColor
*t
= COLOR (colors
, x1
, y1
);
11032 r
+= matrix
[i
] * t
->red
;
11033 g
+= matrix
[i
] * t
->green
;
11034 b
+= matrix
[i
] * t
->blue
;
11037 r
= (r
/ sum
+ color_adjust
) & 0xffff;
11038 g
= (g
/ sum
+ color_adjust
) & 0xffff;
11039 b
= (b
/ sum
+ color_adjust
) & 0xffff;
11040 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
11045 x_from_xcolors (f
, img
, new);
11051 /* Perform the pre-defined `emboss' edge-detection on image IMG
11059 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
11063 /* Transform image IMG which is used on frame F with a Laplace
11064 edge-detection algorithm. The result is an image that can be used
11065 to draw disabled buttons, for example. */
11072 x_detect_edges (f
, img
, laplace_matrix
, 45000);
11076 /* Perform edge-detection on image IMG on frame F, with specified
11077 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
11079 MATRIX must be either
11081 - a list of at least 9 numbers in row-major form
11082 - a vector of at least 9 numbers
11084 COLOR_ADJUST nil means use a default; otherwise it must be a
11088 x_edge_detection (f
, img
, matrix
, color_adjust
)
11091 Lisp_Object matrix
, color_adjust
;
11096 if (CONSP (matrix
))
11099 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
11100 ++i
, matrix
= XCDR (matrix
))
11101 trans
[i
] = XFLOATINT (XCAR (matrix
));
11103 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
11105 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
11106 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
11109 if (NILP (color_adjust
))
11110 color_adjust
= make_number (0xffff / 2);
11112 if (i
== 9 && NUMBERP (color_adjust
))
11113 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
11117 /* Transform image IMG on frame F so that it looks disabled. */
11120 x_disable_image (f
, img
)
11124 struct w32_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
11126 if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
>= 2)
11128 /* Color (or grayscale). Convert to gray, and equalize. Just
11129 drawing such images with a stipple can look very odd, so
11130 we're using this method instead. */
11131 XColor
*colors
= x_to_xcolors (f
, img
, 1);
11133 const int h
= 15000;
11134 const int l
= 30000;
11136 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
11140 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
11141 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
11142 p
->red
= p
->green
= p
->blue
= i2
;
11145 x_from_xcolors (f
, img
, colors
);
11148 /* Draw a cross over the disabled image, if we must or if we
11150 if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
< 2 || cross_disabled_images
)
11155 hdc
= get_frame_dc (f
);
11156 bmpdc
= CreateCompatibleDC (hdc
);
11157 release_frame_dc (f
, hdc
);
11159 prev
= SelectObject (bmpdc
, img
->pixmap
);
11161 SetTextColor (bmpdc
, BLACK_PIX_DEFAULT (f
));
11162 MoveToEx (bmpdc
, 0, 0, NULL
);
11163 LineTo (bmpdc
, img
->width
- 1, img
->height
- 1);
11164 MoveToEx (bmpdc
, 0, img
->height
- 1, NULL
);
11165 LineTo (bmpdc
, img
->width
- 1, 0);
11169 SelectObject (bmpdc
, img
->mask
);
11170 SetTextColor (bmpdc
, WHITE_PIX_DEFAULT (f
));
11171 MoveToEx (bmpdc
, 0, 0, NULL
);
11172 LineTo (bmpdc
, img
->width
- 1, img
->height
- 1);
11173 MoveToEx (bmpdc
, 0, img
->height
- 1, NULL
);
11174 LineTo (bmpdc
, img
->width
- 1, 0);
11176 SelectObject (bmpdc
, prev
);
11182 /* Build a mask for image IMG which is used on frame F. FILE is the
11183 name of an image file, for error messages. HOW determines how to
11184 determine the background color of IMG. If it is a list '(R G B)',
11185 with R, G, and B being integers >= 0, take that as the color of the
11186 background. Otherwise, determine the background color of IMG
11187 heuristically. Value is non-zero if successful. */
11190 x_build_heuristic_mask (f
, img
, how
)
11195 HDC img_dc
, frame_dc
;
11198 int x
, y
, rc
, use_img_background
;
11199 unsigned long bg
= 0;
11204 DeleteObject (img
->mask
);
11206 img
->background_transparent_valid
= 0;
11209 /* Create the bit array serving as mask. */
11210 row_width
= (img
->width
+ 7) / 8;
11211 mask_img
= xmalloc (row_width
* img
->height
);
11212 bzero (mask_img
, row_width
* img
->height
);
11214 /* Create a memory device context for IMG->pixmap. */
11215 frame_dc
= get_frame_dc (f
);
11216 img_dc
= CreateCompatibleDC (frame_dc
);
11217 release_frame_dc (f
, frame_dc
);
11218 prev
= SelectObject (img_dc
, img
->pixmap
);
11220 /* Determine the background color of img_dc. If HOW is `(R G B)'
11221 take that as color. Otherwise, use the image's background color. */
11222 use_img_background
= 1;
11228 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
11230 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
11234 if (i
== 3 && NILP (how
))
11236 char color_name
[30];
11237 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
11238 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0)
11239 & 0x00ffffff; /* Filter out palette info. */
11240 use_img_background
= 0;
11244 if (use_img_background
)
11245 bg
= four_corners_best (img_dc
, img
->width
, img
->height
);
11247 /* Set all bits in mask_img to 1 whose color in ximg is different
11248 from the background color bg. */
11249 for (y
= 0; y
< img
->height
; ++y
)
11250 for (x
= 0; x
< img
->width
; ++x
)
11252 COLORREF p
= GetPixel (img_dc
, x
, y
);
11254 mask_img
[y
* row_width
+ x
/ 8] |= 1 << (x
% 8);
11257 /* Create the mask image. */
11258 img
->mask
= w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
,
11261 /* Fill in the background_transparent field while we have the mask handy. */
11262 SelectObject (img_dc
, img
->mask
);
11264 image_background_transparent (img
, f
, img_dc
);
11266 /* Put mask_img into img->mask. */
11267 x_destroy_x_image ((XImage
*)mask_img
);
11268 SelectObject (img_dc
, prev
);
11275 /***********************************************************************
11276 PBM (mono, gray, color)
11277 ***********************************************************************/
11279 static int pbm_image_p
P_ ((Lisp_Object object
));
11280 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
11281 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
11283 /* The symbol `pbm' identifying images of this type. */
11287 /* Indices of image specification fields in gs_format, below. */
11289 enum pbm_keyword_index
11298 PBM_HEURISTIC_MASK
,
11305 /* Vector of image_keyword structures describing the format
11306 of valid user-defined image specifications. */
11308 static struct image_keyword pbm_format
[PBM_LAST
] =
11310 {":type", IMAGE_SYMBOL_VALUE
, 1},
11311 {":file", IMAGE_STRING_VALUE
, 0},
11312 {":data", IMAGE_STRING_VALUE
, 0},
11313 {":ascent", IMAGE_ASCENT_VALUE
, 0},
11314 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11315 {":relief", IMAGE_INTEGER_VALUE
, 0},
11316 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11317 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11318 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11319 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
11320 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11323 /* Structure describing the image type `pbm'. */
11325 static struct image_type pbm_type
=
11335 /* Return non-zero if OBJECT is a valid PBM image specification. */
11338 pbm_image_p (object
)
11339 Lisp_Object object
;
11341 struct image_keyword fmt
[PBM_LAST
];
11343 bcopy (pbm_format
, fmt
, sizeof fmt
);
11345 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
11348 /* Must specify either :data or :file. */
11349 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
11353 /* Scan a decimal number from *S and return it. Advance *S while
11354 reading the number. END is the end of the string. Value is -1 at
11358 pbm_scan_number (s
, end
)
11359 unsigned char **s
, *end
;
11365 /* Skip white-space. */
11366 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
11371 /* Skip comment to end of line. */
11372 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
11375 else if (isdigit (c
))
11377 /* Read decimal number. */
11379 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
11380 val
= 10 * val
+ c
- '0';
11391 /* Read FILE into memory. Value is a pointer to a buffer allocated
11392 with xmalloc holding FILE's contents. Value is null if an error
11393 occurred. *SIZE is set to the size of the file. */
11396 pbm_read_file (file
, size
)
11404 if (stat (SDATA (file
), &st
) == 0
11405 && (fp
= fopen (SDATA (file
), "r")) != NULL
11406 && (buf
= (char *) xmalloc (st
.st_size
),
11407 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
11409 *size
= st
.st_size
;
11427 /* Load PBM image IMG for use on frame F. */
11435 int width
, height
, max_color_idx
= 0;
11437 Lisp_Object file
, specified_file
;
11438 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
11439 struct gcpro gcpro1
;
11440 unsigned char *contents
= NULL
;
11441 unsigned char *end
, *p
;
11444 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11448 if (STRINGP (specified_file
))
11450 file
= x_find_image_file (specified_file
);
11451 if (!STRINGP (file
))
11453 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11458 contents
= slurp_file (SDATA (file
), &size
);
11459 if (contents
== NULL
)
11461 image_error ("Error reading `%s'", file
, Qnil
);
11467 end
= contents
+ size
;
11472 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11474 end
= p
+ SBYTES (data
);
11477 /* Check magic number. */
11478 if (end
- p
< 2 || *p
++ != 'P')
11480 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
11490 raw_p
= 0, type
= PBM_MONO
;
11494 raw_p
= 0, type
= PBM_GRAY
;
11498 raw_p
= 0, type
= PBM_COLOR
;
11502 raw_p
= 1, type
= PBM_MONO
;
11506 raw_p
= 1, type
= PBM_GRAY
;
11510 raw_p
= 1, type
= PBM_COLOR
;
11514 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
11518 /* Read width, height, maximum color-component. Characters
11519 starting with `#' up to the end of a line are ignored. */
11520 width
= pbm_scan_number (&p
, end
);
11521 height
= pbm_scan_number (&p
, end
);
11523 if (type
!= PBM_MONO
)
11525 max_color_idx
= pbm_scan_number (&p
, end
);
11526 if (raw_p
&& max_color_idx
> 255)
11527 max_color_idx
= 255;
11532 || (type
!= PBM_MONO
&& max_color_idx
< 0))
11535 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11538 #if 0 /* TODO: color tables. */
11539 /* Initialize the color hash table. */
11540 init_color_table ();
11543 if (type
== PBM_MONO
)
11546 struct image_keyword fmt
[PBM_LAST
];
11547 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
11548 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
11550 /* Parse the image specification. */
11551 bcopy (pbm_format
, fmt
, sizeof fmt
);
11552 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
11554 /* Get foreground and background colors, maybe allocate colors. */
11555 if (fmt
[PBM_FOREGROUND
].count
11556 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
11557 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
11558 if (fmt
[PBM_BACKGROUND
].count
11559 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
11561 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
11562 img
->background
= bg
;
11563 img
->background_valid
= 1;
11566 for (y
= 0; y
< height
; ++y
)
11567 for (x
= 0; x
< width
; ++x
)
11577 g
= pbm_scan_number (&p
, end
);
11579 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
11584 for (y
= 0; y
< height
; ++y
)
11585 for (x
= 0; x
< width
; ++x
)
11589 if (type
== PBM_GRAY
)
11590 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
11599 r
= pbm_scan_number (&p
, end
);
11600 g
= pbm_scan_number (&p
, end
);
11601 b
= pbm_scan_number (&p
, end
);
11604 if (r
< 0 || g
< 0 || b
< 0)
11606 x_destroy_x_image (ximg
);
11607 image_error ("Invalid pixel value in image `%s'",
11612 /* RGB values are now in the range 0..max_color_idx.
11613 Scale this to the range 0..0xff supported by W32. */
11614 r
= (int) ((double) r
* 255 / max_color_idx
);
11615 g
= (int) ((double) g
* 255 / max_color_idx
);
11616 b
= (int) ((double) b
* 255 / max_color_idx
);
11617 XPutPixel (ximg
, x
, y
,
11618 #if 0 /* TODO: color tables. */
11619 lookup_rgb_color (f
, r
, g
, b
));
11621 PALETTERGB (r
, g
, b
));
11626 #if 0 /* TODO: color tables. */
11627 /* Store in IMG->colors the colors allocated for the image, and
11628 free the color table. */
11629 img
->colors
= colors_in_color_table (&img
->ncolors
);
11630 free_color_table ();
11632 /* Maybe fill in the background field while we have ximg handy. */
11633 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11634 IMAGE_BACKGROUND (img
, f
, ximg
);
11636 /* Put the image into a pixmap. */
11637 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11638 x_destroy_x_image (ximg
);
11640 img
->width
= width
;
11641 img
->height
= height
;
11649 /***********************************************************************
11651 ***********************************************************************/
11657 /* Function prototypes. */
11659 static int png_image_p
P_ ((Lisp_Object object
));
11660 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
11662 /* The symbol `png' identifying images of this type. */
11666 /* Indices of image specification fields in png_format, below. */
11668 enum png_keyword_index
11677 PNG_HEURISTIC_MASK
,
11683 /* Vector of image_keyword structures describing the format
11684 of valid user-defined image specifications. */
11686 static struct image_keyword png_format
[PNG_LAST
] =
11688 {":type", IMAGE_SYMBOL_VALUE
, 1},
11689 {":data", IMAGE_STRING_VALUE
, 0},
11690 {":file", IMAGE_STRING_VALUE
, 0},
11691 {":ascent", IMAGE_ASCENT_VALUE
, 0},
11692 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11693 {":relief", IMAGE_INTEGER_VALUE
, 0},
11694 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11695 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11696 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11697 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11700 /* Structure describing the image type `png'. */
11702 static struct image_type png_type
=
11711 /* PNG library details. */
11713 DEF_IMGLIB_FN (png_get_io_ptr
);
11714 DEF_IMGLIB_FN (png_check_sig
);
11715 DEF_IMGLIB_FN (png_create_read_struct
);
11716 DEF_IMGLIB_FN (png_create_info_struct
);
11717 DEF_IMGLIB_FN (png_destroy_read_struct
);
11718 DEF_IMGLIB_FN (png_set_read_fn
);
11719 DEF_IMGLIB_FN (png_init_io
);
11720 DEF_IMGLIB_FN (png_set_sig_bytes
);
11721 DEF_IMGLIB_FN (png_read_info
);
11722 DEF_IMGLIB_FN (png_get_IHDR
);
11723 DEF_IMGLIB_FN (png_get_valid
);
11724 DEF_IMGLIB_FN (png_set_strip_16
);
11725 DEF_IMGLIB_FN (png_set_expand
);
11726 DEF_IMGLIB_FN (png_set_gray_to_rgb
);
11727 DEF_IMGLIB_FN (png_set_background
);
11728 DEF_IMGLIB_FN (png_get_bKGD
);
11729 DEF_IMGLIB_FN (png_read_update_info
);
11730 DEF_IMGLIB_FN (png_get_channels
);
11731 DEF_IMGLIB_FN (png_get_rowbytes
);
11732 DEF_IMGLIB_FN (png_read_image
);
11733 DEF_IMGLIB_FN (png_read_end
);
11734 DEF_IMGLIB_FN (png_error
);
11737 init_png_functions (library
)
11740 LOAD_IMGLIB_FN (library
, png_get_io_ptr
);
11741 LOAD_IMGLIB_FN (library
, png_check_sig
);
11742 LOAD_IMGLIB_FN (library
, png_create_read_struct
);
11743 LOAD_IMGLIB_FN (library
, png_create_info_struct
);
11744 LOAD_IMGLIB_FN (library
, png_destroy_read_struct
);
11745 LOAD_IMGLIB_FN (library
, png_set_read_fn
);
11746 LOAD_IMGLIB_FN (library
, png_init_io
);
11747 LOAD_IMGLIB_FN (library
, png_set_sig_bytes
);
11748 LOAD_IMGLIB_FN (library
, png_read_info
);
11749 LOAD_IMGLIB_FN (library
, png_get_IHDR
);
11750 LOAD_IMGLIB_FN (library
, png_get_valid
);
11751 LOAD_IMGLIB_FN (library
, png_set_strip_16
);
11752 LOAD_IMGLIB_FN (library
, png_set_expand
);
11753 LOAD_IMGLIB_FN (library
, png_set_gray_to_rgb
);
11754 LOAD_IMGLIB_FN (library
, png_set_background
);
11755 LOAD_IMGLIB_FN (library
, png_get_bKGD
);
11756 LOAD_IMGLIB_FN (library
, png_read_update_info
);
11757 LOAD_IMGLIB_FN (library
, png_get_channels
);
11758 LOAD_IMGLIB_FN (library
, png_get_rowbytes
);
11759 LOAD_IMGLIB_FN (library
, png_read_image
);
11760 LOAD_IMGLIB_FN (library
, png_read_end
);
11761 LOAD_IMGLIB_FN (library
, png_error
);
11765 /* Return non-zero if OBJECT is a valid PNG image specification. */
11768 png_image_p (object
)
11769 Lisp_Object object
;
11771 struct image_keyword fmt
[PNG_LAST
];
11772 bcopy (png_format
, fmt
, sizeof fmt
);
11774 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
11777 /* Must specify either the :data or :file keyword. */
11778 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
11782 /* Error and warning handlers installed when the PNG library
11786 my_png_error (png_ptr
, msg
)
11787 png_struct
*png_ptr
;
11790 xassert (png_ptr
!= NULL
);
11791 image_error ("PNG error: %s", build_string (msg
), Qnil
);
11792 longjmp (png_ptr
->jmpbuf
, 1);
11797 my_png_warning (png_ptr
, msg
)
11798 png_struct
*png_ptr
;
11801 xassert (png_ptr
!= NULL
);
11802 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
11805 /* Memory source for PNG decoding. */
11807 struct png_memory_storage
11809 unsigned char *bytes
; /* The data */
11810 size_t len
; /* How big is it? */
11811 int index
; /* Where are we? */
11815 /* Function set as reader function when reading PNG image from memory.
11816 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
11817 bytes from the input to DATA. */
11820 png_read_from_memory (png_ptr
, data
, length
)
11821 png_structp png_ptr
;
11825 struct png_memory_storage
*tbr
11826 = (struct png_memory_storage
*) fn_png_get_io_ptr (png_ptr
);
11828 if (length
> tbr
->len
- tbr
->index
)
11829 fn_png_error (png_ptr
, "Read error");
11831 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
11832 tbr
->index
= tbr
->index
+ length
;
11835 /* Load PNG image IMG for use on frame F. Value is non-zero if
11843 Lisp_Object file
, specified_file
;
11844 Lisp_Object specified_data
;
11846 XImage
*ximg
, *mask_img
= NULL
;
11847 struct gcpro gcpro1
;
11848 png_struct
*png_ptr
= NULL
;
11849 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
11850 FILE *volatile fp
= NULL
;
11852 png_byte
* volatile pixels
= NULL
;
11853 png_byte
** volatile rows
= NULL
;
11854 png_uint_32 width
, height
;
11855 int bit_depth
, color_type
, interlace_type
;
11857 png_uint_32 row_bytes
;
11859 double screen_gamma
, image_gamma
;
11861 struct png_memory_storage tbr
; /* Data to be read */
11863 /* Find out what file to load. */
11864 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11865 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11869 if (NILP (specified_data
))
11871 file
= x_find_image_file (specified_file
);
11872 if (!STRINGP (file
))
11874 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11879 /* Open the image file. */
11880 fp
= fopen (SDATA (file
), "rb");
11883 image_error ("Cannot open image file `%s'", file
, Qnil
);
11889 /* Check PNG signature. */
11890 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
11891 || !fn_png_check_sig (sig
, sizeof sig
))
11893 image_error ("Not a PNG file: `%s'", file
, Qnil
);
11901 /* Read from memory. */
11902 tbr
.bytes
= SDATA (specified_data
);
11903 tbr
.len
= SBYTES (specified_data
);
11906 /* Check PNG signature. */
11907 if (tbr
.len
< sizeof sig
11908 || !fn_png_check_sig (tbr
.bytes
, sizeof sig
))
11910 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
11915 /* Need to skip past the signature. */
11916 tbr
.bytes
+= sizeof (sig
);
11919 /* Initialize read and info structs for PNG lib. */
11920 png_ptr
= fn_png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
11921 my_png_error
, my_png_warning
);
11924 if (fp
) fclose (fp
);
11929 info_ptr
= fn_png_create_info_struct (png_ptr
);
11932 fn_png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
11933 if (fp
) fclose (fp
);
11938 end_info
= fn_png_create_info_struct (png_ptr
);
11941 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
11942 if (fp
) fclose (fp
);
11947 /* Set error jump-back. We come back here when the PNG library
11948 detects an error. */
11949 if (setjmp (png_ptr
->jmpbuf
))
11953 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
11956 if (fp
) fclose (fp
);
11961 /* Read image info. */
11962 if (!NILP (specified_data
))
11963 fn_png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
11965 fn_png_init_io (png_ptr
, fp
);
11967 fn_png_set_sig_bytes (png_ptr
, sizeof sig
);
11968 fn_png_read_info (png_ptr
, info_ptr
);
11969 fn_png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
11970 &interlace_type
, NULL
, NULL
);
11972 /* If image contains simply transparency data, we prefer to
11973 construct a clipping mask. */
11974 if (fn_png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
11979 /* This function is easier to write if we only have to handle
11980 one data format: RGB or RGBA with 8 bits per channel. Let's
11981 transform other formats into that format. */
11983 /* Strip more than 8 bits per channel. */
11984 if (bit_depth
== 16)
11985 fn_png_set_strip_16 (png_ptr
);
11987 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
11989 fn_png_set_expand (png_ptr
);
11991 /* Convert grayscale images to RGB. */
11992 if (color_type
== PNG_COLOR_TYPE_GRAY
11993 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
11994 fn_png_set_gray_to_rgb (png_ptr
);
11996 screen_gamma
= (f
->gamma
? 1 / f
->gamma
/ 0.45455 : 2.2);
11998 #if 0 /* Avoid double gamma correction for PNG images. */
11999 /* Tell the PNG lib to handle gamma correction for us. */
12000 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
12001 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
12002 /* The libpng documentation says this is right in this case. */
12003 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
12006 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
12007 /* Image contains gamma information. */
12008 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
12010 /* Use the standard default for the image gamma. */
12011 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
12014 /* Handle alpha channel by combining the image with a background
12015 color. Do this only if a real alpha channel is supplied. For
12016 simple transparency, we prefer a clipping mask. */
12017 if (!transparent_p
)
12019 png_color_16
*image_bg
;
12020 Lisp_Object specified_bg
12021 = image_spec_value (img
->spec
, QCbackground
, NULL
);
12023 if (STRINGP (specified_bg
))
12024 /* The user specified `:background', use that. */
12027 if (w32_defined_color (f
, SDATA (specified_bg
), &color
, 0))
12029 png_color_16 user_bg
;
12031 bzero (&user_bg
, sizeof user_bg
);
12032 user_bg
.red
= 256 * GetRValue (color
);
12033 user_bg
.green
= 256 * GetGValue (color
);
12034 user_bg
.blue
= 256 * GetBValue (color
);
12036 fn_png_set_background (png_ptr
, &user_bg
,
12037 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
12040 else if (fn_png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
12041 /* Image contains a background color with which to
12042 combine the image. */
12043 fn_png_set_background (png_ptr
, image_bg
,
12044 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
12047 /* Image does not contain a background color with which
12048 to combine the image data via an alpha channel. Use
12049 the frame's background instead. */
12051 png_color_16 frame_background
;
12052 color
= FRAME_BACKGROUND_PIXEL (f
);
12053 #if 0 /* TODO : Colormap support. */
12056 cmap
= FRAME_X_COLORMAP (f
);
12057 x_query_color (f
, &color
);
12060 bzero (&frame_background
, sizeof frame_background
);
12061 frame_background
.red
= 256 * GetRValue (color
);
12062 frame_background
.green
= 256 * GetGValue (color
);
12063 frame_background
.blue
= 256 * GetBValue (color
);
12065 fn_png_set_background (png_ptr
, &frame_background
,
12066 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
12070 /* Update info structure. */
12071 fn_png_read_update_info (png_ptr
, info_ptr
);
12073 /* Get number of channels. Valid values are 1 for grayscale images
12074 and images with a palette, 2 for grayscale images with transparency
12075 information (alpha channel), 3 for RGB images, and 4 for RGB
12076 images with alpha channel, i.e. RGBA. If conversions above were
12077 sufficient we should only have 3 or 4 channels here. */
12078 channels
= fn_png_get_channels (png_ptr
, info_ptr
);
12079 xassert (channels
== 3 || channels
== 4);
12081 /* Number of bytes needed for one row of the image. */
12082 row_bytes
= fn_png_get_rowbytes (png_ptr
, info_ptr
);
12084 /* Allocate memory for the image. */
12085 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
12086 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
12087 for (i
= 0; i
< height
; ++i
)
12088 rows
[i
] = pixels
+ i
* row_bytes
;
12090 /* Read the entire image. */
12091 fn_png_read_image (png_ptr
, rows
);
12092 fn_png_read_end (png_ptr
, info_ptr
);
12099 /* Create the X image and pixmap. */
12100 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
12104 /* Create an image and pixmap serving as mask if the PNG image
12105 contains an alpha channel. */
12108 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
12109 &mask_img
, &img
->mask
))
12111 x_destroy_x_image (ximg
);
12112 DeleteObject (img
->pixmap
);
12116 /* Fill the X image and mask from PNG data. */
12117 #if 0 /* TODO: Color tables. */
12118 init_color_table ();
12121 for (y
= 0; y
< height
; ++y
)
12123 png_byte
*p
= rows
[y
];
12125 for (x
= 0; x
< width
; ++x
)
12132 #if 0 /* TODO: Color tables. */
12133 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
12135 XPutPixel (ximg
, x
, y
, PALETTERGB (r
, g
, b
));
12137 /* An alpha channel, aka mask channel, associates variable
12138 transparency with an image. Where other image formats
12139 support binary transparency---fully transparent or fully
12140 opaque---PNG allows up to 254 levels of partial transparency.
12141 The PNG library implements partial transparency by combining
12142 the image with a specified background color.
12144 I'm not sure how to handle this here nicely: because the
12145 background on which the image is displayed may change, for
12146 real alpha channel support, it would be necessary to create
12147 a new image for each possible background.
12149 What I'm doing now is that a mask is created if we have
12150 boolean transparency information. Otherwise I'm using
12151 the frame's background color to combine the image with. */
12156 XPutPixel (mask_img
, x
, y
, *p
> 0);
12162 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12163 /* Set IMG's background color from the PNG image, unless the user
12167 if (fn_png_get_bKGD (png_ptr
, info_ptr
, &bg
))
12169 #if 0 /* TODO: Color tables. */
12170 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
12172 img
->background
= PALETTERGB (bg
->red
/ 256, bg
->green
/ 256,
12175 img
->background_valid
= 1;
12179 #if 0 /* TODO: Color tables. */
12180 /* Remember colors allocated for this image. */
12181 img
->colors
= colors_in_color_table (&img
->ncolors
);
12182 free_color_table ();
12186 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
12190 img
->width
= width
;
12191 img
->height
= height
;
12193 /* Maybe fill in the background field while we have ximg handy. */
12194 IMAGE_BACKGROUND (img
, f
, ximg
);
12196 /* Put the image into the pixmap, then free the X image and its buffer. */
12197 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12198 x_destroy_x_image (ximg
);
12200 /* Same for the mask. */
12203 /* Fill in the background_transparent field while we have the mask
12205 image_background_transparent (img
, f
, mask_img
);
12207 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
12208 x_destroy_x_image (mask_img
);
12215 #endif /* HAVE_PNG != 0 */
12219 /***********************************************************************
12221 ***********************************************************************/
12225 /* Work around a warning about HAVE_STDLIB_H being redefined in
12227 #ifdef HAVE_STDLIB_H
12228 #define HAVE_STDLIB_H_1
12229 #undef HAVE_STDLIB_H
12230 #endif /* HAVE_STLIB_H */
12232 #include <jpeglib.h>
12233 #include <jerror.h>
12234 #include <setjmp.h>
12236 #ifdef HAVE_STLIB_H_1
12237 #define HAVE_STDLIB_H 1
12240 static int jpeg_image_p
P_ ((Lisp_Object object
));
12241 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
12243 /* The symbol `jpeg' identifying images of this type. */
12247 /* Indices of image specification fields in gs_format, below. */
12249 enum jpeg_keyword_index
12258 JPEG_HEURISTIC_MASK
,
12264 /* Vector of image_keyword structures describing the format
12265 of valid user-defined image specifications. */
12267 static struct image_keyword jpeg_format
[JPEG_LAST
] =
12269 {":type", IMAGE_SYMBOL_VALUE
, 1},
12270 {":data", IMAGE_STRING_VALUE
, 0},
12271 {":file", IMAGE_STRING_VALUE
, 0},
12272 {":ascent", IMAGE_ASCENT_VALUE
, 0},
12273 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12274 {":relief", IMAGE_INTEGER_VALUE
, 0},
12275 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12276 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12277 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12278 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12281 /* Structure describing the image type `jpeg'. */
12283 static struct image_type jpeg_type
=
12293 /* JPEG library details. */
12294 DEF_IMGLIB_FN (jpeg_CreateDecompress
);
12295 DEF_IMGLIB_FN (jpeg_start_decompress
);
12296 DEF_IMGLIB_FN (jpeg_finish_decompress
);
12297 DEF_IMGLIB_FN (jpeg_destroy_decompress
);
12298 DEF_IMGLIB_FN (jpeg_read_header
);
12299 DEF_IMGLIB_FN (jpeg_read_scanlines
);
12300 DEF_IMGLIB_FN (jpeg_stdio_src
);
12301 DEF_IMGLIB_FN (jpeg_std_error
);
12302 DEF_IMGLIB_FN (jpeg_resync_to_restart
);
12305 init_jpeg_functions (library
)
12308 LOAD_IMGLIB_FN (library
, jpeg_finish_decompress
);
12309 LOAD_IMGLIB_FN (library
, jpeg_read_scanlines
);
12310 LOAD_IMGLIB_FN (library
, jpeg_start_decompress
);
12311 LOAD_IMGLIB_FN (library
, jpeg_read_header
);
12312 LOAD_IMGLIB_FN (library
, jpeg_stdio_src
);
12313 LOAD_IMGLIB_FN (library
, jpeg_CreateDecompress
);
12314 LOAD_IMGLIB_FN (library
, jpeg_destroy_decompress
);
12315 LOAD_IMGLIB_FN (library
, jpeg_std_error
);
12316 LOAD_IMGLIB_FN (library
, jpeg_resync_to_restart
);
12320 /* Wrapper since we can't directly assign the function pointer
12321 to another function pointer that was declared more completely easily. */
12323 jpeg_resync_to_restart_wrapper(cinfo
, desired
)
12324 j_decompress_ptr cinfo
;
12327 return fn_jpeg_resync_to_restart (cinfo
, desired
);
12331 /* Return non-zero if OBJECT is a valid JPEG image specification. */
12334 jpeg_image_p (object
)
12335 Lisp_Object object
;
12337 struct image_keyword fmt
[JPEG_LAST
];
12339 bcopy (jpeg_format
, fmt
, sizeof fmt
);
12341 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
12344 /* Must specify either the :data or :file keyword. */
12345 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
12349 struct my_jpeg_error_mgr
12351 struct jpeg_error_mgr pub
;
12352 jmp_buf setjmp_buffer
;
12357 my_error_exit (cinfo
)
12358 j_common_ptr cinfo
;
12360 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
12361 longjmp (mgr
->setjmp_buffer
, 1);
12365 /* Init source method for JPEG data source manager. Called by
12366 jpeg_read_header() before any data is actually read. See
12367 libjpeg.doc from the JPEG lib distribution. */
12370 our_init_source (cinfo
)
12371 j_decompress_ptr cinfo
;
12376 /* Fill input buffer method for JPEG data source manager. Called
12377 whenever more data is needed. We read the whole image in one step,
12378 so this only adds a fake end of input marker at the end. */
12381 our_fill_input_buffer (cinfo
)
12382 j_decompress_ptr cinfo
;
12384 /* Insert a fake EOI marker. */
12385 struct jpeg_source_mgr
*src
= cinfo
->src
;
12386 static JOCTET buffer
[2];
12388 buffer
[0] = (JOCTET
) 0xFF;
12389 buffer
[1] = (JOCTET
) JPEG_EOI
;
12391 src
->next_input_byte
= buffer
;
12392 src
->bytes_in_buffer
= 2;
12397 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
12398 is the JPEG data source manager. */
12401 our_skip_input_data (cinfo
, num_bytes
)
12402 j_decompress_ptr cinfo
;
12405 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
12409 if (num_bytes
> src
->bytes_in_buffer
)
12410 ERREXIT (cinfo
, JERR_INPUT_EOF
);
12412 src
->bytes_in_buffer
-= num_bytes
;
12413 src
->next_input_byte
+= num_bytes
;
12418 /* Method to terminate data source. Called by
12419 jpeg_finish_decompress() after all data has been processed. */
12422 our_term_source (cinfo
)
12423 j_decompress_ptr cinfo
;
12428 /* Set up the JPEG lib for reading an image from DATA which contains
12429 LEN bytes. CINFO is the decompression info structure created for
12430 reading the image. */
12433 jpeg_memory_src (cinfo
, data
, len
)
12434 j_decompress_ptr cinfo
;
12438 struct jpeg_source_mgr
*src
;
12440 if (cinfo
->src
== NULL
)
12442 /* First time for this JPEG object? */
12443 cinfo
->src
= (struct jpeg_source_mgr
*)
12444 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
12445 sizeof (struct jpeg_source_mgr
));
12446 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
12447 src
->next_input_byte
= data
;
12450 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
12451 src
->init_source
= our_init_source
;
12452 src
->fill_input_buffer
= our_fill_input_buffer
;
12453 src
->skip_input_data
= our_skip_input_data
;
12454 src
->resync_to_restart
= jpeg_resync_to_restart_wrapper
; /* Use default method. */
12455 src
->term_source
= our_term_source
;
12456 src
->bytes_in_buffer
= len
;
12457 src
->next_input_byte
= data
;
12461 /* Load image IMG for use on frame F. Patterned after example.c
12462 from the JPEG lib. */
12469 struct jpeg_decompress_struct cinfo
;
12470 struct my_jpeg_error_mgr mgr
;
12471 Lisp_Object file
, specified_file
;
12472 Lisp_Object specified_data
;
12473 FILE * volatile fp
= NULL
;
12475 int row_stride
, x
, y
;
12476 XImage
*ximg
= NULL
;
12478 unsigned long *colors
;
12480 struct gcpro gcpro1
;
12482 /* Open the JPEG file. */
12483 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12484 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12488 if (NILP (specified_data
))
12490 file
= x_find_image_file (specified_file
);
12491 if (!STRINGP (file
))
12493 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
12498 fp
= fopen (SDATA (file
), "r");
12501 image_error ("Cannot open `%s'", file
, Qnil
);
12507 /* Customize libjpeg's error handling to call my_error_exit when an
12508 error is detected. This function will perform a longjmp. */
12509 cinfo
.err
= fn_jpeg_std_error (&mgr
.pub
);
12510 mgr
.pub
.error_exit
= my_error_exit
;
12512 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
12516 /* Called from my_error_exit. Display a JPEG error. */
12517 char buffer
[JMSG_LENGTH_MAX
];
12518 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
12519 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
12520 build_string (buffer
));
12523 /* Close the input file and destroy the JPEG object. */
12525 fclose ((FILE *) fp
);
12526 fn_jpeg_destroy_decompress (&cinfo
);
12528 /* If we already have an XImage, free that. */
12529 x_destroy_x_image (ximg
);
12531 /* Free pixmap and colors. */
12532 x_clear_image (f
, img
);
12538 /* Create the JPEG decompression object. Let it read from fp.
12539 Read the JPEG image header. */
12540 fn_jpeg_CreateDecompress (&cinfo
, JPEG_LIB_VERSION
, sizeof (cinfo
));
12542 if (NILP (specified_data
))
12543 fn_jpeg_stdio_src (&cinfo
, (FILE *) fp
);
12545 jpeg_memory_src (&cinfo
, SDATA (specified_data
),
12546 SBYTES (specified_data
));
12548 fn_jpeg_read_header (&cinfo
, TRUE
);
12550 /* Customize decompression so that color quantization will be used.
12551 Start decompression. */
12552 cinfo
.quantize_colors
= TRUE
;
12553 fn_jpeg_start_decompress (&cinfo
);
12554 width
= img
->width
= cinfo
.output_width
;
12555 height
= img
->height
= cinfo
.output_height
;
12557 /* Create X image and pixmap. */
12558 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12559 longjmp (mgr
.setjmp_buffer
, 2);
12561 /* Allocate colors. When color quantization is used,
12562 cinfo.actual_number_of_colors has been set with the number of
12563 colors generated, and cinfo.colormap is a two-dimensional array
12564 of color indices in the range 0..cinfo.actual_number_of_colors.
12565 No more than 255 colors will be generated. */
12569 if (cinfo
.out_color_components
> 2)
12570 ir
= 0, ig
= 1, ib
= 2;
12571 else if (cinfo
.out_color_components
> 1)
12572 ir
= 0, ig
= 1, ib
= 0;
12574 ir
= 0, ig
= 0, ib
= 0;
12576 #if 0 /* TODO: Color tables. */
12577 /* Use the color table mechanism because it handles colors that
12578 cannot be allocated nicely. Such colors will be replaced with
12579 a default color, and we don't have to care about which colors
12580 can be freed safely, and which can't. */
12581 init_color_table ();
12583 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
12586 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
12588 int r
= cinfo
.colormap
[ir
][i
];
12589 int g
= cinfo
.colormap
[ig
][i
];
12590 int b
= cinfo
.colormap
[ib
][i
];
12591 #if 0 /* TODO: Color tables. */
12592 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
12594 colors
[i
] = PALETTERGB (r
, g
, b
);
12598 #if 0 /* TODO: Color tables. */
12599 /* Remember those colors actually allocated. */
12600 img
->colors
= colors_in_color_table (&img
->ncolors
);
12601 free_color_table ();
12606 row_stride
= width
* cinfo
.output_components
;
12607 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
12609 for (y
= 0; y
< height
; ++y
)
12611 fn_jpeg_read_scanlines (&cinfo
, buffer
, 1);
12612 for (x
= 0; x
< cinfo
.output_width
; ++x
)
12613 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
12617 fn_jpeg_finish_decompress (&cinfo
);
12618 fn_jpeg_destroy_decompress (&cinfo
);
12620 fclose ((FILE *) fp
);
12622 /* Maybe fill in the background field while we have ximg handy. */
12623 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12624 IMAGE_BACKGROUND (img
, f
, ximg
);
12626 /* Put the image into the pixmap. */
12627 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12628 x_destroy_x_image (ximg
);
12633 #endif /* HAVE_JPEG */
12637 /***********************************************************************
12639 ***********************************************************************/
12643 #include <tiffio.h>
12645 static int tiff_image_p
P_ ((Lisp_Object object
));
12646 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
12648 /* The symbol `tiff' identifying images of this type. */
12652 /* Indices of image specification fields in tiff_format, below. */
12654 enum tiff_keyword_index
12663 TIFF_HEURISTIC_MASK
,
12669 /* Vector of image_keyword structures describing the format
12670 of valid user-defined image specifications. */
12672 static struct image_keyword tiff_format
[TIFF_LAST
] =
12674 {":type", IMAGE_SYMBOL_VALUE
, 1},
12675 {":data", IMAGE_STRING_VALUE
, 0},
12676 {":file", IMAGE_STRING_VALUE
, 0},
12677 {":ascent", IMAGE_ASCENT_VALUE
, 0},
12678 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12679 {":relief", IMAGE_INTEGER_VALUE
, 0},
12680 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12681 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12682 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12683 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12686 /* Structure describing the image type `tiff'. */
12688 static struct image_type tiff_type
=
12697 /* TIFF library details. */
12698 DEF_IMGLIB_FN (TIFFSetErrorHandler
);
12699 DEF_IMGLIB_FN (TIFFSetWarningHandler
);
12700 DEF_IMGLIB_FN (TIFFOpen
);
12701 DEF_IMGLIB_FN (TIFFClientOpen
);
12702 DEF_IMGLIB_FN (TIFFGetField
);
12703 DEF_IMGLIB_FN (TIFFReadRGBAImage
);
12704 DEF_IMGLIB_FN (TIFFClose
);
12707 init_tiff_functions (library
)
12710 LOAD_IMGLIB_FN (library
, TIFFSetErrorHandler
);
12711 LOAD_IMGLIB_FN (library
, TIFFSetWarningHandler
);
12712 LOAD_IMGLIB_FN (library
, TIFFOpen
);
12713 LOAD_IMGLIB_FN (library
, TIFFClientOpen
);
12714 LOAD_IMGLIB_FN (library
, TIFFGetField
);
12715 LOAD_IMGLIB_FN (library
, TIFFReadRGBAImage
);
12716 LOAD_IMGLIB_FN (library
, TIFFClose
);
12720 /* Return non-zero if OBJECT is a valid TIFF image specification. */
12723 tiff_image_p (object
)
12724 Lisp_Object object
;
12726 struct image_keyword fmt
[TIFF_LAST
];
12727 bcopy (tiff_format
, fmt
, sizeof fmt
);
12729 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
12732 /* Must specify either the :data or :file keyword. */
12733 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
12737 /* Reading from a memory buffer for TIFF images Based on the PNG
12738 memory source, but we have to provide a lot of extra functions.
12741 We really only need to implement read and seek, but I am not
12742 convinced that the TIFF library is smart enough not to destroy
12743 itself if we only hand it the function pointers we need to
12748 unsigned char *bytes
;
12752 tiff_memory_source
;
12755 tiff_read_from_memory (data
, buf
, size
)
12760 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
12762 if (size
> src
->len
- src
->index
)
12763 return (size_t) -1;
12764 bcopy (src
->bytes
+ src
->index
, buf
, size
);
12765 src
->index
+= size
;
12770 tiff_write_from_memory (data
, buf
, size
)
12775 return (size_t) -1;
12779 tiff_seek_in_memory (data
, off
, whence
)
12784 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
12789 case SEEK_SET
: /* Go from beginning of source. */
12793 case SEEK_END
: /* Go from end of source. */
12794 idx
= src
->len
+ off
;
12797 case SEEK_CUR
: /* Go from current position. */
12798 idx
= src
->index
+ off
;
12801 default: /* Invalid `whence'. */
12805 if (idx
> src
->len
|| idx
< 0)
12813 tiff_close_memory (data
)
12821 tiff_mmap_memory (data
, pbase
, psize
)
12826 /* It is already _IN_ memory. */
12831 tiff_unmap_memory (data
, base
, size
)
12836 /* We don't need to do this. */
12840 tiff_size_of_memory (data
)
12843 return ((tiff_memory_source
*) data
)->len
;
12848 tiff_error_handler (title
, format
, ap
)
12849 const char *title
, *format
;
12855 len
= sprintf (buf
, "TIFF error: %s ", title
);
12856 vsprintf (buf
+ len
, format
, ap
);
12857 add_to_log (buf
, Qnil
, Qnil
);
12862 tiff_warning_handler (title
, format
, ap
)
12863 const char *title
, *format
;
12869 len
= sprintf (buf
, "TIFF warning: %s ", title
);
12870 vsprintf (buf
+ len
, format
, ap
);
12871 add_to_log (buf
, Qnil
, Qnil
);
12875 /* Load TIFF image IMG for use on frame F. Value is non-zero if
12883 Lisp_Object file
, specified_file
;
12884 Lisp_Object specified_data
;
12886 int width
, height
, x
, y
;
12890 struct gcpro gcpro1
;
12891 tiff_memory_source memsrc
;
12893 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12894 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12898 fn_TIFFSetErrorHandler (tiff_error_handler
);
12899 fn_TIFFSetWarningHandler (tiff_warning_handler
);
12901 if (NILP (specified_data
))
12903 /* Read from a file */
12904 file
= x_find_image_file (specified_file
);
12905 if (!STRINGP (file
))
12907 image_error ("Cannot find image file `%s'", file
, Qnil
);
12912 /* Try to open the image file. */
12913 tiff
= fn_TIFFOpen (SDATA (file
), "r");
12916 image_error ("Cannot open `%s'", file
, Qnil
);
12923 /* Memory source! */
12924 memsrc
.bytes
= SDATA (specified_data
);
12925 memsrc
.len
= SBYTES (specified_data
);
12928 tiff
= fn_TIFFClientOpen ("memory_source", "r", &memsrc
,
12929 (TIFFReadWriteProc
) tiff_read_from_memory
,
12930 (TIFFReadWriteProc
) tiff_write_from_memory
,
12931 tiff_seek_in_memory
,
12933 tiff_size_of_memory
,
12935 tiff_unmap_memory
);
12939 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
12945 /* Get width and height of the image, and allocate a raster buffer
12946 of width x height 32-bit values. */
12947 fn_TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
12948 fn_TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
12949 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
12951 rc
= fn_TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
12952 fn_TIFFClose (tiff
);
12955 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
12961 /* Create the X image and pixmap. */
12962 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12969 #if 0 /* TODO: Color tables. */
12970 /* Initialize the color table. */
12971 init_color_table ();
12974 /* Process the pixel raster. Origin is in the lower-left corner. */
12975 for (y
= 0; y
< height
; ++y
)
12977 uint32
*row
= buf
+ y
* width
;
12979 for (x
= 0; x
< width
; ++x
)
12981 uint32 abgr
= row
[x
];
12982 int r
= TIFFGetR (abgr
);
12983 int g
= TIFFGetG (abgr
);
12984 int b
= TIFFGetB (abgr
);
12985 #if 0 /* TODO: Color tables. */
12986 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
12988 XPutPixel (ximg
, x
, height
- 1 - y
, PALETTERGB (r
, g
, b
));
12993 #if 0 /* TODO: Color tables. */
12994 /* Remember the colors allocated for the image. Free the color table. */
12995 img
->colors
= colors_in_color_table (&img
->ncolors
);
12996 free_color_table ();
12999 img
->width
= width
;
13000 img
->height
= height
;
13002 /* Maybe fill in the background field while we have ximg handy. */
13003 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
13004 IMAGE_BACKGROUND (img
, f
, ximg
);
13006 /* Put the image into the pixmap, then free the X image and its buffer. */
13007 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
13008 x_destroy_x_image (ximg
);
13015 #endif /* HAVE_TIFF != 0 */
13019 /***********************************************************************
13021 ***********************************************************************/
13025 #define DrawText gif_DrawText
13026 #include <gif_lib.h>
13029 static int gif_image_p
P_ ((Lisp_Object object
));
13030 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
13032 /* The symbol `gif' identifying images of this type. */
13036 /* Indices of image specification fields in gif_format, below. */
13038 enum gif_keyword_index
13047 GIF_HEURISTIC_MASK
,
13054 /* Vector of image_keyword structures describing the format
13055 of valid user-defined image specifications. */
13057 static struct image_keyword gif_format
[GIF_LAST
] =
13059 {":type", IMAGE_SYMBOL_VALUE
, 1},
13060 {":data", IMAGE_STRING_VALUE
, 0},
13061 {":file", IMAGE_STRING_VALUE
, 0},
13062 {":ascent", IMAGE_ASCENT_VALUE
, 0},
13063 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
13064 {":relief", IMAGE_INTEGER_VALUE
, 0},
13065 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13066 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13067 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13068 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
13069 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
13072 /* Structure describing the image type `gif'. */
13074 static struct image_type gif_type
=
13084 /* GIF library details. */
13085 DEF_IMGLIB_FN (DGifCloseFile
);
13086 DEF_IMGLIB_FN (DGifSlurp
);
13087 DEF_IMGLIB_FN (DGifOpen
);
13088 DEF_IMGLIB_FN (DGifOpenFileName
);
13091 init_gif_functions (library
)
13094 LOAD_IMGLIB_FN (library
, DGifCloseFile
);
13095 LOAD_IMGLIB_FN (library
, DGifSlurp
);
13096 LOAD_IMGLIB_FN (library
, DGifOpen
);
13097 LOAD_IMGLIB_FN (library
, DGifOpenFileName
);
13102 /* Return non-zero if OBJECT is a valid GIF image specification. */
13105 gif_image_p (object
)
13106 Lisp_Object object
;
13108 struct image_keyword fmt
[GIF_LAST
];
13109 bcopy (gif_format
, fmt
, sizeof fmt
);
13111 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
13114 /* Must specify either the :data or :file keyword. */
13115 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
13118 /* Reading a GIF image from memory
13119 Based on the PNG memory stuff to a certain extent. */
13123 unsigned char *bytes
;
13129 /* Make the current memory source available to gif_read_from_memory.
13130 It's done this way because not all versions of libungif support
13131 a UserData field in the GifFileType structure. */
13132 static gif_memory_source
*current_gif_memory_src
;
13135 gif_read_from_memory (file
, buf
, len
)
13140 gif_memory_source
*src
= current_gif_memory_src
;
13142 if (len
> src
->len
- src
->index
)
13145 bcopy (src
->bytes
+ src
->index
, buf
, len
);
13151 /* Load GIF image IMG for use on frame F. Value is non-zero if
13159 Lisp_Object file
, specified_file
;
13160 Lisp_Object specified_data
;
13161 int rc
, width
, height
, x
, y
, i
;
13163 ColorMapObject
*gif_color_map
;
13164 unsigned long pixel_colors
[256];
13166 struct gcpro gcpro1
;
13168 int ino
, image_left
, image_top
, image_width
, image_height
;
13169 gif_memory_source memsrc
;
13170 unsigned char *raster
;
13172 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
13173 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
13177 if (NILP (specified_data
))
13179 file
= x_find_image_file (specified_file
);
13180 if (!STRINGP (file
))
13182 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
13187 /* Open the GIF file. */
13188 gif
= fn_DGifOpenFileName (SDATA (file
));
13191 image_error ("Cannot open `%s'", file
, Qnil
);
13198 /* Read from memory! */
13199 current_gif_memory_src
= &memsrc
;
13200 memsrc
.bytes
= SDATA (specified_data
);
13201 memsrc
.len
= SBYTES (specified_data
);
13204 gif
= fn_DGifOpen(&memsrc
, gif_read_from_memory
);
13207 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
13213 /* Read entire contents. */
13214 rc
= fn_DGifSlurp (gif
);
13215 if (rc
== GIF_ERROR
)
13217 image_error ("Error reading `%s'", img
->spec
, Qnil
);
13218 fn_DGifCloseFile (gif
);
13223 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
13224 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
13225 if (ino
>= gif
->ImageCount
)
13227 image_error ("Invalid image number `%s' in image `%s'",
13229 fn_DGifCloseFile (gif
);
13234 width
= img
->width
= max (gif
->SWidth
, gif
->Image
.Left
+ gif
->Image
.Width
);
13235 height
= img
->height
= max (gif
->SHeight
, gif
->Image
.Top
+ gif
->Image
.Height
);
13237 /* Create the X image and pixmap. */
13238 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
13240 fn_DGifCloseFile (gif
);
13245 /* Allocate colors. */
13246 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
13247 if (!gif_color_map
)
13248 gif_color_map
= gif
->SColorMap
;
13249 #if 0 /* TODO: Color tables */
13250 init_color_table ();
13252 bzero (pixel_colors
, sizeof pixel_colors
);
13254 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
13256 int r
= gif_color_map
->Colors
[i
].Red
;
13257 int g
= gif_color_map
->Colors
[i
].Green
;
13258 int b
= gif_color_map
->Colors
[i
].Blue
;
13259 #if 0 /* TODO: Color tables */
13260 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
13262 pixel_colors
[i
] = PALETTERGB (r
, g
, b
);
13266 #if 0 /* TODO: Color tables */
13267 img
->colors
= colors_in_color_table (&img
->ncolors
);
13268 free_color_table ();
13271 /* Clear the part of the screen image that are not covered by
13272 the image from the GIF file. Full animated GIF support
13273 requires more than can be done here (see the gif89 spec,
13274 disposal methods). Let's simply assume that the part
13275 not covered by a sub-image is in the frame's background color. */
13276 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
13277 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
13278 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
13279 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
13281 for (y
= 0; y
< image_top
; ++y
)
13282 for (x
= 0; x
< width
; ++x
)
13283 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
13285 for (y
= image_top
+ image_height
; y
< height
; ++y
)
13286 for (x
= 0; x
< width
; ++x
)
13287 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
13289 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
13291 for (x
= 0; x
< image_left
; ++x
)
13292 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
13293 for (x
= image_left
+ image_width
; x
< width
; ++x
)
13294 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
13297 /* Read the GIF image into the X image. We use a local variable
13298 `raster' here because RasterBits below is a char *, and invites
13299 problems with bytes >= 0x80. */
13300 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
13302 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
13304 static int interlace_start
[] = {0, 4, 2, 1};
13305 static int interlace_increment
[] = {8, 8, 4, 2};
13307 int row
= interlace_start
[0];
13311 for (y
= 0; y
< image_height
; y
++)
13313 if (row
>= image_height
)
13315 row
= interlace_start
[++pass
];
13316 while (row
>= image_height
)
13317 row
= interlace_start
[++pass
];
13320 for (x
= 0; x
< image_width
; x
++)
13322 int i
= raster
[(y
* image_width
) + x
];
13323 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
13327 row
+= interlace_increment
[pass
];
13332 for (y
= 0; y
< image_height
; ++y
)
13333 for (x
= 0; x
< image_width
; ++x
)
13335 int i
= raster
[y
* image_width
+ x
];
13336 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
13340 fn_DGifCloseFile (gif
);
13342 /* Maybe fill in the background field while we have ximg handy. */
13343 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
13344 IMAGE_BACKGROUND (img
, f
, ximg
);
13346 /* Put the image into the pixmap, then free the X image and its buffer. */
13347 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
13348 x_destroy_x_image (ximg
);
13354 #endif /* HAVE_GIF != 0 */
13358 /***********************************************************************
13360 ***********************************************************************/
13362 Lisp_Object Qpostscript
;
13364 /* Keyword symbols. */
13366 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
13368 #ifdef HAVE_GHOSTSCRIPT
13369 static int gs_image_p
P_ ((Lisp_Object object
));
13370 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
13371 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
13373 /* The symbol `postscript' identifying images of this type. */
13375 /* Keyword symbols. */
13377 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
13379 /* Indices of image specification fields in gs_format, below. */
13381 enum gs_keyword_index
13399 /* Vector of image_keyword structures describing the format
13400 of valid user-defined image specifications. */
13402 static struct image_keyword gs_format
[GS_LAST
] =
13404 {":type", IMAGE_SYMBOL_VALUE
, 1},
13405 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
13406 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
13407 {":file", IMAGE_STRING_VALUE
, 1},
13408 {":loader", IMAGE_FUNCTION_VALUE
, 0},
13409 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
13410 {":ascent", IMAGE_ASCENT_VALUE
, 0},
13411 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
13412 {":relief", IMAGE_INTEGER_VALUE
, 0},
13413 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13414 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13415 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
13416 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
13419 /* Structure describing the image type `ghostscript'. */
13421 static struct image_type gs_type
=
13431 /* Free X resources of Ghostscript image IMG which is used on frame F. */
13434 gs_clear_image (f
, img
)
13438 /* IMG->data.ptr_val may contain a recorded colormap. */
13439 xfree (img
->data
.ptr_val
);
13440 x_clear_image (f
, img
);
13444 /* Return non-zero if OBJECT is a valid Ghostscript image
13448 gs_image_p (object
)
13449 Lisp_Object object
;
13451 struct image_keyword fmt
[GS_LAST
];
13455 bcopy (gs_format
, fmt
, sizeof fmt
);
13457 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
13460 /* Bounding box must be a list or vector containing 4 integers. */
13461 tem
= fmt
[GS_BOUNDING_BOX
].value
;
13464 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
13465 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
13470 else if (VECTORP (tem
))
13472 if (XVECTOR (tem
)->size
!= 4)
13474 for (i
= 0; i
< 4; ++i
)
13475 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
13485 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
13494 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
13495 struct gcpro gcpro1
, gcpro2
;
13497 double in_width
, in_height
;
13498 Lisp_Object pixel_colors
= Qnil
;
13500 /* Compute pixel size of pixmap needed from the given size in the
13501 image specification. Sizes in the specification are in pt. 1 pt
13502 = 1/72 in, xdpi and ydpi are stored in the frame's X display
13504 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
13505 in_width
= XFASTINT (pt_width
) / 72.0;
13506 img
->width
= in_width
* FRAME_W32_DISPLAY_INFO (f
)->resx
;
13507 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
13508 in_height
= XFASTINT (pt_height
) / 72.0;
13509 img
->height
= in_height
* FRAME_W32_DISPLAY_INFO (f
)->resy
;
13511 /* Create the pixmap. */
13513 xassert (img
->pixmap
== 0);
13514 img
->pixmap
= XCreatePixmap (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13515 img
->width
, img
->height
,
13516 one_w32_display_info
.n_cbits
);
13521 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
13525 /* Call the loader to fill the pixmap. It returns a process object
13526 if successful. We do not record_unwind_protect here because
13527 other places in redisplay like calling window scroll functions
13528 don't either. Let the Lisp loader use `unwind-protect' instead. */
13529 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
13531 sprintf (buffer
, "%lu %lu",
13532 (unsigned long) FRAME_W32_WINDOW (f
),
13533 (unsigned long) img
->pixmap
);
13534 window_and_pixmap_id
= build_string (buffer
);
13536 sprintf (buffer
, "%lu %lu",
13537 FRAME_FOREGROUND_PIXEL (f
),
13538 FRAME_BACKGROUND_PIXEL (f
));
13539 pixel_colors
= build_string (buffer
);
13541 XSETFRAME (frame
, f
);
13542 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
13544 loader
= intern ("gs-load-image");
13546 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
13547 make_number (img
->width
),
13548 make_number (img
->height
),
13549 window_and_pixmap_id
,
13552 return PROCESSP (img
->data
.lisp_val
);
13556 /* Kill the Ghostscript process that was started to fill PIXMAP on
13557 frame F. Called from XTread_socket when receiving an event
13558 telling Emacs that Ghostscript has finished drawing. */
13561 x_kill_gs_process (pixmap
, f
)
13565 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
13569 /* Find the image containing PIXMAP. */
13570 for (i
= 0; i
< c
->used
; ++i
)
13571 if (c
->images
[i
]->pixmap
== pixmap
)
13574 /* Should someone in between have cleared the image cache, for
13575 instance, give up. */
13579 /* Kill the GS process. We should have found PIXMAP in the image
13580 cache and its image should contain a process object. */
13581 img
= c
->images
[i
];
13582 xassert (PROCESSP (img
->data
.lisp_val
));
13583 Fkill_process (img
->data
.lisp_val
, Qnil
);
13584 img
->data
.lisp_val
= Qnil
;
13586 /* On displays with a mutable colormap, figure out the colors
13587 allocated for the image by looking at the pixels of an XImage for
13589 class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
13590 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
13596 /* Try to get an XImage for img->pixmep. */
13597 ximg
= XGetImage (FRAME_W32_DISPLAY (f
), img
->pixmap
,
13598 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
13603 /* Initialize the color table. */
13604 init_color_table ();
13606 /* For each pixel of the image, look its color up in the
13607 color table. After having done so, the color table will
13608 contain an entry for each color used by the image. */
13609 for (y
= 0; y
< img
->height
; ++y
)
13610 for (x
= 0; x
< img
->width
; ++x
)
13612 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
13613 lookup_pixel_color (f
, pixel
);
13616 /* Record colors in the image. Free color table and XImage. */
13617 img
->colors
= colors_in_color_table (&img
->ncolors
);
13618 free_color_table ();
13619 XDestroyImage (ximg
);
13621 #if 0 /* This doesn't seem to be the case. If we free the colors
13622 here, we get a BadAccess later in x_clear_image when
13623 freeing the colors. */
13624 /* We have allocated colors once, but Ghostscript has also
13625 allocated colors on behalf of us. So, to get the
13626 reference counts right, free them once. */
13628 x_free_colors (FRAME_W32_DISPLAY (f
), cmap
,
13629 img
->colors
, img
->ncolors
, 0);
13633 image_error ("Cannot get X image of `%s'; colors will not be freed",
13639 /* Now that we have the pixmap, compute mask and transform the
13640 image if requested. */
13642 postprocess_image (f
, img
);
13646 #endif /* HAVE_GHOSTSCRIPT */
13649 /***********************************************************************
13651 ***********************************************************************/
13653 DEFUN ("x-change-window-property", Fx_change_window_property
,
13654 Sx_change_window_property
, 2, 3, 0,
13655 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
13656 PROP and VALUE must be strings. FRAME nil or omitted means use the
13657 selected frame. Value is VALUE. */)
13658 (prop
, value
, frame
)
13659 Lisp_Object frame
, prop
, value
;
13661 #if 0 /* TODO : port window properties to W32 */
13662 struct frame
*f
= check_x_frame (frame
);
13665 CHECK_STRING (prop
);
13666 CHECK_STRING (value
);
13669 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
13670 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13671 prop_atom
, XA_STRING
, 8, PropModeReplace
,
13672 SDATA (value
), SCHARS (value
));
13674 /* Make sure the property is set when we return. */
13675 XFlush (FRAME_W32_DISPLAY (f
));
13684 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
13685 Sx_delete_window_property
, 1, 2, 0,
13686 doc
: /* Remove window property PROP from X window of FRAME.
13687 FRAME nil or omitted means use the selected frame. Value is PROP. */)
13689 Lisp_Object prop
, frame
;
13691 #if 0 /* TODO : port window properties to W32 */
13693 struct frame
*f
= check_x_frame (frame
);
13696 CHECK_STRING (prop
);
13698 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
13699 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
13701 /* Make sure the property is removed when we return. */
13702 XFlush (FRAME_W32_DISPLAY (f
));
13710 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
13712 doc
: /* Value is the value of window property PROP on FRAME.
13713 If FRAME is nil or omitted, use the selected frame. Value is nil
13714 if FRAME hasn't a property with name PROP or if PROP has no string
13717 Lisp_Object prop
, frame
;
13719 #if 0 /* TODO : port window properties to W32 */
13721 struct frame
*f
= check_x_frame (frame
);
13724 Lisp_Object prop_value
= Qnil
;
13725 char *tmp_data
= NULL
;
13728 unsigned long actual_size
, bytes_remaining
;
13730 CHECK_STRING (prop
);
13732 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
13733 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13734 prop_atom
, 0, 0, False
, XA_STRING
,
13735 &actual_type
, &actual_format
, &actual_size
,
13736 &bytes_remaining
, (unsigned char **) &tmp_data
);
13739 int size
= bytes_remaining
;
13744 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
13745 prop_atom
, 0, bytes_remaining
,
13747 &actual_type
, &actual_format
,
13748 &actual_size
, &bytes_remaining
,
13749 (unsigned char **) &tmp_data
);
13751 prop_value
= make_string (tmp_data
, size
);
13766 /***********************************************************************
13768 ***********************************************************************/
13770 /* If non-null, an asynchronous timer that, when it expires, displays
13771 an hourglass cursor on all frames. */
13773 static struct atimer
*hourglass_atimer
;
13775 /* Non-zero means an hourglass cursor is currently shown. */
13777 static int hourglass_shown_p
;
13779 /* Number of seconds to wait before displaying an hourglass cursor. */
13781 static Lisp_Object Vhourglass_delay
;
13783 /* Default number of seconds to wait before displaying an hourglass
13786 #define DEFAULT_HOURGLASS_DELAY 1
13788 /* Function prototypes. */
13790 static void show_hourglass
P_ ((struct atimer
*));
13791 static void hide_hourglass
P_ ((void));
13794 /* Cancel a currently active hourglass timer, and start a new one. */
13799 #if 0 /* TODO: cursor shape changes. */
13801 int secs
, usecs
= 0;
13803 cancel_hourglass ();
13805 if (INTEGERP (Vhourglass_delay
)
13806 && XINT (Vhourglass_delay
) > 0)
13807 secs
= XFASTINT (Vhourglass_delay
);
13808 else if (FLOATP (Vhourglass_delay
)
13809 && XFLOAT_DATA (Vhourglass_delay
) > 0)
13812 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
13813 secs
= XFASTINT (tem
);
13814 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
13817 secs
= DEFAULT_HOURGLASS_DELAY
;
13819 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
13820 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
13821 show_hourglass
, NULL
);
13826 /* Cancel the hourglass cursor timer if active, hide an hourglass
13827 cursor if shown. */
13830 cancel_hourglass ()
13832 if (hourglass_atimer
)
13834 cancel_atimer (hourglass_atimer
);
13835 hourglass_atimer
= NULL
;
13838 if (hourglass_shown_p
)
13843 /* Timer function of hourglass_atimer. TIMER is equal to
13846 Display an hourglass cursor on all frames by mapping the frames'
13847 hourglass_window. Set the hourglass_p flag in the frames'
13848 output_data.x structure to indicate that an hourglass cursor is
13849 shown on the frames. */
13852 show_hourglass (timer
)
13853 struct atimer
*timer
;
13855 #if 0 /* TODO: cursor shape changes. */
13856 /* The timer implementation will cancel this timer automatically
13857 after this function has run. Set hourglass_atimer to null
13858 so that we know the timer doesn't have to be canceled. */
13859 hourglass_atimer
= NULL
;
13861 if (!hourglass_shown_p
)
13863 Lisp_Object rest
, frame
;
13867 FOR_EACH_FRAME (rest
, frame
)
13868 if (FRAME_W32_P (XFRAME (frame
)))
13870 struct frame
*f
= XFRAME (frame
);
13872 f
->output_data
.w32
->hourglass_p
= 1;
13874 if (!f
->output_data
.w32
->hourglass_window
)
13876 unsigned long mask
= CWCursor
;
13877 XSetWindowAttributes attrs
;
13879 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
13881 f
->output_data
.w32
->hourglass_window
13882 = XCreateWindow (FRAME_X_DISPLAY (f
),
13883 FRAME_OUTER_WINDOW (f
),
13884 0, 0, 32000, 32000, 0, 0,
13890 XMapRaised (FRAME_X_DISPLAY (f
),
13891 f
->output_data
.w32
->hourglass_window
);
13892 XFlush (FRAME_X_DISPLAY (f
));
13895 hourglass_shown_p
= 1;
13902 /* Hide the hourglass cursor on all frames, if it is currently shown. */
13907 #if 0 /* TODO: cursor shape changes. */
13908 if (hourglass_shown_p
)
13910 Lisp_Object rest
, frame
;
13913 FOR_EACH_FRAME (rest
, frame
)
13915 struct frame
*f
= XFRAME (frame
);
13917 if (FRAME_W32_P (f
)
13918 /* Watch out for newly created frames. */
13919 && f
->output_data
.x
->hourglass_window
)
13921 XUnmapWindow (FRAME_X_DISPLAY (f
),
13922 f
->output_data
.x
->hourglass_window
);
13923 /* Sync here because XTread_socket looks at the
13924 hourglass_p flag that is reset to zero below. */
13925 XSync (FRAME_X_DISPLAY (f
), False
);
13926 f
->output_data
.x
->hourglass_p
= 0;
13930 hourglass_shown_p
= 0;
13938 /***********************************************************************
13940 ***********************************************************************/
13942 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
13943 Lisp_Object
, Lisp_Object
));
13944 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
13945 Lisp_Object
, int, int, int *, int *));
13947 /* The frame of a currently visible tooltip. */
13949 Lisp_Object tip_frame
;
13951 /* If non-nil, a timer started that hides the last tooltip when it
13954 Lisp_Object tip_timer
;
13957 /* If non-nil, a vector of 3 elements containing the last args
13958 with which x-show-tip was called. See there. */
13960 Lisp_Object last_show_tip_args
;
13962 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
13964 Lisp_Object Vx_max_tooltip_size
;
13968 unwind_create_tip_frame (frame
)
13971 Lisp_Object deleted
;
13973 deleted
= unwind_create_frame (frame
);
13974 if (EQ (deleted
, Qt
))
13984 /* Create a frame for a tooltip on the display described by DPYINFO.
13985 PARMS is a list of frame parameters. TEXT is the string to
13986 display in the tip frame. Value is the frame.
13988 Note that functions called here, esp. x_default_parameter can
13989 signal errors, for instance when a specified color name is
13990 undefined. We have to make sure that we're in a consistent state
13991 when this happens. */
13994 x_create_tip_frame (dpyinfo
, parms
, text
)
13995 struct w32_display_info
*dpyinfo
;
13996 Lisp_Object parms
, text
;
13999 Lisp_Object frame
, tem
;
14001 long window_prompting
= 0;
14003 int count
= SPECPDL_INDEX ();
14004 struct gcpro gcpro1
, gcpro2
, gcpro3
;
14006 int face_change_count_before
= face_change_count
;
14007 Lisp_Object buffer
;
14008 struct buffer
*old_buffer
;
14012 /* Use this general default value to start with until we know if
14013 this frame has a specified name. */
14014 Vx_resource_name
= Vinvocation_name
;
14016 #ifdef MULTI_KBOARD
14017 kb
= dpyinfo
->kboard
;
14019 kb
= &the_only_kboard
;
14022 /* Get the name of the frame to use for resource lookup. */
14023 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
14024 if (!STRINGP (name
)
14025 && !EQ (name
, Qunbound
)
14027 error ("Invalid frame name--not a string or nil");
14028 Vx_resource_name
= name
;
14031 GCPRO3 (parms
, name
, frame
);
14032 /* Make a frame without minibuffer nor mode-line. */
14033 f
= make_frame (0);
14034 f
->wants_modeline
= 0;
14035 XSETFRAME (frame
, f
);
14037 buffer
= Fget_buffer_create (build_string (" *tip*"));
14038 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
14039 old_buffer
= current_buffer
;
14040 set_buffer_internal_1 (XBUFFER (buffer
));
14041 current_buffer
->truncate_lines
= Qnil
;
14043 Finsert (1, &text
);
14044 set_buffer_internal_1 (old_buffer
);
14046 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
14047 record_unwind_protect (unwind_create_tip_frame
, frame
);
14049 /* By setting the output method, we're essentially saying that
14050 the frame is live, as per FRAME_LIVE_P. If we get a signal
14051 from this point on, x_destroy_window might screw up reference
14053 f
->output_method
= output_w32
;
14054 f
->output_data
.w32
=
14055 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
14056 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
14058 FRAME_FONTSET (f
) = -1;
14059 f
->icon_name
= Qnil
;
14061 #if 0 /* GLYPH_DEBUG TODO: image support. */
14062 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
14063 dpyinfo_refcount
= dpyinfo
->reference_count
;
14064 #endif /* GLYPH_DEBUG */
14065 #ifdef MULTI_KBOARD
14066 FRAME_KBOARD (f
) = kb
;
14068 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
14069 f
->output_data
.w32
->explicit_parent
= 0;
14071 /* Set the name; the functions to which we pass f expect the name to
14073 if (EQ (name
, Qunbound
) || NILP (name
))
14075 f
->name
= build_string (dpyinfo
->w32_id_name
);
14076 f
->explicit_name
= 0;
14081 f
->explicit_name
= 1;
14082 /* use the frame's title when getting resources for this frame. */
14083 specbind (Qx_resource_name
, name
);
14086 /* Extract the window parameters from the supplied values
14087 that are needed to determine window geometry. */
14091 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
14094 /* First, try whatever font the caller has specified. */
14095 if (STRINGP (font
))
14097 tem
= Fquery_fontset (font
, Qnil
);
14099 font
= x_new_fontset (f
, SDATA (tem
));
14101 font
= x_new_font (f
, SDATA (font
));
14104 /* Try out a font which we hope has bold and italic variations. */
14105 if (!STRINGP (font
))
14106 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
14107 if (! STRINGP (font
))
14108 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
14109 /* If those didn't work, look for something which will at least work. */
14110 if (! STRINGP (font
))
14111 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
14113 if (! STRINGP (font
))
14114 font
= build_string ("Fixedsys");
14116 x_default_parameter (f
, parms
, Qfont
, font
,
14117 "font", "Font", RES_TYPE_STRING
);
14120 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
14121 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
14122 /* This defaults to 2 in order to match xterm. We recognize either
14123 internalBorderWidth or internalBorder (which is what xterm calls
14125 if (NILP (Fassq (Qinternal_border_width
, parms
)))
14129 value
= w32_get_arg (parms
, Qinternal_border_width
,
14130 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
14131 if (! EQ (value
, Qunbound
))
14132 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
14135 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
14136 "internalBorderWidth", "internalBorderWidth",
14139 /* Also do the stuff which must be set before the window exists. */
14140 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
14141 "foreground", "Foreground", RES_TYPE_STRING
);
14142 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
14143 "background", "Background", RES_TYPE_STRING
);
14144 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
14145 "pointerColor", "Foreground", RES_TYPE_STRING
);
14146 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
14147 "cursorColor", "Foreground", RES_TYPE_STRING
);
14148 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
14149 "borderColor", "BorderColor", RES_TYPE_STRING
);
14151 /* Init faces before x_default_parameter is called for scroll-bar
14152 parameters because that function calls x_set_scroll_bar_width,
14153 which calls change_frame_size, which calls Fset_window_buffer,
14154 which runs hooks, which call Fvertical_motion. At the end, we
14155 end up in init_iterator with a null face cache, which should not
14157 init_frame_faces (f
);
14159 f
->output_data
.w32
->dwStyle
= WS_BORDER
| WS_POPUP
| WS_DISABLED
;
14160 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
14162 window_prompting
= x_figure_window_size (f
, parms
);
14164 /* No fringes on tip frame. */
14165 f
->output_data
.w32
->fringes_extra
= 0;
14166 f
->output_data
.w32
->fringe_cols
= 0;
14167 f
->output_data
.w32
->left_fringe_width
= 0;
14168 f
->output_data
.w32
->right_fringe_width
= 0;
14170 if (window_prompting
& XNegative
)
14172 if (window_prompting
& YNegative
)
14173 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
14175 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
14179 if (window_prompting
& YNegative
)
14180 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
14182 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
14185 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
14188 my_create_tip_window (f
);
14193 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
14194 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
14195 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
14196 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
14197 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
14198 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
14200 /* Dimensions, especially f->height, must be done via change_frame_size.
14201 Change will not be effected unless different from the current
14204 height
= f
->height
;
14206 SET_FRAME_WIDTH (f
, 0);
14207 change_frame_size (f
, height
, width
, 1, 0, 0);
14209 /* Add `tooltip' frame parameter's default value. */
14210 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
14211 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
14214 /* Set up faces after all frame parameters are known. This call
14215 also merges in face attributes specified for new frames.
14217 Frame parameters may be changed if .Xdefaults contains
14218 specifications for the default font. For example, if there is an
14219 `Emacs.default.attributeBackground: pink', the `background-color'
14220 attribute of the frame get's set, which let's the internal border
14221 of the tooltip frame appear in pink. Prevent this. */
14223 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
14225 /* Set tip_frame here, so that */
14227 call1 (Qface_set_after_frame_default
, frame
);
14229 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
14230 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
14238 /* It is now ok to make the frame official even if we get an error
14239 below. And the frame needs to be on Vframe_list or making it
14240 visible won't work. */
14241 Vframe_list
= Fcons (frame
, Vframe_list
);
14243 /* Now that the frame is official, it counts as a reference to
14245 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
14247 /* Setting attributes of faces of the tooltip frame from resources
14248 and similar will increment face_change_count, which leads to the
14249 clearing of all current matrices. Since this isn't necessary
14250 here, avoid it by resetting face_change_count to the value it
14251 had before we created the tip frame. */
14252 face_change_count
= face_change_count_before
;
14254 /* Discard the unwind_protect. */
14255 return unbind_to (count
, frame
);
14259 /* Compute where to display tip frame F. PARMS is the list of frame
14260 parameters for F. DX and DY are specified offsets from the current
14261 location of the mouse. WIDTH and HEIGHT are the width and height
14262 of the tooltip. Return coordinates relative to the root window of
14263 the display in *ROOT_X, and *ROOT_Y. */
14266 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
14268 Lisp_Object parms
, dx
, dy
;
14270 int *root_x
, *root_y
;
14272 Lisp_Object left
, top
;
14274 /* User-specified position? */
14275 left
= Fcdr (Fassq (Qleft
, parms
));
14276 top
= Fcdr (Fassq (Qtop
, parms
));
14278 /* Move the tooltip window where the mouse pointer is. Resize and
14280 if (!INTEGERP (left
) || !INTEGERP (top
))
14285 GetCursorPos (&pt
);
14291 if (INTEGERP (top
))
14292 *root_y
= XINT (top
);
14293 else if (*root_y
+ XINT (dy
) - height
< 0)
14294 *root_y
-= XINT (dy
);
14298 *root_y
+= XINT (dy
);
14301 if (INTEGERP (left
))
14302 *root_x
= XINT (left
);
14303 else if (*root_x
+ XINT (dx
) + width
<= FRAME_W32_DISPLAY_INFO (f
)->width
)
14304 /* It fits to the right of the pointer. */
14305 *root_x
+= XINT (dx
);
14306 else if (width
+ XINT (dx
) <= *root_x
)
14307 /* It fits to the left of the pointer. */
14308 *root_x
-= width
+ XINT (dx
);
14310 /* Put it left justified on the screen -- it ought to fit that way. */
14315 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
14316 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
14317 A tooltip window is a small window displaying a string.
14319 FRAME nil or omitted means use the selected frame.
14321 PARMS is an optional list of frame parameters which can be
14322 used to change the tooltip's appearance.
14324 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
14325 means use the default timeout of 5 seconds.
14327 If the list of frame parameters PARAMS contains a `left' parameter,
14328 the tooltip is displayed at that x-position. Otherwise it is
14329 displayed at the mouse position, with offset DX added (default is 5 if
14330 DX isn't specified). Likewise for the y-position; if a `top' frame
14331 parameter is specified, it determines the y-position of the tooltip
14332 window, otherwise it is displayed at the mouse position, with offset
14333 DY added (default is -10).
14335 A tooltip's maximum size is specified by `x-max-tooltip-size'.
14336 Text larger than the specified size is clipped. */)
14337 (string
, frame
, parms
, timeout
, dx
, dy
)
14338 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
14342 int root_x
, root_y
;
14343 struct buffer
*old_buffer
;
14344 struct text_pos pos
;
14345 int i
, width
, height
;
14346 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
14347 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
14348 int count
= SPECPDL_INDEX ();
14350 specbind (Qinhibit_redisplay
, Qt
);
14352 GCPRO4 (string
, parms
, frame
, timeout
);
14354 CHECK_STRING (string
);
14355 f
= check_x_frame (frame
);
14356 if (NILP (timeout
))
14357 timeout
= make_number (5);
14359 CHECK_NATNUM (timeout
);
14362 dx
= make_number (5);
14367 dy
= make_number (-10);
14371 if (NILP (last_show_tip_args
))
14372 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
14374 if (!NILP (tip_frame
))
14376 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
14377 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
14378 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
14380 if (EQ (frame
, last_frame
)
14381 && !NILP (Fequal (last_string
, string
))
14382 && !NILP (Fequal (last_parms
, parms
)))
14384 struct frame
*f
= XFRAME (tip_frame
);
14386 /* Only DX and DY have changed. */
14387 if (!NILP (tip_timer
))
14389 Lisp_Object timer
= tip_timer
;
14391 call1 (Qcancel_timer
, timer
);
14395 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
14396 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
14398 /* Put tooltip in topmost group and in position. */
14399 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
14400 root_x
, root_y
, 0, 0,
14401 SWP_NOSIZE
| SWP_NOACTIVATE
);
14403 /* Ensure tooltip is on top of other topmost windows (eg menus). */
14404 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
14406 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
14413 /* Hide a previous tip, if any. */
14416 ASET (last_show_tip_args
, 0, string
);
14417 ASET (last_show_tip_args
, 1, frame
);
14418 ASET (last_show_tip_args
, 2, parms
);
14420 /* Add default values to frame parameters. */
14421 if (NILP (Fassq (Qname
, parms
)))
14422 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
14423 if (NILP (Fassq (Qinternal_border_width
, parms
)))
14424 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
14425 if (NILP (Fassq (Qborder_width
, parms
)))
14426 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
14427 if (NILP (Fassq (Qborder_color
, parms
)))
14428 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
14429 if (NILP (Fassq (Qbackground_color
, parms
)))
14430 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
14433 /* Block input until the tip has been fully drawn, to avoid crashes
14434 when drawing tips in menus. */
14437 /* Create a frame for the tooltip, and record it in the global
14438 variable tip_frame. */
14439 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
, string
);
14440 f
= XFRAME (frame
);
14442 /* Set up the frame's root window. */
14443 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
14444 w
->left
= w
->top
= make_number (0);
14446 if (CONSP (Vx_max_tooltip_size
)
14447 && INTEGERP (XCAR (Vx_max_tooltip_size
))
14448 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
14449 && INTEGERP (XCDR (Vx_max_tooltip_size
))
14450 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
14452 w
->width
= XCAR (Vx_max_tooltip_size
);
14453 w
->height
= XCDR (Vx_max_tooltip_size
);
14457 w
->width
= make_number (80);
14458 w
->height
= make_number (40);
14461 f
->window_width
= XINT (w
->width
);
14463 w
->pseudo_window_p
= 1;
14465 /* Display the tooltip text in a temporary buffer. */
14466 old_buffer
= current_buffer
;
14467 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
14468 current_buffer
->truncate_lines
= Qnil
;
14469 clear_glyph_matrix (w
->desired_matrix
);
14470 clear_glyph_matrix (w
->current_matrix
);
14471 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
14472 try_window (FRAME_ROOT_WINDOW (f
), pos
);
14474 /* Compute width and height of the tooltip. */
14475 width
= height
= 0;
14476 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
14478 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
14479 struct glyph
*last
;
14482 /* Stop at the first empty row at the end. */
14483 if (!row
->enabled_p
|| !row
->displays_text_p
)
14486 /* Let the row go over the full width of the frame. */
14487 row
->full_width_p
= 1;
14489 #ifdef TODO /* Investigate why some fonts need more width than is
14490 calculated for some tooltips. */
14491 /* There's a glyph at the end of rows that is use to place
14492 the cursor there. Don't include the width of this glyph. */
14493 if (row
->used
[TEXT_AREA
])
14495 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
14496 row_width
= row
->pixel_width
- last
->pixel_width
;
14500 row_width
= row
->pixel_width
;
14502 /* TODO: find why tips do not draw along baseline as instructed. */
14503 height
+= row
->height
;
14504 width
= max (width
, row_width
);
14507 /* Add the frame's internal border to the width and height the X
14508 window should have. */
14509 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
14510 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
14512 /* Move the tooltip window where the mouse pointer is. Resize and
14514 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
14517 /* Adjust Window size to take border into account. */
14519 rect
.left
= rect
.top
= 0;
14520 rect
.right
= width
;
14521 rect
.bottom
= height
;
14522 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
14523 FRAME_EXTERNAL_MENU_BAR (f
));
14525 /* Position and size tooltip, and put it in the topmost group. */
14526 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
14527 root_x
, root_y
, rect
.right
- rect
.left
,
14528 rect
.bottom
- rect
.top
, SWP_NOACTIVATE
);
14530 /* Ensure tooltip is on top of other topmost windows (eg menus). */
14531 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
14533 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
14535 /* Let redisplay know that we have made the frame visible already. */
14536 f
->async_visible
= 1;
14538 ShowWindow (FRAME_W32_WINDOW (f
), SW_SHOWNOACTIVATE
);
14541 /* Draw into the window. */
14542 w
->must_be_updated_p
= 1;
14543 update_single_window (w
, 1);
14547 /* Restore original current buffer. */
14548 set_buffer_internal_1 (old_buffer
);
14549 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
14552 /* Let the tip disappear after timeout seconds. */
14553 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
14554 intern ("x-hide-tip"));
14557 return unbind_to (count
, Qnil
);
14561 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
14562 doc
: /* Hide the current tooltip window, if there is any.
14563 Value is t if tooltip was open, nil otherwise. */)
14567 Lisp_Object deleted
, frame
, timer
;
14568 struct gcpro gcpro1
, gcpro2
;
14570 /* Return quickly if nothing to do. */
14571 if (NILP (tip_timer
) && NILP (tip_frame
))
14576 GCPRO2 (frame
, timer
);
14577 tip_frame
= tip_timer
= deleted
= Qnil
;
14579 count
= SPECPDL_INDEX ();
14580 specbind (Qinhibit_redisplay
, Qt
);
14581 specbind (Qinhibit_quit
, Qt
);
14584 call1 (Qcancel_timer
, timer
);
14586 if (FRAMEP (frame
))
14588 Fdelete_frame (frame
, Qnil
);
14593 return unbind_to (count
, deleted
);
14598 /***********************************************************************
14599 File selection dialog
14600 ***********************************************************************/
14601 extern Lisp_Object Qfile_name_history
;
14603 /* Callback for altering the behaviour of the Open File dialog.
14604 Makes the Filename text field contain "Current Directory" and be
14605 read-only when "Directories" is selected in the filter. This
14606 allows us to work around the fact that the standard Open File
14607 dialog does not support directories. */
14609 file_dialog_callback (hwnd
, msg
, wParam
, lParam
)
14615 if (msg
== WM_NOTIFY
)
14617 OFNOTIFY
* notify
= (OFNOTIFY
*)lParam
;
14618 /* Detect when the Filter dropdown is changed. */
14619 if (notify
->hdr
.code
== CDN_TYPECHANGE
)
14621 HWND dialog
= GetParent (hwnd
);
14622 HWND edit_control
= GetDlgItem (dialog
, FILE_NAME_TEXT_FIELD
);
14624 /* Directories is in index 2. */
14625 if (notify
->lpOFN
->nFilterIndex
== 2)
14627 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
14628 "Current Directory");
14629 EnableWindow (edit_control
, FALSE
);
14633 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
14635 EnableWindow (edit_control
, TRUE
);
14642 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
14643 doc
: /* Read file name, prompting with PROMPT in directory DIR.
14644 Use a file selection dialog.
14645 Select DEFAULT-FILENAME in the dialog's file selection box, if
14646 specified. Ensure that file exists if MUSTMATCH is non-nil. */)
14647 (prompt
, dir
, default_filename
, mustmatch
)
14648 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
14650 struct frame
*f
= SELECTED_FRAME ();
14651 Lisp_Object file
= Qnil
;
14652 int count
= SPECPDL_INDEX ();
14653 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
14654 char filename
[MAX_PATH
+ 1];
14655 char init_dir
[MAX_PATH
+ 1];
14657 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
14658 CHECK_STRING (prompt
);
14659 CHECK_STRING (dir
);
14661 /* Create the dialog with PROMPT as title, using DIR as initial
14662 directory and using "*" as pattern. */
14663 dir
= Fexpand_file_name (dir
, Qnil
);
14664 strncpy (init_dir
, SDATA (dir
), MAX_PATH
);
14665 init_dir
[MAX_PATH
] = '\0';
14666 unixtodos_filename (init_dir
);
14668 if (STRINGP (default_filename
))
14670 char *file_name_only
;
14671 char *full_path_name
= SDATA (default_filename
);
14673 unixtodos_filename (full_path_name
);
14675 file_name_only
= strrchr (full_path_name
, '\\');
14676 if (!file_name_only
)
14677 file_name_only
= full_path_name
;
14683 strncpy (filename
, file_name_only
, MAX_PATH
);
14684 filename
[MAX_PATH
] = '\0';
14687 filename
[0] = '\0';
14690 OPENFILENAME file_details
;
14692 /* Prevent redisplay. */
14693 specbind (Qinhibit_redisplay
, Qt
);
14696 bzero (&file_details
, sizeof (file_details
));
14697 file_details
.lStructSize
= sizeof (file_details
);
14698 file_details
.hwndOwner
= FRAME_W32_WINDOW (f
);
14699 /* Undocumented Bug in Common File Dialog:
14700 If a filter is not specified, shell links are not resolved. */
14701 file_details
.lpstrFilter
= "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
14702 file_details
.lpstrFile
= filename
;
14703 file_details
.nMaxFile
= sizeof (filename
);
14704 file_details
.lpstrInitialDir
= init_dir
;
14705 file_details
.lpstrTitle
= SDATA (prompt
);
14706 file_details
.Flags
= (OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
14707 | OFN_EXPLORER
| OFN_ENABLEHOOK
);
14708 if (!NILP (mustmatch
))
14709 file_details
.Flags
|= OFN_FILEMUSTEXIST
| OFN_PATHMUSTEXIST
;
14711 file_details
.lpfnHook
= (LPOFNHOOKPROC
) file_dialog_callback
;
14713 if (GetOpenFileName (&file_details
))
14715 dostounix_filename (filename
);
14716 if (file_details
.nFilterIndex
== 2)
14718 /* "Folder Only" selected - strip dummy file name. */
14719 char * last
= strrchr (filename
, '/');
14723 file
= DECODE_FILE(build_string (filename
));
14725 /* User cancelled the dialog without making a selection. */
14726 else if (!CommDlgExtendedError ())
14728 /* An error occurred, fallback on reading from the mini-buffer. */
14730 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
14731 dir
, mustmatch
, dir
, Qfile_name_history
,
14732 default_filename
, Qnil
);
14735 file
= unbind_to (count
, file
);
14740 /* Make "Cancel" equivalent to C-g. */
14742 Fsignal (Qquit
, Qnil
);
14744 return unbind_to (count
, file
);
14749 /***********************************************************************
14750 w32 specialized functions
14751 ***********************************************************************/
14753 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 2, 0,
14754 doc
: /* Select a font using the W32 font dialog.
14755 Returns an X font string corresponding to the selection. */)
14756 (frame
, include_proportional
)
14757 Lisp_Object frame
, include_proportional
;
14759 FRAME_PTR f
= check_x_frame (frame
);
14767 bzero (&cf
, sizeof (cf
));
14768 bzero (&lf
, sizeof (lf
));
14770 cf
.lStructSize
= sizeof (cf
);
14771 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
14772 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
14774 /* Unless include_proportional is non-nil, limit the selection to
14775 monospaced fonts. */
14776 if (NILP (include_proportional
))
14777 cf
.Flags
|= CF_FIXEDPITCHONLY
;
14779 cf
.lpLogFont
= &lf
;
14781 /* Initialize as much of the font details as we can from the current
14783 hdc
= GetDC (FRAME_W32_WINDOW (f
));
14784 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
14785 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
14786 if (GetTextMetrics (hdc
, &tm
))
14788 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
14789 lf
.lfWeight
= tm
.tmWeight
;
14790 lf
.lfItalic
= tm
.tmItalic
;
14791 lf
.lfUnderline
= tm
.tmUnderlined
;
14792 lf
.lfStrikeOut
= tm
.tmStruckOut
;
14793 lf
.lfCharSet
= tm
.tmCharSet
;
14794 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
14796 SelectObject (hdc
, oldobj
);
14797 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
14799 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
14802 return build_string (buf
);
14805 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
14806 Sw32_send_sys_command
, 1, 2, 0,
14807 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
14808 Some useful values for command are #xf030 to maximise frame (#xf020
14809 to minimize), #xf120 to restore frame to original size, and #xf100
14810 to activate the menubar for keyboard access. #xf140 activates the
14811 screen saver if defined.
14813 If optional parameter FRAME is not specified, use selected frame. */)
14815 Lisp_Object command
, frame
;
14817 FRAME_PTR f
= check_x_frame (frame
);
14819 CHECK_NUMBER (command
);
14821 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
14826 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
14827 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
14828 This is a wrapper around the ShellExecute system function, which
14829 invokes the application registered to handle OPERATION for DOCUMENT.
14830 OPERATION is typically \"open\", \"print\" or \"explore\" (but can be
14831 nil for the default action), and DOCUMENT is typically the name of a
14832 document file or URL, but can also be a program executable to run or
14833 a directory to open in the Windows Explorer.
14835 If DOCUMENT is a program executable, PARAMETERS can be a string
14836 containing command line parameters, but otherwise should be nil.
14838 SHOW-FLAG can be used to control whether the invoked application is hidden
14839 or minimized. If SHOW-FLAG is nil, the application is displayed normally,
14840 otherwise it is an integer representing a ShowWindow flag:
14844 3 - start maximized
14845 6 - start minimized */)
14846 (operation
, document
, parameters
, show_flag
)
14847 Lisp_Object operation
, document
, parameters
, show_flag
;
14849 Lisp_Object current_dir
;
14851 CHECK_STRING (document
);
14853 /* Encode filename and current directory. */
14854 current_dir
= ENCODE_FILE (current_buffer
->directory
);
14855 document
= ENCODE_FILE (document
);
14856 if ((int) ShellExecute (NULL
,
14857 (STRINGP (operation
) ?
14858 SDATA (operation
) : NULL
),
14860 (STRINGP (parameters
) ?
14861 SDATA (parameters
) : NULL
),
14862 SDATA (current_dir
),
14863 (INTEGERP (show_flag
) ?
14864 XINT (show_flag
) : SW_SHOWDEFAULT
))
14867 error ("ShellExecute failed: %s", w32_strerror (0));
14870 /* Lookup virtual keycode from string representing the name of a
14871 non-ascii keystroke into the corresponding virtual key, using
14872 lispy_function_keys. */
14874 lookup_vk_code (char *key
)
14878 for (i
= 0; i
< 256; i
++)
14879 if (lispy_function_keys
[i
] != 0
14880 && strcmp (lispy_function_keys
[i
], key
) == 0)
14886 /* Convert a one-element vector style key sequence to a hot key
14889 w32_parse_hot_key (key
)
14892 /* Copied from Fdefine_key and store_in_keymap. */
14893 register Lisp_Object c
;
14895 int lisp_modifiers
;
14897 struct gcpro gcpro1
;
14899 CHECK_VECTOR (key
);
14901 if (XFASTINT (Flength (key
)) != 1)
14906 c
= Faref (key
, make_number (0));
14908 if (CONSP (c
) && lucid_event_type_list_p (c
))
14909 c
= Fevent_convert_list (c
);
14913 if (! INTEGERP (c
) && ! SYMBOLP (c
))
14914 error ("Key definition is invalid");
14916 /* Work out the base key and the modifiers. */
14919 c
= parse_modifiers (c
);
14920 lisp_modifiers
= Fcar (Fcdr (c
));
14924 vk_code
= lookup_vk_code (SDATA (SYMBOL_NAME (c
)));
14926 else if (INTEGERP (c
))
14928 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
14929 /* Many ascii characters are their own virtual key code. */
14930 vk_code
= XINT (c
) & CHARACTERBITS
;
14933 if (vk_code
< 0 || vk_code
> 255)
14936 if ((lisp_modifiers
& meta_modifier
) != 0
14937 && !NILP (Vw32_alt_is_meta
))
14938 lisp_modifiers
|= alt_modifier
;
14940 /* Supply defs missing from mingw32. */
14942 #define MOD_ALT 0x0001
14943 #define MOD_CONTROL 0x0002
14944 #define MOD_SHIFT 0x0004
14945 #define MOD_WIN 0x0008
14948 /* Convert lisp modifiers to Windows hot-key form. */
14949 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
14950 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
14951 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
14952 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
14954 return HOTKEY (vk_code
, w32_modifiers
);
14957 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
14958 Sw32_register_hot_key
, 1, 1, 0,
14959 doc
: /* Register KEY as a hot-key combination.
14960 Certain key combinations like Alt-Tab are reserved for system use on
14961 Windows, and therefore are normally intercepted by the system. However,
14962 most of these key combinations can be received by registering them as
14963 hot-keys, overriding their special meaning.
14965 KEY must be a one element key definition in vector form that would be
14966 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
14967 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
14968 is always interpreted as the Windows modifier keys.
14970 The return value is the hotkey-id if registered, otherwise nil. */)
14974 key
= w32_parse_hot_key (key
);
14976 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
14978 /* Reuse an empty slot if possible. */
14979 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
14981 /* Safe to add new key to list, even if we have focus. */
14983 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
14985 XSETCAR (item
, key
);
14987 /* Notify input thread about new hot-key definition, so that it
14988 takes effect without needing to switch focus. */
14989 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
14996 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
14997 Sw32_unregister_hot_key
, 1, 1, 0,
14998 doc
: /* Unregister HOTKEY as a hot-key combination. */)
15004 if (!INTEGERP (key
))
15005 key
= w32_parse_hot_key (key
);
15007 item
= Fmemq (key
, w32_grabbed_keys
);
15011 /* Notify input thread about hot-key definition being removed, so
15012 that it takes effect without needing focus switch. */
15013 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
15014 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
15017 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
15024 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
15025 Sw32_registered_hot_keys
, 0, 0, 0,
15026 doc
: /* Return list of registered hot-key IDs. */)
15029 return Fcopy_sequence (w32_grabbed_keys
);
15032 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
15033 Sw32_reconstruct_hot_key
, 1, 1, 0,
15034 doc
: /* Convert hot-key ID to a lisp key combination. */)
15036 Lisp_Object hotkeyid
;
15038 int vk_code
, w32_modifiers
;
15041 CHECK_NUMBER (hotkeyid
);
15043 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
15044 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
15046 if (lispy_function_keys
[vk_code
])
15047 key
= intern (lispy_function_keys
[vk_code
]);
15049 key
= make_number (vk_code
);
15051 key
= Fcons (key
, Qnil
);
15052 if (w32_modifiers
& MOD_SHIFT
)
15053 key
= Fcons (Qshift
, key
);
15054 if (w32_modifiers
& MOD_CONTROL
)
15055 key
= Fcons (Qctrl
, key
);
15056 if (w32_modifiers
& MOD_ALT
)
15057 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
15058 if (w32_modifiers
& MOD_WIN
)
15059 key
= Fcons (Qhyper
, key
);
15064 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
15065 Sw32_toggle_lock_key
, 1, 2, 0,
15066 doc
: /* Toggle the state of the lock key KEY.
15067 KEY can be `capslock', `kp-numlock', or `scroll'.
15068 If the optional parameter NEW-STATE is a number, then the state of KEY
15069 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
15071 Lisp_Object key
, new_state
;
15075 if (EQ (key
, intern ("capslock")))
15076 vk_code
= VK_CAPITAL
;
15077 else if (EQ (key
, intern ("kp-numlock")))
15078 vk_code
= VK_NUMLOCK
;
15079 else if (EQ (key
, intern ("scroll")))
15080 vk_code
= VK_SCROLL
;
15084 if (!dwWindowsThreadId
)
15085 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
15087 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
15088 (WPARAM
) vk_code
, (LPARAM
) new_state
))
15091 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
15092 return make_number (msg
.wParam
);
15097 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
15098 doc
: /* Return storage information about the file system FILENAME is on.
15099 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
15100 storage of the file system, FREE is the free storage, and AVAIL is the
15101 storage available to a non-superuser. All 3 numbers are in bytes.
15102 If the underlying system call fails, value is nil. */)
15104 Lisp_Object filename
;
15106 Lisp_Object encoded
, value
;
15108 CHECK_STRING (filename
);
15109 filename
= Fexpand_file_name (filename
, Qnil
);
15110 encoded
= ENCODE_FILE (filename
);
15114 /* Determining the required information on Windows turns out, sadly,
15115 to be more involved than one would hope. The original Win32 api
15116 call for this will return bogus information on some systems, but we
15117 must dynamically probe for the replacement api, since that was
15118 added rather late on. */
15120 HMODULE hKernel
= GetModuleHandle ("kernel32");
15121 BOOL (*pfn_GetDiskFreeSpaceEx
)
15122 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
15123 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
15125 /* On Windows, we may need to specify the root directory of the
15126 volume holding FILENAME. */
15127 char rootname
[MAX_PATH
];
15128 char *name
= SDATA (encoded
);
15130 /* find the root name of the volume if given */
15131 if (isalpha (name
[0]) && name
[1] == ':')
15133 rootname
[0] = name
[0];
15134 rootname
[1] = name
[1];
15135 rootname
[2] = '\\';
15138 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
15140 char *str
= rootname
;
15144 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
15154 if (pfn_GetDiskFreeSpaceEx
)
15156 /* Unsigned large integers cannot be cast to double, so
15157 use signed ones instead. */
15158 LARGE_INTEGER availbytes
;
15159 LARGE_INTEGER freebytes
;
15160 LARGE_INTEGER totalbytes
;
15162 if (pfn_GetDiskFreeSpaceEx(rootname
,
15163 (ULARGE_INTEGER
*)&availbytes
,
15164 (ULARGE_INTEGER
*)&totalbytes
,
15165 (ULARGE_INTEGER
*)&freebytes
))
15166 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
15167 make_float ((double) freebytes
.QuadPart
),
15168 make_float ((double) availbytes
.QuadPart
));
15172 DWORD sectors_per_cluster
;
15173 DWORD bytes_per_sector
;
15174 DWORD free_clusters
;
15175 DWORD total_clusters
;
15177 if (GetDiskFreeSpace(rootname
,
15178 §ors_per_cluster
,
15182 value
= list3 (make_float ((double) total_clusters
15183 * sectors_per_cluster
* bytes_per_sector
),
15184 make_float ((double) free_clusters
15185 * sectors_per_cluster
* bytes_per_sector
),
15186 make_float ((double) free_clusters
15187 * sectors_per_cluster
* bytes_per_sector
));
15194 /***********************************************************************
15196 ***********************************************************************/
15201 globals_of_w32fns ();
15202 /* This is zero if not using MS-Windows. */
15204 track_mouse_window
= NULL
;
15206 w32_visible_system_caret_hwnd
= NULL
;
15208 Qauto_raise
= intern ("auto-raise");
15209 staticpro (&Qauto_raise
);
15210 Qauto_lower
= intern ("auto-lower");
15211 staticpro (&Qauto_lower
);
15212 Qborder_color
= intern ("border-color");
15213 staticpro (&Qborder_color
);
15214 Qborder_width
= intern ("border-width");
15215 staticpro (&Qborder_width
);
15216 Qcursor_color
= intern ("cursor-color");
15217 staticpro (&Qcursor_color
);
15218 Qcursor_type
= intern ("cursor-type");
15219 staticpro (&Qcursor_type
);
15220 Qgeometry
= intern ("geometry");
15221 staticpro (&Qgeometry
);
15222 Qicon_left
= intern ("icon-left");
15223 staticpro (&Qicon_left
);
15224 Qicon_top
= intern ("icon-top");
15225 staticpro (&Qicon_top
);
15226 Qicon_type
= intern ("icon-type");
15227 staticpro (&Qicon_type
);
15228 Qicon_name
= intern ("icon-name");
15229 staticpro (&Qicon_name
);
15230 Qinternal_border_width
= intern ("internal-border-width");
15231 staticpro (&Qinternal_border_width
);
15232 Qleft
= intern ("left");
15233 staticpro (&Qleft
);
15234 Qright
= intern ("right");
15235 staticpro (&Qright
);
15236 Qmouse_color
= intern ("mouse-color");
15237 staticpro (&Qmouse_color
);
15238 Qnone
= intern ("none");
15239 staticpro (&Qnone
);
15240 Qparent_id
= intern ("parent-id");
15241 staticpro (&Qparent_id
);
15242 Qscroll_bar_width
= intern ("scroll-bar-width");
15243 staticpro (&Qscroll_bar_width
);
15244 Qsuppress_icon
= intern ("suppress-icon");
15245 staticpro (&Qsuppress_icon
);
15246 Qundefined_color
= intern ("undefined-color");
15247 staticpro (&Qundefined_color
);
15248 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
15249 staticpro (&Qvertical_scroll_bars
);
15250 Qvisibility
= intern ("visibility");
15251 staticpro (&Qvisibility
);
15252 Qwindow_id
= intern ("window-id");
15253 staticpro (&Qwindow_id
);
15254 Qx_frame_parameter
= intern ("x-frame-parameter");
15255 staticpro (&Qx_frame_parameter
);
15256 Qx_resource_name
= intern ("x-resource-name");
15257 staticpro (&Qx_resource_name
);
15258 Quser_position
= intern ("user-position");
15259 staticpro (&Quser_position
);
15260 Quser_size
= intern ("user-size");
15261 staticpro (&Quser_size
);
15262 Qscreen_gamma
= intern ("screen-gamma");
15263 staticpro (&Qscreen_gamma
);
15264 Qline_spacing
= intern ("line-spacing");
15265 staticpro (&Qline_spacing
);
15266 Qcenter
= intern ("center");
15267 staticpro (&Qcenter
);
15268 Qcancel_timer
= intern ("cancel-timer");
15269 staticpro (&Qcancel_timer
);
15270 Qfullscreen
= intern ("fullscreen");
15271 staticpro (&Qfullscreen
);
15272 Qfullwidth
= intern ("fullwidth");
15273 staticpro (&Qfullwidth
);
15274 Qfullheight
= intern ("fullheight");
15275 staticpro (&Qfullheight
);
15276 Qfullboth
= intern ("fullboth");
15277 staticpro (&Qfullboth
);
15279 Qhyper
= intern ("hyper");
15280 staticpro (&Qhyper
);
15281 Qsuper
= intern ("super");
15282 staticpro (&Qsuper
);
15283 Qmeta
= intern ("meta");
15284 staticpro (&Qmeta
);
15285 Qalt
= intern ("alt");
15287 Qctrl
= intern ("ctrl");
15288 staticpro (&Qctrl
);
15289 Qcontrol
= intern ("control");
15290 staticpro (&Qcontrol
);
15291 Qshift
= intern ("shift");
15292 staticpro (&Qshift
);
15293 /* This is the end of symbol initialization. */
15295 /* Text property `display' should be nonsticky by default. */
15296 Vtext_property_default_nonsticky
15297 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
15300 Qlaplace
= intern ("laplace");
15301 staticpro (&Qlaplace
);
15302 Qemboss
= intern ("emboss");
15303 staticpro (&Qemboss
);
15304 Qedge_detection
= intern ("edge-detection");
15305 staticpro (&Qedge_detection
);
15306 Qheuristic
= intern ("heuristic");
15307 staticpro (&Qheuristic
);
15308 QCmatrix
= intern (":matrix");
15309 staticpro (&QCmatrix
);
15310 QCcolor_adjustment
= intern (":color-adjustment");
15311 staticpro (&QCcolor_adjustment
);
15312 QCmask
= intern (":mask");
15313 staticpro (&QCmask
);
15315 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
15316 staticpro (&Qface_set_after_frame_default
);
15318 Fput (Qundefined_color
, Qerror_conditions
,
15319 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
15320 Fput (Qundefined_color
, Qerror_message
,
15321 build_string ("Undefined color"));
15323 staticpro (&w32_grabbed_keys
);
15324 w32_grabbed_keys
= Qnil
;
15326 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
15327 doc
: /* An array of color name mappings for windows. */);
15328 Vw32_color_map
= Qnil
;
15330 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
15331 doc
: /* Non-nil if alt key presses are passed on to Windows.
15332 When non-nil, for example, alt pressed and released and then space will
15333 open the System menu. When nil, Emacs silently swallows alt key events. */);
15334 Vw32_pass_alt_to_system
= Qnil
;
15336 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
15337 doc
: /* Non-nil if the alt key is to be considered the same as the meta key.
15338 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta. */);
15339 Vw32_alt_is_meta
= Qt
;
15341 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
15342 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
15343 XSETINT (Vw32_quit_key
, 0);
15345 DEFVAR_LISP ("w32-pass-lwindow-to-system",
15346 &Vw32_pass_lwindow_to_system
,
15347 doc
: /* Non-nil if the left \"Windows\" key is passed on to Windows.
15348 When non-nil, the Start menu is opened by tapping the key. */);
15349 Vw32_pass_lwindow_to_system
= Qt
;
15351 DEFVAR_LISP ("w32-pass-rwindow-to-system",
15352 &Vw32_pass_rwindow_to_system
,
15353 doc
: /* Non-nil if the right \"Windows\" key is passed on to Windows.
15354 When non-nil, the Start menu is opened by tapping the key. */);
15355 Vw32_pass_rwindow_to_system
= Qt
;
15357 DEFVAR_INT ("w32-phantom-key-code",
15358 &Vw32_phantom_key_code
,
15359 doc
: /* Virtual key code used to generate \"phantom\" key presses.
15360 Value is a number between 0 and 255.
15362 Phantom key presses are generated in order to stop the system from
15363 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
15364 `w32-pass-rwindow-to-system' is nil. */);
15365 /* Although 255 is technically not a valid key code, it works and
15366 means that this hack won't interfere with any real key code. */
15367 Vw32_phantom_key_code
= 255;
15369 DEFVAR_LISP ("w32-enable-num-lock",
15370 &Vw32_enable_num_lock
,
15371 doc
: /* Non-nil if Num Lock should act normally.
15372 Set to nil to see Num Lock as the key `kp-numlock'. */);
15373 Vw32_enable_num_lock
= Qt
;
15375 DEFVAR_LISP ("w32-enable-caps-lock",
15376 &Vw32_enable_caps_lock
,
15377 doc
: /* Non-nil if Caps Lock should act normally.
15378 Set to nil to see Caps Lock as the key `capslock'. */);
15379 Vw32_enable_caps_lock
= Qt
;
15381 DEFVAR_LISP ("w32-scroll-lock-modifier",
15382 &Vw32_scroll_lock_modifier
,
15383 doc
: /* Modifier to use for the Scroll Lock on state.
15384 The value can be hyper, super, meta, alt, control or shift for the
15385 respective modifier, or nil to see Scroll Lock as the key `scroll'.
15386 Any other value will cause the key to be ignored. */);
15387 Vw32_scroll_lock_modifier
= Qt
;
15389 DEFVAR_LISP ("w32-lwindow-modifier",
15390 &Vw32_lwindow_modifier
,
15391 doc
: /* Modifier to use for the left \"Windows\" key.
15392 The value can be hyper, super, meta, alt, control or shift for the
15393 respective modifier, or nil to appear as the key `lwindow'.
15394 Any other value will cause the key to be ignored. */);
15395 Vw32_lwindow_modifier
= Qnil
;
15397 DEFVAR_LISP ("w32-rwindow-modifier",
15398 &Vw32_rwindow_modifier
,
15399 doc
: /* Modifier to use for the right \"Windows\" key.
15400 The value can be hyper, super, meta, alt, control or shift for the
15401 respective modifier, or nil to appear as the key `rwindow'.
15402 Any other value will cause the key to be ignored. */);
15403 Vw32_rwindow_modifier
= Qnil
;
15405 DEFVAR_LISP ("w32-apps-modifier",
15406 &Vw32_apps_modifier
,
15407 doc
: /* Modifier to use for the \"Apps\" key.
15408 The value can be hyper, super, meta, alt, control or shift for the
15409 respective modifier, or nil to appear as the key `apps'.
15410 Any other value will cause the key to be ignored. */);
15411 Vw32_apps_modifier
= Qnil
;
15413 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts
,
15414 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
15415 w32_enable_synthesized_fonts
= 0;
15417 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
15418 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
15419 Vw32_enable_palette
= Qt
;
15421 DEFVAR_INT ("w32-mouse-button-tolerance",
15422 &Vw32_mouse_button_tolerance
,
15423 doc
: /* Analogue of double click interval for faking middle mouse events.
15424 The value is the minimum time in milliseconds that must elapse between
15425 left/right button down events before they are considered distinct events.
15426 If both mouse buttons are depressed within this interval, a middle mouse
15427 button down event is generated instead. */);
15428 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
15430 DEFVAR_INT ("w32-mouse-move-interval",
15431 &Vw32_mouse_move_interval
,
15432 doc
: /* Minimum interval between mouse move events.
15433 The value is the minimum time in milliseconds that must elapse between
15434 successive mouse move (or scroll bar drag) events before they are
15435 reported as lisp events. */);
15436 XSETINT (Vw32_mouse_move_interval
, 0);
15438 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
15439 &w32_pass_extra_mouse_buttons_to_system
,
15440 doc
: /* Non-nil if the fourth and fifth mouse buttons are passed to Windows.
15441 Recent versions of Windows support mice with up to five buttons.
15442 Since most applications don't support these extra buttons, most mouse
15443 drivers will allow you to map them to functions at the system level.
15444 If this variable is non-nil, Emacs will pass them on, allowing the
15445 system to handle them. */);
15446 w32_pass_extra_mouse_buttons_to_system
= 0;
15448 init_x_parm_symbols ();
15450 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
15451 doc
: /* List of directories to search for window system bitmap files. */);
15452 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
15454 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
15455 doc
: /* The shape of the pointer when over text.
15456 Changing the value does not affect existing frames
15457 unless you set the mouse color. */);
15458 Vx_pointer_shape
= Qnil
;
15460 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
15461 doc
: /* The name Emacs uses to look up resources; for internal use only.
15462 `x-get-resource' uses this as the first component of the instance name
15463 when requesting resource values.
15464 Emacs initially sets `x-resource-name' to the name under which Emacs
15465 was invoked, or to the value specified with the `-name' or `-rn'
15466 switches, if present. */);
15467 Vx_resource_name
= Qnil
;
15469 Vx_nontext_pointer_shape
= Qnil
;
15471 Vx_mode_pointer_shape
= Qnil
;
15473 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
15474 doc
: /* The shape of the pointer when Emacs is busy.
15475 This variable takes effect when you create a new frame
15476 or when you set the mouse color. */);
15477 Vx_hourglass_pointer_shape
= Qnil
;
15479 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
15480 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
15481 display_hourglass_p
= 1;
15483 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
15484 doc
: /* *Seconds to wait before displaying an hourglass pointer.
15485 Value must be an integer or float. */);
15486 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
15488 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
15489 &Vx_sensitive_text_pointer_shape
,
15490 doc
: /* The shape of the pointer when over mouse-sensitive text.
15491 This variable takes effect when you create a new frame
15492 or when you set the mouse color. */);
15493 Vx_sensitive_text_pointer_shape
= Qnil
;
15495 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
15496 &Vx_window_horizontal_drag_shape
,
15497 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
15498 This variable takes effect when you create a new frame
15499 or when you set the mouse color. */);
15500 Vx_window_horizontal_drag_shape
= Qnil
;
15502 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
15503 doc
: /* A string indicating the foreground color of the cursor box. */);
15504 Vx_cursor_fore_pixel
= Qnil
;
15506 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
15507 doc
: /* Maximum size for tooltips.
15508 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
15509 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
15511 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
15512 doc
: /* Non-nil if no window manager is in use.
15513 Emacs doesn't try to figure this out; this is always nil
15514 unless you set it to something else. */);
15515 /* We don't have any way to find this out, so set it to nil
15516 and maybe the user would like to set it to t. */
15517 Vx_no_window_manager
= Qnil
;
15519 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
15520 &Vx_pixel_size_width_font_regexp
,
15521 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
15523 Since Emacs gets width of a font matching with this regexp from
15524 PIXEL_SIZE field of the name, font finding mechanism gets faster for
15525 such a font. This is especially effective for such large fonts as
15526 Chinese, Japanese, and Korean. */);
15527 Vx_pixel_size_width_font_regexp
= Qnil
;
15529 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
15530 doc
: /* Time after which cached images are removed from the cache.
15531 When an image has not been displayed this many seconds, remove it
15532 from the image cache. Value must be an integer or nil with nil
15533 meaning don't clear the cache. */);
15534 Vimage_cache_eviction_delay
= make_number (30 * 60);
15536 DEFVAR_LISP ("w32-bdf-filename-alist",
15537 &Vw32_bdf_filename_alist
,
15538 doc
: /* List of bdf fonts and their corresponding filenames. */);
15539 Vw32_bdf_filename_alist
= Qnil
;
15541 DEFVAR_BOOL ("w32-strict-fontnames",
15542 &w32_strict_fontnames
,
15543 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
15544 Default is nil, which allows old fontnames that are not XLFD compliant,
15545 and allows third-party CJK display to work by specifying false charset
15546 fields to trick Emacs into translating to Big5, SJIS etc.
15547 Setting this to t will prevent wrong fonts being selected when
15548 fontsets are automatically created. */);
15549 w32_strict_fontnames
= 0;
15551 DEFVAR_BOOL ("w32-strict-painting",
15552 &w32_strict_painting
,
15553 doc
: /* Non-nil means use strict rules for repainting frames.
15554 Set this to nil to get the old behaviour for repainting; this should
15555 only be necessary if the default setting causes problems. */);
15556 w32_strict_painting
= 1;
15558 DEFVAR_LISP ("w32-charset-info-alist",
15559 &Vw32_charset_info_alist
,
15560 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
15561 Each entry should be of the form:
15563 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
15565 where CHARSET_NAME is a string used in font names to identify the charset,
15566 WINDOWS_CHARSET is a symbol that can be one of:
15567 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
15568 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
15569 w32-charset-chinesebig5,
15570 #ifdef JOHAB_CHARSET
15571 w32-charset-johab, w32-charset-hebrew,
15572 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
15573 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
15574 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
15576 #ifdef UNICODE_CHARSET
15577 w32-charset-unicode,
15579 or w32-charset-oem.
15580 CODEPAGE should be an integer specifying the codepage that should be used
15581 to display the character set, t to do no translation and output as Unicode,
15582 or nil to do no translation and output as 8 bit (or multibyte on far-east
15583 versions of Windows) characters. */);
15584 Vw32_charset_info_alist
= Qnil
;
15586 staticpro (&Qw32_charset_ansi
);
15587 Qw32_charset_ansi
= intern ("w32-charset-ansi");
15588 staticpro (&Qw32_charset_symbol
);
15589 Qw32_charset_symbol
= intern ("w32-charset-symbol");
15590 staticpro (&Qw32_charset_shiftjis
);
15591 Qw32_charset_shiftjis
= intern ("w32-charset-shiftjis");
15592 staticpro (&Qw32_charset_hangeul
);
15593 Qw32_charset_hangeul
= intern ("w32-charset-hangeul");
15594 staticpro (&Qw32_charset_chinesebig5
);
15595 Qw32_charset_chinesebig5
= intern ("w32-charset-chinesebig5");
15596 staticpro (&Qw32_charset_gb2312
);
15597 Qw32_charset_gb2312
= intern ("w32-charset-gb2312");
15598 staticpro (&Qw32_charset_oem
);
15599 Qw32_charset_oem
= intern ("w32-charset-oem");
15601 #ifdef JOHAB_CHARSET
15603 static int w32_extra_charsets_defined
= 1;
15604 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
15605 doc
: /* Internal variable. */);
15607 staticpro (&Qw32_charset_johab
);
15608 Qw32_charset_johab
= intern ("w32-charset-johab");
15609 staticpro (&Qw32_charset_easteurope
);
15610 Qw32_charset_easteurope
= intern ("w32-charset-easteurope");
15611 staticpro (&Qw32_charset_turkish
);
15612 Qw32_charset_turkish
= intern ("w32-charset-turkish");
15613 staticpro (&Qw32_charset_baltic
);
15614 Qw32_charset_baltic
= intern ("w32-charset-baltic");
15615 staticpro (&Qw32_charset_russian
);
15616 Qw32_charset_russian
= intern ("w32-charset-russian");
15617 staticpro (&Qw32_charset_arabic
);
15618 Qw32_charset_arabic
= intern ("w32-charset-arabic");
15619 staticpro (&Qw32_charset_greek
);
15620 Qw32_charset_greek
= intern ("w32-charset-greek");
15621 staticpro (&Qw32_charset_hebrew
);
15622 Qw32_charset_hebrew
= intern ("w32-charset-hebrew");
15623 staticpro (&Qw32_charset_vietnamese
);
15624 Qw32_charset_vietnamese
= intern ("w32-charset-vietnamese");
15625 staticpro (&Qw32_charset_thai
);
15626 Qw32_charset_thai
= intern ("w32-charset-thai");
15627 staticpro (&Qw32_charset_mac
);
15628 Qw32_charset_mac
= intern ("w32-charset-mac");
15632 #ifdef UNICODE_CHARSET
15634 static int w32_unicode_charset_defined
= 1;
15635 DEFVAR_BOOL ("w32-unicode-charset-defined",
15636 &w32_unicode_charset_defined
,
15637 doc
: /* Internal variable. */);
15639 staticpro (&Qw32_charset_unicode
);
15640 Qw32_charset_unicode
= intern ("w32-charset-unicode");
15643 defsubr (&Sx_get_resource
);
15644 #if 0 /* TODO: Port to W32 */
15645 defsubr (&Sx_change_window_property
);
15646 defsubr (&Sx_delete_window_property
);
15647 defsubr (&Sx_window_property
);
15649 defsubr (&Sxw_display_color_p
);
15650 defsubr (&Sx_display_grayscale_p
);
15651 defsubr (&Sxw_color_defined_p
);
15652 defsubr (&Sxw_color_values
);
15653 defsubr (&Sx_server_max_request_size
);
15654 defsubr (&Sx_server_vendor
);
15655 defsubr (&Sx_server_version
);
15656 defsubr (&Sx_display_pixel_width
);
15657 defsubr (&Sx_display_pixel_height
);
15658 defsubr (&Sx_display_mm_width
);
15659 defsubr (&Sx_display_mm_height
);
15660 defsubr (&Sx_display_screens
);
15661 defsubr (&Sx_display_planes
);
15662 defsubr (&Sx_display_color_cells
);
15663 defsubr (&Sx_display_visual_class
);
15664 defsubr (&Sx_display_backing_store
);
15665 defsubr (&Sx_display_save_under
);
15666 defsubr (&Sx_parse_geometry
);
15667 defsubr (&Sx_create_frame
);
15668 defsubr (&Sx_open_connection
);
15669 defsubr (&Sx_close_connection
);
15670 defsubr (&Sx_display_list
);
15671 defsubr (&Sx_synchronize
);
15673 /* W32 specific functions */
15675 defsubr (&Sw32_focus_frame
);
15676 defsubr (&Sw32_select_font
);
15677 defsubr (&Sw32_define_rgb_color
);
15678 defsubr (&Sw32_default_color_map
);
15679 defsubr (&Sw32_load_color_file
);
15680 defsubr (&Sw32_send_sys_command
);
15681 defsubr (&Sw32_shell_execute
);
15682 defsubr (&Sw32_register_hot_key
);
15683 defsubr (&Sw32_unregister_hot_key
);
15684 defsubr (&Sw32_registered_hot_keys
);
15685 defsubr (&Sw32_reconstruct_hot_key
);
15686 defsubr (&Sw32_toggle_lock_key
);
15687 defsubr (&Sw32_find_bdf_fonts
);
15689 defsubr (&Sfile_system_info
);
15691 /* Setting callback functions for fontset handler. */
15692 get_font_info_func
= w32_get_font_info
;
15694 #if 0 /* This function pointer doesn't seem to be used anywhere.
15695 And the pointer assigned has the wrong type, anyway. */
15696 list_fonts_func
= w32_list_fonts
;
15699 load_font_func
= w32_load_font
;
15700 find_ccl_program_func
= w32_find_ccl_program
;
15701 query_font_func
= w32_query_font
;
15702 set_frame_fontset_func
= x_set_font
;
15703 check_window_system_func
= check_w32
;
15706 Qxbm
= intern ("xbm");
15708 QCconversion
= intern (":conversion");
15709 staticpro (&QCconversion
);
15710 QCheuristic_mask
= intern (":heuristic-mask");
15711 staticpro (&QCheuristic_mask
);
15712 QCcolor_symbols
= intern (":color-symbols");
15713 staticpro (&QCcolor_symbols
);
15714 QCascent
= intern (":ascent");
15715 staticpro (&QCascent
);
15716 QCmargin
= intern (":margin");
15717 staticpro (&QCmargin
);
15718 QCrelief
= intern (":relief");
15719 staticpro (&QCrelief
);
15720 Qpostscript
= intern ("postscript");
15721 staticpro (&Qpostscript
);
15722 QCloader
= intern (":loader");
15723 staticpro (&QCloader
);
15724 QCbounding_box
= intern (":bounding-box");
15725 staticpro (&QCbounding_box
);
15726 QCpt_width
= intern (":pt-width");
15727 staticpro (&QCpt_width
);
15728 QCpt_height
= intern (":pt-height");
15729 staticpro (&QCpt_height
);
15730 QCindex
= intern (":index");
15731 staticpro (&QCindex
);
15732 Qpbm
= intern ("pbm");
15736 Qxpm
= intern ("xpm");
15741 Qjpeg
= intern ("jpeg");
15742 staticpro (&Qjpeg
);
15746 Qtiff
= intern ("tiff");
15747 staticpro (&Qtiff
);
15751 Qgif
= intern ("gif");
15756 Qpng
= intern ("png");
15760 defsubr (&Sclear_image_cache
);
15761 defsubr (&Simage_size
);
15762 defsubr (&Simage_mask_p
);
15765 defsubr (&Simagep
);
15766 defsubr (&Slookup_image
);
15769 hourglass_atimer
= NULL
;
15770 hourglass_shown_p
= 0;
15771 defsubr (&Sx_show_tip
);
15772 defsubr (&Sx_hide_tip
);
15774 staticpro (&tip_timer
);
15776 staticpro (&tip_frame
);
15778 last_show_tip_args
= Qnil
;
15779 staticpro (&last_show_tip_args
);
15781 defsubr (&Sx_file_dialog
);
15786 globals_of_w32fns is used to initialize those global variables that
15787 must always be initialized on startup even when the global variable
15788 initialized is non zero (see the function main in emacs.c).
15789 globals_of_w32fns is called from syms_of_w32fns when the global
15790 variable initialized is 0 and directly from main when initialized
15793 void globals_of_w32fns ()
15795 HMODULE user32_lib
= GetModuleHandle ("user32.dll");
15797 TrackMouseEvent not available in all versions of Windows, so must load
15798 it dynamically. Do it once, here, instead of every time it is used.
15800 track_mouse_event_fn
= (TrackMouseEvent_Proc
) GetProcAddress (user32_lib
, "TrackMouseEvent");
15803 /* Initialize image types. Based on which libraries are available. */
15805 init_external_image_libraries ()
15810 if ((library
= LoadLibrary ("libXpm.dll")))
15812 if (init_xpm_functions (library
))
15813 define_image_type (&xpm_type
);
15819 /* Try loading jpeg library under probable names. */
15820 if ((library
= LoadLibrary ("libjpeg.dll"))
15821 || (library
= LoadLibrary ("jpeg-62.dll"))
15822 || (library
= LoadLibrary ("jpeg.dll")))
15824 if (init_jpeg_functions (library
))
15825 define_image_type (&jpeg_type
);
15830 if (library
= LoadLibrary ("libtiff.dll"))
15832 if (init_tiff_functions (library
))
15833 define_image_type (&tiff_type
);
15838 if (library
= LoadLibrary ("libungif.dll"))
15840 if (init_gif_functions (library
))
15841 define_image_type (&gif_type
);
15846 /* Ensure zlib is loaded. Try debug version first. */
15847 if (!LoadLibrary ("zlibd.dll"))
15848 LoadLibrary ("zlib.dll");
15850 /* Try loading libpng under probable names. */
15851 if ((library
= LoadLibrary ("libpng13d.dll"))
15852 || (library
= LoadLibrary ("libpng13.dll"))
15853 || (library
= LoadLibrary ("libpng12d.dll"))
15854 || (library
= LoadLibrary ("libpng12.dll"))
15855 || (library
= LoadLibrary ("libpng.dll")))
15857 if (init_png_functions (library
))
15858 define_image_type (&png_type
);
15866 image_types
= NULL
;
15867 Vimage_types
= Qnil
;
15869 define_image_type (&pbm_type
);
15870 define_image_type (&xbm_type
);
15872 #if 0 /* TODO : Ghostscript support for W32 */
15873 define_image_type (&gs_type
);
15876 /* Image types that rely on external libraries are loaded dynamically
15877 if the library is available. */
15878 init_external_image_libraries ();
15887 button
= MessageBox (NULL
,
15888 "A fatal error has occurred!\n\n"
15889 "Select Abort to exit, Retry to debug, Ignore to continue",
15890 "Emacs Abort Dialog",
15891 MB_ICONEXCLAMATION
| MB_TASKMODAL
15892 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
15907 /* For convenience when debugging. */
15911 return GetLastError ();