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"
57 #define FILE_NAME_TEXT_FIELD edt1
59 void syms_of_w32fns ();
60 void globals_of_w32fns ();
61 static void init_external_image_libraries ();
63 extern void free_frame_menubar ();
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 /* Non nil if no window manager is in use. */
146 Lisp_Object Vx_no_window_manager
;
148 /* Non-zero means we're allowed to display a hourglass pointer. */
150 int display_hourglass_p
;
152 /* The background and shape of the mouse pointer, and shape when not
153 over text or in the modeline. */
155 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
156 Lisp_Object Vx_hourglass_pointer_shape
, Vx_window_horizontal_drag_shape
, Vx_hand_shape
;
158 /* The shape when over mouse-sensitive text. */
160 Lisp_Object Vx_sensitive_text_pointer_shape
;
163 #define IDC_HAND MAKEINTRESOURCE(32649)
166 /* Color of chars displayed in cursor box. */
168 Lisp_Object Vx_cursor_fore_pixel
;
170 /* Nonzero if using Windows. */
172 static int w32_in_use
;
174 /* Search path for bitmap files. */
176 Lisp_Object Vx_bitmap_file_path
;
178 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
180 Lisp_Object Vx_pixel_size_width_font_regexp
;
182 /* Alist of bdf fonts and the files that define them. */
183 Lisp_Object Vw32_bdf_filename_alist
;
185 /* A flag to control whether fonts are matched strictly or not. */
186 int w32_strict_fontnames
;
188 /* A flag to control whether we should only repaint if GetUpdateRect
189 indicates there is an update region. */
190 int w32_strict_painting
;
192 /* Associative list linking character set strings to Windows codepages. */
193 Lisp_Object Vw32_charset_info_alist
;
195 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
196 #ifndef VIETNAMESE_CHARSET
197 #define VIETNAMESE_CHARSET 163
201 Lisp_Object Qsuppress_icon
;
202 Lisp_Object Qundefined_color
;
204 Lisp_Object Qcancel_timer
;
210 Lisp_Object Qcontrol
;
213 Lisp_Object Qw32_charset_ansi
;
214 Lisp_Object Qw32_charset_default
;
215 Lisp_Object Qw32_charset_symbol
;
216 Lisp_Object Qw32_charset_shiftjis
;
217 Lisp_Object Qw32_charset_hangeul
;
218 Lisp_Object Qw32_charset_gb2312
;
219 Lisp_Object Qw32_charset_chinesebig5
;
220 Lisp_Object Qw32_charset_oem
;
222 #ifndef JOHAB_CHARSET
223 #define JOHAB_CHARSET 130
226 Lisp_Object Qw32_charset_easteurope
;
227 Lisp_Object Qw32_charset_turkish
;
228 Lisp_Object Qw32_charset_baltic
;
229 Lisp_Object Qw32_charset_russian
;
230 Lisp_Object Qw32_charset_arabic
;
231 Lisp_Object Qw32_charset_greek
;
232 Lisp_Object Qw32_charset_hebrew
;
233 Lisp_Object Qw32_charset_vietnamese
;
234 Lisp_Object Qw32_charset_thai
;
235 Lisp_Object Qw32_charset_johab
;
236 Lisp_Object Qw32_charset_mac
;
239 #ifdef UNICODE_CHARSET
240 Lisp_Object Qw32_charset_unicode
;
243 /* Prefix for system colors. */
244 #define SYSTEM_COLOR_PREFIX "System"
245 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
247 /* State variables for emulating a three button mouse. */
252 static int button_state
= 0;
253 static W32Msg saved_mouse_button_msg
;
254 static unsigned mouse_button_timer
= 0; /* non-zero when timer is active */
255 static W32Msg saved_mouse_move_msg
;
256 static unsigned mouse_move_timer
= 0;
258 /* Window that is tracking the mouse. */
259 static HWND track_mouse_window
;
261 typedef BOOL (WINAPI
* TrackMouseEvent_Proc
)
262 (IN OUT LPTRACKMOUSEEVENT lpEventTrack
);
264 TrackMouseEvent_Proc track_mouse_event_fn
= NULL
;
265 ClipboardSequence_Proc clipboard_sequence_fn
= NULL
;
267 /* W95 mousewheel handler */
268 unsigned int msh_mousewheel
= 0;
271 #define MOUSE_BUTTON_ID 1
272 #define MOUSE_MOVE_ID 2
273 #define MENU_FREE_ID 3
274 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
276 #define MENU_FREE_DELAY 1000
277 static unsigned menu_free_timer
= 0;
279 /* The below are defined in frame.c. */
281 extern Lisp_Object Vwindow_system_version
;
284 int image_cache_refcount
, dpyinfo_refcount
;
288 /* From w32term.c. */
289 extern Lisp_Object Vw32_num_mouse_buttons
;
290 extern Lisp_Object Vw32_recognize_altgr
;
292 extern HWND w32_system_caret_hwnd
;
294 extern int w32_system_caret_height
;
295 extern int w32_system_caret_x
;
296 extern int w32_system_caret_y
;
297 extern int w32_use_visible_system_caret
;
299 static HWND w32_visible_system_caret_hwnd
;
302 /* Error if we are not connected to MS-Windows. */
307 error ("MS-Windows not in use or not initialized");
310 /* Nonzero if we can use mouse menus.
311 You should not call this unless HAVE_MENUS is defined. */
319 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
320 and checking validity for W32. */
323 check_x_frame (frame
)
329 frame
= selected_frame
;
330 CHECK_LIVE_FRAME (frame
);
332 if (! FRAME_W32_P (f
))
333 error ("non-w32 frame used");
337 /* Let the user specify a display with a frame.
338 nil stands for the selected frame--or, if that is not a w32 frame,
339 the first display on the list. */
341 struct w32_display_info
*
342 check_x_display_info (frame
)
347 struct frame
*sf
= XFRAME (selected_frame
);
349 if (FRAME_W32_P (sf
) && FRAME_LIVE_P (sf
))
350 return FRAME_W32_DISPLAY_INFO (sf
);
352 return &one_w32_display_info
;
354 else if (STRINGP (frame
))
355 return x_display_info_for_name (frame
);
360 CHECK_LIVE_FRAME (frame
);
362 if (! FRAME_W32_P (f
))
363 error ("non-w32 frame used");
364 return FRAME_W32_DISPLAY_INFO (f
);
368 /* Return the Emacs frame-object corresponding to an w32 window.
369 It could be the frame's main window or an icon window. */
371 /* This function can be called during GC, so use GC_xxx type test macros. */
374 x_window_to_frame (dpyinfo
, wdesc
)
375 struct w32_display_info
*dpyinfo
;
378 Lisp_Object tail
, frame
;
381 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
384 if (!GC_FRAMEP (frame
))
387 if (!FRAME_W32_P (f
) || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
389 if (f
->output_data
.w32
->hourglass_window
== wdesc
)
392 if (FRAME_W32_WINDOW (f
) == wdesc
)
400 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
401 id, which is just an int that this section returns. Bitmaps are
402 reference counted so they can be shared among frames.
404 Bitmap indices are guaranteed to be > 0, so a negative number can
405 be used to indicate no bitmap.
407 If you use x_create_bitmap_from_data, then you must keep track of
408 the bitmaps yourself. That is, creating a bitmap from the same
409 data more than once will not be caught. */
412 /* Functions to access the contents of a bitmap, given an id. */
415 x_bitmap_height (f
, id
)
419 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
423 x_bitmap_width (f
, id
)
427 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
431 x_bitmap_pixmap (f
, id
)
435 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
439 /* Allocate a new bitmap record. Returns index of new record. */
442 x_allocate_bitmap_record (f
)
445 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
448 if (dpyinfo
->bitmaps
== NULL
)
450 dpyinfo
->bitmaps_size
= 10;
452 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
453 dpyinfo
->bitmaps_last
= 1;
457 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
458 return ++dpyinfo
->bitmaps_last
;
460 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
461 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
464 dpyinfo
->bitmaps_size
*= 2;
466 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
467 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
468 return ++dpyinfo
->bitmaps_last
;
471 /* Add one reference to the reference count of the bitmap with id ID. */
474 x_reference_bitmap (f
, id
)
478 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
481 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
484 x_create_bitmap_from_data (f
, bits
, width
, height
)
487 unsigned int width
, height
;
489 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
493 bitmap
= CreateBitmap (width
, height
,
494 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
495 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
501 id
= x_allocate_bitmap_record (f
);
502 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
503 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
504 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
505 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
506 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
507 dpyinfo
->bitmaps
[id
- 1].height
= height
;
508 dpyinfo
->bitmaps
[id
- 1].width
= width
;
513 /* Create bitmap from file FILE for frame F. */
516 x_create_bitmap_from_file (f
, file
)
521 #if 0 /* TODO : bitmap support */
522 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
523 unsigned int width
, height
;
525 int xhot
, yhot
, result
, id
;
531 /* Look for an existing bitmap with the same name. */
532 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
534 if (dpyinfo
->bitmaps
[id
].refcount
535 && dpyinfo
->bitmaps
[id
].file
536 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) SDATA (file
)))
538 ++dpyinfo
->bitmaps
[id
].refcount
;
543 /* Search bitmap-file-path for the file, if appropriate. */
544 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, Qnil
);
549 filename
= (char *) SDATA (found
);
551 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
557 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
558 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
559 if (result
!= BitmapSuccess
)
562 id
= x_allocate_bitmap_record (f
);
563 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
564 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
565 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (SCHARS (file
) + 1);
566 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
567 dpyinfo
->bitmaps
[id
- 1].height
= height
;
568 dpyinfo
->bitmaps
[id
- 1].width
= width
;
569 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, SDATA (file
));
575 /* Remove reference to bitmap with id number ID. */
578 x_destroy_bitmap (f
, id
)
582 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
586 --dpyinfo
->bitmaps
[id
- 1].refcount
;
587 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
590 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
591 if (dpyinfo
->bitmaps
[id
- 1].file
)
593 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
594 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
601 /* Free all the bitmaps for the display specified by DPYINFO. */
604 x_destroy_all_bitmaps (dpyinfo
)
605 struct w32_display_info
*dpyinfo
;
608 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
609 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
611 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
612 if (dpyinfo
->bitmaps
[i
].file
)
613 xfree (dpyinfo
->bitmaps
[i
].file
);
615 dpyinfo
->bitmaps_last
= 0;
618 BOOL my_show_window
P_ ((struct frame
*, HWND
, int));
619 void my_set_window_pos
P_ ((HWND
, HWND
, int, int, int, int, UINT
));
620 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
621 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
623 /* TODO: Native Input Method support; see x_create_im. */
624 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
625 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
626 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
627 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
628 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
629 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
630 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
631 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
632 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
633 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
634 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
635 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
636 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
642 /* Store the screen positions of frame F into XPTR and YPTR.
643 These are the positions of the containing window manager window,
644 not Emacs's own window. */
647 x_real_positions (f
, xptr
, yptr
)
654 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
655 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
660 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
662 /* Remember x_pixels_diff and y_pixels_diff. */
663 f
->x_pixels_diff
= pt
.x
- rect
.left
;
664 f
->y_pixels_diff
= pt
.y
- rect
.top
;
672 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
,
673 Sw32_define_rgb_color
, 4, 4, 0,
674 doc
: /* Convert RGB numbers to a windows color reference and associate with NAME.
675 This adds or updates a named color to w32-color-map, making it
676 available for use. The original entry's RGB ref is returned, or nil
677 if the entry is new. */)
678 (red
, green
, blue
, name
)
679 Lisp_Object red
, green
, blue
, name
;
682 Lisp_Object oldrgb
= Qnil
;
686 CHECK_NUMBER (green
);
690 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
694 /* replace existing entry in w32-color-map or add new entry. */
695 entry
= Fassoc (name
, Vw32_color_map
);
698 entry
= Fcons (name
, rgb
);
699 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
703 oldrgb
= Fcdr (entry
);
704 Fsetcdr (entry
, rgb
);
712 DEFUN ("w32-load-color-file", Fw32_load_color_file
,
713 Sw32_load_color_file
, 1, 1, 0,
714 doc
: /* Create an alist of color entries from an external file.
715 Assign this value to w32-color-map to replace the existing color map.
717 The file should define one named RGB color per line like so:
719 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
721 Lisp_Object filename
;
724 Lisp_Object cmap
= Qnil
;
727 CHECK_STRING (filename
);
728 abspath
= Fexpand_file_name (filename
, Qnil
);
730 fp
= fopen (SDATA (filename
), "rt");
734 int red
, green
, blue
;
739 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
740 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
742 char *name
= buf
+ num
;
743 num
= strlen (name
) - 1;
744 if (name
[num
] == '\n')
746 cmap
= Fcons (Fcons (build_string (name
),
747 make_number (RGB (red
, green
, blue
))),
759 /* The default colors for the w32 color map */
760 typedef struct colormap_t
766 colormap_t w32_color_map
[] =
768 {"snow" , PALETTERGB (255,250,250)},
769 {"ghost white" , PALETTERGB (248,248,255)},
770 {"GhostWhite" , PALETTERGB (248,248,255)},
771 {"white smoke" , PALETTERGB (245,245,245)},
772 {"WhiteSmoke" , PALETTERGB (245,245,245)},
773 {"gainsboro" , PALETTERGB (220,220,220)},
774 {"floral white" , PALETTERGB (255,250,240)},
775 {"FloralWhite" , PALETTERGB (255,250,240)},
776 {"old lace" , PALETTERGB (253,245,230)},
777 {"OldLace" , PALETTERGB (253,245,230)},
778 {"linen" , PALETTERGB (250,240,230)},
779 {"antique white" , PALETTERGB (250,235,215)},
780 {"AntiqueWhite" , PALETTERGB (250,235,215)},
781 {"papaya whip" , PALETTERGB (255,239,213)},
782 {"PapayaWhip" , PALETTERGB (255,239,213)},
783 {"blanched almond" , PALETTERGB (255,235,205)},
784 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
785 {"bisque" , PALETTERGB (255,228,196)},
786 {"peach puff" , PALETTERGB (255,218,185)},
787 {"PeachPuff" , PALETTERGB (255,218,185)},
788 {"navajo white" , PALETTERGB (255,222,173)},
789 {"NavajoWhite" , PALETTERGB (255,222,173)},
790 {"moccasin" , PALETTERGB (255,228,181)},
791 {"cornsilk" , PALETTERGB (255,248,220)},
792 {"ivory" , PALETTERGB (255,255,240)},
793 {"lemon chiffon" , PALETTERGB (255,250,205)},
794 {"LemonChiffon" , PALETTERGB (255,250,205)},
795 {"seashell" , PALETTERGB (255,245,238)},
796 {"honeydew" , PALETTERGB (240,255,240)},
797 {"mint cream" , PALETTERGB (245,255,250)},
798 {"MintCream" , PALETTERGB (245,255,250)},
799 {"azure" , PALETTERGB (240,255,255)},
800 {"alice blue" , PALETTERGB (240,248,255)},
801 {"AliceBlue" , PALETTERGB (240,248,255)},
802 {"lavender" , PALETTERGB (230,230,250)},
803 {"lavender blush" , PALETTERGB (255,240,245)},
804 {"LavenderBlush" , PALETTERGB (255,240,245)},
805 {"misty rose" , PALETTERGB (255,228,225)},
806 {"MistyRose" , PALETTERGB (255,228,225)},
807 {"white" , PALETTERGB (255,255,255)},
808 {"black" , PALETTERGB ( 0, 0, 0)},
809 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
810 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
811 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
812 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
813 {"dim gray" , PALETTERGB (105,105,105)},
814 {"DimGray" , PALETTERGB (105,105,105)},
815 {"dim grey" , PALETTERGB (105,105,105)},
816 {"DimGrey" , PALETTERGB (105,105,105)},
817 {"slate gray" , PALETTERGB (112,128,144)},
818 {"SlateGray" , PALETTERGB (112,128,144)},
819 {"slate grey" , PALETTERGB (112,128,144)},
820 {"SlateGrey" , PALETTERGB (112,128,144)},
821 {"light slate gray" , PALETTERGB (119,136,153)},
822 {"LightSlateGray" , PALETTERGB (119,136,153)},
823 {"light slate grey" , PALETTERGB (119,136,153)},
824 {"LightSlateGrey" , PALETTERGB (119,136,153)},
825 {"gray" , PALETTERGB (190,190,190)},
826 {"grey" , PALETTERGB (190,190,190)},
827 {"light grey" , PALETTERGB (211,211,211)},
828 {"LightGrey" , PALETTERGB (211,211,211)},
829 {"light gray" , PALETTERGB (211,211,211)},
830 {"LightGray" , PALETTERGB (211,211,211)},
831 {"midnight blue" , PALETTERGB ( 25, 25,112)},
832 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
833 {"navy" , PALETTERGB ( 0, 0,128)},
834 {"navy blue" , PALETTERGB ( 0, 0,128)},
835 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
836 {"cornflower blue" , PALETTERGB (100,149,237)},
837 {"CornflowerBlue" , PALETTERGB (100,149,237)},
838 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
839 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
840 {"slate blue" , PALETTERGB (106, 90,205)},
841 {"SlateBlue" , PALETTERGB (106, 90,205)},
842 {"medium slate blue" , PALETTERGB (123,104,238)},
843 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
844 {"light slate blue" , PALETTERGB (132,112,255)},
845 {"LightSlateBlue" , PALETTERGB (132,112,255)},
846 {"medium blue" , PALETTERGB ( 0, 0,205)},
847 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
848 {"royal blue" , PALETTERGB ( 65,105,225)},
849 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
850 {"blue" , PALETTERGB ( 0, 0,255)},
851 {"dodger blue" , PALETTERGB ( 30,144,255)},
852 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
853 {"deep sky blue" , PALETTERGB ( 0,191,255)},
854 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
855 {"sky blue" , PALETTERGB (135,206,235)},
856 {"SkyBlue" , PALETTERGB (135,206,235)},
857 {"light sky blue" , PALETTERGB (135,206,250)},
858 {"LightSkyBlue" , PALETTERGB (135,206,250)},
859 {"steel blue" , PALETTERGB ( 70,130,180)},
860 {"SteelBlue" , PALETTERGB ( 70,130,180)},
861 {"light steel blue" , PALETTERGB (176,196,222)},
862 {"LightSteelBlue" , PALETTERGB (176,196,222)},
863 {"light blue" , PALETTERGB (173,216,230)},
864 {"LightBlue" , PALETTERGB (173,216,230)},
865 {"powder blue" , PALETTERGB (176,224,230)},
866 {"PowderBlue" , PALETTERGB (176,224,230)},
867 {"pale turquoise" , PALETTERGB (175,238,238)},
868 {"PaleTurquoise" , PALETTERGB (175,238,238)},
869 {"dark turquoise" , PALETTERGB ( 0,206,209)},
870 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
871 {"medium turquoise" , PALETTERGB ( 72,209,204)},
872 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
873 {"turquoise" , PALETTERGB ( 64,224,208)},
874 {"cyan" , PALETTERGB ( 0,255,255)},
875 {"light cyan" , PALETTERGB (224,255,255)},
876 {"LightCyan" , PALETTERGB (224,255,255)},
877 {"cadet blue" , PALETTERGB ( 95,158,160)},
878 {"CadetBlue" , PALETTERGB ( 95,158,160)},
879 {"medium aquamarine" , PALETTERGB (102,205,170)},
880 {"MediumAquamarine" , PALETTERGB (102,205,170)},
881 {"aquamarine" , PALETTERGB (127,255,212)},
882 {"dark green" , PALETTERGB ( 0,100, 0)},
883 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
884 {"dark olive green" , PALETTERGB ( 85,107, 47)},
885 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
886 {"dark sea green" , PALETTERGB (143,188,143)},
887 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
888 {"sea green" , PALETTERGB ( 46,139, 87)},
889 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
890 {"medium sea green" , PALETTERGB ( 60,179,113)},
891 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
892 {"light sea green" , PALETTERGB ( 32,178,170)},
893 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
894 {"pale green" , PALETTERGB (152,251,152)},
895 {"PaleGreen" , PALETTERGB (152,251,152)},
896 {"spring green" , PALETTERGB ( 0,255,127)},
897 {"SpringGreen" , PALETTERGB ( 0,255,127)},
898 {"lawn green" , PALETTERGB (124,252, 0)},
899 {"LawnGreen" , PALETTERGB (124,252, 0)},
900 {"green" , PALETTERGB ( 0,255, 0)},
901 {"chartreuse" , PALETTERGB (127,255, 0)},
902 {"medium spring green" , PALETTERGB ( 0,250,154)},
903 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
904 {"green yellow" , PALETTERGB (173,255, 47)},
905 {"GreenYellow" , PALETTERGB (173,255, 47)},
906 {"lime green" , PALETTERGB ( 50,205, 50)},
907 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
908 {"yellow green" , PALETTERGB (154,205, 50)},
909 {"YellowGreen" , PALETTERGB (154,205, 50)},
910 {"forest green" , PALETTERGB ( 34,139, 34)},
911 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
912 {"olive drab" , PALETTERGB (107,142, 35)},
913 {"OliveDrab" , PALETTERGB (107,142, 35)},
914 {"dark khaki" , PALETTERGB (189,183,107)},
915 {"DarkKhaki" , PALETTERGB (189,183,107)},
916 {"khaki" , PALETTERGB (240,230,140)},
917 {"pale goldenrod" , PALETTERGB (238,232,170)},
918 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
919 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
920 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
921 {"light yellow" , PALETTERGB (255,255,224)},
922 {"LightYellow" , PALETTERGB (255,255,224)},
923 {"yellow" , PALETTERGB (255,255, 0)},
924 {"gold" , PALETTERGB (255,215, 0)},
925 {"light goldenrod" , PALETTERGB (238,221,130)},
926 {"LightGoldenrod" , PALETTERGB (238,221,130)},
927 {"goldenrod" , PALETTERGB (218,165, 32)},
928 {"dark goldenrod" , PALETTERGB (184,134, 11)},
929 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
930 {"rosy brown" , PALETTERGB (188,143,143)},
931 {"RosyBrown" , PALETTERGB (188,143,143)},
932 {"indian red" , PALETTERGB (205, 92, 92)},
933 {"IndianRed" , PALETTERGB (205, 92, 92)},
934 {"saddle brown" , PALETTERGB (139, 69, 19)},
935 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
936 {"sienna" , PALETTERGB (160, 82, 45)},
937 {"peru" , PALETTERGB (205,133, 63)},
938 {"burlywood" , PALETTERGB (222,184,135)},
939 {"beige" , PALETTERGB (245,245,220)},
940 {"wheat" , PALETTERGB (245,222,179)},
941 {"sandy brown" , PALETTERGB (244,164, 96)},
942 {"SandyBrown" , PALETTERGB (244,164, 96)},
943 {"tan" , PALETTERGB (210,180,140)},
944 {"chocolate" , PALETTERGB (210,105, 30)},
945 {"firebrick" , PALETTERGB (178,34, 34)},
946 {"brown" , PALETTERGB (165,42, 42)},
947 {"dark salmon" , PALETTERGB (233,150,122)},
948 {"DarkSalmon" , PALETTERGB (233,150,122)},
949 {"salmon" , PALETTERGB (250,128,114)},
950 {"light salmon" , PALETTERGB (255,160,122)},
951 {"LightSalmon" , PALETTERGB (255,160,122)},
952 {"orange" , PALETTERGB (255,165, 0)},
953 {"dark orange" , PALETTERGB (255,140, 0)},
954 {"DarkOrange" , PALETTERGB (255,140, 0)},
955 {"coral" , PALETTERGB (255,127, 80)},
956 {"light coral" , PALETTERGB (240,128,128)},
957 {"LightCoral" , PALETTERGB (240,128,128)},
958 {"tomato" , PALETTERGB (255, 99, 71)},
959 {"orange red" , PALETTERGB (255, 69, 0)},
960 {"OrangeRed" , PALETTERGB (255, 69, 0)},
961 {"red" , PALETTERGB (255, 0, 0)},
962 {"hot pink" , PALETTERGB (255,105,180)},
963 {"HotPink" , PALETTERGB (255,105,180)},
964 {"deep pink" , PALETTERGB (255, 20,147)},
965 {"DeepPink" , PALETTERGB (255, 20,147)},
966 {"pink" , PALETTERGB (255,192,203)},
967 {"light pink" , PALETTERGB (255,182,193)},
968 {"LightPink" , PALETTERGB (255,182,193)},
969 {"pale violet red" , PALETTERGB (219,112,147)},
970 {"PaleVioletRed" , PALETTERGB (219,112,147)},
971 {"maroon" , PALETTERGB (176, 48, 96)},
972 {"medium violet red" , PALETTERGB (199, 21,133)},
973 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
974 {"violet red" , PALETTERGB (208, 32,144)},
975 {"VioletRed" , PALETTERGB (208, 32,144)},
976 {"magenta" , PALETTERGB (255, 0,255)},
977 {"violet" , PALETTERGB (238,130,238)},
978 {"plum" , PALETTERGB (221,160,221)},
979 {"orchid" , PALETTERGB (218,112,214)},
980 {"medium orchid" , PALETTERGB (186, 85,211)},
981 {"MediumOrchid" , PALETTERGB (186, 85,211)},
982 {"dark orchid" , PALETTERGB (153, 50,204)},
983 {"DarkOrchid" , PALETTERGB (153, 50,204)},
984 {"dark violet" , PALETTERGB (148, 0,211)},
985 {"DarkViolet" , PALETTERGB (148, 0,211)},
986 {"blue violet" , PALETTERGB (138, 43,226)},
987 {"BlueViolet" , PALETTERGB (138, 43,226)},
988 {"purple" , PALETTERGB (160, 32,240)},
989 {"medium purple" , PALETTERGB (147,112,219)},
990 {"MediumPurple" , PALETTERGB (147,112,219)},
991 {"thistle" , PALETTERGB (216,191,216)},
992 {"gray0" , PALETTERGB ( 0, 0, 0)},
993 {"grey0" , PALETTERGB ( 0, 0, 0)},
994 {"dark grey" , PALETTERGB (169,169,169)},
995 {"DarkGrey" , PALETTERGB (169,169,169)},
996 {"dark gray" , PALETTERGB (169,169,169)},
997 {"DarkGray" , PALETTERGB (169,169,169)},
998 {"dark blue" , PALETTERGB ( 0, 0,139)},
999 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1000 {"dark cyan" , PALETTERGB ( 0,139,139)},
1001 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1002 {"dark magenta" , PALETTERGB (139, 0,139)},
1003 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1004 {"dark red" , PALETTERGB (139, 0, 0)},
1005 {"DarkRed" , PALETTERGB (139, 0, 0)},
1006 {"light green" , PALETTERGB (144,238,144)},
1007 {"LightGreen" , PALETTERGB (144,238,144)},
1010 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1011 0, 0, 0, doc
: /* Return the default color map. */)
1015 colormap_t
*pc
= w32_color_map
;
1022 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1024 cmap
= Fcons (Fcons (build_string (pc
->name
),
1025 make_number (pc
->colorref
)),
1034 w32_to_x_color (rgb
)
1043 color
= Frassq (rgb
, Vw32_color_map
);
1048 return (Fcar (color
));
1054 w32_color_map_lookup (colorname
)
1057 Lisp_Object tail
, ret
= Qnil
;
1061 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1063 register Lisp_Object elt
, tem
;
1066 if (!CONSP (elt
)) continue;
1070 if (lstrcmpi (SDATA (tem
), colorname
) == 0)
1072 ret
= XUINT (Fcdr (elt
));
1087 add_system_logical_colors_to_map (system_colors
)
1088 Lisp_Object
*system_colors
;
1092 /* Other registry operations are done with input blocked. */
1095 /* Look for "Control Panel/Colors" under User and Machine registry
1097 if (RegOpenKeyEx (HKEY_CURRENT_USER
, "Control Panel\\Colors", 0,
1098 KEY_READ
, &colors_key
) == ERROR_SUCCESS
1099 || RegOpenKeyEx (HKEY_LOCAL_MACHINE
, "Control Panel\\Colors", 0,
1100 KEY_READ
, &colors_key
) == ERROR_SUCCESS
)
1102 /* List all keys. */
1103 char color_buffer
[64];
1104 char full_name_buffer
[MAX_PATH
+ SYSTEM_COLOR_PREFIX_LEN
];
1106 DWORD name_size
, color_size
;
1107 char *name_buffer
= full_name_buffer
+ SYSTEM_COLOR_PREFIX_LEN
;
1109 name_size
= sizeof (full_name_buffer
) - SYSTEM_COLOR_PREFIX_LEN
;
1110 color_size
= sizeof (color_buffer
);
1112 strcpy (full_name_buffer
, SYSTEM_COLOR_PREFIX
);
1114 while (RegEnumValueA (colors_key
, index
, name_buffer
, &name_size
,
1115 NULL
, NULL
, color_buffer
, &color_size
)
1119 if (sscanf (color_buffer
, " %u %u %u", &r
, &g
, &b
) == 3)
1120 *system_colors
= Fcons (Fcons (build_string (full_name_buffer
),
1121 make_number (RGB (r
, g
, b
))),
1124 name_size
= sizeof (full_name_buffer
) - SYSTEM_COLOR_PREFIX_LEN
;
1125 color_size
= sizeof (color_buffer
);
1128 RegCloseKey (colors_key
);
1136 x_to_w32_color (colorname
)
1139 register Lisp_Object ret
= Qnil
;
1143 if (colorname
[0] == '#')
1145 /* Could be an old-style RGB Device specification. */
1148 color
= colorname
+ 1;
1150 size
= strlen(color
);
1151 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1159 for (i
= 0; i
< 3; i
++)
1163 unsigned long value
;
1165 /* The check for 'x' in the following conditional takes into
1166 account the fact that strtol allows a "0x" in front of
1167 our numbers, and we don't. */
1168 if (!isxdigit(color
[0]) || color
[1] == 'x')
1172 value
= strtoul(color
, &end
, 16);
1174 if (errno
== ERANGE
|| end
- color
!= size
)
1179 value
= value
* 0x10;
1190 colorval
|= (value
<< pos
);
1201 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1209 color
= colorname
+ 4;
1210 for (i
= 0; i
< 3; i
++)
1213 unsigned long value
;
1215 /* The check for 'x' in the following conditional takes into
1216 account the fact that strtol allows a "0x" in front of
1217 our numbers, and we don't. */
1218 if (!isxdigit(color
[0]) || color
[1] == 'x')
1220 value
= strtoul(color
, &end
, 16);
1221 if (errno
== ERANGE
)
1223 switch (end
- color
)
1226 value
= value
* 0x10 + value
;
1239 if (value
== ULONG_MAX
)
1241 colorval
|= (value
<< pos
);
1255 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1257 /* This is an RGB Intensity specification. */
1264 color
= colorname
+ 5;
1265 for (i
= 0; i
< 3; i
++)
1271 value
= strtod(color
, &end
);
1272 if (errno
== ERANGE
)
1274 if (value
< 0.0 || value
> 1.0)
1276 val
= (UINT
)(0x100 * value
);
1277 /* We used 0x100 instead of 0xFF to give a continuous
1278 range between 0.0 and 1.0 inclusive. The next statement
1279 fixes the 1.0 case. */
1282 colorval
|= (val
<< pos
);
1296 /* I am not going to attempt to handle any of the CIE color schemes
1297 or TekHVC, since I don't know the algorithms for conversion to
1300 /* If we fail to lookup the color name in w32_color_map, then check the
1301 colorname to see if it can be crudely approximated: If the X color
1302 ends in a number (e.g., "darkseagreen2"), strip the number and
1303 return the result of looking up the base color name. */
1304 ret
= w32_color_map_lookup (colorname
);
1307 int len
= strlen (colorname
);
1309 if (isdigit (colorname
[len
- 1]))
1311 char *ptr
, *approx
= alloca (len
+ 1);
1313 strcpy (approx
, colorname
);
1314 ptr
= &approx
[len
- 1];
1315 while (ptr
> approx
&& isdigit (*ptr
))
1318 ret
= w32_color_map_lookup (approx
);
1327 w32_regenerate_palette (FRAME_PTR f
)
1329 struct w32_palette_entry
* list
;
1330 LOGPALETTE
* log_palette
;
1331 HPALETTE new_palette
;
1334 /* don't bother trying to create palette if not supported */
1335 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1338 log_palette
= (LOGPALETTE
*)
1339 alloca (sizeof (LOGPALETTE
) +
1340 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1341 log_palette
->palVersion
= 0x300;
1342 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1344 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1346 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1347 i
++, list
= list
->next
)
1348 log_palette
->palPalEntry
[i
] = list
->entry
;
1350 new_palette
= CreatePalette (log_palette
);
1354 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1355 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1356 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1358 /* Realize display palette and garbage all frames. */
1359 release_frame_dc (f
, get_frame_dc (f
));
1364 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1365 #define SET_W32_COLOR(pe, color) \
1368 pe.peRed = GetRValue (color); \
1369 pe.peGreen = GetGValue (color); \
1370 pe.peBlue = GetBValue (color); \
1375 /* Keep these around in case we ever want to track color usage. */
1377 w32_map_color (FRAME_PTR f
, COLORREF color
)
1379 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1381 if (NILP (Vw32_enable_palette
))
1384 /* check if color is already mapped */
1387 if (W32_COLOR (list
->entry
) == color
)
1395 /* not already mapped, so add to list and recreate Windows palette */
1396 list
= (struct w32_palette_entry
*)
1397 xmalloc (sizeof (struct w32_palette_entry
));
1398 SET_W32_COLOR (list
->entry
, color
);
1400 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1401 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1402 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1404 /* set flag that palette must be regenerated */
1405 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1409 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1411 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1412 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1414 if (NILP (Vw32_enable_palette
))
1417 /* check if color is already mapped */
1420 if (W32_COLOR (list
->entry
) == color
)
1422 if (--list
->refcount
== 0)
1426 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1436 /* set flag that palette must be regenerated */
1437 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1442 /* Gamma-correct COLOR on frame F. */
1445 gamma_correct (f
, color
)
1451 *color
= PALETTERGB (
1452 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1453 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1454 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1459 /* Decide if color named COLOR is valid for the display associated with
1460 the selected frame; if so, return the rgb values in COLOR_DEF.
1461 If ALLOC is nonzero, allocate a new colormap cell. */
1464 w32_defined_color (f
, color
, color_def
, alloc
)
1470 register Lisp_Object tem
;
1471 COLORREF w32_color_ref
;
1473 tem
= x_to_w32_color (color
);
1479 /* Apply gamma correction. */
1480 w32_color_ref
= XUINT (tem
);
1481 gamma_correct (f
, &w32_color_ref
);
1482 XSETINT (tem
, w32_color_ref
);
1485 /* Map this color to the palette if it is enabled. */
1486 if (!NILP (Vw32_enable_palette
))
1488 struct w32_palette_entry
* entry
=
1489 one_w32_display_info
.color_list
;
1490 struct w32_palette_entry
** prev
=
1491 &one_w32_display_info
.color_list
;
1493 /* check if color is already mapped */
1496 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1498 prev
= &entry
->next
;
1499 entry
= entry
->next
;
1502 if (entry
== NULL
&& alloc
)
1504 /* not already mapped, so add to list */
1505 entry
= (struct w32_palette_entry
*)
1506 xmalloc (sizeof (struct w32_palette_entry
));
1507 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1510 one_w32_display_info
.num_colors
++;
1512 /* set flag that palette must be regenerated */
1513 one_w32_display_info
.regen_palette
= TRUE
;
1516 /* Ensure COLORREF value is snapped to nearest color in (default)
1517 palette by simulating the PALETTERGB macro. This works whether
1518 or not the display device has a palette. */
1519 w32_color_ref
= XUINT (tem
) | 0x2000000;
1521 color_def
->pixel
= w32_color_ref
;
1522 color_def
->red
= GetRValue (w32_color_ref
) * 256;
1523 color_def
->green
= GetGValue (w32_color_ref
) * 256;
1524 color_def
->blue
= GetBValue (w32_color_ref
) * 256;
1534 /* Given a string ARG naming a color, compute a pixel value from it
1535 suitable for screen F.
1536 If F is not a color screen, return DEF (default) regardless of what
1540 x_decode_color (f
, arg
, def
)
1549 if (strcmp (SDATA (arg
), "black") == 0)
1550 return BLACK_PIX_DEFAULT (f
);
1551 else if (strcmp (SDATA (arg
), "white") == 0)
1552 return WHITE_PIX_DEFAULT (f
);
1554 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1557 /* w32_defined_color is responsible for coping with failures
1558 by looking for a near-miss. */
1559 if (w32_defined_color (f
, SDATA (arg
), &cdef
, 1))
1562 /* defined_color failed; return an ultimate default. */
1568 /* Functions called only from `x_set_frame_param'
1569 to set individual parameters.
1571 If FRAME_W32_WINDOW (f) is 0,
1572 the frame is being created and its window does not exist yet.
1573 In that case, just record the parameter's new value
1574 in the standard place; do not attempt to change the window. */
1577 x_set_foreground_color (f
, arg
, oldval
)
1579 Lisp_Object arg
, oldval
;
1581 struct w32_output
*x
= f
->output_data
.w32
;
1582 PIX_TYPE fg
, old_fg
;
1584 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1585 old_fg
= FRAME_FOREGROUND_PIXEL (f
);
1586 FRAME_FOREGROUND_PIXEL (f
) = fg
;
1588 if (FRAME_W32_WINDOW (f
) != 0)
1590 if (x
->cursor_pixel
== old_fg
)
1591 x
->cursor_pixel
= fg
;
1593 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1594 if (FRAME_VISIBLE_P (f
))
1600 x_set_background_color (f
, arg
, oldval
)
1602 Lisp_Object arg
, oldval
;
1604 FRAME_BACKGROUND_PIXEL (f
)
1605 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1607 if (FRAME_W32_WINDOW (f
) != 0)
1609 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
1610 FRAME_BACKGROUND_PIXEL (f
));
1612 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1614 if (FRAME_VISIBLE_P (f
))
1620 x_set_mouse_color (f
, arg
, oldval
)
1622 Lisp_Object arg
, oldval
;
1624 Cursor cursor
, nontext_cursor
, mode_cursor
, hand_cursor
;
1628 if (!EQ (Qnil
, arg
))
1629 f
->output_data
.w32
->mouse_pixel
1630 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1631 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
1633 /* Don't let pointers be invisible. */
1634 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1635 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
1636 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
1638 #if 0 /* TODO : cursor changes */
1641 /* It's not okay to crash if the user selects a screwy cursor. */
1642 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1644 if (!EQ (Qnil
, Vx_pointer_shape
))
1646 CHECK_NUMBER (Vx_pointer_shape
);
1647 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1650 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1651 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1653 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1655 CHECK_NUMBER (Vx_nontext_pointer_shape
);
1656 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1657 XINT (Vx_nontext_pointer_shape
));
1660 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1661 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1663 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
1665 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
1666 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1667 XINT (Vx_hourglass_pointer_shape
));
1670 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
1671 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
1673 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1674 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1676 CHECK_NUMBER (Vx_mode_pointer_shape
);
1677 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1678 XINT (Vx_mode_pointer_shape
));
1681 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1682 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1684 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1686 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
1688 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1689 XINT (Vx_sensitive_text_pointer_shape
));
1692 hand_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1694 if (!NILP (Vx_window_horizontal_drag_shape
))
1696 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
1697 horizontal_drag_cursor
1698 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1699 XINT (Vx_window_horizontal_drag_shape
));
1702 horizontal_drag_cursor
1703 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1705 /* Check and report errors with the above calls. */
1706 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1707 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1710 XColor fore_color
, back_color
;
1712 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1713 back_color
.pixel
= mask_color
;
1714 XQueryColor (FRAME_W32_DISPLAY (f
),
1715 DefaultColormap (FRAME_W32_DISPLAY (f
),
1716 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1718 XQueryColor (FRAME_W32_DISPLAY (f
),
1719 DefaultColormap (FRAME_W32_DISPLAY (f
),
1720 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1722 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1723 &fore_color
, &back_color
);
1724 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1725 &fore_color
, &back_color
);
1726 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1727 &fore_color
, &back_color
);
1728 XRecolorCursor (FRAME_W32_DISPLAY (f
), hand_cursor
,
1729 &fore_color
, &back_color
);
1730 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
1731 &fore_color
, &back_color
);
1734 if (FRAME_W32_WINDOW (f
) != 0)
1735 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1737 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1738 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1739 f
->output_data
.w32
->text_cursor
= cursor
;
1741 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1742 && f
->output_data
.w32
->nontext_cursor
!= 0)
1743 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1744 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1746 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
1747 && f
->output_data
.w32
->hourglass_cursor
!= 0)
1748 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
1749 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
1751 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1752 && f
->output_data
.w32
->modeline_cursor
!= 0)
1753 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1754 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1756 if (hand_cursor
!= f
->output_data
.w32
->hand_cursor
1757 && f
->output_data
.w32
->hand_cursor
!= 0)
1758 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hand_cursor
);
1759 f
->output_data
.w32
->hand_cursor
= hand_cursor
;
1761 XFlush (FRAME_W32_DISPLAY (f
));
1764 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1768 /* Defined in w32term.c. */
1770 x_set_cursor_color (f
, arg
, oldval
)
1772 Lisp_Object arg
, oldval
;
1774 unsigned long fore_pixel
, pixel
;
1776 if (!NILP (Vx_cursor_fore_pixel
))
1777 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1778 WHITE_PIX_DEFAULT (f
));
1780 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
1782 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1784 /* Make sure that the cursor color differs from the background color. */
1785 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
1787 pixel
= f
->output_data
.w32
->mouse_pixel
;
1788 if (pixel
== fore_pixel
)
1789 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
1792 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1793 f
->output_data
.w32
->cursor_pixel
= pixel
;
1795 if (FRAME_W32_WINDOW (f
) != 0)
1798 /* Update frame's cursor_gc. */
1799 f
->output_data
.w32
->cursor_gc
->foreground
= fore_pixel
;
1800 f
->output_data
.w32
->cursor_gc
->background
= pixel
;
1804 if (FRAME_VISIBLE_P (f
))
1806 x_update_cursor (f
, 0);
1807 x_update_cursor (f
, 1);
1811 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1814 /* Set the border-color of frame F to pixel value PIX.
1815 Note that this does not fully take effect if done before
1819 x_set_border_pixel (f
, pix
)
1824 f
->output_data
.w32
->border_pixel
= pix
;
1826 if (FRAME_W32_WINDOW (f
) != 0 && f
->border_width
> 0)
1828 if (FRAME_VISIBLE_P (f
))
1833 /* Set the border-color of frame F to value described by ARG.
1834 ARG can be a string naming a color.
1835 The border-color is used for the border that is drawn by the server.
1836 Note that this does not fully take effect if done before
1837 F has a window; it must be redone when the window is created. */
1840 x_set_border_color (f
, arg
, oldval
)
1842 Lisp_Object arg
, oldval
;
1847 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1848 x_set_border_pixel (f
, pix
);
1849 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1854 x_set_cursor_type (f
, arg
, oldval
)
1856 Lisp_Object arg
, oldval
;
1858 set_frame_cursor_types (f
, arg
);
1860 /* Make sure the cursor gets redrawn. */
1861 cursor_type_changed
= 1;
1865 x_set_icon_type (f
, arg
, oldval
)
1867 Lisp_Object arg
, oldval
;
1871 if (NILP (arg
) && NILP (oldval
))
1874 if (STRINGP (arg
) && STRINGP (oldval
)
1875 && EQ (Fstring_equal (oldval
, arg
), Qt
))
1878 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
1883 result
= x_bitmap_icon (f
, arg
);
1887 error ("No icon window available");
1894 x_set_icon_name (f
, arg
, oldval
)
1896 Lisp_Object arg
, oldval
;
1900 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1903 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1909 if (f
->output_data
.w32
->icon_bitmap
!= 0)
1914 result
= x_text_icon (f
,
1915 (char *) SDATA ((!NILP (f
->icon_name
)
1924 error ("No icon window available");
1927 /* If the window was unmapped (and its icon was mapped),
1928 the new icon is not mapped, so map the window in its stead. */
1929 if (FRAME_VISIBLE_P (f
))
1931 #ifdef USE_X_TOOLKIT
1932 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
1934 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
1937 XFlush (FRAME_W32_DISPLAY (f
));
1944 x_set_menu_bar_lines (f
, value
, oldval
)
1946 Lisp_Object value
, oldval
;
1949 int olines
= FRAME_MENU_BAR_LINES (f
);
1951 /* Right now, menu bars don't work properly in minibuf-only frames;
1952 most of the commands try to apply themselves to the minibuffer
1953 frame itself, and get an error because you can't switch buffers
1954 in or split the minibuffer window. */
1955 if (FRAME_MINIBUF_ONLY_P (f
))
1958 if (INTEGERP (value
))
1959 nlines
= XINT (value
);
1963 FRAME_MENU_BAR_LINES (f
) = 0;
1965 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1968 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1969 free_frame_menubar (f
);
1970 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1972 /* Adjust the frame size so that the client (text) dimensions
1973 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1975 x_set_window_size (f
, 0, FRAME_COLS (f
), FRAME_LINES (f
));
1976 do_pending_window_change (0);
1982 /* Set the number of lines used for the tool bar of frame F to VALUE.
1983 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1984 is the old number of tool bar lines. This function changes the
1985 height of all windows on frame F to match the new tool bar height.
1986 The frame's height doesn't change. */
1989 x_set_tool_bar_lines (f
, value
, oldval
)
1991 Lisp_Object value
, oldval
;
1993 int delta
, nlines
, root_height
;
1994 Lisp_Object root_window
;
1996 /* Treat tool bars like menu bars. */
1997 if (FRAME_MINIBUF_ONLY_P (f
))
2000 /* Use VALUE only if an integer >= 0. */
2001 if (INTEGERP (value
) && XINT (value
) >= 0)
2002 nlines
= XFASTINT (value
);
2006 /* Make sure we redisplay all windows in this frame. */
2007 ++windows_or_buffers_changed
;
2009 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2011 /* Don't resize the tool-bar to more than we have room for. */
2012 root_window
= FRAME_ROOT_WINDOW (f
);
2013 root_height
= WINDOW_TOTAL_LINES (XWINDOW (root_window
));
2014 if (root_height
- delta
< 1)
2016 delta
= root_height
- 1;
2017 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2020 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2021 change_window_heights (root_window
, delta
);
2024 /* We also have to make sure that the internal border at the top of
2025 the frame, below the menu bar or tool bar, is redrawn when the
2026 tool bar disappears. This is so because the internal border is
2027 below the tool bar if one is displayed, but is below the menu bar
2028 if there isn't a tool bar. The tool bar draws into the area
2029 below the menu bar. */
2030 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2034 clear_current_matrices (f
);
2035 updating_frame
= NULL
;
2038 /* If the tool bar gets smaller, the internal border below it
2039 has to be cleared. It was formerly part of the display
2040 of the larger tool bar, and updating windows won't clear it. */
2043 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2044 int width
= FRAME_PIXEL_WIDTH (f
);
2045 int y
= nlines
* FRAME_LINE_HEIGHT (f
);
2049 HDC hdc
= get_frame_dc (f
);
2050 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
2051 release_frame_dc (f
, hdc
);
2055 if (WINDOWP (f
->tool_bar_window
))
2056 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2061 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2064 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2065 name; if NAME is a string, set F's name to NAME and set
2066 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2068 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2069 suggesting a new name, which lisp code should override; if
2070 F->explicit_name is set, ignore the new name; otherwise, set it. */
2073 x_set_name (f
, name
, explicit)
2078 /* Make sure that requests from lisp code override requests from
2079 Emacs redisplay code. */
2082 /* If we're switching from explicit to implicit, we had better
2083 update the mode lines and thereby update the title. */
2084 if (f
->explicit_name
&& NILP (name
))
2085 update_mode_lines
= 1;
2087 f
->explicit_name
= ! NILP (name
);
2089 else if (f
->explicit_name
)
2092 /* If NAME is nil, set the name to the w32_id_name. */
2095 /* Check for no change needed in this very common case
2096 before we do any consing. */
2097 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2100 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2103 CHECK_STRING (name
);
2105 /* Don't change the name if it's already NAME. */
2106 if (! NILP (Fstring_equal (name
, f
->name
)))
2111 /* For setting the frame title, the title parameter should override
2112 the name parameter. */
2113 if (! NILP (f
->title
))
2116 if (FRAME_W32_WINDOW (f
))
2118 if (STRING_MULTIBYTE (name
))
2119 name
= ENCODE_SYSTEM (name
);
2122 SetWindowText(FRAME_W32_WINDOW (f
), SDATA (name
));
2127 /* This function should be called when the user's lisp code has
2128 specified a name for the frame; the name will override any set by the
2131 x_explicitly_set_name (f
, arg
, oldval
)
2133 Lisp_Object arg
, oldval
;
2135 x_set_name (f
, arg
, 1);
2138 /* This function should be called by Emacs redisplay code to set the
2139 name; names set this way will never override names set by the user's
2142 x_implicitly_set_name (f
, arg
, oldval
)
2144 Lisp_Object arg
, oldval
;
2146 x_set_name (f
, arg
, 0);
2149 /* Change the title of frame F to NAME.
2150 If NAME is nil, use the frame name as the title.
2152 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2153 name; if NAME is a string, set F's name to NAME and set
2154 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2156 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2157 suggesting a new name, which lisp code should override; if
2158 F->explicit_name is set, ignore the new name; otherwise, set it. */
2161 x_set_title (f
, name
, old_name
)
2163 Lisp_Object name
, old_name
;
2165 /* Don't change the title if it's already NAME. */
2166 if (EQ (name
, f
->title
))
2169 update_mode_lines
= 1;
2176 if (FRAME_W32_WINDOW (f
))
2178 if (STRING_MULTIBYTE (name
))
2179 name
= ENCODE_SYSTEM (name
);
2182 SetWindowText(FRAME_W32_WINDOW (f
), SDATA (name
));
2188 void x_set_scroll_bar_default_width (f
)
2191 int wid
= FRAME_COLUMN_WIDTH (f
);
2193 FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
2194 FRAME_CONFIG_SCROLL_BAR_COLS (f
) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) +
2199 /* Subroutines of creating a frame. */
2202 /* Return the value of parameter PARAM.
2204 First search ALIST, then Vdefault_frame_alist, then the X defaults
2205 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2207 Convert the resource to the type specified by desired_type.
2209 If no default is specified, return Qunbound. If you call
2210 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
2211 and don't let it get stored in any Lisp-visible variables! */
2214 w32_get_arg (alist
, param
, attribute
, class, type
)
2215 Lisp_Object alist
, param
;
2218 enum resource_types type
;
2220 return x_get_arg (check_x_display_info (Qnil
),
2221 alist
, param
, attribute
, class, type
);
2226 w32_load_cursor (LPCTSTR name
)
2228 /* Try first to load cursor from application resource. */
2229 Cursor cursor
= LoadImage ((HINSTANCE
) GetModuleHandle(NULL
),
2230 name
, IMAGE_CURSOR
, 0, 0,
2231 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
2234 /* Then try to load a shared predefined cursor. */
2235 cursor
= LoadImage (NULL
, name
, IMAGE_CURSOR
, 0, 0,
2236 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
2241 extern LRESULT CALLBACK
w32_wnd_proc ();
2244 w32_init_class (hinst
)
2249 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2250 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2252 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2253 wc
.hInstance
= hinst
;
2254 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2255 wc
.hCursor
= w32_load_cursor (IDC_ARROW
);
2256 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
2257 wc
.lpszMenuName
= NULL
;
2258 wc
.lpszClassName
= EMACS_CLASS
;
2260 return (RegisterClass (&wc
));
2264 w32_createscrollbar (f
, bar
)
2266 struct scroll_bar
* bar
;
2268 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2269 /* Position and size of scroll bar. */
2270 XINT(bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
2272 XINT(bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
2274 FRAME_W32_WINDOW (f
),
2281 w32_createwindow (f
)
2287 rect
.left
= rect
.top
= 0;
2288 rect
.right
= FRAME_PIXEL_WIDTH (f
);
2289 rect
.bottom
= FRAME_PIXEL_HEIGHT (f
);
2291 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
2292 FRAME_EXTERNAL_MENU_BAR (f
));
2294 /* Do first time app init */
2298 w32_init_class (hinst
);
2301 FRAME_W32_WINDOW (f
) = hwnd
2302 = CreateWindow (EMACS_CLASS
,
2304 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
2307 rect
.right
- rect
.left
,
2308 rect
.bottom
- rect
.top
,
2316 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FRAME_COLUMN_WIDTH (f
));
2317 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, FRAME_LINE_HEIGHT (f
));
2318 SetWindowLong (hwnd
, WND_BORDER_INDEX
, FRAME_INTERNAL_BORDER_WIDTH (f
));
2319 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->scroll_bar_actual_width
);
2320 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
2322 /* Enable drag-n-drop. */
2323 DragAcceptFiles (hwnd
, TRUE
);
2325 /* Do this to discard the default setting specified by our parent. */
2326 ShowWindow (hwnd
, SW_HIDE
);
2331 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
2338 wmsg
->msg
.hwnd
= hwnd
;
2339 wmsg
->msg
.message
= msg
;
2340 wmsg
->msg
.wParam
= wParam
;
2341 wmsg
->msg
.lParam
= lParam
;
2342 wmsg
->msg
.time
= GetMessageTime ();
2347 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2348 between left and right keys as advertised. We test for this
2349 support dynamically, and set a flag when the support is absent. If
2350 absent, we keep track of the left and right control and alt keys
2351 ourselves. This is particularly necessary on keyboards that rely
2352 upon the AltGr key, which is represented as having the left control
2353 and right alt keys pressed. For these keyboards, we need to know
2354 when the left alt key has been pressed in addition to the AltGr key
2355 so that we can properly support M-AltGr-key sequences (such as M-@
2356 on Swedish keyboards). */
2358 #define EMACS_LCONTROL 0
2359 #define EMACS_RCONTROL 1
2360 #define EMACS_LMENU 2
2361 #define EMACS_RMENU 3
2363 static int modifiers
[4];
2364 static int modifiers_recorded
;
2365 static int modifier_key_support_tested
;
2368 test_modifier_support (unsigned int wparam
)
2372 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2374 if (wparam
== VK_CONTROL
)
2384 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
2385 modifiers_recorded
= 1;
2387 modifiers_recorded
= 0;
2388 modifier_key_support_tested
= 1;
2392 record_keydown (unsigned int wparam
, unsigned int lparam
)
2396 if (!modifier_key_support_tested
)
2397 test_modifier_support (wparam
);
2399 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2402 if (wparam
== VK_CONTROL
)
2403 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2405 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2411 record_keyup (unsigned int wparam
, unsigned int lparam
)
2415 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2418 if (wparam
== VK_CONTROL
)
2419 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2421 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2426 /* Emacs can lose focus while a modifier key has been pressed. When
2427 it regains focus, be conservative and clear all modifiers since
2428 we cannot reconstruct the left and right modifier state. */
2434 if (GetFocus () == NULL
)
2435 /* Emacs doesn't have keyboard focus. Do nothing. */
2438 ctrl
= GetAsyncKeyState (VK_CONTROL
);
2439 alt
= GetAsyncKeyState (VK_MENU
);
2441 if (!(ctrl
& 0x08000))
2442 /* Clear any recorded control modifier state. */
2443 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2445 if (!(alt
& 0x08000))
2446 /* Clear any recorded alt modifier state. */
2447 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2449 /* Update the state of all modifier keys, because modifiers used in
2450 hot-key combinations can get stuck on if Emacs loses focus as a
2451 result of a hot-key being pressed. */
2455 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2457 GetKeyboardState (keystate
);
2458 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
2459 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
2460 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
2461 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
2462 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
2463 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
2464 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
2465 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
2466 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
2467 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
2468 SetKeyboardState (keystate
);
2472 /* Synchronize modifier state with what is reported with the current
2473 keystroke. Even if we cannot distinguish between left and right
2474 modifier keys, we know that, if no modifiers are set, then neither
2475 the left or right modifier should be set. */
2479 if (!modifiers_recorded
)
2482 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
2483 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2485 if (!(GetKeyState (VK_MENU
) & 0x8000))
2486 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2490 modifier_set (int vkey
)
2492 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
2493 return (GetKeyState (vkey
) & 0x1);
2494 if (!modifiers_recorded
)
2495 return (GetKeyState (vkey
) & 0x8000);
2500 return modifiers
[EMACS_LCONTROL
];
2502 return modifiers
[EMACS_RCONTROL
];
2504 return modifiers
[EMACS_LMENU
];
2506 return modifiers
[EMACS_RMENU
];
2508 return (GetKeyState (vkey
) & 0x8000);
2511 /* Convert between the modifier bits W32 uses and the modifier bits
2515 w32_key_to_modifier (int key
)
2517 Lisp_Object key_mapping
;
2522 key_mapping
= Vw32_lwindow_modifier
;
2525 key_mapping
= Vw32_rwindow_modifier
;
2528 key_mapping
= Vw32_apps_modifier
;
2531 key_mapping
= Vw32_scroll_lock_modifier
;
2537 /* NB. This code runs in the input thread, asychronously to the lisp
2538 thread, so we must be careful to ensure access to lisp data is
2539 thread-safe. The following code is safe because the modifier
2540 variable values are updated atomically from lisp and symbols are
2541 not relocated by GC. Also, we don't have to worry about seeing GC
2543 if (EQ (key_mapping
, Qhyper
))
2544 return hyper_modifier
;
2545 if (EQ (key_mapping
, Qsuper
))
2546 return super_modifier
;
2547 if (EQ (key_mapping
, Qmeta
))
2548 return meta_modifier
;
2549 if (EQ (key_mapping
, Qalt
))
2550 return alt_modifier
;
2551 if (EQ (key_mapping
, Qctrl
))
2552 return ctrl_modifier
;
2553 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
2554 return ctrl_modifier
;
2555 if (EQ (key_mapping
, Qshift
))
2556 return shift_modifier
;
2558 /* Don't generate any modifier if not explicitly requested. */
2563 w32_get_modifiers ()
2565 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
2566 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
2567 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
2568 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
2569 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
2570 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
2571 (modifier_set (VK_MENU
) ?
2572 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
2575 /* We map the VK_* modifiers into console modifier constants
2576 so that we can use the same routines to handle both console
2577 and window input. */
2580 construct_console_modifiers ()
2585 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
2586 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
2587 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
2588 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
2589 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
2590 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
2591 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
2592 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
2593 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
2594 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
2595 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
2601 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
2605 /* Convert to emacs modifiers. */
2606 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
2612 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
2614 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
2617 if (virt_key
== VK_RETURN
)
2618 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
2620 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
2621 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
2623 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
2624 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
2626 if (virt_key
== VK_CLEAR
)
2627 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
2632 /* List of special key combinations which w32 would normally capture,
2633 but emacs should grab instead. Not directly visible to lisp, to
2634 simplify synchronization. Each item is an integer encoding a virtual
2635 key code and modifier combination to capture. */
2636 Lisp_Object w32_grabbed_keys
;
2638 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
2639 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2640 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2641 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2643 /* Register hot-keys for reserved key combinations when Emacs has
2644 keyboard focus, since this is the only way Emacs can receive key
2645 combinations like Alt-Tab which are used by the system. */
2648 register_hot_keys (hwnd
)
2651 Lisp_Object keylist
;
2653 /* Use GC_CONSP, since we are called asynchronously. */
2654 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
2656 Lisp_Object key
= XCAR (keylist
);
2658 /* Deleted entries get set to nil. */
2659 if (!INTEGERP (key
))
2662 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
2663 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
2668 unregister_hot_keys (hwnd
)
2671 Lisp_Object keylist
;
2673 /* Use GC_CONSP, since we are called asynchronously. */
2674 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
2676 Lisp_Object key
= XCAR (keylist
);
2678 if (!INTEGERP (key
))
2681 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
2685 /* Main message dispatch loop. */
2688 w32_msg_pump (deferred_msg
* msg_buf
)
2694 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
2696 while (GetMessage (&msg
, NULL
, 0, 0))
2698 if (msg
.hwnd
== NULL
)
2700 switch (msg
.message
)
2703 /* Produced by complete_deferred_msg; just ignore. */
2705 case WM_EMACS_CREATEWINDOW
:
2706 w32_createwindow ((struct frame
*) msg
.wParam
);
2707 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2710 case WM_EMACS_SETLOCALE
:
2711 SetThreadLocale (msg
.wParam
);
2712 /* Reply is not expected. */
2714 case WM_EMACS_SETKEYBOARDLAYOUT
:
2715 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
2716 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
2720 case WM_EMACS_REGISTER_HOT_KEY
:
2721 focus_window
= GetFocus ();
2722 if (focus_window
!= NULL
)
2723 RegisterHotKey (focus_window
,
2724 HOTKEY_ID (msg
.wParam
),
2725 HOTKEY_MODIFIERS (msg
.wParam
),
2726 HOTKEY_VK_CODE (msg
.wParam
));
2727 /* Reply is not expected. */
2729 case WM_EMACS_UNREGISTER_HOT_KEY
:
2730 focus_window
= GetFocus ();
2731 if (focus_window
!= NULL
)
2732 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
2733 /* Mark item as erased. NB: this code must be
2734 thread-safe. The next line is okay because the cons
2735 cell is never made into garbage and is not relocated by
2737 XSETCAR ((Lisp_Object
) msg
.lParam
, Qnil
);
2738 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2741 case WM_EMACS_TOGGLE_LOCK_KEY
:
2743 int vk_code
= (int) msg
.wParam
;
2744 int cur_state
= (GetKeyState (vk_code
) & 1);
2745 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
2747 /* NB: This code must be thread-safe. It is safe to
2748 call NILP because symbols are not relocated by GC,
2749 and pointer here is not touched by GC (so the markbit
2750 can't be set). Numbers are safe because they are
2751 immediate values. */
2752 if (NILP (new_state
)
2753 || (NUMBERP (new_state
)
2754 && ((XUINT (new_state
)) & 1) != cur_state
))
2756 one_w32_display_info
.faked_key
= vk_code
;
2758 keybd_event ((BYTE
) vk_code
,
2759 (BYTE
) MapVirtualKey (vk_code
, 0),
2760 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
2761 keybd_event ((BYTE
) vk_code
,
2762 (BYTE
) MapVirtualKey (vk_code
, 0),
2763 KEYEVENTF_EXTENDEDKEY
| 0, 0);
2764 keybd_event ((BYTE
) vk_code
,
2765 (BYTE
) MapVirtualKey (vk_code
, 0),
2766 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
2767 cur_state
= !cur_state
;
2769 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
2775 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
2780 DispatchMessage (&msg
);
2783 /* Exit nested loop when our deferred message has completed. */
2784 if (msg_buf
->completed
)
2789 deferred_msg
* deferred_msg_head
;
2791 static deferred_msg
*
2792 find_deferred_msg (HWND hwnd
, UINT msg
)
2794 deferred_msg
* item
;
2796 /* Don't actually need synchronization for read access, since
2797 modification of single pointer is always atomic. */
2798 /* enter_crit (); */
2800 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
2801 if (item
->w32msg
.msg
.hwnd
== hwnd
2802 && item
->w32msg
.msg
.message
== msg
)
2805 /* leave_crit (); */
2811 send_deferred_msg (deferred_msg
* msg_buf
,
2817 /* Only input thread can send deferred messages. */
2818 if (GetCurrentThreadId () != dwWindowsThreadId
)
2821 /* It is an error to send a message that is already deferred. */
2822 if (find_deferred_msg (hwnd
, msg
) != NULL
)
2825 /* Enforced synchronization is not needed because this is the only
2826 function that alters deferred_msg_head, and the following critical
2827 section is guaranteed to only be serially reentered (since only the
2828 input thread can call us). */
2830 /* enter_crit (); */
2832 msg_buf
->completed
= 0;
2833 msg_buf
->next
= deferred_msg_head
;
2834 deferred_msg_head
= msg_buf
;
2835 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
2837 /* leave_crit (); */
2839 /* Start a new nested message loop to process other messages until
2840 this one is completed. */
2841 w32_msg_pump (msg_buf
);
2843 deferred_msg_head
= msg_buf
->next
;
2845 return msg_buf
->result
;
2849 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
2851 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
2853 if (msg_buf
== NULL
)
2854 /* Message may have been cancelled, so don't abort(). */
2857 msg_buf
->result
= result
;
2858 msg_buf
->completed
= 1;
2860 /* Ensure input thread is woken so it notices the completion. */
2861 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
2865 cancel_all_deferred_msgs ()
2867 deferred_msg
* item
;
2869 /* Don't actually need synchronization for read access, since
2870 modification of single pointer is always atomic. */
2871 /* enter_crit (); */
2873 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
2876 item
->completed
= 1;
2879 /* leave_crit (); */
2881 /* Ensure input thread is woken so it notices the completion. */
2882 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
2890 deferred_msg dummy_buf
;
2892 /* Ensure our message queue is created */
2894 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
2896 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2899 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
2900 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
2901 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
2903 /* This is the inital message loop which should only exit when the
2904 application quits. */
2905 w32_msg_pump (&dummy_buf
);
2911 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
2921 wmsg
.dwModifiers
= modifiers
;
2923 /* Detect quit_char and set quit-flag directly. Note that we
2924 still need to post a message to ensure the main thread will be
2925 woken up if blocked in sys_select(), but we do NOT want to post
2926 the quit_char message itself (because it will usually be as if
2927 the user had typed quit_char twice). Instead, we post a dummy
2928 message that has no particular effect. */
2931 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
2932 c
= make_ctrl_char (c
) & 0377;
2934 || (wmsg
.dwModifiers
== 0 &&
2935 XFASTINT (Vw32_quit_key
) && wParam
== XFASTINT (Vw32_quit_key
)))
2939 /* The choice of message is somewhat arbitrary, as long as
2940 the main thread handler just ignores it. */
2943 /* Interrupt any blocking system calls. */
2946 /* As a safety precaution, forcibly complete any deferred
2947 messages. This is a kludge, but I don't see any particularly
2948 clean way to handle the situation where a deferred message is
2949 "dropped" in the lisp thread, and will thus never be
2950 completed, eg. by the user trying to activate the menubar
2951 when the lisp thread is busy, and then typing C-g when the
2952 menubar doesn't open promptly (with the result that the
2953 menubar never responds at all because the deferred
2954 WM_INITMENU message is never completed). Another problem
2955 situation is when the lisp thread calls SendMessage (to send
2956 a window manager command) when a message has been deferred;
2957 the lisp thread gets blocked indefinitely waiting for the
2958 deferred message to be completed, which itself is waiting for
2959 the lisp thread to respond.
2961 Note that we don't want to block the input thread waiting for
2962 a reponse from the lisp thread (although that would at least
2963 solve the deadlock problem above), because we want to be able
2964 to receive C-g to interrupt the lisp thread. */
2965 cancel_all_deferred_msgs ();
2969 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2972 /* Main window procedure */
2975 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
2982 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
2984 int windows_translate
;
2987 /* Note that it is okay to call x_window_to_frame, even though we are
2988 not running in the main lisp thread, because frame deletion
2989 requires the lisp thread to synchronize with this thread. Thus, if
2990 a frame struct is returned, it can be used without concern that the
2991 lisp thread might make it disappear while we are using it.
2993 NB. Walking the frame list in this thread is safe (as long as
2994 writes of Lisp_Object slots are atomic, which they are on Windows).
2995 Although delete-frame can destructively modify the frame list while
2996 we are walking it, a garbage collection cannot occur until after
2997 delete-frame has synchronized with this thread.
2999 It is also safe to use functions that make GDI calls, such as
3000 w32_clear_rect, because these functions must obtain a DC handle
3001 from the frame struct using get_frame_dc which is thread-aware. */
3006 f
= x_window_to_frame (dpyinfo
, hwnd
);
3009 HDC hdc
= get_frame_dc (f
);
3010 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
3011 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
3012 release_frame_dc (f
, hdc
);
3014 #if defined (W32_DEBUG_DISPLAY)
3015 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
3017 wmsg
.rect
.left
, wmsg
.rect
.top
,
3018 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
3019 #endif /* W32_DEBUG_DISPLAY */
3022 case WM_PALETTECHANGED
:
3023 /* ignore our own changes */
3024 if ((HWND
)wParam
!= hwnd
)
3026 f
= x_window_to_frame (dpyinfo
, hwnd
);
3028 /* get_frame_dc will realize our palette and force all
3029 frames to be redrawn if needed. */
3030 release_frame_dc (f
, get_frame_dc (f
));
3035 PAINTSTRUCT paintStruct
;
3037 bzero (&update_rect
, sizeof (update_rect
));
3039 f
= x_window_to_frame (dpyinfo
, hwnd
);
3042 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
3046 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
3047 fails. Apparently this can happen under some
3049 if (GetUpdateRect (hwnd
, &update_rect
, FALSE
) || !w32_strict_painting
)
3052 BeginPaint (hwnd
, &paintStruct
);
3054 /* The rectangles returned by GetUpdateRect and BeginPaint
3055 do not always match. Play it safe by assuming both areas
3057 UnionRect (&(wmsg
.rect
), &update_rect
, &(paintStruct
.rcPaint
));
3059 #if defined (W32_DEBUG_DISPLAY)
3060 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
3062 wmsg
.rect
.left
, wmsg
.rect
.top
,
3063 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
3064 DebPrint ((" [update region is %d,%d-%d,%d]\n",
3065 update_rect
.left
, update_rect
.top
,
3066 update_rect
.right
, update_rect
.bottom
));
3068 EndPaint (hwnd
, &paintStruct
);
3071 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3076 /* If GetUpdateRect returns 0 (meaning there is no update
3077 region), assume the whole window needs to be repainted. */
3078 GetClientRect(hwnd
, &wmsg
.rect
);
3079 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3083 case WM_INPUTLANGCHANGE
:
3084 /* Inform lisp thread of keyboard layout changes. */
3085 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3087 /* Clear dead keys in the keyboard state; for simplicity only
3088 preserve modifier key states. */
3093 GetKeyboardState (keystate
);
3094 for (i
= 0; i
< 256; i
++)
3111 SetKeyboardState (keystate
);
3116 /* Synchronize hot keys with normal input. */
3117 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
3122 record_keyup (wParam
, lParam
);
3127 /* Ignore keystrokes we fake ourself; see below. */
3128 if (dpyinfo
->faked_key
== wParam
)
3130 dpyinfo
->faked_key
= 0;
3131 /* Make sure TranslateMessage sees them though (as long as
3132 they don't produce WM_CHAR messages). This ensures that
3133 indicator lights are toggled promptly on Windows 9x, for
3135 if (lispy_function_keys
[wParam
] != 0)
3137 windows_translate
= 1;
3143 /* Synchronize modifiers with current keystroke. */
3145 record_keydown (wParam
, lParam
);
3146 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
3148 windows_translate
= 0;
3153 if (NILP (Vw32_pass_lwindow_to_system
))
3155 /* Prevent system from acting on keyup (which opens the
3156 Start menu if no other key was pressed) by simulating a
3157 press of Space which we will ignore. */
3158 if (GetAsyncKeyState (wParam
) & 1)
3160 if (NUMBERP (Vw32_phantom_key_code
))
3161 key
= XUINT (Vw32_phantom_key_code
) & 255;
3164 dpyinfo
->faked_key
= key
;
3165 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3168 if (!NILP (Vw32_lwindow_modifier
))
3172 if (NILP (Vw32_pass_rwindow_to_system
))
3174 if (GetAsyncKeyState (wParam
) & 1)
3176 if (NUMBERP (Vw32_phantom_key_code
))
3177 key
= XUINT (Vw32_phantom_key_code
) & 255;
3180 dpyinfo
->faked_key
= key
;
3181 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3184 if (!NILP (Vw32_rwindow_modifier
))
3188 if (!NILP (Vw32_apps_modifier
))
3192 if (NILP (Vw32_pass_alt_to_system
))
3193 /* Prevent DefWindowProc from activating the menu bar if an
3194 Alt key is pressed and released by itself. */
3196 windows_translate
= 1;
3199 /* Decide whether to treat as modifier or function key. */
3200 if (NILP (Vw32_enable_caps_lock
))
3201 goto disable_lock_key
;
3202 windows_translate
= 1;
3205 /* Decide whether to treat as modifier or function key. */
3206 if (NILP (Vw32_enable_num_lock
))
3207 goto disable_lock_key
;
3208 windows_translate
= 1;
3211 /* Decide whether to treat as modifier or function key. */
3212 if (NILP (Vw32_scroll_lock_modifier
))
3213 goto disable_lock_key
;
3214 windows_translate
= 1;
3217 /* Ensure the appropriate lock key state (and indicator light)
3218 remains in the same state. We do this by faking another
3219 press of the relevant key. Apparently, this really is the
3220 only way to toggle the state of the indicator lights. */
3221 dpyinfo
->faked_key
= wParam
;
3222 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3223 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3224 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3225 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3226 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3227 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3228 /* Ensure indicator lights are updated promptly on Windows 9x
3229 (TranslateMessage apparently does this), after forwarding
3231 post_character_message (hwnd
, msg
, wParam
, lParam
,
3232 w32_get_key_modifiers (wParam
, lParam
));
3233 windows_translate
= 1;
3237 case VK_PROCESSKEY
: /* Generated by IME. */
3238 windows_translate
= 1;
3241 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3242 which is confusing for purposes of key binding; convert
3243 VK_CANCEL events into VK_PAUSE events. */
3247 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3248 for purposes of key binding; convert these back into
3249 VK_NUMLOCK events, at least when we want to see NumLock key
3250 presses. (Note that there is never any possibility that
3251 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3252 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
3253 wParam
= VK_NUMLOCK
;
3256 /* If not defined as a function key, change it to a WM_CHAR message. */
3257 if (lispy_function_keys
[wParam
] == 0)
3259 DWORD modifiers
= construct_console_modifiers ();
3261 if (!NILP (Vw32_recognize_altgr
)
3262 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
3264 /* Always let TranslateMessage handle AltGr key chords;
3265 for some reason, ToAscii doesn't always process AltGr
3266 chords correctly. */
3267 windows_translate
= 1;
3269 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
3271 /* Handle key chords including any modifiers other
3272 than shift directly, in order to preserve as much
3273 modifier information as possible. */
3274 if ('A' <= wParam
&& wParam
<= 'Z')
3276 /* Don't translate modified alphabetic keystrokes,
3277 so the user doesn't need to constantly switch
3278 layout to type control or meta keystrokes when
3279 the normal layout translates alphabetic
3280 characters to non-ascii characters. */
3281 if (!modifier_set (VK_SHIFT
))
3282 wParam
+= ('a' - 'A');
3287 /* Try to handle other keystrokes by determining the
3288 base character (ie. translating the base key plus
3292 KEY_EVENT_RECORD key
;
3294 key
.bKeyDown
= TRUE
;
3295 key
.wRepeatCount
= 1;
3296 key
.wVirtualKeyCode
= wParam
;
3297 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
3298 key
.uChar
.AsciiChar
= 0;
3299 key
.dwControlKeyState
= modifiers
;
3301 add
= w32_kbd_patch_key (&key
);
3302 /* 0 means an unrecognised keycode, negative means
3303 dead key. Ignore both. */
3306 /* Forward asciified character sequence. */
3307 post_character_message
3308 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
3309 w32_get_key_modifiers (wParam
, lParam
));
3310 w32_kbd_patch_key (&key
);
3317 /* Let TranslateMessage handle everything else. */
3318 windows_translate
= 1;
3324 if (windows_translate
)
3326 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3328 windows_msg
.time
= GetMessageTime ();
3329 TranslateMessage (&windows_msg
);
3337 post_character_message (hwnd
, msg
, wParam
, lParam
,
3338 w32_get_key_modifiers (wParam
, lParam
));
3341 /* Simulate middle mouse button events when left and right buttons
3342 are used together, but only if user has two button mouse. */
3343 case WM_LBUTTONDOWN
:
3344 case WM_RBUTTONDOWN
:
3345 if (XINT (Vw32_num_mouse_buttons
) > 2)
3346 goto handle_plain_button
;
3349 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3350 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3352 if (button_state
& this)
3355 if (button_state
== 0)
3358 button_state
|= this;
3360 if (button_state
& other
)
3362 if (mouse_button_timer
)
3364 KillTimer (hwnd
, mouse_button_timer
);
3365 mouse_button_timer
= 0;
3367 /* Generate middle mouse event instead. */
3368 msg
= WM_MBUTTONDOWN
;
3369 button_state
|= MMOUSE
;
3371 else if (button_state
& MMOUSE
)
3373 /* Ignore button event if we've already generated a
3374 middle mouse down event. This happens if the
3375 user releases and press one of the two buttons
3376 after we've faked a middle mouse event. */
3381 /* Flush out saved message. */
3382 post_msg (&saved_mouse_button_msg
);
3384 wmsg
.dwModifiers
= w32_get_modifiers ();
3385 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3387 /* Clear message buffer. */
3388 saved_mouse_button_msg
.msg
.hwnd
= 0;
3392 /* Hold onto message for now. */
3393 mouse_button_timer
=
3394 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
3395 XINT (Vw32_mouse_button_tolerance
), NULL
);
3396 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3397 saved_mouse_button_msg
.msg
.message
= msg
;
3398 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3399 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3400 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3401 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
3408 if (XINT (Vw32_num_mouse_buttons
) > 2)
3409 goto handle_plain_button
;
3412 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3413 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3415 if ((button_state
& this) == 0)
3418 button_state
&= ~this;
3420 if (button_state
& MMOUSE
)
3422 /* Only generate event when second button is released. */
3423 if ((button_state
& other
) == 0)
3426 button_state
&= ~MMOUSE
;
3428 if (button_state
) abort ();
3435 /* Flush out saved message if necessary. */
3436 if (saved_mouse_button_msg
.msg
.hwnd
)
3438 post_msg (&saved_mouse_button_msg
);
3441 wmsg
.dwModifiers
= w32_get_modifiers ();
3442 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3444 /* Always clear message buffer and cancel timer. */
3445 saved_mouse_button_msg
.msg
.hwnd
= 0;
3446 KillTimer (hwnd
, mouse_button_timer
);
3447 mouse_button_timer
= 0;
3449 if (button_state
== 0)
3454 case WM_XBUTTONDOWN
:
3456 if (w32_pass_extra_mouse_buttons_to_system
)
3458 /* else fall through and process them. */
3459 case WM_MBUTTONDOWN
:
3461 handle_plain_button
:
3466 if (parse_button (msg
, HIWORD (wParam
), &button
, &up
))
3468 if (up
) ReleaseCapture ();
3469 else SetCapture (hwnd
);
3470 button
= (button
== 0) ? LMOUSE
:
3471 ((button
== 1) ? MMOUSE
: RMOUSE
);
3473 button_state
&= ~button
;
3475 button_state
|= button
;
3479 wmsg
.dwModifiers
= w32_get_modifiers ();
3480 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3482 /* Need to return true for XBUTTON messages, false for others,
3483 to indicate that we processed the message. */
3484 return (msg
== WM_XBUTTONDOWN
|| msg
== WM_XBUTTONUP
);
3487 /* If the mouse has just moved into the frame, start tracking
3488 it, so we will be notified when it leaves the frame. Mouse
3489 tracking only works under W98 and NT4 and later. On earlier
3490 versions, there is no way of telling when the mouse leaves the
3491 frame, so we just have to put up with help-echo and mouse
3492 highlighting remaining while the frame is not active. */
3493 if (track_mouse_event_fn
&& !track_mouse_window
)
3495 TRACKMOUSEEVENT tme
;
3496 tme
.cbSize
= sizeof (tme
);
3497 tme
.dwFlags
= TME_LEAVE
;
3498 tme
.hwndTrack
= hwnd
;
3500 track_mouse_event_fn (&tme
);
3501 track_mouse_window
= hwnd
;
3504 if (XINT (Vw32_mouse_move_interval
) <= 0
3505 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
3507 wmsg
.dwModifiers
= w32_get_modifiers ();
3508 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3512 /* Hang onto mouse move and scroll messages for a bit, to avoid
3513 sending such events to Emacs faster than it can process them.
3514 If we get more events before the timer from the first message
3515 expires, we just replace the first message. */
3517 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
3519 SetTimer (hwnd
, MOUSE_MOVE_ID
,
3520 XINT (Vw32_mouse_move_interval
), NULL
);
3522 /* Hold onto message for now. */
3523 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
3524 saved_mouse_move_msg
.msg
.message
= msg
;
3525 saved_mouse_move_msg
.msg
.wParam
= wParam
;
3526 saved_mouse_move_msg
.msg
.lParam
= lParam
;
3527 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
3528 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
3533 wmsg
.dwModifiers
= w32_get_modifiers ();
3534 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3538 wmsg
.dwModifiers
= w32_get_modifiers ();
3539 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3543 /* Flush out saved messages if necessary. */
3544 if (wParam
== mouse_button_timer
)
3546 if (saved_mouse_button_msg
.msg
.hwnd
)
3548 post_msg (&saved_mouse_button_msg
);
3549 saved_mouse_button_msg
.msg
.hwnd
= 0;
3551 KillTimer (hwnd
, mouse_button_timer
);
3552 mouse_button_timer
= 0;
3554 else if (wParam
== mouse_move_timer
)
3556 if (saved_mouse_move_msg
.msg
.hwnd
)
3558 post_msg (&saved_mouse_move_msg
);
3559 saved_mouse_move_msg
.msg
.hwnd
= 0;
3561 KillTimer (hwnd
, mouse_move_timer
);
3562 mouse_move_timer
= 0;
3564 else if (wParam
== menu_free_timer
)
3566 KillTimer (hwnd
, menu_free_timer
);
3567 menu_free_timer
= 0;
3568 f
= x_window_to_frame (dpyinfo
, hwnd
);
3569 if (!f
->output_data
.w32
->menu_command_in_progress
)
3571 /* Free memory used by owner-drawn and help-echo strings. */
3572 w32_free_menu_strings (hwnd
);
3573 f
->output_data
.w32
->menubar_active
= 0;
3579 /* Windows doesn't send us focus messages when putting up and
3580 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3581 The only indication we get that something happened is receiving
3582 this message afterwards. So this is a good time to reset our
3583 keyboard modifiers' state. */
3590 /* We must ensure menu bar is fully constructed and up to date
3591 before allowing user interaction with it. To achieve this
3592 we send this message to the lisp thread and wait for a
3593 reply (whose value is not actually needed) to indicate that
3594 the menu bar is now ready for use, so we can now return.
3596 To remain responsive in the meantime, we enter a nested message
3597 loop that can process all other messages.
3599 However, we skip all this if the message results from calling
3600 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3601 thread a message because it is blocked on us at this point. We
3602 set menubar_active before calling TrackPopupMenu to indicate
3603 this (there is no possibility of confusion with real menubar
3606 f
= x_window_to_frame (dpyinfo
, hwnd
);
3608 && (f
->output_data
.w32
->menubar_active
3609 /* We can receive this message even in the absence of a
3610 menubar (ie. when the system menu is activated) - in this
3611 case we do NOT want to forward the message, otherwise it
3612 will cause the menubar to suddenly appear when the user
3613 had requested it to be turned off! */
3614 || f
->output_data
.w32
->menubar_widget
== NULL
))
3618 deferred_msg msg_buf
;
3620 /* Detect if message has already been deferred; in this case
3621 we cannot return any sensible value to ignore this. */
3622 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3625 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
3628 case WM_EXITMENULOOP
:
3629 f
= x_window_to_frame (dpyinfo
, hwnd
);
3631 /* If a menu command is not already in progress, check again
3632 after a short delay, since Windows often (always?) sends the
3633 WM_EXITMENULOOP before the corresponding WM_COMMAND message. */
3634 if (f
&& !f
->output_data
.w32
->menu_command_in_progress
)
3635 menu_free_timer
= SetTimer (hwnd
, MENU_FREE_ID
, MENU_FREE_DELAY
, NULL
);
3639 /* Direct handling of help_echo in menus. Should be safe now
3640 that we generate the help_echo by placing a help event in the
3643 HMENU menu
= (HMENU
) lParam
;
3644 UINT menu_item
= (UINT
) LOWORD (wParam
);
3645 UINT flags
= (UINT
) HIWORD (wParam
);
3647 w32_menu_display_help (hwnd
, menu
, menu_item
, flags
);
3651 case WM_MEASUREITEM
:
3652 f
= x_window_to_frame (dpyinfo
, hwnd
);
3655 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
3657 if (pMis
->CtlType
== ODT_MENU
)
3659 /* Work out dimensions for popup menu titles. */
3660 char * title
= (char *) pMis
->itemData
;
3661 HDC hdc
= GetDC (hwnd
);
3662 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3663 LOGFONT menu_logfont
;
3667 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3668 menu_logfont
.lfWeight
= FW_BOLD
;
3669 menu_font
= CreateFontIndirect (&menu_logfont
);
3670 old_font
= SelectObject (hdc
, menu_font
);
3672 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
3675 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
3676 pMis
->itemWidth
= size
.cx
;
3677 if (pMis
->itemHeight
< size
.cy
)
3678 pMis
->itemHeight
= size
.cy
;
3681 pMis
->itemWidth
= 0;
3683 SelectObject (hdc
, old_font
);
3684 DeleteObject (menu_font
);
3685 ReleaseDC (hwnd
, hdc
);
3692 f
= x_window_to_frame (dpyinfo
, hwnd
);
3695 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
3697 if (pDis
->CtlType
== ODT_MENU
)
3699 /* Draw popup menu title. */
3700 char * title
= (char *) pDis
->itemData
;
3703 HDC hdc
= pDis
->hDC
;
3704 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3705 LOGFONT menu_logfont
;
3708 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3709 menu_logfont
.lfWeight
= FW_BOLD
;
3710 menu_font
= CreateFontIndirect (&menu_logfont
);
3711 old_font
= SelectObject (hdc
, menu_font
);
3713 /* Always draw title as if not selected. */
3716 + GetSystemMetrics (SM_CXMENUCHECK
),
3718 ETO_OPAQUE
, &pDis
->rcItem
,
3719 title
, strlen (title
), NULL
);
3721 SelectObject (hdc
, old_font
);
3722 DeleteObject (menu_font
);
3730 /* Still not right - can't distinguish between clicks in the
3731 client area of the frame from clicks forwarded from the scroll
3732 bars - may have to hook WM_NCHITTEST to remember the mouse
3733 position and then check if it is in the client area ourselves. */
3734 case WM_MOUSEACTIVATE
:
3735 /* Discard the mouse click that activates a frame, allowing the
3736 user to click anywhere without changing point (or worse!).
3737 Don't eat mouse clicks on scrollbars though!! */
3738 if (LOWORD (lParam
) == HTCLIENT
)
3739 return MA_ACTIVATEANDEAT
;
3744 /* No longer tracking mouse. */
3745 track_mouse_window
= NULL
;
3747 case WM_ACTIVATEAPP
:
3749 case WM_WINDOWPOSCHANGED
:
3751 /* Inform lisp thread that a frame might have just been obscured
3752 or exposed, so should recheck visibility of all frames. */
3753 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3757 dpyinfo
->faked_key
= 0;
3759 register_hot_keys (hwnd
);
3762 unregister_hot_keys (hwnd
);
3765 /* Relinquish the system caret. */
3766 if (w32_system_caret_hwnd
)
3768 w32_visible_system_caret_hwnd
= NULL
;
3769 w32_system_caret_hwnd
= NULL
;
3774 f
= x_window_to_frame (dpyinfo
, hwnd
);
3775 if (f
&& HIWORD (wParam
) == 0)
3777 f
->output_data
.w32
->menu_command_in_progress
= 1;
3778 if (menu_free_timer
)
3780 KillTimer (hwnd
, menu_free_timer
);
3781 menu_free_timer
= 0;
3787 wmsg
.dwModifiers
= w32_get_modifiers ();
3788 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3792 wmsg
.dwModifiers
= w32_get_modifiers ();
3793 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3796 case WM_WINDOWPOSCHANGING
:
3797 /* Don't restrict the sizing of tip frames. */
3798 if (hwnd
== tip_window
)
3802 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3804 wp
.length
= sizeof (WINDOWPLACEMENT
);
3805 GetWindowPlacement (hwnd
, &wp
);
3807 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
3814 DWORD internal_border
;
3815 DWORD scrollbar_extra
;
3818 wp
.length
= sizeof(wp
);
3819 GetWindowRect (hwnd
, &wr
);
3823 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
3824 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
3825 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
3826 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
3830 memset (&rect
, 0, sizeof (rect
));
3831 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3832 GetMenu (hwnd
) != NULL
);
3834 /* Force width and height of client area to be exact
3835 multiples of the character cell dimensions. */
3836 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
3837 - 2 * internal_border
- scrollbar_extra
)
3839 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
3840 - 2 * internal_border
)
3845 /* For right/bottom sizing we can just fix the sizes.
3846 However for top/left sizing we will need to fix the X
3847 and Y positions as well. */
3852 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3853 && (lppos
->flags
& SWP_NOMOVE
) == 0)
3855 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3862 lppos
->flags
|= SWP_NOMOVE
;
3873 case WM_GETMINMAXINFO
:
3874 /* Hack to correct bug that allows Emacs frames to be resized
3875 below the Minimum Tracking Size. */
3876 ((LPMINMAXINFO
) lParam
)->ptMinTrackSize
.y
++;
3877 /* Hack to allow resizing the Emacs frame above the screen size.
3878 Note that Windows 9x limits coordinates to 16-bits. */
3879 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
3880 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
3884 if (LOWORD (lParam
) == HTCLIENT
)
3889 case WM_EMACS_SETCURSOR
:
3891 Cursor cursor
= (Cursor
) wParam
;
3897 case WM_EMACS_CREATESCROLLBAR
:
3898 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
3899 (struct scroll_bar
*) lParam
);
3901 case WM_EMACS_SHOWWINDOW
:
3902 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
3904 case WM_EMACS_SETFOREGROUND
:
3906 HWND foreground_window
;
3907 DWORD foreground_thread
, retval
;
3909 /* On NT 5.0, and apparently Windows 98, it is necessary to
3910 attach to the thread that currently has focus in order to
3911 pull the focus away from it. */
3912 foreground_window
= GetForegroundWindow ();
3913 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
3914 if (!foreground_window
3915 || foreground_thread
== GetCurrentThreadId ()
3916 || !AttachThreadInput (GetCurrentThreadId (),
3917 foreground_thread
, TRUE
))
3918 foreground_thread
= 0;
3920 retval
= SetForegroundWindow ((HWND
) wParam
);
3922 /* Detach from the previous foreground thread. */
3923 if (foreground_thread
)
3924 AttachThreadInput (GetCurrentThreadId (),
3925 foreground_thread
, FALSE
);
3930 case WM_EMACS_SETWINDOWPOS
:
3932 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
3933 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
3934 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3937 case WM_EMACS_DESTROYWINDOW
:
3938 DragAcceptFiles ((HWND
) wParam
, FALSE
);
3939 return DestroyWindow ((HWND
) wParam
);
3941 case WM_EMACS_HIDE_CARET
:
3942 return HideCaret (hwnd
);
3944 case WM_EMACS_SHOW_CARET
:
3945 return ShowCaret (hwnd
);
3947 case WM_EMACS_DESTROY_CARET
:
3948 w32_system_caret_hwnd
= NULL
;
3949 w32_visible_system_caret_hwnd
= NULL
;
3950 return DestroyCaret ();
3952 case WM_EMACS_TRACK_CARET
:
3953 /* If there is currently no system caret, create one. */
3954 if (w32_system_caret_hwnd
== NULL
)
3956 /* Use the default caret width, and avoid changing it
3957 unneccesarily, as it confuses screen reader software. */
3958 w32_system_caret_hwnd
= hwnd
;
3959 CreateCaret (hwnd
, NULL
, 0,
3960 w32_system_caret_height
);
3963 if (!SetCaretPos (w32_system_caret_x
, w32_system_caret_y
))
3965 /* Ensure visible caret gets turned on when requested. */
3966 else if (w32_use_visible_system_caret
3967 && w32_visible_system_caret_hwnd
!= hwnd
)
3969 w32_visible_system_caret_hwnd
= hwnd
;
3970 return ShowCaret (hwnd
);
3972 /* Ensure visible caret gets turned off when requested. */
3973 else if (!w32_use_visible_system_caret
3974 && w32_visible_system_caret_hwnd
)
3976 w32_visible_system_caret_hwnd
= NULL
;
3977 return HideCaret (hwnd
);
3982 case WM_EMACS_TRACKPOPUPMENU
:
3987 pos
= (POINT
*)lParam
;
3988 flags
= TPM_CENTERALIGN
;
3989 if (button_state
& LMOUSE
)
3990 flags
|= TPM_LEFTBUTTON
;
3991 else if (button_state
& RMOUSE
)
3992 flags
|= TPM_RIGHTBUTTON
;
3994 /* Remember we did a SetCapture on the initial mouse down event,
3995 so for safety, we make sure the capture is cancelled now. */
3999 /* Use menubar_active to indicate that WM_INITMENU is from
4000 TrackPopupMenu below, and should be ignored. */
4001 f
= x_window_to_frame (dpyinfo
, hwnd
);
4003 f
->output_data
.w32
->menubar_active
= 1;
4005 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
4009 /* Eat any mouse messages during popupmenu */
4010 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
4012 /* Get the menu selection, if any */
4013 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
4015 retval
= LOWORD (amsg
.wParam
);
4031 /* Check for messages registered at runtime. */
4032 if (msg
== msh_mousewheel
)
4034 wmsg
.dwModifiers
= w32_get_modifiers ();
4035 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4040 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
4044 /* The most common default return code for handled messages is 0. */
4049 my_create_window (f
)
4054 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
4056 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
4060 /* Create a tooltip window. Unlike my_create_window, we do not do this
4061 indirectly via the Window thread, as we do not need to process Window
4062 messages for the tooltip. Creating tooltips indirectly also creates
4063 deadlocks when tooltips are created for menu items. */
4065 my_create_tip_window (f
)
4070 rect
.left
= rect
.top
= 0;
4071 rect
.right
= FRAME_PIXEL_WIDTH (f
);
4072 rect
.bottom
= FRAME_PIXEL_HEIGHT (f
);
4074 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
4075 FRAME_EXTERNAL_MENU_BAR (f
));
4077 tip_window
= FRAME_W32_WINDOW (f
)
4078 = CreateWindow (EMACS_CLASS
,
4080 f
->output_data
.w32
->dwStyle
,
4083 rect
.right
- rect
.left
,
4084 rect
.bottom
- rect
.top
,
4085 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4092 SetWindowLong (tip_window
, WND_FONTWIDTH_INDEX
, FRAME_COLUMN_WIDTH (f
));
4093 SetWindowLong (tip_window
, WND_LINEHEIGHT_INDEX
, FRAME_LINE_HEIGHT (f
));
4094 SetWindowLong (tip_window
, WND_BORDER_INDEX
, FRAME_INTERNAL_BORDER_WIDTH (f
));
4095 SetWindowLong (tip_window
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
4097 /* Tip frames have no scrollbars. */
4098 SetWindowLong (tip_window
, WND_SCROLLBAR_INDEX
, 0);
4100 /* Do this to discard the default setting specified by our parent. */
4101 ShowWindow (tip_window
, SW_HIDE
);
4106 /* Create and set up the w32 window for frame F. */
4109 w32_window (f
, window_prompting
, minibuffer_only
)
4111 long window_prompting
;
4112 int minibuffer_only
;
4116 /* Use the resource name as the top-level window name
4117 for looking up resources. Make a non-Lisp copy
4118 for the window manager, so GC relocation won't bother it.
4120 Elsewhere we specify the window name for the window manager. */
4123 char *str
= (char *) SDATA (Vx_resource_name
);
4124 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
4125 strcpy (f
->namebuf
, str
);
4128 my_create_window (f
);
4130 validate_x_resource_name ();
4132 /* x_set_name normally ignores requests to set the name if the
4133 requested name is the same as the current name. This is the one
4134 place where that assumption isn't correct; f->name is set, but
4135 the server hasn't been told. */
4138 int explicit = f
->explicit_name
;
4140 f
->explicit_name
= 0;
4143 x_set_name (f
, name
, explicit);
4148 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4149 initialize_frame_menubar (f
);
4151 if (FRAME_W32_WINDOW (f
) == 0)
4152 error ("Unable to create window");
4155 /* Handle the icon stuff for this window. Perhaps later we might
4156 want an x_set_icon_position which can be called interactively as
4164 Lisp_Object icon_x
, icon_y
;
4166 /* Set the position of the icon. Note that Windows 95 groups all
4167 icons in the tray. */
4168 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
4169 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
4170 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4172 CHECK_NUMBER (icon_x
);
4173 CHECK_NUMBER (icon_y
);
4175 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4176 error ("Both left and top icon corners of icon must be specified");
4180 if (! EQ (icon_x
, Qunbound
))
4181 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4184 /* Start up iconic or window? */
4185 x_wm_set_window_state
4186 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
4190 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
4203 XGCValues gc_values
;
4207 /* Create the GC's of this frame.
4208 Note that many default values are used. */
4211 gc_values
.font
= FRAME_FONT (f
);
4213 /* Cursor has cursor-color background, background-color foreground. */
4214 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
4215 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
4216 f
->output_data
.w32
->cursor_gc
4217 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
4218 (GCFont
| GCForeground
| GCBackground
),
4222 f
->output_data
.w32
->white_relief
.gc
= 0;
4223 f
->output_data
.w32
->black_relief
.gc
= 0;
4229 /* Handler for signals raised during x_create_frame and
4230 x_create_top_frame. FRAME is the frame which is partially
4234 unwind_create_frame (frame
)
4237 struct frame
*f
= XFRAME (frame
);
4239 /* If frame is ``official'', nothing to do. */
4240 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4243 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4246 x_free_frame_resources (f
);
4248 /* Check that reference counts are indeed correct. */
4249 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4250 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4259 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4261 doc
: /* Make a new window, which is called a \"frame\" in Emacs terms.
4262 Returns an Emacs frame object.
4263 ALIST is an alist of frame parameters.
4264 If the parameters specify that the frame should not have a minibuffer,
4265 and do not specify a specific minibuffer window to use,
4266 then `default-minibuffer-frame' must be a frame whose minibuffer can
4267 be shared by the new frame.
4269 This function is an internal primitive--use `make-frame' instead. */)
4274 Lisp_Object frame
, tem
;
4276 int minibuffer_only
= 0;
4277 long window_prompting
= 0;
4279 int count
= SPECPDL_INDEX ();
4280 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4281 Lisp_Object display
;
4282 struct w32_display_info
*dpyinfo
= NULL
;
4288 /* Use this general default value to start with
4289 until we know if this frame has a specified name. */
4290 Vx_resource_name
= Vinvocation_name
;
4292 display
= w32_get_arg (parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4293 if (EQ (display
, Qunbound
))
4295 dpyinfo
= check_x_display_info (display
);
4297 kb
= dpyinfo
->kboard
;
4299 kb
= &the_only_kboard
;
4302 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4304 && ! EQ (name
, Qunbound
)
4306 error ("Invalid frame name--not a string or nil");
4309 Vx_resource_name
= name
;
4311 /* See if parent window is specified. */
4312 parent
= w32_get_arg (parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4313 if (EQ (parent
, Qunbound
))
4315 if (! NILP (parent
))
4316 CHECK_NUMBER (parent
);
4318 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4319 /* No need to protect DISPLAY because that's not used after passing
4320 it to make_frame_without_minibuffer. */
4322 GCPRO4 (parms
, parent
, name
, frame
);
4323 tem
= w32_get_arg (parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4325 if (EQ (tem
, Qnone
) || NILP (tem
))
4326 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4327 else if (EQ (tem
, Qonly
))
4329 f
= make_minibuffer_frame ();
4330 minibuffer_only
= 1;
4332 else if (WINDOWP (tem
))
4333 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4337 XSETFRAME (frame
, f
);
4339 /* Note that Windows does support scroll bars. */
4340 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4342 /* By default, make scrollbars the system standard width. */
4343 FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
4345 f
->output_method
= output_w32
;
4346 f
->output_data
.w32
=
4347 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
4348 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
4349 FRAME_FONTSET (f
) = -1;
4350 record_unwind_protect (unwind_create_frame
, frame
);
4353 = w32_get_arg (parms
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
4354 if (! STRINGP (f
->icon_name
))
4355 f
->icon_name
= Qnil
;
4357 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4359 FRAME_KBOARD (f
) = kb
;
4362 /* Specify the parent under which to make this window. */
4366 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
4367 f
->output_data
.w32
->explicit_parent
= 1;
4371 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4372 f
->output_data
.w32
->explicit_parent
= 0;
4375 /* Set the name; the functions to which we pass f expect the name to
4377 if (EQ (name
, Qunbound
) || NILP (name
))
4379 f
->name
= build_string (dpyinfo
->w32_id_name
);
4380 f
->explicit_name
= 0;
4385 f
->explicit_name
= 1;
4386 /* use the frame's title when getting resources for this frame. */
4387 specbind (Qx_resource_name
, name
);
4390 /* Extract the window parameters from the supplied values
4391 that are needed to determine window geometry. */
4395 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4398 /* First, try whatever font the caller has specified. */
4401 tem
= Fquery_fontset (font
, Qnil
);
4403 font
= x_new_fontset (f
, SDATA (tem
));
4405 font
= x_new_font (f
, SDATA (font
));
4407 /* Try out a font which we hope has bold and italic variations. */
4408 if (!STRINGP (font
))
4409 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
4410 if (! STRINGP (font
))
4411 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4412 /* If those didn't work, look for something which will at least work. */
4413 if (! STRINGP (font
))
4414 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
4416 if (! STRINGP (font
))
4417 font
= build_string ("Fixedsys");
4419 x_default_parameter (f
, parms
, Qfont
, font
,
4420 "font", "Font", RES_TYPE_STRING
);
4423 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4424 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4425 /* This defaults to 2 in order to match xterm. We recognize either
4426 internalBorderWidth or internalBorder (which is what xterm calls
4428 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4432 value
= w32_get_arg (parms
, Qinternal_border_width
,
4433 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
4434 if (! EQ (value
, Qunbound
))
4435 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4438 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4439 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
4440 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
4441 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qright
,
4442 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
4444 /* Also do the stuff which must be set before the window exists. */
4445 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4446 "foreground", "Foreground", RES_TYPE_STRING
);
4447 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4448 "background", "Background", RES_TYPE_STRING
);
4449 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4450 "pointerColor", "Foreground", RES_TYPE_STRING
);
4451 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4452 "cursorColor", "Foreground", RES_TYPE_STRING
);
4453 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4454 "borderColor", "BorderColor", RES_TYPE_STRING
);
4455 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4456 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4457 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4458 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4459 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
4460 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
4461 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
4462 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
4465 /* Init faces before x_default_parameter is called for scroll-bar
4466 parameters because that function calls x_set_scroll_bar_width,
4467 which calls change_frame_size, which calls Fset_window_buffer,
4468 which runs hooks, which call Fvertical_motion. At the end, we
4469 end up in init_iterator with a null face cache, which should not
4471 init_frame_faces (f
);
4473 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4474 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4475 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4476 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4478 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4479 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
4480 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4481 "title", "Title", RES_TYPE_STRING
);
4482 x_default_parameter (f
, parms
, Qfullscreen
, Qnil
,
4483 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
4485 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
4486 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4488 f
->output_data
.w32
->text_cursor
= w32_load_cursor (IDC_IBEAM
);
4489 f
->output_data
.w32
->nontext_cursor
= w32_load_cursor (IDC_ARROW
);
4490 f
->output_data
.w32
->modeline_cursor
= w32_load_cursor (IDC_ARROW
);
4491 f
->output_data
.w32
->hand_cursor
= w32_load_cursor (IDC_HAND
);
4492 f
->output_data
.w32
->hourglass_cursor
= w32_load_cursor (IDC_WAIT
);
4493 f
->output_data
.w32
->horizontal_drag_cursor
= w32_load_cursor (IDC_SIZEWE
);
4495 window_prompting
= x_figure_window_size (f
, parms
, 1);
4497 tem
= w32_get_arg (parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4498 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4500 w32_window (f
, window_prompting
, minibuffer_only
);
4505 /* Now consider the frame official. */
4506 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
4507 Vframe_list
= Fcons (frame
, Vframe_list
);
4509 /* We need to do this after creating the window, so that the
4510 icon-creation functions can say whose icon they're describing. */
4511 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4512 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4514 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4515 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4516 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4517 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4518 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4519 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4520 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4521 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
4523 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4524 Change will not be effected unless different from the current
4526 width
= FRAME_COLS (f
);
4527 height
= FRAME_LINES (f
);
4529 FRAME_LINES (f
) = 0;
4530 SET_FRAME_COLS (f
, 0);
4531 change_frame_size (f
, height
, width
, 1, 0, 0);
4533 /* Tell the server what size and position, etc, we want, and how
4534 badly we want them. This should be done after we have the menu
4535 bar so that its size can be taken into account. */
4537 x_wm_set_size_hint (f
, window_prompting
, 0);
4540 /* Avoid a bug that causes the new frame to never become visible if
4541 an echo area message is displayed during the following call1. */
4542 specbind(Qredisplay_dont_pause
, Qt
);
4544 /* Set up faces after all frame parameters are known. This call
4545 also merges in face attributes specified for new frames. If we
4546 don't do this, the `menu' face for instance won't have the right
4547 colors, and the menu bar won't appear in the specified colors for
4549 call1 (Qface_set_after_frame_default
, frame
);
4551 /* Make the window appear on the frame and enable display, unless
4552 the caller says not to. However, with explicit parent, Emacs
4553 cannot control visibility, so don't try. */
4554 if (! f
->output_data
.w32
->explicit_parent
)
4556 Lisp_Object visibility
;
4558 visibility
= w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
4559 if (EQ (visibility
, Qunbound
))
4562 if (EQ (visibility
, Qicon
))
4563 x_iconify_frame (f
);
4564 else if (! NILP (visibility
))
4565 x_make_frame_visible (f
);
4567 /* Must have been Qnil. */
4572 /* Make sure windows on this frame appear in calls to next-window
4573 and similar functions. */
4574 Vwindow_list
= Qnil
;
4576 return unbind_to (count
, frame
);
4579 /* FRAME is used only to get a handle on the X display. We don't pass the
4580 display info directly because we're called from frame.c, which doesn't
4581 know about that structure. */
4583 x_get_focus_frame (frame
)
4584 struct frame
*frame
;
4586 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
4588 if (! dpyinfo
->w32_focus_frame
)
4591 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
4595 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
4596 doc
: /* Give FRAME input focus, raising to foreground if necessary. */)
4600 x_focus_on_frame (check_x_frame (frame
));
4605 /* Return the charset portion of a font name. */
4606 char * xlfd_charset_of_font (char * fontname
)
4608 char *charset
, *encoding
;
4610 encoding
= strrchr(fontname
, '-');
4611 if (!encoding
|| encoding
== fontname
)
4614 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
4615 if (*charset
== '-')
4618 if (charset
== fontname
|| strcmp(charset
, "-*-*") == 0)
4624 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
4625 int size
, char* filename
);
4626 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
4627 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
4629 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
4631 static struct font_info
*
4632 w32_load_system_font (f
,fontname
,size
)
4637 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4638 Lisp_Object font_names
;
4640 /* Get a list of all the fonts that match this name. Once we
4641 have a list of matching fonts, we compare them against the fonts
4642 we already have loaded by comparing names. */
4643 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
4645 if (!NILP (font_names
))
4650 /* First check if any are already loaded, as that is cheaper
4651 than loading another one. */
4652 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4653 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
4654 if (dpyinfo
->font_table
[i
].name
4655 && (!strcmp (dpyinfo
->font_table
[i
].name
,
4656 SDATA (XCAR (tail
)))
4657 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
4658 SDATA (XCAR (tail
)))))
4659 return (dpyinfo
->font_table
+ i
);
4661 fontname
= (char *) SDATA (XCAR (font_names
));
4663 else if (w32_strict_fontnames
)
4665 /* If EnumFontFamiliesEx was available, we got a full list of
4666 fonts back so stop now to avoid the possibility of loading a
4667 random font. If we had to fall back to EnumFontFamilies, the
4668 list is incomplete, so continue whether the font we want was
4670 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
4671 FARPROC enum_font_families_ex
4672 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
4673 if (enum_font_families_ex
)
4677 /* Load the font and add it to the table. */
4679 char *full_name
, *encoding
, *charset
;
4681 struct font_info
*fontp
;
4687 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
4690 if (!*lf
.lfFaceName
)
4691 /* If no name was specified for the font, we get a random font
4692 from CreateFontIndirect - this is not particularly
4693 desirable, especially since CreateFontIndirect does not
4694 fill out the missing name in lf, so we never know what we
4698 lf
.lfQuality
= DEFAULT_QUALITY
;
4700 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
4701 bzero (font
, sizeof (*font
));
4703 /* Set bdf to NULL to indicate that this is a Windows font. */
4708 font
->hfont
= CreateFontIndirect (&lf
);
4710 if (font
->hfont
== NULL
)
4719 codepage
= w32_codepage_for_font (fontname
);
4721 hdc
= GetDC (dpyinfo
->root_window
);
4722 oldobj
= SelectObject (hdc
, font
->hfont
);
4724 ok
= GetTextMetrics (hdc
, &font
->tm
);
4725 if (codepage
== CP_UNICODE
)
4726 font
->double_byte_p
= 1;
4729 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
4730 don't report themselves as double byte fonts, when
4731 patently they are. So instead of trusting
4732 GetFontLanguageInfo, we check the properties of the
4733 codepage directly, since that is ultimately what we are
4734 working from anyway. */
4735 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
4737 GetCPInfo (codepage
, &cpi
);
4738 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
4741 SelectObject (hdc
, oldobj
);
4742 ReleaseDC (dpyinfo
->root_window
, hdc
);
4743 /* Fill out details in lf according to the font that was
4745 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
4746 lf
.lfWidth
= font
->tm
.tmAveCharWidth
;
4747 lf
.lfWeight
= font
->tm
.tmWeight
;
4748 lf
.lfItalic
= font
->tm
.tmItalic
;
4749 lf
.lfCharSet
= font
->tm
.tmCharSet
;
4750 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
4751 ? VARIABLE_PITCH
: FIXED_PITCH
);
4752 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
4753 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
4755 w32_cache_char_metrics (font
);
4762 w32_unload_font (dpyinfo
, font
);
4766 /* Find a free slot in the font table. */
4767 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
4768 if (dpyinfo
->font_table
[i
].name
== NULL
)
4771 /* If no free slot found, maybe enlarge the font table. */
4772 if (i
== dpyinfo
->n_fonts
4773 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
4776 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
4777 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
4779 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
4782 fontp
= dpyinfo
->font_table
+ i
;
4783 if (i
== dpyinfo
->n_fonts
)
4786 /* Now fill in the slots of *FONTP. */
4788 bzero (fontp
, sizeof (*fontp
));
4790 fontp
->font_idx
= i
;
4791 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
4792 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
4794 charset
= xlfd_charset_of_font (fontname
);
4796 /* Cache the W32 codepage for a font. This makes w32_encode_char
4797 (called for every glyph during redisplay) much faster. */
4798 fontp
->codepage
= codepage
;
4800 /* Work out the font's full name. */
4801 full_name
= (char *)xmalloc (100);
4802 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
4803 fontp
->full_name
= full_name
;
4806 /* If all else fails - just use the name we used to load it. */
4808 fontp
->full_name
= fontp
->name
;
4811 fontp
->size
= FONT_WIDTH (font
);
4812 fontp
->height
= FONT_HEIGHT (font
);
4814 /* The slot `encoding' specifies how to map a character
4815 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
4816 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
4817 (0:0x20..0x7F, 1:0xA0..0xFF,
4818 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4819 2:0xA020..0xFF7F). For the moment, we don't know which charset
4820 uses this font. So, we set information in fontp->encoding[1]
4821 which is never used by any charset. If mapping can't be
4822 decided, set FONT_ENCODING_NOT_DECIDED. */
4824 /* SJIS fonts need to be set to type 4, all others seem to work as
4825 type FONT_ENCODING_NOT_DECIDED. */
4826 encoding
= strrchr (fontp
->name
, '-');
4827 if (encoding
&& strnicmp (encoding
+1, "sjis", 4) == 0)
4828 fontp
->encoding
[1] = 4;
4830 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
4832 /* The following three values are set to 0 under W32, which is
4833 what they get set to if XGetFontProperty fails under X. */
4834 fontp
->baseline_offset
= 0;
4835 fontp
->relative_compose
= 0;
4836 fontp
->default_ascent
= 0;
4838 /* Set global flag fonts_changed_p to non-zero if the font loaded
4839 has a character with a smaller width than any other character
4840 before, or if the font loaded has a smaller height than any
4841 other font loaded before. If this happens, it will make a
4842 glyph matrix reallocation necessary. */
4843 fonts_changed_p
|= x_compute_min_glyph_bounds (f
);
4849 /* Load font named FONTNAME of size SIZE for frame F, and return a
4850 pointer to the structure font_info while allocating it dynamically.
4851 If loading fails, return NULL. */
4853 w32_load_font (f
,fontname
,size
)
4858 Lisp_Object bdf_fonts
;
4859 struct font_info
*retval
= NULL
;
4861 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
4863 while (!retval
&& CONSP (bdf_fonts
))
4865 char *bdf_name
, *bdf_file
;
4866 Lisp_Object bdf_pair
;
4868 bdf_name
= SDATA (XCAR (bdf_fonts
));
4869 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
4870 bdf_file
= SDATA (XCDR (bdf_pair
));
4872 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
4874 bdf_fonts
= XCDR (bdf_fonts
);
4880 return w32_load_system_font(f
, fontname
, size
);
4885 w32_unload_font (dpyinfo
, font
)
4886 struct w32_display_info
*dpyinfo
;
4891 if (font
->per_char
) xfree (font
->per_char
);
4892 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
4894 if (font
->hfont
) DeleteObject(font
->hfont
);
4899 /* The font conversion stuff between x and w32 */
4901 /* X font string is as follows (from faces.el)
4905 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4906 * (weight\? "\\([^-]*\\)") ; 1
4907 * (slant "\\([ior]\\)") ; 2
4908 * (slant\? "\\([^-]?\\)") ; 2
4909 * (swidth "\\([^-]*\\)") ; 3
4910 * (adstyle "[^-]*") ; 4
4911 * (pixelsize "[0-9]+")
4912 * (pointsize "[0-9][0-9]+")
4913 * (resx "[0-9][0-9]+")
4914 * (resy "[0-9][0-9]+")
4915 * (spacing "[cmp?*]")
4916 * (avgwidth "[0-9]+")
4917 * (registry "[^-]+")
4918 * (encoding "[^-]+")
4923 x_to_w32_weight (lpw
)
4926 if (!lpw
) return (FW_DONTCARE
);
4928 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
4929 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
4930 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
4931 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
4932 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
4933 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
4934 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
4935 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
4936 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
4937 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
4944 w32_to_x_weight (fnweight
)
4947 if (fnweight
>= FW_HEAVY
) return "heavy";
4948 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
4949 if (fnweight
>= FW_BOLD
) return "bold";
4950 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
4951 if (fnweight
>= FW_MEDIUM
) return "medium";
4952 if (fnweight
>= FW_NORMAL
) return "normal";
4953 if (fnweight
>= FW_LIGHT
) return "light";
4954 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
4955 if (fnweight
>= FW_THIN
) return "thin";
4961 x_to_w32_charset (lpcs
)
4964 Lisp_Object this_entry
, w32_charset
;
4966 int len
= strlen (lpcs
);
4968 /* Support "*-#nnn" format for unknown charsets. */
4969 if (strncmp (lpcs
, "*-#", 3) == 0)
4970 return atoi (lpcs
+ 3);
4972 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
4973 charset
= alloca (len
+ 1);
4974 strcpy (charset
, lpcs
);
4975 lpcs
= strchr (charset
, '*');
4979 /* Look through w32-charset-info-alist for the character set.
4980 Format of each entry is
4981 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
4983 this_entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
4985 if (NILP(this_entry
))
4987 /* At startup, we want iso8859-1 fonts to come up properly. */
4988 if (stricmp(charset
, "iso8859-1") == 0)
4989 return ANSI_CHARSET
;
4991 return DEFAULT_CHARSET
;
4994 w32_charset
= Fcar (Fcdr (this_entry
));
4996 /* Translate Lisp symbol to number. */
4997 if (w32_charset
== Qw32_charset_ansi
)
4998 return ANSI_CHARSET
;
4999 if (w32_charset
== Qw32_charset_symbol
)
5000 return SYMBOL_CHARSET
;
5001 if (w32_charset
== Qw32_charset_shiftjis
)
5002 return SHIFTJIS_CHARSET
;
5003 if (w32_charset
== Qw32_charset_hangeul
)
5004 return HANGEUL_CHARSET
;
5005 if (w32_charset
== Qw32_charset_chinesebig5
)
5006 return CHINESEBIG5_CHARSET
;
5007 if (w32_charset
== Qw32_charset_gb2312
)
5008 return GB2312_CHARSET
;
5009 if (w32_charset
== Qw32_charset_oem
)
5011 #ifdef JOHAB_CHARSET
5012 if (w32_charset
== Qw32_charset_johab
)
5013 return JOHAB_CHARSET
;
5014 if (w32_charset
== Qw32_charset_easteurope
)
5015 return EASTEUROPE_CHARSET
;
5016 if (w32_charset
== Qw32_charset_turkish
)
5017 return TURKISH_CHARSET
;
5018 if (w32_charset
== Qw32_charset_baltic
)
5019 return BALTIC_CHARSET
;
5020 if (w32_charset
== Qw32_charset_russian
)
5021 return RUSSIAN_CHARSET
;
5022 if (w32_charset
== Qw32_charset_arabic
)
5023 return ARABIC_CHARSET
;
5024 if (w32_charset
== Qw32_charset_greek
)
5025 return GREEK_CHARSET
;
5026 if (w32_charset
== Qw32_charset_hebrew
)
5027 return HEBREW_CHARSET
;
5028 if (w32_charset
== Qw32_charset_vietnamese
)
5029 return VIETNAMESE_CHARSET
;
5030 if (w32_charset
== Qw32_charset_thai
)
5031 return THAI_CHARSET
;
5032 if (w32_charset
== Qw32_charset_mac
)
5034 #endif /* JOHAB_CHARSET */
5035 #ifdef UNICODE_CHARSET
5036 if (w32_charset
== Qw32_charset_unicode
)
5037 return UNICODE_CHARSET
;
5040 return DEFAULT_CHARSET
;
5045 w32_to_x_charset (fncharset
)
5048 static char buf
[32];
5049 Lisp_Object charset_type
;
5054 /* Handle startup case of w32-charset-info-alist not
5055 being set up yet. */
5056 if (NILP(Vw32_charset_info_alist
))
5058 charset_type
= Qw32_charset_ansi
;
5060 case DEFAULT_CHARSET
:
5061 charset_type
= Qw32_charset_default
;
5063 case SYMBOL_CHARSET
:
5064 charset_type
= Qw32_charset_symbol
;
5066 case SHIFTJIS_CHARSET
:
5067 charset_type
= Qw32_charset_shiftjis
;
5069 case HANGEUL_CHARSET
:
5070 charset_type
= Qw32_charset_hangeul
;
5072 case GB2312_CHARSET
:
5073 charset_type
= Qw32_charset_gb2312
;
5075 case CHINESEBIG5_CHARSET
:
5076 charset_type
= Qw32_charset_chinesebig5
;
5079 charset_type
= Qw32_charset_oem
;
5082 /* More recent versions of Windows (95 and NT4.0) define more
5084 #ifdef EASTEUROPE_CHARSET
5085 case EASTEUROPE_CHARSET
:
5086 charset_type
= Qw32_charset_easteurope
;
5088 case TURKISH_CHARSET
:
5089 charset_type
= Qw32_charset_turkish
;
5091 case BALTIC_CHARSET
:
5092 charset_type
= Qw32_charset_baltic
;
5094 case RUSSIAN_CHARSET
:
5095 charset_type
= Qw32_charset_russian
;
5097 case ARABIC_CHARSET
:
5098 charset_type
= Qw32_charset_arabic
;
5101 charset_type
= Qw32_charset_greek
;
5103 case HEBREW_CHARSET
:
5104 charset_type
= Qw32_charset_hebrew
;
5106 case VIETNAMESE_CHARSET
:
5107 charset_type
= Qw32_charset_vietnamese
;
5110 charset_type
= Qw32_charset_thai
;
5113 charset_type
= Qw32_charset_mac
;
5116 charset_type
= Qw32_charset_johab
;
5120 #ifdef UNICODE_CHARSET
5121 case UNICODE_CHARSET
:
5122 charset_type
= Qw32_charset_unicode
;
5126 /* Encode numerical value of unknown charset. */
5127 sprintf (buf
, "*-#%u", fncharset
);
5133 char * best_match
= NULL
;
5135 /* Look through w32-charset-info-alist for the character set.
5136 Prefer ISO codepages, and prefer lower numbers in the ISO
5137 range. Only return charsets for codepages which are installed.
5139 Format of each entry is
5140 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5142 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5145 Lisp_Object w32_charset
;
5146 Lisp_Object codepage
;
5148 Lisp_Object this_entry
= XCAR (rest
);
5150 /* Skip invalid entries in alist. */
5151 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5152 || !CONSP (XCDR (this_entry
))
5153 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5156 x_charset
= SDATA (XCAR (this_entry
));
5157 w32_charset
= XCAR (XCDR (this_entry
));
5158 codepage
= XCDR (XCDR (this_entry
));
5160 /* Look for Same charset and a valid codepage (or non-int
5161 which means ignore). */
5162 if (w32_charset
== charset_type
5163 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
5164 || IsValidCodePage (XINT (codepage
))))
5166 /* If we don't have a match already, then this is the
5169 best_match
= x_charset
;
5170 /* If this is an ISO codepage, and the best so far isn't,
5171 then this is better. */
5172 else if (strnicmp (best_match
, "iso", 3) != 0
5173 && strnicmp (x_charset
, "iso", 3) == 0)
5174 best_match
= x_charset
;
5175 /* If both are ISO8859 codepages, choose the one with the
5176 lowest number in the encoding field. */
5177 else if (strnicmp (best_match
, "iso8859-", 8) == 0
5178 && strnicmp (x_charset
, "iso8859-", 8) == 0)
5180 int best_enc
= atoi (best_match
+ 8);
5181 int this_enc
= atoi (x_charset
+ 8);
5182 if (this_enc
> 0 && this_enc
< best_enc
)
5183 best_match
= x_charset
;
5188 /* If no match, encode the numeric value. */
5191 sprintf (buf
, "*-#%u", fncharset
);
5195 strncpy(buf
, best_match
, 31);
5202 /* Return all the X charsets that map to a font. */
5204 w32_to_all_x_charsets (fncharset
)
5207 static char buf
[32];
5208 Lisp_Object charset_type
;
5209 Lisp_Object retval
= Qnil
;
5214 /* Handle startup case of w32-charset-info-alist not
5215 being set up yet. */
5216 if (NILP(Vw32_charset_info_alist
))
5217 return Fcons (build_string ("iso8859-1"), Qnil
);
5219 charset_type
= Qw32_charset_ansi
;
5221 case DEFAULT_CHARSET
:
5222 charset_type
= Qw32_charset_default
;
5224 case SYMBOL_CHARSET
:
5225 charset_type
= Qw32_charset_symbol
;
5227 case SHIFTJIS_CHARSET
:
5228 charset_type
= Qw32_charset_shiftjis
;
5230 case HANGEUL_CHARSET
:
5231 charset_type
= Qw32_charset_hangeul
;
5233 case GB2312_CHARSET
:
5234 charset_type
= Qw32_charset_gb2312
;
5236 case CHINESEBIG5_CHARSET
:
5237 charset_type
= Qw32_charset_chinesebig5
;
5240 charset_type
= Qw32_charset_oem
;
5243 /* More recent versions of Windows (95 and NT4.0) define more
5245 #ifdef EASTEUROPE_CHARSET
5246 case EASTEUROPE_CHARSET
:
5247 charset_type
= Qw32_charset_easteurope
;
5249 case TURKISH_CHARSET
:
5250 charset_type
= Qw32_charset_turkish
;
5252 case BALTIC_CHARSET
:
5253 charset_type
= Qw32_charset_baltic
;
5255 case RUSSIAN_CHARSET
:
5256 charset_type
= Qw32_charset_russian
;
5258 case ARABIC_CHARSET
:
5259 charset_type
= Qw32_charset_arabic
;
5262 charset_type
= Qw32_charset_greek
;
5264 case HEBREW_CHARSET
:
5265 charset_type
= Qw32_charset_hebrew
;
5267 case VIETNAMESE_CHARSET
:
5268 charset_type
= Qw32_charset_vietnamese
;
5271 charset_type
= Qw32_charset_thai
;
5274 charset_type
= Qw32_charset_mac
;
5277 charset_type
= Qw32_charset_johab
;
5281 #ifdef UNICODE_CHARSET
5282 case UNICODE_CHARSET
:
5283 charset_type
= Qw32_charset_unicode
;
5287 /* Encode numerical value of unknown charset. */
5288 sprintf (buf
, "*-#%u", fncharset
);
5289 return Fcons (build_string (buf
), Qnil
);
5294 /* Look through w32-charset-info-alist for the character set.
5295 Only return charsets for codepages which are installed.
5297 Format of each entry in Vw32_charset_info_alist is
5298 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5300 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5302 Lisp_Object x_charset
;
5303 Lisp_Object w32_charset
;
5304 Lisp_Object codepage
;
5306 Lisp_Object this_entry
= XCAR (rest
);
5308 /* Skip invalid entries in alist. */
5309 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5310 || !CONSP (XCDR (this_entry
))
5311 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5314 x_charset
= XCAR (this_entry
);
5315 w32_charset
= XCAR (XCDR (this_entry
));
5316 codepage
= XCDR (XCDR (this_entry
));
5318 /* Look for Same charset and a valid codepage (or non-int
5319 which means ignore). */
5320 if (w32_charset
== charset_type
5321 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
5322 || IsValidCodePage (XINT (codepage
))))
5324 retval
= Fcons (x_charset
, retval
);
5328 /* If no match, encode the numeric value. */
5331 sprintf (buf
, "*-#%u", fncharset
);
5332 return Fcons (build_string (buf
), Qnil
);
5339 /* Get the Windows codepage corresponding to the specified font. The
5340 charset info in the font name is used to look up
5341 w32-charset-to-codepage-alist. */
5343 w32_codepage_for_font (char *fontname
)
5345 Lisp_Object codepage
, entry
;
5346 char *charset_str
, *charset
, *end
;
5348 if (NILP (Vw32_charset_info_alist
))
5351 /* Extract charset part of font string. */
5352 charset
= xlfd_charset_of_font (fontname
);
5357 charset_str
= (char *) alloca (strlen (charset
) + 1);
5358 strcpy (charset_str
, charset
);
5361 /* Remove leading "*-". */
5362 if (strncmp ("*-", charset_str
, 2) == 0)
5363 charset
= charset_str
+ 2;
5366 charset
= charset_str
;
5368 /* Stop match at wildcard (including preceding '-'). */
5369 if (end
= strchr (charset
, '*'))
5371 if (end
> charset
&& *(end
-1) == '-')
5376 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
5380 codepage
= Fcdr (Fcdr (entry
));
5382 if (NILP (codepage
))
5384 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
5386 else if (INTEGERP (codepage
))
5387 return XINT (codepage
);
5394 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
5395 LOGFONT
* lplogfont
;
5398 char * specific_charset
;
5402 char height_pixels
[8];
5404 char width_pixels
[8];
5405 char *fontname_dash
;
5406 int display_resy
= (int) one_w32_display_info
.resy
;
5407 int display_resx
= (int) one_w32_display_info
.resx
;
5409 struct coding_system coding
;
5411 if (!lpxstr
) abort ();
5416 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
5417 fonttype
= "raster";
5418 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
5419 fonttype
= "outline";
5421 fonttype
= "unknown";
5423 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system
),
5425 coding
.src_multibyte
= 0;
5426 coding
.dst_multibyte
= 1;
5427 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5428 /* We explicitely disable composition handling because selection
5429 data should not contain any composition sequence. */
5430 coding
.composing
= COMPOSITION_DISABLED
;
5431 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
5433 fontname
= alloca(sizeof(*fontname
) * bufsz
);
5434 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
5435 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
5436 *(fontname
+ coding
.produced
) = '\0';
5438 /* Replace dashes with underscores so the dashes are not
5440 fontname_dash
= fontname
;
5441 while (fontname_dash
= strchr (fontname_dash
, '-'))
5442 *fontname_dash
= '_';
5444 if (lplogfont
->lfHeight
)
5446 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
5447 sprintf (height_dpi
, "%u",
5448 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
5452 strcpy (height_pixels
, "*");
5453 strcpy (height_dpi
, "*");
5455 if (lplogfont
->lfWidth
)
5456 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
5458 strcpy (width_pixels
, "*");
5460 _snprintf (lpxstr
, len
- 1,
5461 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5462 fonttype
, /* foundry */
5463 fontname
, /* family */
5464 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
5465 lplogfont
->lfItalic
?'i':'r', /* slant */
5467 /* add style name */
5468 height_pixels
, /* pixel size */
5469 height_dpi
, /* point size */
5470 display_resx
, /* resx */
5471 display_resy
, /* resy */
5472 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
5473 ? 'p' : 'c', /* spacing */
5474 width_pixels
, /* avg width */
5475 specific_charset
? specific_charset
5476 : w32_to_x_charset (lplogfont
->lfCharSet
)
5477 /* charset registry and encoding */
5480 lpxstr
[len
- 1] = 0; /* just to be sure */
5485 x_to_w32_font (lpxstr
, lplogfont
)
5487 LOGFONT
* lplogfont
;
5489 struct coding_system coding
;
5491 if (!lplogfont
) return (FALSE
);
5493 memset (lplogfont
, 0, sizeof (*lplogfont
));
5495 /* Set default value for each field. */
5497 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
5498 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
5499 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
5501 /* go for maximum quality */
5502 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
5503 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
5504 lplogfont
->lfQuality
= PROOF_QUALITY
;
5507 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
5508 lplogfont
->lfWeight
= FW_DONTCARE
;
5509 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
5514 /* Provide a simple escape mechanism for specifying Windows font names
5515 * directly -- if font spec does not beginning with '-', assume this
5517 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5523 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
5524 width
[10], resy
[10], remainder
[50];
5526 int dpi
= (int) one_w32_display_info
.resy
;
5528 fields
= sscanf (lpxstr
,
5529 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
5530 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
5534 /* In the general case when wildcards cover more than one field,
5535 we don't know which field is which, so don't fill any in.
5536 However, we need to cope with this particular form, which is
5537 generated by font_list_1 (invoked by try_font_list):
5538 "-raster-6x10-*-gb2312*-*"
5539 and make sure to correctly parse the charset field. */
5542 fields
= sscanf (lpxstr
,
5543 "-%*[^-]-%49[^-]-*-%49s",
5546 else if (fields
< 9)
5552 if (fields
> 0 && name
[0] != '*')
5558 (Fcheck_coding_system (Vlocale_coding_system
), &coding
);
5559 coding
.src_multibyte
= 1;
5560 coding
.dst_multibyte
= 1;
5561 /* Need to set COMPOSITION_DISABLED, otherwise Emacs crashes in
5562 encode_coding_iso2022 trying to dereference a null pointer. */
5563 coding
.composing
= COMPOSITION_DISABLED
;
5564 if (coding
.type
== coding_type_iso2022
)
5565 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
5566 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
5567 buf
= (unsigned char *) alloca (bufsize
);
5568 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5569 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
5570 if (coding
.produced
>= LF_FACESIZE
)
5571 coding
.produced
= LF_FACESIZE
- 1;
5572 buf
[coding
.produced
] = 0;
5573 strcpy (lplogfont
->lfFaceName
, buf
);
5577 lplogfont
->lfFaceName
[0] = '\0';
5582 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5586 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
5590 if (fields
> 0 && pixels
[0] != '*')
5591 lplogfont
->lfHeight
= atoi (pixels
);
5595 if (fields
> 0 && resy
[0] != '*')
5598 if (tem
> 0) dpi
= tem
;
5601 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
5602 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
5605 lplogfont
->lfPitchAndFamily
=
5606 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
5610 if (fields
> 0 && width
[0] != '*')
5611 lplogfont
->lfWidth
= atoi (width
) / 10;
5615 /* Strip the trailing '-' if present. (it shouldn't be, as it
5616 fails the test against xlfd-tight-regexp in fontset.el). */
5618 int len
= strlen (remainder
);
5619 if (len
> 0 && remainder
[len
-1] == '-')
5620 remainder
[len
-1] = 0;
5622 encoding
= remainder
;
5624 if (strncmp (encoding
, "*-", 2) == 0)
5627 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
5632 char name
[100], height
[10], width
[10], weight
[20];
5634 fields
= sscanf (lpxstr
,
5635 "%99[^:]:%9[^:]:%9[^:]:%19s",
5636 name
, height
, width
, weight
);
5638 if (fields
== EOF
) return (FALSE
);
5642 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
5643 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
5647 lplogfont
->lfFaceName
[0] = 0;
5653 lplogfont
->lfHeight
= atoi (height
);
5658 lplogfont
->lfWidth
= atoi (width
);
5662 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5665 /* This makes TrueType fonts work better. */
5666 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
5671 /* Strip the pixel height and point height from the given xlfd, and
5672 return the pixel height. If no pixel height is specified, calculate
5673 one from the point height, or if that isn't defined either, return
5674 0 (which usually signifies a scalable font).
5677 xlfd_strip_height (char *fontname
)
5679 int pixel_height
, field_number
;
5680 char *read_from
, *write_to
;
5684 pixel_height
= field_number
= 0;
5687 /* Look for height fields. */
5688 for (read_from
= fontname
; *read_from
; read_from
++)
5690 if (*read_from
== '-')
5693 if (field_number
== 7) /* Pixel height. */
5696 write_to
= read_from
;
5698 /* Find end of field. */
5699 for (;*read_from
&& *read_from
!= '-'; read_from
++)
5702 /* Split the fontname at end of field. */
5708 pixel_height
= atoi (write_to
);
5709 /* Blank out field. */
5710 if (read_from
> write_to
)
5715 /* If the pixel height field is at the end (partial xlfd),
5718 return pixel_height
;
5720 /* If we got a pixel height, the point height can be
5721 ignored. Just blank it out and break now. */
5724 /* Find end of point size field. */
5725 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5731 /* Blank out the point size field. */
5732 if (read_from
> write_to
)
5738 return pixel_height
;
5742 /* If the point height is already blank, break now. */
5743 if (*read_from
== '-')
5749 else if (field_number
== 8)
5751 /* If we didn't get a pixel height, try to get the point
5752 height and convert that. */
5754 char *point_size_start
= read_from
++;
5756 /* Find end of field. */
5757 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5766 point_size
= atoi (point_size_start
);
5768 /* Convert to pixel height. */
5769 pixel_height
= point_size
5770 * one_w32_display_info
.height_in
/ 720;
5772 /* Blank out this field and break. */
5780 /* Shift the rest of the font spec into place. */
5781 if (write_to
&& read_from
> write_to
)
5783 for (; *read_from
; read_from
++, write_to
++)
5784 *write_to
= *read_from
;
5788 return pixel_height
;
5791 /* Assume parameter 1 is fully qualified, no wildcards. */
5793 w32_font_match (fontname
, pattern
)
5797 char *regex
= alloca (strlen (pattern
) * 2 + 3);
5798 char *font_name_copy
= alloca (strlen (fontname
) + 1);
5801 /* Copy fontname so we can modify it during comparison. */
5802 strcpy (font_name_copy
, fontname
);
5807 /* Turn pattern into a regexp and do a regexp match. */
5808 for (; *pattern
; pattern
++)
5810 if (*pattern
== '?')
5812 else if (*pattern
== '*')
5823 /* Strip out font heights and compare them seperately, since
5824 rounding error can cause mismatches. This also allows a
5825 comparison between a font that declares only a pixel height and a
5826 pattern that declares the point height.
5829 int font_height
, pattern_height
;
5831 font_height
= xlfd_strip_height (font_name_copy
);
5832 pattern_height
= xlfd_strip_height (regex
);
5834 /* Compare now, and don't bother doing expensive regexp matching
5835 if the heights differ. */
5836 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
5840 return (fast_c_string_match_ignore_case (build_string (regex
),
5841 font_name_copy
) >= 0);
5844 /* Callback functions, and a structure holding info they need, for
5845 listing system fonts on W32. We need one set of functions to do the
5846 job properly, but these don't work on NT 3.51 and earlier, so we
5847 have a second set which don't handle character sets properly to
5850 In both cases, there are two passes made. The first pass gets one
5851 font from each family, the second pass lists all the fonts from
5854 typedef struct enumfont_t
5859 XFontStruct
*size_ref
;
5860 Lisp_Object pattern
;
5866 enum_font_maybe_add_to_list (enumfont_t
*, LOGFONT
*, char *, Lisp_Object
);
5870 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
5872 NEWTEXTMETRIC
* lptm
;
5876 /* Ignore struck out and underlined versions of fonts. */
5877 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
5880 /* Only return fonts with names starting with @ if they were
5881 explicitly specified, since Microsoft uses an initial @ to
5882 denote fonts for vertical writing, without providing a more
5883 convenient way of identifying them. */
5884 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
5885 && lpef
->logfont
.lfFaceName
[0] != '@')
5888 /* Check that the character set matches if it was specified */
5889 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
5890 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
5893 if (FontType
== RASTER_FONTTYPE
)
5895 /* DBCS raster fonts have problems displaying, so skip them. */
5896 int charset
= lplf
->elfLogFont
.lfCharSet
;
5897 if (charset
== SHIFTJIS_CHARSET
5898 || charset
== HANGEUL_CHARSET
5899 || charset
== CHINESEBIG5_CHARSET
5900 || charset
== GB2312_CHARSET
5901 #ifdef JOHAB_CHARSET
5902 || charset
== JOHAB_CHARSET
5910 Lisp_Object width
= Qnil
;
5911 Lisp_Object charset_list
= Qnil
;
5912 char *charset
= NULL
;
5914 /* Truetype fonts do not report their true metrics until loaded */
5915 if (FontType
!= RASTER_FONTTYPE
)
5917 if (!NILP (lpef
->pattern
))
5919 /* Scalable fonts are as big as you want them to be. */
5920 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
5921 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
5922 width
= make_number (lpef
->logfont
.lfWidth
);
5926 lplf
->elfLogFont
.lfHeight
= 0;
5927 lplf
->elfLogFont
.lfWidth
= 0;
5931 /* Make sure the height used here is the same as everywhere
5932 else (ie character height, not cell height). */
5933 if (lplf
->elfLogFont
.lfHeight
> 0)
5935 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
5936 if (FontType
== RASTER_FONTTYPE
)
5937 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
5939 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
5942 if (!NILP (lpef
->pattern
))
5944 charset
= xlfd_charset_of_font (SDATA (lpef
->pattern
));
5946 /* We already checked charsets above, but DEFAULT_CHARSET
5947 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
5949 && strncmp (charset
, "*-*", 3) != 0
5950 && lpef
->logfont
.lfCharSet
== DEFAULT_CHARSET
5951 && strcmp (charset
, w32_to_x_charset (DEFAULT_CHARSET
)) != 0)
5956 charset_list
= Fcons (build_string (charset
), Qnil
);
5958 charset_list
= w32_to_all_x_charsets (lplf
->elfLogFont
.lfCharSet
);
5960 /* Loop through the charsets. */
5961 for ( ; CONSP (charset_list
); charset_list
= Fcdr (charset_list
))
5963 Lisp_Object this_charset
= Fcar (charset_list
);
5964 charset
= SDATA (this_charset
);
5966 /* List bold and italic variations if w32-enable-synthesized-fonts
5967 is non-nil and this is a plain font. */
5968 if (w32_enable_synthesized_fonts
5969 && lplf
->elfLogFont
.lfWeight
== FW_NORMAL
5970 && lplf
->elfLogFont
.lfItalic
== FALSE
)
5972 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
5975 lplf
->elfLogFont
.lfWeight
= FW_BOLD
;
5976 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
5979 lplf
->elfLogFont
.lfItalic
= TRUE
;
5980 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
5983 lplf
->elfLogFont
.lfWeight
= FW_NORMAL
;
5984 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
5988 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
5997 enum_font_maybe_add_to_list (lpef
, logfont
, match_charset
, width
)
6000 char * match_charset
;
6005 if (!w32_to_x_font (logfont
, buf
, 100, match_charset
))
6008 if (NILP (lpef
->pattern
)
6009 || w32_font_match (buf
, SDATA (lpef
->pattern
)))
6011 /* Check if we already listed this font. This may happen if
6012 w32_enable_synthesized_fonts is non-nil, and there are real
6013 bold and italic versions of the font. */
6014 Lisp_Object font_name
= build_string (buf
);
6015 if (NILP (Fmember (font_name
, lpef
->list
)))
6017 Lisp_Object entry
= Fcons (font_name
, width
);
6018 lpef
->list
= Fcons (entry
, lpef
->list
);
6026 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
6028 NEWTEXTMETRIC
* lptm
;
6032 return EnumFontFamilies (lpef
->hdc
,
6033 lplf
->elfLogFont
.lfFaceName
,
6034 (FONTENUMPROC
) enum_font_cb2
,
6040 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
6041 ENUMLOGFONTEX
* lplf
;
6042 NEWTEXTMETRICEX
* lptm
;
6046 /* We are not interested in the extra info we get back from the 'Ex
6047 version - only the fact that we get character set variations
6048 enumerated seperately. */
6049 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
6054 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
6055 ENUMLOGFONTEX
* lplf
;
6056 NEWTEXTMETRICEX
* lptm
;
6060 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6061 FARPROC enum_font_families_ex
6062 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6063 /* We don't really expect EnumFontFamiliesEx to disappear once we
6064 get here, so don't bother handling it gracefully. */
6065 if (enum_font_families_ex
== NULL
)
6066 error ("gdi32.dll has disappeared!");
6067 return enum_font_families_ex (lpef
->hdc
,
6069 (FONTENUMPROC
) enum_fontex_cb2
,
6073 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6074 and xterm.c in Emacs 20.3) */
6076 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
6078 char *fontname
, *ptnstr
;
6079 Lisp_Object list
, tem
, newlist
= Qnil
;
6082 list
= Vw32_bdf_filename_alist
;
6083 ptnstr
= SDATA (pattern
);
6085 for ( ; CONSP (list
); list
= XCDR (list
))
6089 fontname
= SDATA (XCAR (tem
));
6090 else if (STRINGP (tem
))
6091 fontname
= SDATA (tem
);
6095 if (w32_font_match (fontname
, ptnstr
))
6097 newlist
= Fcons (XCAR (tem
), newlist
);
6099 if (max_names
>= 0 && n_fonts
>= max_names
)
6108 /* Return a list of names of available fonts matching PATTERN on frame
6109 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6110 to be listed. Frame F NULL means we have not yet created any
6111 frame, which means we can't get proper size info, as we don't have
6112 a device context to use for GetTextMetrics.
6113 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
6114 negative, then all matching fonts are returned. */
6117 w32_list_fonts (f
, pattern
, size
, maxnames
)
6119 Lisp_Object pattern
;
6123 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
6124 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
6125 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
6128 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
6129 if (NILP (patterns
))
6130 patterns
= Fcons (pattern
, Qnil
);
6132 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
6137 tpat
= XCAR (patterns
);
6139 if (!STRINGP (tpat
))
6142 /* Avoid expensive EnumFontFamilies functions if we are not
6143 going to be able to output one of these anyway. */
6144 codepage
= w32_codepage_for_font (SDATA (tpat
));
6145 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
6146 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
6147 && !IsValidCodePage(codepage
))
6150 /* See if we cached the result for this particular query.
6151 The cache is an alist of the form:
6152 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6154 if (tem
= XCDR (dpyinfo
->name_list_element
),
6155 !NILP (list
= Fassoc (tpat
, tem
)))
6157 list
= Fcdr_safe (list
);
6158 /* We have a cached list. Don't have to get the list again. */
6163 /* At first, put PATTERN in the cache. */
6168 /* Use EnumFontFamiliesEx where it is available, as it knows
6169 about character sets. Fall back to EnumFontFamilies for
6170 older versions of NT that don't support the 'Ex function. */
6171 x_to_w32_font (SDATA (tpat
), &ef
.logfont
);
6173 LOGFONT font_match_pattern
;
6174 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6175 FARPROC enum_font_families_ex
6176 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6178 /* We do our own pattern matching so we can handle wildcards. */
6179 font_match_pattern
.lfFaceName
[0] = 0;
6180 font_match_pattern
.lfPitchAndFamily
= 0;
6181 /* We can use the charset, because if it is a wildcard it will
6182 be DEFAULT_CHARSET anyway. */
6183 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
6185 ef
.hdc
= GetDC (dpyinfo
->root_window
);
6187 if (enum_font_families_ex
)
6188 enum_font_families_ex (ef
.hdc
,
6189 &font_match_pattern
,
6190 (FONTENUMPROC
) enum_fontex_cb1
,
6193 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
6196 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
6202 /* Make a list of the fonts we got back.
6203 Store that in the font cache for the display. */
6204 XSETCDR (dpyinfo
->name_list_element
,
6205 Fcons (Fcons (tpat
, list
),
6206 XCDR (dpyinfo
->name_list_element
)));
6209 if (NILP (list
)) continue; /* Try the remaining alternatives. */
6211 newlist
= second_best
= Qnil
;
6213 /* Make a list of the fonts that have the right width. */
6214 for (; CONSP (list
); list
= XCDR (list
))
6221 if (NILP (XCAR (tem
)))
6225 newlist
= Fcons (XCAR (tem
), newlist
);
6227 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6232 if (!INTEGERP (XCDR (tem
)))
6234 /* Since we don't yet know the size of the font, we must
6235 load it and try GetTextMetrics. */
6236 W32FontStruct thisinfo
;
6241 if (!x_to_w32_font (SDATA (XCAR (tem
)), &lf
))
6245 thisinfo
.bdf
= NULL
;
6246 thisinfo
.hfont
= CreateFontIndirect (&lf
);
6247 if (thisinfo
.hfont
== NULL
)
6250 hdc
= GetDC (dpyinfo
->root_window
);
6251 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
6252 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
6253 XSETCDR (tem
, make_number (FONT_WIDTH (&thisinfo
)));
6255 XSETCDR (tem
, make_number (0));
6256 SelectObject (hdc
, oldobj
);
6257 ReleaseDC (dpyinfo
->root_window
, hdc
);
6258 DeleteObject(thisinfo
.hfont
);
6261 found_size
= XINT (XCDR (tem
));
6262 if (found_size
== size
)
6264 newlist
= Fcons (XCAR (tem
), newlist
);
6266 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6269 /* keep track of the closest matching size in case
6270 no exact match is found. */
6271 else if (found_size
> 0)
6273 if (NILP (second_best
))
6276 else if (found_size
< size
)
6278 if (XINT (XCDR (second_best
)) > size
6279 || XINT (XCDR (second_best
)) < found_size
)
6284 if (XINT (XCDR (second_best
)) > size
6285 && XINT (XCDR (second_best
)) >
6292 if (!NILP (newlist
))
6294 else if (!NILP (second_best
))
6296 newlist
= Fcons (XCAR (second_best
), Qnil
);
6301 /* Include any bdf fonts. */
6302 if (n_fonts
< maxnames
|| maxnames
< 0)
6304 Lisp_Object combined
[2];
6305 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
6306 combined
[1] = newlist
;
6307 newlist
= Fnconc(2, combined
);
6314 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6316 w32_get_font_info (f
, font_idx
)
6320 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
6325 w32_query_font (struct frame
*f
, char *fontname
)
6328 struct font_info
*pfi
;
6330 pfi
= FRAME_W32_FONT_TABLE (f
);
6332 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
6334 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
6340 /* Find a CCL program for a font specified by FONTP, and set the member
6341 `encoder' of the structure. */
6344 w32_find_ccl_program (fontp
)
6345 struct font_info
*fontp
;
6347 Lisp_Object list
, elt
;
6349 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
6353 && STRINGP (XCAR (elt
))
6354 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
6360 struct ccl_program
*ccl
6361 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
6363 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
6366 fontp
->font_encoder
= ccl
;
6371 /* Find BDF files in a specified directory. (use GCPRO when calling,
6372 as this calls lisp to get a directory listing). */
6374 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
6376 Lisp_Object filelist
, list
= Qnil
;
6379 if (!STRINGP(directory
))
6382 filelist
= Fdirectory_files (directory
, Qt
,
6383 build_string (".*\\.[bB][dD][fF]"), Qt
);
6385 for ( ; CONSP(filelist
); filelist
= XCDR (filelist
))
6387 Lisp_Object filename
= XCAR (filelist
);
6388 if (w32_BDF_to_x_font (SDATA (filename
), fontname
, 100))
6389 store_in_alist (&list
, build_string (fontname
), filename
);
6394 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
6396 doc
: /* Return a list of BDF fonts in DIR.
6397 The list is suitable for appending to w32-bdf-filename-alist. Fonts
6398 which do not contain an xlfd description will not be included in the
6399 list. DIR may be a list of directories. */)
6401 Lisp_Object directory
;
6403 Lisp_Object list
= Qnil
;
6404 struct gcpro gcpro1
, gcpro2
;
6406 if (!CONSP (directory
))
6407 return w32_find_bdf_fonts_in_dir (directory
);
6409 for ( ; CONSP (directory
); directory
= XCDR (directory
))
6411 Lisp_Object pair
[2];
6414 GCPRO2 (directory
, list
);
6415 pair
[1] = w32_find_bdf_fonts_in_dir( XCAR (directory
) );
6416 list
= Fnconc( 2, pair
);
6423 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
6424 doc
: /* Internal function called by `color-defined-p', which see. */)
6426 Lisp_Object color
, frame
;
6429 FRAME_PTR f
= check_x_frame (frame
);
6431 CHECK_STRING (color
);
6433 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6439 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
6440 doc
: /* Internal function called by `color-values', which see. */)
6442 Lisp_Object color
, frame
;
6445 FRAME_PTR f
= check_x_frame (frame
);
6447 CHECK_STRING (color
);
6449 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6453 rgb
[0] = make_number ((GetRValue (foo
.pixel
) << 8)
6454 | GetRValue (foo
.pixel
));
6455 rgb
[1] = make_number ((GetGValue (foo
.pixel
) << 8)
6456 | GetGValue (foo
.pixel
));
6457 rgb
[2] = make_number ((GetBValue (foo
.pixel
) << 8)
6458 | GetBValue (foo
.pixel
));
6459 return Flist (3, rgb
);
6465 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
6466 doc
: /* Internal function called by `display-color-p', which see. */)
6468 Lisp_Object display
;
6470 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6472 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
6478 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
6479 Sx_display_grayscale_p
, 0, 1, 0,
6480 doc
: /* Return t if the X display supports shades of gray.
6481 Note that color displays do support shades of gray.
6482 The optional argument DISPLAY specifies which display to ask about.
6483 DISPLAY should be either a frame or a display name (a string).
6484 If omitted or nil, that stands for the selected frame's display. */)
6486 Lisp_Object display
;
6488 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6490 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
6496 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
6497 Sx_display_pixel_width
, 0, 1, 0,
6498 doc
: /* Returns the width in pixels of DISPLAY.
6499 The optional argument DISPLAY specifies which display to ask about.
6500 DISPLAY should be either a frame or a display name (a string).
6501 If omitted or nil, that stands for the selected frame's display. */)
6503 Lisp_Object display
;
6505 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6507 return make_number (dpyinfo
->width
);
6510 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
6511 Sx_display_pixel_height
, 0, 1, 0,
6512 doc
: /* Returns the height in pixels of DISPLAY.
6513 The optional argument DISPLAY specifies which display to ask about.
6514 DISPLAY should be either a frame or a display name (a string).
6515 If omitted or nil, that stands for the selected frame's display. */)
6517 Lisp_Object display
;
6519 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6521 return make_number (dpyinfo
->height
);
6524 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
6526 doc
: /* Returns the number of bitplanes of DISPLAY.
6527 The optional argument DISPLAY specifies which display to ask about.
6528 DISPLAY should be either a frame or a display name (a string).
6529 If omitted or nil, that stands for the selected frame's display. */)
6531 Lisp_Object display
;
6533 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6535 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
6538 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
6540 doc
: /* Returns the number of color cells of DISPLAY.
6541 The optional argument DISPLAY specifies which display to ask about.
6542 DISPLAY should be either a frame or a display name (a string).
6543 If omitted or nil, that stands for the selected frame's display. */)
6545 Lisp_Object display
;
6547 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6551 hdc
= GetDC (dpyinfo
->root_window
);
6552 if (dpyinfo
->has_palette
)
6553 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
6555 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
6557 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
6558 and because probably is more meaningful on Windows anyway */
6560 cap
= 1 << min(dpyinfo
->n_planes
* dpyinfo
->n_cbits
, 24);
6562 ReleaseDC (dpyinfo
->root_window
, hdc
);
6564 return make_number (cap
);
6567 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
6568 Sx_server_max_request_size
,
6570 doc
: /* Returns the maximum request size of the server of DISPLAY.
6571 The optional argument DISPLAY specifies which display to ask about.
6572 DISPLAY should be either a frame or a display name (a string).
6573 If omitted or nil, that stands for the selected frame's display. */)
6575 Lisp_Object display
;
6577 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6579 return make_number (1);
6582 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
6583 doc
: /* Returns the vendor ID string of the W32 system (Microsoft).
6584 The optional argument DISPLAY specifies which display to ask about.
6585 DISPLAY should be either a frame or a display name (a string).
6586 If omitted or nil, that stands for the selected frame's display. */)
6588 Lisp_Object display
;
6590 return build_string ("Microsoft Corp.");
6593 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
6594 doc
: /* Returns the version numbers of the server of DISPLAY.
6595 The value is a list of three integers: the major and minor
6596 version numbers, and the vendor-specific release
6597 number. See also the function `x-server-vendor'.
6599 The optional argument DISPLAY specifies which display to ask about.
6600 DISPLAY should be either a frame or a display name (a string).
6601 If omitted or nil, that stands for the selected frame's display. */)
6603 Lisp_Object display
;
6605 return Fcons (make_number (w32_major_version
),
6606 Fcons (make_number (w32_minor_version
),
6607 Fcons (make_number (w32_build_number
), Qnil
)));
6610 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
6611 doc
: /* Returns the number of screens on the server of DISPLAY.
6612 The optional argument DISPLAY specifies which display to ask about.
6613 DISPLAY should be either a frame or a display name (a string).
6614 If omitted or nil, that stands for the selected frame's display. */)
6616 Lisp_Object display
;
6618 return make_number (1);
6621 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
6622 Sx_display_mm_height
, 0, 1, 0,
6623 doc
: /* Returns the height in millimeters of DISPLAY.
6624 The optional argument DISPLAY specifies which display to ask about.
6625 DISPLAY should be either a frame or a display name (a string).
6626 If omitted or nil, that stands for the selected frame's display. */)
6628 Lisp_Object display
;
6630 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6634 hdc
= GetDC (dpyinfo
->root_window
);
6636 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
6638 ReleaseDC (dpyinfo
->root_window
, hdc
);
6640 return make_number (cap
);
6643 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
6644 doc
: /* Returns the width in millimeters of DISPLAY.
6645 The optional argument DISPLAY specifies which display to ask about.
6646 DISPLAY should be either a frame or a display name (a string).
6647 If omitted or nil, that stands for the selected frame's display. */)
6649 Lisp_Object display
;
6651 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6656 hdc
= GetDC (dpyinfo
->root_window
);
6658 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
6660 ReleaseDC (dpyinfo
->root_window
, hdc
);
6662 return make_number (cap
);
6665 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
6666 Sx_display_backing_store
, 0, 1, 0,
6667 doc
: /* Returns an indication of whether DISPLAY does backing store.
6668 The value may be `always', `when-mapped', or `not-useful'.
6669 The optional argument DISPLAY specifies which display to ask about.
6670 DISPLAY should be either a frame or a display name (a string).
6671 If omitted or nil, that stands for the selected frame's display. */)
6673 Lisp_Object display
;
6675 return intern ("not-useful");
6678 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
6679 Sx_display_visual_class
, 0, 1, 0,
6680 doc
: /* Returns the visual class of DISPLAY.
6681 The value is one of the symbols `static-gray', `gray-scale',
6682 `static-color', `pseudo-color', `true-color', or `direct-color'.
6684 The optional argument DISPLAY specifies which display to ask about.
6685 DISPLAY should be either a frame or a display name (a string).
6686 If omitted or nil, that stands for the selected frame's display. */)
6688 Lisp_Object display
;
6690 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6691 Lisp_Object result
= Qnil
;
6693 if (dpyinfo
->has_palette
)
6694 result
= intern ("pseudo-color");
6695 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
6696 result
= intern ("static-grey");
6697 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
6698 result
= intern ("static-color");
6699 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
6700 result
= intern ("true-color");
6705 DEFUN ("x-display-save-under", Fx_display_save_under
,
6706 Sx_display_save_under
, 0, 1, 0,
6707 doc
: /* Returns t if DISPLAY supports the save-under feature.
6708 The optional argument DISPLAY specifies which display to ask about.
6709 DISPLAY should be either a frame or a display name (a string).
6710 If omitted or nil, that stands for the selected frame's display. */)
6712 Lisp_Object display
;
6719 register struct frame
*f
;
6721 return FRAME_PIXEL_WIDTH (f
);
6726 register struct frame
*f
;
6728 return FRAME_PIXEL_HEIGHT (f
);
6733 register struct frame
*f
;
6735 return FRAME_COLUMN_WIDTH (f
);
6740 register struct frame
*f
;
6742 return FRAME_LINE_HEIGHT (f
);
6747 register struct frame
*f
;
6749 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
6752 /* Return the display structure for the display named NAME.
6753 Open a new connection if necessary. */
6755 struct w32_display_info
*
6756 x_display_info_for_name (name
)
6760 struct w32_display_info
*dpyinfo
;
6762 CHECK_STRING (name
);
6764 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
6766 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
6769 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
6774 /* Use this general default value to start with. */
6775 Vx_resource_name
= Vinvocation_name
;
6777 validate_x_resource_name ();
6779 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
6780 (char *) SDATA (Vx_resource_name
));
6783 error ("Cannot connect to server %s", SDATA (name
));
6786 XSETFASTINT (Vwindow_system_version
, 3);
6791 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
6792 1, 3, 0, doc
: /* Open a connection to a server.
6793 DISPLAY is the name of the display to connect to.
6794 Optional second arg XRM-STRING is a string of resources in xrdb format.
6795 If the optional third arg MUST-SUCCEED is non-nil,
6796 terminate Emacs if we can't open the connection. */)
6797 (display
, xrm_string
, must_succeed
)
6798 Lisp_Object display
, xrm_string
, must_succeed
;
6800 unsigned char *xrm_option
;
6801 struct w32_display_info
*dpyinfo
;
6803 /* If initialization has already been done, return now to avoid
6804 overwriting critical parts of one_w32_display_info. */
6808 CHECK_STRING (display
);
6809 if (! NILP (xrm_string
))
6810 CHECK_STRING (xrm_string
);
6812 if (! EQ (Vwindow_system
, intern ("w32")))
6813 error ("Not using Microsoft Windows");
6815 /* Allow color mapping to be defined externally; first look in user's
6816 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6818 Lisp_Object color_file
;
6819 struct gcpro gcpro1
;
6821 color_file
= build_string("~/rgb.txt");
6823 GCPRO1 (color_file
);
6825 if (NILP (Ffile_readable_p (color_file
)))
6827 Fexpand_file_name (build_string ("rgb.txt"),
6828 Fsymbol_value (intern ("data-directory")));
6830 Vw32_color_map
= Fw32_load_color_file (color_file
);
6834 if (NILP (Vw32_color_map
))
6835 Vw32_color_map
= Fw32_default_color_map ();
6837 /* Merge in system logical colors. */
6838 add_system_logical_colors_to_map (&Vw32_color_map
);
6840 if (! NILP (xrm_string
))
6841 xrm_option
= (unsigned char *) SDATA (xrm_string
);
6843 xrm_option
= (unsigned char *) 0;
6845 /* Use this general default value to start with. */
6846 /* First remove .exe suffix from invocation-name - it looks ugly. */
6848 char basename
[ MAX_PATH
], *str
;
6850 strcpy (basename
, SDATA (Vinvocation_name
));
6851 str
= strrchr (basename
, '.');
6853 Vinvocation_name
= build_string (basename
);
6855 Vx_resource_name
= Vinvocation_name
;
6857 validate_x_resource_name ();
6859 /* This is what opens the connection and sets x_current_display.
6860 This also initializes many symbols, such as those used for input. */
6861 dpyinfo
= w32_term_init (display
, xrm_option
,
6862 (char *) SDATA (Vx_resource_name
));
6866 if (!NILP (must_succeed
))
6867 fatal ("Cannot connect to server %s.\n",
6870 error ("Cannot connect to server %s", SDATA (display
));
6875 XSETFASTINT (Vwindow_system_version
, 3);
6879 DEFUN ("x-close-connection", Fx_close_connection
,
6880 Sx_close_connection
, 1, 1, 0,
6881 doc
: /* Close the connection to DISPLAY's server.
6882 For DISPLAY, specify either a frame or a display name (a string).
6883 If DISPLAY is nil, that stands for the selected frame's display. */)
6885 Lisp_Object display
;
6887 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6890 if (dpyinfo
->reference_count
> 0)
6891 error ("Display still has frames on it");
6894 /* Free the fonts in the font table. */
6895 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
6896 if (dpyinfo
->font_table
[i
].name
)
6898 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
6899 xfree (dpyinfo
->font_table
[i
].full_name
);
6900 xfree (dpyinfo
->font_table
[i
].name
);
6901 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
6903 x_destroy_all_bitmaps (dpyinfo
);
6905 x_delete_display (dpyinfo
);
6911 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
6912 doc
: /* Return the list of display names that Emacs has connections to. */)
6915 Lisp_Object tail
, result
;
6918 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
6919 result
= Fcons (XCAR (XCAR (tail
)), result
);
6924 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
6925 doc
: /* This is a noop on W32 systems. */)
6927 Lisp_Object display
, on
;
6933 /***********************************************************************
6935 ***********************************************************************/
6937 /* Value is the number of elements of vector VECTOR. */
6939 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
6941 /* List of supported image types. Use define_image_type to add new
6942 types. Use lookup_image_type to find a type for a given symbol. */
6944 static struct image_type
*image_types
;
6946 /* The symbol `xbm' which is used as the type symbol for XBM images. */
6952 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
6953 extern Lisp_Object QCdata
, QCtype
;
6954 Lisp_Object QCascent
, QCmargin
, QCrelief
;
6955 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
6956 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
6958 /* Other symbols. */
6960 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
6962 /* Time in seconds after which images should be removed from the cache
6963 if not displayed. */
6965 Lisp_Object Vimage_cache_eviction_delay
;
6967 /* Function prototypes. */
6969 static void define_image_type
P_ ((struct image_type
*type
));
6970 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
6971 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
6972 static void x_laplace
P_ ((struct frame
*, struct image
*));
6973 static void x_emboss
P_ ((struct frame
*, struct image
*));
6974 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
6978 /* Define a new image type from TYPE. This adds a copy of TYPE to
6979 image_types and adds the symbol *TYPE->type to Vimage_types. */
6982 define_image_type (type
)
6983 struct image_type
*type
;
6985 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
6986 The initialized data segment is read-only. */
6987 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
6988 bcopy (type
, p
, sizeof *p
);
6989 p
->next
= image_types
;
6991 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
6995 /* Look up image type SYMBOL, and return a pointer to its image_type
6996 structure. Value is null if SYMBOL is not a known image type. */
6998 static INLINE
struct image_type
*
6999 lookup_image_type (symbol
)
7002 struct image_type
*type
;
7004 for (type
= image_types
; type
; type
= type
->next
)
7005 if (EQ (symbol
, *type
->type
))
7012 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
7013 valid image specification is a list whose car is the symbol
7014 `image', and whose rest is a property list. The property list must
7015 contain a value for key `:type'. That value must be the name of a
7016 supported image type. The rest of the property list depends on the
7020 valid_image_p (object
)
7025 if (IMAGEP (object
))
7029 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
7030 if (EQ (XCAR (tem
), QCtype
))
7033 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
7035 struct image_type
*type
;
7036 type
= lookup_image_type (XCAR (tem
));
7038 valid_p
= type
->valid_p (object
);
7049 /* Log error message with format string FORMAT and argument ARG.
7050 Signaling an error, e.g. when an image cannot be loaded, is not a
7051 good idea because this would interrupt redisplay, and the error
7052 message display would lead to another redisplay. This function
7053 therefore simply displays a message. */
7056 image_error (format
, arg1
, arg2
)
7058 Lisp_Object arg1
, arg2
;
7060 add_to_log (format
, arg1
, arg2
);
7065 /***********************************************************************
7066 Image specifications
7067 ***********************************************************************/
7069 enum image_value_type
7071 IMAGE_DONT_CHECK_VALUE_TYPE
,
7073 IMAGE_STRING_OR_NIL_VALUE
,
7075 IMAGE_POSITIVE_INTEGER_VALUE
,
7076 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
7077 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
7079 IMAGE_INTEGER_VALUE
,
7080 IMAGE_FUNCTION_VALUE
,
7085 /* Structure used when parsing image specifications. */
7087 struct image_keyword
7089 /* Name of keyword. */
7092 /* The type of value allowed. */
7093 enum image_value_type type
;
7095 /* Non-zero means key must be present. */
7098 /* Used to recognize duplicate keywords in a property list. */
7101 /* The value that was found. */
7106 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
7108 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
7111 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
7112 has the format (image KEYWORD VALUE ...). One of the keyword/
7113 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7114 image_keywords structures of size NKEYWORDS describing other
7115 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7118 parse_image_spec (spec
, keywords
, nkeywords
, type
)
7120 struct image_keyword
*keywords
;
7130 plist
= XCDR (spec
);
7131 while (CONSP (plist
))
7133 Lisp_Object key
, value
;
7135 /* First element of a pair must be a symbol. */
7137 plist
= XCDR (plist
);
7141 /* There must follow a value. */
7144 value
= XCAR (plist
);
7145 plist
= XCDR (plist
);
7147 /* Find key in KEYWORDS. Error if not found. */
7148 for (i
= 0; i
< nkeywords
; ++i
)
7149 if (strcmp (keywords
[i
].name
, SDATA (SYMBOL_NAME (key
))) == 0)
7155 /* Record that we recognized the keyword. If a keywords
7156 was found more than once, it's an error. */
7157 keywords
[i
].value
= value
;
7158 ++keywords
[i
].count
;
7160 if (keywords
[i
].count
> 1)
7163 /* Check type of value against allowed type. */
7164 switch (keywords
[i
].type
)
7166 case IMAGE_STRING_VALUE
:
7167 if (!STRINGP (value
))
7171 case IMAGE_STRING_OR_NIL_VALUE
:
7172 if (!STRINGP (value
) && !NILP (value
))
7176 case IMAGE_SYMBOL_VALUE
:
7177 if (!SYMBOLP (value
))
7181 case IMAGE_POSITIVE_INTEGER_VALUE
:
7182 if (!INTEGERP (value
) || XINT (value
) <= 0)
7186 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
7187 if (INTEGERP (value
) && XINT (value
) >= 0)
7190 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
7191 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
7195 case IMAGE_ASCENT_VALUE
:
7196 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
7198 else if (INTEGERP (value
)
7199 && XINT (value
) >= 0
7200 && XINT (value
) <= 100)
7204 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
7205 if (!INTEGERP (value
) || XINT (value
) < 0)
7209 case IMAGE_DONT_CHECK_VALUE_TYPE
:
7212 case IMAGE_FUNCTION_VALUE
:
7213 value
= indirect_function (value
);
7215 || COMPILEDP (value
)
7216 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
7220 case IMAGE_NUMBER_VALUE
:
7221 if (!INTEGERP (value
) && !FLOATP (value
))
7225 case IMAGE_INTEGER_VALUE
:
7226 if (!INTEGERP (value
))
7230 case IMAGE_BOOL_VALUE
:
7231 if (!NILP (value
) && !EQ (value
, Qt
))
7240 if (EQ (key
, QCtype
) && !EQ (type
, value
))
7244 /* Check that all mandatory fields are present. */
7245 for (i
= 0; i
< nkeywords
; ++i
)
7246 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
7249 return NILP (plist
);
7253 /* Return the value of KEY in image specification SPEC. Value is nil
7254 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
7255 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
7258 image_spec_value (spec
, key
, found
)
7259 Lisp_Object spec
, key
;
7264 xassert (valid_image_p (spec
));
7266 for (tail
= XCDR (spec
);
7267 CONSP (tail
) && CONSP (XCDR (tail
));
7268 tail
= XCDR (XCDR (tail
)))
7270 if (EQ (XCAR (tail
), key
))
7274 return XCAR (XCDR (tail
));
7284 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
7285 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
7286 PIXELS non-nil means return the size in pixels, otherwise return the
7287 size in canonical character units.
7288 FRAME is the frame on which the image will be displayed. FRAME nil
7289 or omitted means use the selected frame. */)
7290 (spec
, pixels
, frame
)
7291 Lisp_Object spec
, pixels
, frame
;
7296 if (valid_image_p (spec
))
7298 struct frame
*f
= check_x_frame (frame
);
7299 int id
= lookup_image (f
, spec
);
7300 struct image
*img
= IMAGE_FROM_ID (f
, id
);
7301 int width
= img
->width
+ 2 * img
->hmargin
;
7302 int height
= img
->height
+ 2 * img
->vmargin
;
7305 size
= Fcons (make_float ((double) width
/ FRAME_COLUMN_WIDTH (f
)),
7306 make_float ((double) height
/ FRAME_LINE_HEIGHT (f
)));
7308 size
= Fcons (make_number (width
), make_number (height
));
7311 error ("Invalid image specification");
7317 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
7318 doc
: /* Return t if image SPEC has a mask bitmap.
7319 FRAME is the frame on which the image will be displayed. FRAME nil
7320 or omitted means use the selected frame. */)
7322 Lisp_Object spec
, frame
;
7327 if (valid_image_p (spec
))
7329 struct frame
*f
= check_x_frame (frame
);
7330 int id
= lookup_image (f
, spec
);
7331 struct image
*img
= IMAGE_FROM_ID (f
, id
);
7336 error ("Invalid image specification");
7342 /***********************************************************************
7343 Image type independent image structures
7344 ***********************************************************************/
7346 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
7347 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
7348 static void x_destroy_x_image
P_ ((XImage
*));
7351 /* Allocate and return a new image structure for image specification
7352 SPEC. SPEC has a hash value of HASH. */
7354 static struct image
*
7355 make_image (spec
, hash
)
7359 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
7361 xassert (valid_image_p (spec
));
7362 bzero (img
, sizeof *img
);
7363 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
7364 xassert (img
->type
!= NULL
);
7366 img
->data
.lisp_val
= Qnil
;
7367 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
7373 /* Free image IMG which was used on frame F, including its resources. */
7382 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
7384 /* Remove IMG from the hash table of its cache. */
7386 img
->prev
->next
= img
->next
;
7388 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
7391 img
->next
->prev
= img
->prev
;
7393 c
->images
[img
->id
] = NULL
;
7395 /* Free resources, then free IMG. */
7396 img
->type
->free (f
, img
);
7402 /* Prepare image IMG for display on frame F. Must be called before
7403 drawing an image. */
7406 prepare_image_for_display (f
, img
)
7412 /* We're about to display IMG, so set its timestamp to `now'. */
7414 img
->timestamp
= EMACS_SECS (t
);
7416 /* If IMG doesn't have a pixmap yet, load it now, using the image
7417 type dependent loader function. */
7418 if (img
->pixmap
== 0 && !img
->load_failed_p
)
7419 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
7423 /* Value is the number of pixels for the ascent of image IMG when
7424 drawn in face FACE. */
7427 image_ascent (img
, face
)
7431 int height
= img
->height
+ img
->vmargin
;
7434 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
7437 ascent
= height
/ 2 - (FONT_DESCENT(face
->font
)
7438 - FONT_BASE(face
->font
)) / 2;
7440 ascent
= height
/ 2;
7443 ascent
= (int) (height
* img
->ascent
/ 100.0);
7450 /* Image background colors. */
7452 /* Find the "best" corner color of a bitmap. XIMG is assumed to a device
7453 context with the bitmap selected. */
7455 four_corners_best (img_dc
, width
, height
)
7457 unsigned long width
, height
;
7459 COLORREF corners
[4], best
;
7462 /* Get the colors at the corners of img_dc. */
7463 corners
[0] = GetPixel (img_dc
, 0, 0);
7464 corners
[1] = GetPixel (img_dc
, width
- 1, 0);
7465 corners
[2] = GetPixel (img_dc
, width
- 1, height
- 1);
7466 corners
[3] = GetPixel (img_dc
, 0, height
- 1);
7468 /* Choose the most frequently found color as background. */
7469 for (i
= best_count
= 0; i
< 4; ++i
)
7473 for (j
= n
= 0; j
< 4; ++j
)
7474 if (corners
[i
] == corners
[j
])
7478 best
= corners
[i
], best_count
= n
;
7484 /* Return the `background' field of IMG. If IMG doesn't have one yet,
7485 it is guessed heuristically. If non-zero, IMG_DC is an existing
7486 device context with the image selected to use for the heuristic. */
7489 image_background (img
, f
, img_dc
)
7494 if (! img
->background_valid
)
7495 /* IMG doesn't have a background yet, try to guess a reasonable value. */
7497 int free_ximg
= !img_dc
;
7502 HDC frame_dc
= get_frame_dc (f
);
7503 img_dc
= CreateCompatibleDC (frame_dc
);
7504 release_frame_dc (f
, frame_dc
);
7506 prev
= SelectObject (img_dc
, img
->pixmap
);
7509 img
->background
= four_corners_best (img_dc
, img
->width
, img
->height
);
7513 SelectObject (img_dc
, prev
);
7517 img
->background_valid
= 1;
7520 return img
->background
;
7523 /* Return the `background_transparent' field of IMG. If IMG doesn't
7524 have one yet, it is guessed heuristically. If non-zero, MASK is an
7525 existing XImage object to use for the heuristic. */
7528 image_background_transparent (img
, f
, mask
)
7533 if (! img
->background_transparent_valid
)
7534 /* IMG doesn't have a background yet, try to guess a reasonable value. */
7538 int free_mask
= !mask
;
7543 HDC frame_dc
= get_frame_dc (f
);
7544 mask
= CreateCompatibleDC (frame_dc
);
7545 release_frame_dc (f
, frame_dc
);
7547 prev
= SelectObject (mask
, img
->mask
);
7550 img
->background_transparent
7551 = !four_corners_best (mask
, img
->width
, img
->height
);
7555 SelectObject (mask
, prev
);
7560 img
->background_transparent
= 0;
7562 img
->background_transparent_valid
= 1;
7565 return img
->background_transparent
;
7569 /***********************************************************************
7570 Helper functions for X image types
7571 ***********************************************************************/
7573 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
7575 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
7576 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
7578 Lisp_Object color_name
,
7579 unsigned long dflt
));
7582 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
7583 free the pixmap if any. MASK_P non-zero means clear the mask
7584 pixmap if any. COLORS_P non-zero means free colors allocated for
7585 the image, if any. */
7588 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
7591 int pixmap_p
, mask_p
, colors_p
;
7593 if (pixmap_p
&& img
->pixmap
)
7595 DeleteObject (img
->pixmap
);
7597 img
->background_valid
= 0;
7600 if (mask_p
&& img
->mask
)
7602 DeleteObject (img
->mask
);
7604 img
->background_transparent_valid
= 0;
7607 if (colors_p
&& img
->ncolors
)
7609 #if 0 /* TODO: color table support. */
7610 x_free_colors (f
, img
->colors
, img
->ncolors
);
7612 xfree (img
->colors
);
7618 /* Free X resources of image IMG which is used on frame F. */
7621 x_clear_image (f
, img
)
7628 DeleteObject (img
->pixmap
);
7635 #if 0 /* TODO: color table support */
7637 int class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
7639 /* If display has an immutable color map, freeing colors is not
7640 necessary and some servers don't allow it. So don't do it. */
7641 if (class != StaticColor
7642 && class != StaticGray
7643 && class != TrueColor
)
7647 cmap
= DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f
)->screen
);
7648 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
, img
->colors
,
7654 xfree (img
->colors
);
7661 /* Allocate color COLOR_NAME for image IMG on frame F. If color
7662 cannot be allocated, use DFLT. Add a newly allocated color to
7663 IMG->colors, so that it can be freed again. Value is the pixel
7666 static unsigned long
7667 x_alloc_image_color (f
, img
, color_name
, dflt
)
7670 Lisp_Object color_name
;
7674 unsigned long result
;
7676 xassert (STRINGP (color_name
));
7678 if (w32_defined_color (f
, SDATA (color_name
), &color
, 1))
7680 /* This isn't called frequently so we get away with simply
7681 reallocating the color vector to the needed size, here. */
7684 (unsigned long *) xrealloc (img
->colors
,
7685 img
->ncolors
* sizeof *img
->colors
);
7686 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
7687 result
= color
.pixel
;
7696 /***********************************************************************
7698 ***********************************************************************/
7700 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
7701 static void postprocess_image
P_ ((struct frame
*, struct image
*));
7702 static void x_disable_image
P_ ((struct frame
*, struct image
*));
7705 /* Return a new, initialized image cache that is allocated from the
7706 heap. Call free_image_cache to free an image cache. */
7708 struct image_cache
*
7711 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
7714 bzero (c
, sizeof *c
);
7716 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
7717 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
7718 c
->buckets
= (struct image
**) xmalloc (size
);
7719 bzero (c
->buckets
, size
);
7724 /* Free image cache of frame F. Be aware that X frames share images
7728 free_image_cache (f
)
7731 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
7736 /* Cache should not be referenced by any frame when freed. */
7737 xassert (c
->refcount
== 0);
7739 for (i
= 0; i
< c
->used
; ++i
)
7740 free_image (f
, c
->images
[i
]);
7744 FRAME_X_IMAGE_CACHE (f
) = NULL
;
7749 /* Clear image cache of frame F. FORCE_P non-zero means free all
7750 images. FORCE_P zero means clear only images that haven't been
7751 displayed for some time. Should be called from time to time to
7752 reduce the number of loaded images. If image-eviction-seconds is
7753 non-nil, this frees images in the cache which weren't displayed for
7754 at least that many seconds. */
7757 clear_image_cache (f
, force_p
)
7761 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
7763 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
7770 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
7772 /* Block input so that we won't be interrupted by a SIGIO
7773 while being in an inconsistent state. */
7776 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
7778 struct image
*img
= c
->images
[i
];
7780 && (force_p
|| (img
->timestamp
< old
)))
7782 free_image (f
, img
);
7787 /* We may be clearing the image cache because, for example,
7788 Emacs was iconified for a longer period of time. In that
7789 case, current matrices may still contain references to
7790 images freed above. So, clear these matrices. */
7793 Lisp_Object tail
, frame
;
7795 FOR_EACH_FRAME (tail
, frame
)
7797 struct frame
*f
= XFRAME (frame
);
7799 && FRAME_X_IMAGE_CACHE (f
) == c
)
7800 clear_current_matrices (f
);
7803 ++windows_or_buffers_changed
;
7811 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
7813 doc
: /* Clear the image cache of FRAME.
7814 FRAME nil or omitted means use the selected frame.
7815 FRAME t means clear the image caches of all frames. */)
7823 FOR_EACH_FRAME (tail
, frame
)
7824 if (FRAME_W32_P (XFRAME (frame
)))
7825 clear_image_cache (XFRAME (frame
), 1);
7828 clear_image_cache (check_x_frame (frame
), 1);
7834 /* Compute masks and transform image IMG on frame F, as specified
7835 by the image's specification, */
7838 postprocess_image (f
, img
)
7842 /* Manipulation of the image's mask. */
7845 Lisp_Object conversion
, spec
;
7850 /* `:heuristic-mask t'
7852 means build a mask heuristically.
7853 `:heuristic-mask (R G B)'
7854 `:mask (heuristic (R G B))'
7855 means build a mask from color (R G B) in the
7858 means remove a mask, if any. */
7860 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
7862 x_build_heuristic_mask (f
, img
, mask
);
7867 mask
= image_spec_value (spec
, QCmask
, &found_p
);
7869 if (EQ (mask
, Qheuristic
))
7870 x_build_heuristic_mask (f
, img
, Qt
);
7871 else if (CONSP (mask
)
7872 && EQ (XCAR (mask
), Qheuristic
))
7874 if (CONSP (XCDR (mask
)))
7875 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
7877 x_build_heuristic_mask (f
, img
, XCDR (mask
));
7879 else if (NILP (mask
) && found_p
&& img
->mask
)
7881 DeleteObject (img
->mask
);
7887 /* Should we apply an image transformation algorithm? */
7888 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
7889 if (EQ (conversion
, Qdisabled
))
7890 x_disable_image (f
, img
);
7891 else if (EQ (conversion
, Qlaplace
))
7893 else if (EQ (conversion
, Qemboss
))
7895 else if (CONSP (conversion
)
7896 && EQ (XCAR (conversion
), Qedge_detection
))
7899 tem
= XCDR (conversion
);
7901 x_edge_detection (f
, img
,
7902 Fplist_get (tem
, QCmatrix
),
7903 Fplist_get (tem
, QCcolor_adjustment
));
7909 /* Return the id of image with Lisp specification SPEC on frame F.
7910 SPEC must be a valid Lisp image specification (see valid_image_p). */
7913 lookup_image (f
, spec
)
7917 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
7921 struct gcpro gcpro1
;
7924 /* F must be a window-system frame, and SPEC must be a valid image
7926 xassert (FRAME_WINDOW_P (f
));
7927 xassert (valid_image_p (spec
));
7931 /* Look up SPEC in the hash table of the image cache. */
7932 hash
= sxhash (spec
, 0);
7933 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
7935 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
7936 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
7939 /* If not found, create a new image and cache it. */
7942 extern Lisp_Object Qpostscript
;
7945 img
= make_image (spec
, hash
);
7946 cache_image (f
, img
);
7947 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
7949 /* If we can't load the image, and we don't have a width and
7950 height, use some arbitrary width and height so that we can
7951 draw a rectangle for it. */
7952 if (img
->load_failed_p
)
7956 value
= image_spec_value (spec
, QCwidth
, NULL
);
7957 img
->width
= (INTEGERP (value
)
7958 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
7959 value
= image_spec_value (spec
, QCheight
, NULL
);
7960 img
->height
= (INTEGERP (value
)
7961 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
7965 /* Handle image type independent image attributes
7966 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
7967 `:background COLOR'. */
7968 Lisp_Object ascent
, margin
, relief
, bg
;
7970 ascent
= image_spec_value (spec
, QCascent
, NULL
);
7971 if (INTEGERP (ascent
))
7972 img
->ascent
= XFASTINT (ascent
);
7973 else if (EQ (ascent
, Qcenter
))
7974 img
->ascent
= CENTERED_IMAGE_ASCENT
;
7976 margin
= image_spec_value (spec
, QCmargin
, NULL
);
7977 if (INTEGERP (margin
) && XINT (margin
) >= 0)
7978 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
7979 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
7980 && INTEGERP (XCDR (margin
)))
7982 if (XINT (XCAR (margin
)) > 0)
7983 img
->hmargin
= XFASTINT (XCAR (margin
));
7984 if (XINT (XCDR (margin
)) > 0)
7985 img
->vmargin
= XFASTINT (XCDR (margin
));
7988 relief
= image_spec_value (spec
, QCrelief
, NULL
);
7989 if (INTEGERP (relief
))
7991 img
->relief
= XINT (relief
);
7992 img
->hmargin
+= abs (img
->relief
);
7993 img
->vmargin
+= abs (img
->relief
);
7996 if (! img
->background_valid
)
7998 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
8002 = x_alloc_image_color (f
, img
, bg
,
8003 FRAME_BACKGROUND_PIXEL (f
));
8004 img
->background_valid
= 1;
8008 /* Do image transformations and compute masks, unless we
8009 don't have the image yet. */
8010 if (!EQ (*img
->type
->type
, Qpostscript
))
8011 postprocess_image (f
, img
);
8015 xassert (!interrupt_input_blocked
);
8018 /* We're using IMG, so set its timestamp to `now'. */
8019 EMACS_GET_TIME (now
);
8020 img
->timestamp
= EMACS_SECS (now
);
8024 /* Value is the image id. */
8029 /* Cache image IMG in the image cache of frame F. */
8032 cache_image (f
, img
)
8036 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8039 /* Find a free slot in c->images. */
8040 for (i
= 0; i
< c
->used
; ++i
)
8041 if (c
->images
[i
] == NULL
)
8044 /* If no free slot found, maybe enlarge c->images. */
8045 if (i
== c
->used
&& c
->used
== c
->size
)
8048 c
->images
= (struct image
**) xrealloc (c
->images
,
8049 c
->size
* sizeof *c
->images
);
8052 /* Add IMG to c->images, and assign IMG an id. */
8058 /* Add IMG to the cache's hash table. */
8059 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8060 img
->next
= c
->buckets
[i
];
8062 img
->next
->prev
= img
;
8064 c
->buckets
[i
] = img
;
8068 /* Call FN on every image in the image cache of frame F. Used to mark
8069 Lisp Objects in the image cache. */
8072 forall_images_in_image_cache (f
, fn
)
8074 void (*fn
) P_ ((struct image
*img
));
8076 if (FRAME_LIVE_P (f
) && FRAME_W32_P (f
))
8078 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8082 for (i
= 0; i
< c
->used
; ++i
)
8091 /***********************************************************************
8093 ***********************************************************************/
8095 /* Macro for defining functions that will be loaded from image DLLs. */
8096 #define DEF_IMGLIB_FN(func) FARPROC fn_##func
8098 /* Macro for loading those image functions from the library. */
8099 #define LOAD_IMGLIB_FN(lib,func) { \
8100 fn_##func = (void *) GetProcAddress (lib, #func); \
8101 if (!fn_##func) return 0; \
8104 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
8105 XImage
**, Pixmap
*));
8106 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
8109 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
8110 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
8111 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
8112 via xmalloc. DEPTH of zero signifies a 24 bit image, otherwise
8113 DEPTH should indicate the bit depth of the image. Print error
8114 messages via image_error if an error occurs. Value is non-zero if
8118 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
8120 int width
, height
, depth
;
8124 BITMAPINFOHEADER
*header
;
8126 int scanline_width_bits
;
8128 int palette_colors
= 0;
8133 if (depth
!= 1 && depth
!= 4 && depth
!= 8
8134 && depth
!= 16 && depth
!= 24 && depth
!= 32)
8136 image_error ("Invalid image bit depth specified", Qnil
, Qnil
);
8140 scanline_width_bits
= width
* depth
;
8141 remainder
= scanline_width_bits
% 32;
8144 scanline_width_bits
+= 32 - remainder
;
8146 /* Bitmaps with a depth less than 16 need a palette. */
8147 /* BITMAPINFO structure already contains the first RGBQUAD. */
8149 palette_colors
= 1 << depth
- 1;
8151 *ximg
= xmalloc (sizeof (XImage
) + palette_colors
* sizeof (RGBQUAD
));
8154 image_error ("Unable to allocate memory for XImage", Qnil
, Qnil
);
8158 header
= &((*ximg
)->info
.bmiHeader
);
8159 bzero (&((*ximg
)->info
), sizeof (BITMAPINFO
));
8160 header
->biSize
= sizeof (*header
);
8161 header
->biWidth
= width
;
8162 header
->biHeight
= -height
; /* negative indicates a top-down bitmap. */
8163 header
->biPlanes
= 1;
8164 header
->biBitCount
= depth
;
8165 header
->biCompression
= BI_RGB
;
8166 header
->biClrUsed
= palette_colors
;
8168 /* TODO: fill in palette. */
8171 (*ximg
)->info
.bmiColors
[0].rgbBlue
= 0;
8172 (*ximg
)->info
.bmiColors
[0].rgbGreen
= 0;
8173 (*ximg
)->info
.bmiColors
[0].rgbRed
= 0;
8174 (*ximg
)->info
.bmiColors
[0].rgbReserved
= 0;
8175 (*ximg
)->info
.bmiColors
[1].rgbBlue
= 255;
8176 (*ximg
)->info
.bmiColors
[1].rgbGreen
= 255;
8177 (*ximg
)->info
.bmiColors
[1].rgbRed
= 255;
8178 (*ximg
)->info
.bmiColors
[1].rgbReserved
= 0;
8181 hdc
= get_frame_dc (f
);
8183 /* Create a DIBSection and raster array for the bitmap,
8184 and store its handle in *pixmap. */
8185 *pixmap
= CreateDIBSection (hdc
, &((*ximg
)->info
),
8186 (depth
< 16) ? DIB_PAL_COLORS
: DIB_RGB_COLORS
,
8187 &((*ximg
)->data
), NULL
, 0);
8189 /* Realize display palette and garbage all frames. */
8190 release_frame_dc (f
, hdc
);
8192 if (*pixmap
== NULL
)
8194 DWORD err
= GetLastError();
8195 Lisp_Object errcode
;
8196 /* All system errors are < 10000, so the following is safe. */
8197 XSETINT (errcode
, (int) err
);
8198 image_error ("Unable to create bitmap, error code %d", errcode
, Qnil
);
8199 x_destroy_x_image (*ximg
);
8207 /* Destroy XImage XIMG. Free XIMG->data. */
8210 x_destroy_x_image (ximg
)
8213 xassert (interrupt_input_blocked
);
8216 /* Data will be freed by DestroyObject. */
8223 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
8224 are width and height of both the image and pixmap. */
8227 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
8233 #if 0 /* I don't think this is necessary looking at where it is used. */
8234 HDC hdc
= get_frame_dc (f
);
8235 SetDIBits (hdc
, pixmap
, 0, height
, ximg
->data
, &(ximg
->info
), DIB_RGB_COLORS
);
8236 release_frame_dc (f
, hdc
);
8241 /***********************************************************************
8243 ***********************************************************************/
8245 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
8246 static char *slurp_file
P_ ((char *, int *));
8249 /* Find image file FILE. Look in data-directory, then
8250 x-bitmap-file-path. Value is the full name of the file found, or
8251 nil if not found. */
8254 x_find_image_file (file
)
8257 Lisp_Object file_found
, search_path
;
8258 struct gcpro gcpro1
, gcpro2
;
8262 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
8263 GCPRO2 (file_found
, search_path
);
8265 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
8266 fd
= openp (search_path
, file
, Qnil
, &file_found
, Qnil
);
8278 /* Read FILE into memory. Value is a pointer to a buffer allocated
8279 with xmalloc holding FILE's contents. Value is null if an error
8280 occurred. *SIZE is set to the size of the file. */
8283 slurp_file (file
, size
)
8291 if (stat (file
, &st
) == 0
8292 && (fp
= fopen (file
, "rb")) != NULL
8293 && (buf
= (char *) xmalloc (st
.st_size
),
8294 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
8315 /***********************************************************************
8317 ***********************************************************************/
8319 static int xbm_scan
P_ ((char **, char *, char *, int *));
8320 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
8321 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
8323 static int xbm_image_p
P_ ((Lisp_Object object
));
8324 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
8326 static int xbm_file_p
P_ ((Lisp_Object
));
8329 /* Indices of image specification fields in xbm_format, below. */
8331 enum xbm_keyword_index
8349 /* Vector of image_keyword structures describing the format
8350 of valid XBM image specifications. */
8352 static struct image_keyword xbm_format
[XBM_LAST
] =
8354 {":type", IMAGE_SYMBOL_VALUE
, 1},
8355 {":file", IMAGE_STRING_VALUE
, 0},
8356 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8357 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8358 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8359 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8360 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
8361 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8362 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8363 {":relief", IMAGE_INTEGER_VALUE
, 0},
8364 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8365 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8366 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8369 /* Structure describing the image type XBM. */
8371 static struct image_type xbm_type
=
8380 /* Tokens returned from xbm_scan. */
8389 /* Return non-zero if OBJECT is a valid XBM-type image specification.
8390 A valid specification is a list starting with the symbol `image'
8391 The rest of the list is a property list which must contain an
8394 If the specification specifies a file to load, it must contain
8395 an entry `:file FILENAME' where FILENAME is a string.
8397 If the specification is for a bitmap loaded from memory it must
8398 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
8399 WIDTH and HEIGHT are integers > 0. DATA may be:
8401 1. a string large enough to hold the bitmap data, i.e. it must
8402 have a size >= (WIDTH + 7) / 8 * HEIGHT
8404 2. a bool-vector of size >= WIDTH * HEIGHT
8406 3. a vector of strings or bool-vectors, one for each line of the
8409 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
8410 may not be specified in this case because they are defined in the
8413 Both the file and data forms may contain the additional entries
8414 `:background COLOR' and `:foreground COLOR'. If not present,
8415 foreground and background of the frame on which the image is
8416 displayed is used. */
8419 xbm_image_p (object
)
8422 struct image_keyword kw
[XBM_LAST
];
8424 bcopy (xbm_format
, kw
, sizeof kw
);
8425 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
8428 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
8430 if (kw
[XBM_FILE
].count
)
8432 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
8435 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
8437 /* In-memory XBM file. */
8438 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
8446 /* Entries for `:width', `:height' and `:data' must be present. */
8447 if (!kw
[XBM_WIDTH
].count
8448 || !kw
[XBM_HEIGHT
].count
8449 || !kw
[XBM_DATA
].count
)
8452 data
= kw
[XBM_DATA
].value
;
8453 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
8454 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
8456 /* Check type of data, and width and height against contents of
8462 /* Number of elements of the vector must be >= height. */
8463 if (XVECTOR (data
)->size
< height
)
8466 /* Each string or bool-vector in data must be large enough
8467 for one line of the image. */
8468 for (i
= 0; i
< height
; ++i
)
8470 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
8475 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
8478 else if (BOOL_VECTOR_P (elt
))
8480 if (XBOOL_VECTOR (elt
)->size
< width
)
8487 else if (STRINGP (data
))
8490 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
8493 else if (BOOL_VECTOR_P (data
))
8495 if (XBOOL_VECTOR (data
)->size
< width
* height
)
8506 /* Scan a bitmap file. FP is the stream to read from. Value is
8507 either an enumerator from enum xbm_token, or a character for a
8508 single-character token, or 0 at end of file. If scanning an
8509 identifier, store the lexeme of the identifier in SVAL. If
8510 scanning a number, store its value in *IVAL. */
8513 xbm_scan (s
, end
, sval
, ival
)
8522 /* Skip white space. */
8523 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8528 else if (isdigit (c
))
8530 int value
= 0, digit
;
8532 if (c
== '0' && *s
< end
)
8535 if (c
== 'x' || c
== 'X')
8542 else if (c
>= 'a' && c
<= 'f')
8543 digit
= c
- 'a' + 10;
8544 else if (c
>= 'A' && c
<= 'F')
8545 digit
= c
- 'A' + 10;
8548 value
= 16 * value
+ digit
;
8551 else if (isdigit (c
))
8555 && (c
= *(*s
)++, isdigit (c
)))
8556 value
= 8 * value
+ c
- '0';
8563 && (c
= *(*s
)++, isdigit (c
)))
8564 value
= 10 * value
+ c
- '0';
8572 else if (isalpha (c
) || c
== '_')
8576 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
8583 else if (c
== '/' && **s
== '*')
8585 /* C-style comment. */
8587 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
8600 /* XBM bits seem to be backward within bytes compared with how
8601 Windows does things. */
8602 static unsigned char reflect_byte (unsigned char orig
)
8605 unsigned char reflected
= 0x00;
8606 for (i
= 0; i
< 8; i
++)
8608 if (orig
& (0x01 << i
))
8609 reflected
|= 0x80 >> i
;
8615 /* Create a Windows bitmap from X bitmap data. */
8617 w32_create_pixmap_from_bitmap_data (int width
, int height
, char *data
)
8623 w1
= (width
+ 7) / 8; /* nb of 8bits elt in X bitmap */
8624 w2
= ((width
+ 15) / 16) * 2; /* nb of 16bits elt in W32 bitmap */
8625 bits
= (char *) alloca (height
* w2
);
8626 bzero (bits
, height
* w2
);
8627 for (i
= 0; i
< height
; i
++)
8630 for (j
= 0; j
< w1
; j
++)
8631 *p
++ = reflect_byte(*data
++);
8633 bmp
= CreateBitmap (width
, height
, 1, 1, bits
);
8639 /* Replacement for XReadBitmapFileData which isn't available under old
8640 X versions. CONTENTS is a pointer to a buffer to parse; END is the
8641 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
8642 the image. Return in *DATA the bitmap data allocated with xmalloc.
8643 Value is non-zero if successful. DATA null means just test if
8644 CONTENTS looks like an in-memory XBM file. */
8647 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
8648 char *contents
, *end
;
8649 int *width
, *height
;
8650 unsigned char **data
;
8653 char buffer
[BUFSIZ
];
8656 int bytes_per_line
, i
, nbytes
;
8662 LA1 = xbm_scan (&s, end, buffer, &value)
8664 #define expect(TOKEN) \
8665 if (LA1 != (TOKEN)) \
8670 #define expect_ident(IDENT) \
8671 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
8676 *width
= *height
= -1;
8679 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
8681 /* Parse defines for width, height and hot-spots. */
8685 expect_ident ("define");
8686 expect (XBM_TK_IDENT
);
8688 if (LA1
== XBM_TK_NUMBER
);
8690 char *p
= strrchr (buffer
, '_');
8691 p
= p
? p
+ 1 : buffer
;
8692 if (strcmp (p
, "width") == 0)
8694 else if (strcmp (p
, "height") == 0)
8697 expect (XBM_TK_NUMBER
);
8700 if (*width
< 0 || *height
< 0)
8702 else if (data
== NULL
)
8705 /* Parse bits. Must start with `static'. */
8706 expect_ident ("static");
8707 if (LA1
== XBM_TK_IDENT
)
8709 if (strcmp (buffer
, "unsigned") == 0)
8712 expect_ident ("char");
8714 else if (strcmp (buffer
, "short") == 0)
8718 if (*width
% 16 && *width
% 16 < 9)
8721 else if (strcmp (buffer
, "char") == 0)
8729 expect (XBM_TK_IDENT
);
8735 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
8736 nbytes
= bytes_per_line
* *height
;
8737 p
= *data
= (char *) xmalloc (nbytes
);
8741 for (i
= 0; i
< nbytes
; i
+= 2)
8744 expect (XBM_TK_NUMBER
);
8747 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
8748 *p
++ = ~ (value
>> 8);
8750 if (LA1
== ',' || LA1
== '}')
8758 for (i
= 0; i
< nbytes
; ++i
)
8761 expect (XBM_TK_NUMBER
);
8765 if (LA1
== ',' || LA1
== '}')
8789 static void convert_mono_to_color_image (f
, img
, foreground
, background
)
8792 COLORREF foreground
, background
;
8794 HDC hdc
, old_img_dc
, new_img_dc
;
8795 HGDIOBJ old_prev
, new_prev
;
8798 hdc
= get_frame_dc (f
);
8799 old_img_dc
= CreateCompatibleDC (hdc
);
8800 new_img_dc
= CreateCompatibleDC (hdc
);
8801 new_pixmap
= CreateCompatibleBitmap (hdc
, img
->width
, img
->height
);
8802 release_frame_dc (f
, hdc
);
8803 old_prev
= SelectObject (old_img_dc
, img
->pixmap
);
8804 new_prev
= SelectObject (new_img_dc
, new_pixmap
);
8805 SetTextColor (new_img_dc
, foreground
);
8806 SetBkColor (new_img_dc
, background
);
8808 BitBlt (new_img_dc
, 0, 0, img
->width
, img
->height
, old_img_dc
,
8811 SelectObject (old_img_dc
, old_prev
);
8812 SelectObject (new_img_dc
, new_prev
);
8813 DeleteDC (old_img_dc
);
8814 DeleteDC (new_img_dc
);
8815 DeleteObject (img
->pixmap
);
8816 if (new_pixmap
== 0)
8817 fprintf (stderr
, "Failed to convert image to color.\n");
8819 img
->pixmap
= new_pixmap
;
8822 /* Load XBM image IMG which will be displayed on frame F from buffer
8823 CONTENTS. END is the end of the buffer. Value is non-zero if
8827 xbm_load_image (f
, img
, contents
, end
)
8830 char *contents
, *end
;
8833 unsigned char *data
;
8836 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
8839 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
8840 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
8841 int non_default_colors
= 0;
8844 xassert (img
->width
> 0 && img
->height
> 0);
8846 /* Get foreground and background colors, maybe allocate colors. */
8847 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
8850 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
8851 non_default_colors
= 1;
8853 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
8856 background
= x_alloc_image_color (f
, img
, value
, background
);
8857 img
->background
= background
;
8858 img
->background_valid
= 1;
8859 non_default_colors
= 1;
8862 = w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
, data
);
8864 /* If colors were specified, transfer the bitmap to a color one. */
8865 if (non_default_colors
)
8866 convert_mono_to_color_image (f
, img
, foreground
, background
);
8870 if (img
->pixmap
== 0)
8872 x_clear_image (f
, img
);
8873 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
8879 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
8885 /* Value is non-zero if DATA looks like an in-memory XBM file. */
8892 return (STRINGP (data
)
8893 && xbm_read_bitmap_data (SDATA (data
),
8900 /* Fill image IMG which is used on frame F with pixmap data. Value is
8901 non-zero if successful. */
8909 Lisp_Object file_name
;
8911 xassert (xbm_image_p (img
->spec
));
8913 /* If IMG->spec specifies a file name, create a non-file spec from it. */
8914 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
8915 if (STRINGP (file_name
))
8920 struct gcpro gcpro1
;
8922 file
= x_find_image_file (file_name
);
8924 if (!STRINGP (file
))
8926 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
8931 contents
= slurp_file (SDATA (file
), &size
);
8932 if (contents
== NULL
)
8934 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
8939 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
8944 struct image_keyword fmt
[XBM_LAST
];
8946 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
8947 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
8948 int non_default_colors
= 0;
8951 int in_memory_file_p
= 0;
8953 /* See if data looks like an in-memory XBM file. */
8954 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8955 in_memory_file_p
= xbm_file_p (data
);
8957 /* Parse the image specification. */
8958 bcopy (xbm_format
, fmt
, sizeof fmt
);
8959 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
8962 /* Get specified width, and height. */
8963 if (!in_memory_file_p
)
8965 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
8966 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
8967 xassert (img
->width
> 0 && img
->height
> 0);
8970 /* Get foreground and background colors, maybe allocate colors. */
8971 if (fmt
[XBM_FOREGROUND
].count
8972 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
8974 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
8976 non_default_colors
= 1;
8979 if (fmt
[XBM_BACKGROUND
].count
8980 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
8982 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
8984 non_default_colors
= 1;
8987 if (in_memory_file_p
)
8988 success_p
= xbm_load_image (f
, img
, SDATA (data
),
8997 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
8999 p
= bits
= (char *) alloca (nbytes
* img
->height
);
9000 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
9002 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
9004 bcopy (SDATA (line
), p
, nbytes
);
9006 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
9009 else if (STRINGP (data
))
9010 bits
= SDATA (data
);
9012 bits
= XBOOL_VECTOR (data
)->data
;
9014 /* Create the pixmap. */
9016 = w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
,
9019 /* If colors were specified, transfer the bitmap to a color one. */
9020 if (non_default_colors
)
9021 convert_mono_to_color_image (f
, img
, foreground
, background
);
9027 image_error ("Unable to create pixmap for XBM image `%s'",
9029 x_clear_image (f
, img
);
9039 /***********************************************************************
9041 ***********************************************************************/
9045 static int xpm_image_p
P_ ((Lisp_Object object
));
9046 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
9047 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
9049 /* Indicate to xpm.h that we don't have Xlib. */
9051 /* simx.h in xpm defines XColor and XImage differently than Emacs. */
9052 #define XColor xpm_XColor
9053 #define XImage xpm_XImage
9054 #define PIXEL_ALREADY_TYPEDEFED
9055 #include "X11/xpm.h"
9059 #undef PIXEL_ALREADY_TYPEDEFED
9061 /* The symbol `xpm' identifying XPM-format images. */
9065 /* Indices of image specification fields in xpm_format, below. */
9067 enum xpm_keyword_index
9083 /* Vector of image_keyword structures describing the format
9084 of valid XPM image specifications. */
9086 static struct image_keyword xpm_format
[XPM_LAST
] =
9088 {":type", IMAGE_SYMBOL_VALUE
, 1},
9089 {":file", IMAGE_STRING_VALUE
, 0},
9090 {":data", IMAGE_STRING_VALUE
, 0},
9091 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9092 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9093 {":relief", IMAGE_INTEGER_VALUE
, 0},
9094 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9095 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9096 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9097 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9098 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9101 /* Structure describing the image type XPM. */
9103 static struct image_type xpm_type
=
9113 /* XPM library details. */
9115 DEF_IMGLIB_FN (XpmFreeAttributes
);
9116 DEF_IMGLIB_FN (XpmCreateImageFromBuffer
);
9117 DEF_IMGLIB_FN (XpmReadFileToImage
);
9118 DEF_IMGLIB_FN (XImageFree
);
9122 init_xpm_functions (library
)
9125 LOAD_IMGLIB_FN (library
, XpmFreeAttributes
);
9126 LOAD_IMGLIB_FN (library
, XpmCreateImageFromBuffer
);
9127 LOAD_IMGLIB_FN (library
, XpmReadFileToImage
);
9128 LOAD_IMGLIB_FN (library
, XImageFree
);
9133 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
9134 for XPM images. Such a list must consist of conses whose car and
9138 xpm_valid_color_symbols_p (color_symbols
)
9139 Lisp_Object color_symbols
;
9141 while (CONSP (color_symbols
))
9143 Lisp_Object sym
= XCAR (color_symbols
);
9145 || !STRINGP (XCAR (sym
))
9146 || !STRINGP (XCDR (sym
)))
9148 color_symbols
= XCDR (color_symbols
);
9151 return NILP (color_symbols
);
9155 /* Value is non-zero if OBJECT is a valid XPM image specification. */
9158 xpm_image_p (object
)
9161 struct image_keyword fmt
[XPM_LAST
];
9162 bcopy (xpm_format
, fmt
, sizeof fmt
);
9163 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
9164 /* Either `:file' or `:data' must be present. */
9165 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
9166 /* Either no `:color-symbols' or it's a list of conses
9167 whose car and cdr are strings. */
9168 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
9169 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
9173 /* Load image IMG which will be displayed on frame F. Value is
9174 non-zero if successful. */
9183 XpmAttributes attrs
;
9184 Lisp_Object specified_file
, color_symbols
;
9185 xpm_XImage
* xpm_image
, * xpm_mask
;
9187 /* Configure the XPM lib. Use the visual of frame F. Allocate
9188 close colors. Return colors allocated. */
9189 bzero (&attrs
, sizeof attrs
);
9190 xpm_image
= xpm_mask
= NULL
;
9193 attrs
.visual
= FRAME_X_VISUAL (f
);
9194 attrs
.colormap
= FRAME_X_COLORMAP (f
);
9195 attrs
.valuemask
|= XpmVisual
;
9196 attrs
.valuemask
|= XpmColormap
;
9198 attrs
.valuemask
|= XpmReturnAllocPixels
;
9199 #ifdef XpmAllocCloseColors
9200 attrs
.alloc_close_colors
= 1;
9201 attrs
.valuemask
|= XpmAllocCloseColors
;
9203 attrs
.closeness
= 600;
9204 attrs
.valuemask
|= XpmCloseness
;
9207 /* If image specification contains symbolic color definitions, add
9208 these to `attrs'. */
9209 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
9210 if (CONSP (color_symbols
))
9213 XpmColorSymbol
*xpm_syms
;
9216 attrs
.valuemask
|= XpmColorSymbols
;
9218 /* Count number of symbols. */
9219 attrs
.numsymbols
= 0;
9220 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
9223 /* Allocate an XpmColorSymbol array. */
9224 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
9225 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
9226 bzero (xpm_syms
, size
);
9227 attrs
.colorsymbols
= xpm_syms
;
9229 /* Fill the color symbol array. */
9230 for (tail
= color_symbols
, i
= 0;
9232 ++i
, tail
= XCDR (tail
))
9234 Lisp_Object name
= XCAR (XCAR (tail
));
9235 Lisp_Object color
= XCDR (XCAR (tail
));
9236 xpm_syms
[i
].name
= (char *) alloca (SCHARS (name
) + 1);
9237 strcpy (xpm_syms
[i
].name
, SDATA (name
));
9238 xpm_syms
[i
].value
= (char *) alloca (SCHARS (color
) + 1);
9239 strcpy (xpm_syms
[i
].value
, SDATA (color
));
9243 /* Create a pixmap for the image, either from a file, or from a
9244 string buffer containing data in the same format as an XPM file. */
9246 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9249 HDC frame_dc
= get_frame_dc (f
);
9250 hdc
= CreateCompatibleDC (frame_dc
);
9251 release_frame_dc (f
, frame_dc
);
9254 if (STRINGP (specified_file
))
9256 Lisp_Object file
= x_find_image_file (specified_file
);
9257 if (!STRINGP (file
))
9259 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9263 /* XpmReadFileToPixmap is not available in the Windows port of
9264 libxpm. But XpmReadFileToImage almost does what we want. */
9265 rc
= fn_XpmReadFileToImage (&hdc
, SDATA (file
),
9266 &xpm_image
, &xpm_mask
,
9271 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
9272 /* XpmCreatePixmapFromBuffer is not available in the Windows port
9273 of libxpm. But XpmCreateImageFromBuffer almost does what we want. */
9274 rc
= fn_XpmCreateImageFromBuffer (&hdc
, SDATA (buffer
),
9275 &xpm_image
, &xpm_mask
,
9279 if (rc
== XpmSuccess
)
9283 /* W32 XPM uses XImage to wrap what W32 Emacs calls a Pixmap,
9284 plus some duplicate attributes. */
9285 if (xpm_image
&& xpm_image
->bitmap
)
9287 img
->pixmap
= xpm_image
->bitmap
;
9288 /* XImageFree in libXpm frees XImage struct without destroying
9289 the bitmap, which is what we want. */
9290 fn_XImageFree (xpm_image
);
9292 if (xpm_mask
&& xpm_mask
->bitmap
)
9294 /* The mask appears to be inverted compared with what we expect.
9295 TODO: invert our expectations. See other places where we
9296 have to invert bits because our idea of masks is backwards. */
9298 old_obj
= SelectObject (hdc
, xpm_mask
->bitmap
);
9300 PatBlt (hdc
, 0, 0, xpm_mask
->width
, xpm_mask
->height
, DSTINVERT
);
9301 SelectObject (hdc
, old_obj
);
9303 img
->mask
= xpm_mask
->bitmap
;
9304 fn_XImageFree (xpm_mask
);
9310 /* Remember allocated colors. */
9311 img
->ncolors
= attrs
.nalloc_pixels
;
9312 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
9313 * sizeof *img
->colors
);
9314 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
9315 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
9317 img
->width
= attrs
.width
;
9318 img
->height
= attrs
.height
;
9319 xassert (img
->width
> 0 && img
->height
> 0);
9321 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
9322 fn_XpmFreeAttributes (&attrs
);
9331 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
9334 case XpmFileInvalid
:
9335 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
9339 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
9342 case XpmColorFailed
:
9343 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
9347 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
9352 return rc
== XpmSuccess
;
9355 #endif /* HAVE_XPM != 0 */
9358 #if 0 /* TODO : Color tables on W32. */
9359 /***********************************************************************
9361 ***********************************************************************/
9363 /* An entry in the color table mapping an RGB color to a pixel color. */
9368 unsigned long pixel
;
9370 /* Next in color table collision list. */
9371 struct ct_color
*next
;
9374 /* The bucket vector size to use. Must be prime. */
9378 /* Value is a hash of the RGB color given by R, G, and B. */
9380 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
9382 /* The color hash table. */
9384 struct ct_color
**ct_table
;
9386 /* Number of entries in the color table. */
9388 int ct_colors_allocated
;
9390 /* Function prototypes. */
9392 static void init_color_table
P_ ((void));
9393 static void free_color_table
P_ ((void));
9394 static unsigned long *colors_in_color_table
P_ ((int *n
));
9395 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
9396 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
9399 /* Initialize the color table. */
9404 int size
= CT_SIZE
* sizeof (*ct_table
);
9405 ct_table
= (struct ct_color
**) xmalloc (size
);
9406 bzero (ct_table
, size
);
9407 ct_colors_allocated
= 0;
9411 /* Free memory associated with the color table. */
9417 struct ct_color
*p
, *next
;
9419 for (i
= 0; i
< CT_SIZE
; ++i
)
9420 for (p
= ct_table
[i
]; p
; p
= next
)
9431 /* Value is a pixel color for RGB color R, G, B on frame F. If an
9432 entry for that color already is in the color table, return the
9433 pixel color of that entry. Otherwise, allocate a new color for R,
9434 G, B, and make an entry in the color table. */
9436 static unsigned long
9437 lookup_rgb_color (f
, r
, g
, b
)
9441 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
9442 int i
= hash
% CT_SIZE
;
9445 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9446 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
9455 color
= PALETTERGB (r
, g
, b
);
9457 ++ct_colors_allocated
;
9459 p
= (struct ct_color
*) xmalloc (sizeof *p
);
9464 p
->next
= ct_table
[i
];
9472 /* Look up pixel color PIXEL which is used on frame F in the color
9473 table. If not already present, allocate it. Value is PIXEL. */
9475 static unsigned long
9476 lookup_pixel_color (f
, pixel
)
9478 unsigned long pixel
;
9480 int i
= pixel
% CT_SIZE
;
9483 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9484 if (p
->pixel
== pixel
)
9495 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9496 color
.pixel
= pixel
;
9497 XQueryColor (NULL
, cmap
, &color
);
9498 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
9503 ++ct_colors_allocated
;
9505 p
= (struct ct_color
*) xmalloc (sizeof *p
);
9510 p
->next
= ct_table
[i
];
9514 return FRAME_FOREGROUND_PIXEL (f
);
9520 /* Value is a vector of all pixel colors contained in the color table,
9521 allocated via xmalloc. Set *N to the number of colors. */
9523 static unsigned long *
9524 colors_in_color_table (n
)
9529 unsigned long *colors
;
9531 if (ct_colors_allocated
== 0)
9538 colors
= (unsigned long *) xmalloc (ct_colors_allocated
9540 *n
= ct_colors_allocated
;
9542 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
9543 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9544 colors
[j
++] = p
->pixel
;
9553 /***********************************************************************
9555 ***********************************************************************/
9556 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
9557 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
9558 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
9559 static void XPutPixel (XImage
*, int, int, COLORREF
);
9561 /* Non-zero means draw a cross on images having `:conversion
9564 int cross_disabled_images
;
9566 /* Edge detection matrices for different edge-detection
9569 static int emboss_matrix
[9] = {
9571 2, -1, 0, /* y - 1 */
9573 0, 1, -2 /* y + 1 */
9576 static int laplace_matrix
[9] = {
9578 1, 0, 0, /* y - 1 */
9580 0, 0, -1 /* y + 1 */
9583 /* Value is the intensity of the color whose red/green/blue values
9586 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
9589 /* On frame F, return an array of XColor structures describing image
9590 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
9591 non-zero means also fill the red/green/blue members of the XColor
9592 structures. Value is a pointer to the array of XColors structures,
9593 allocated with xmalloc; it must be freed by the caller. */
9596 x_to_xcolors (f
, img
, rgb_p
)
9606 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
9608 /* Load the image into a memory device context. */
9609 hdc
= get_frame_dc (f
);
9610 bmpdc
= CreateCompatibleDC (hdc
);
9611 release_frame_dc (f
, hdc
);
9612 prev
= SelectObject (bmpdc
, img
->pixmap
);
9614 /* Fill the `pixel' members of the XColor array. I wished there
9615 were an easy and portable way to circumvent XGetPixel. */
9617 for (y
= 0; y
< img
->height
; ++y
)
9621 for (x
= 0; x
< img
->width
; ++x
, ++p
)
9623 /* TODO: palette support needed here? */
9624 p
->pixel
= GetPixel (bmpdc
, x
, y
);
9628 p
->red
= 256 * GetRValue (p
->pixel
);
9629 p
->green
= 256 * GetGValue (p
->pixel
);
9630 p
->blue
= 256 * GetBValue (p
->pixel
);
9635 SelectObject (bmpdc
, prev
);
9641 /* Put a pixel of COLOR at position X, Y in XIMG. XIMG must have been
9642 created with CreateDIBSection, with the pointer to the bit values
9643 stored in ximg->data. */
9645 static void XPutPixel (ximg
, x
, y
, color
)
9650 int width
= ximg
->info
.bmiHeader
.biWidth
;
9651 int height
= ximg
->info
.bmiHeader
.biHeight
;
9652 unsigned char * pixel
;
9654 /* True color images. */
9655 if (ximg
->info
.bmiHeader
.biBitCount
== 24)
9657 int rowbytes
= width
* 3;
9658 /* Ensure scanlines are aligned on 4 byte boundaries. */
9660 rowbytes
+= 4 - (rowbytes
% 4);
9662 pixel
= ximg
->data
+ y
* rowbytes
+ x
* 3;
9663 /* Windows bitmaps are in BGR order. */
9664 *pixel
= GetBValue (color
);
9665 *(pixel
+ 1) = GetGValue (color
);
9666 *(pixel
+ 2) = GetRValue (color
);
9668 /* Monochrome images. */
9669 else if (ximg
->info
.bmiHeader
.biBitCount
== 1)
9671 int rowbytes
= width
/ 8;
9672 /* Ensure scanlines are aligned on 4 byte boundaries. */
9674 rowbytes
+= 4 - (rowbytes
% 4);
9675 pixel
= ximg
->data
+ y
* rowbytes
+ x
/ 8;
9676 /* Filter out palette info. */
9677 if (color
& 0x00ffffff)
9678 *pixel
= *pixel
| (1 << x
% 8);
9680 *pixel
= *pixel
& ~(1 << x
% 8);
9683 image_error ("XPutPixel: palette image not supported", Qnil
, Qnil
);
9686 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
9687 RGB members are set. F is the frame on which this all happens.
9688 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
9691 x_from_xcolors (f
, img
, colors
)
9700 #if 0 /* TODO: color tables. */
9701 init_color_table ();
9703 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
9706 for (y
= 0; y
< img
->height
; ++y
)
9707 for (x
= 0; x
< img
->width
; ++x
, ++p
)
9709 unsigned long pixel
;
9710 #if 0 /* TODO: color tables. */
9711 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
9713 pixel
= PALETTERGB (p
->red
/ 256, p
->green
/ 256, p
->blue
/ 256);
9715 XPutPixel (oimg
, x
, y
, pixel
);
9719 x_clear_image_1 (f
, img
, 1, 0, 1);
9721 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
9722 x_destroy_x_image (oimg
);
9723 img
->pixmap
= pixmap
;
9724 #if 0 /* TODO: color tables. */
9725 img
->colors
= colors_in_color_table (&img
->ncolors
);
9726 free_color_table ();
9731 /* On frame F, perform edge-detection on image IMG.
9733 MATRIX is a nine-element array specifying the transformation
9734 matrix. See emboss_matrix for an example.
9736 COLOR_ADJUST is a color adjustment added to each pixel of the
9740 x_detect_edges (f
, img
, matrix
, color_adjust
)
9743 int matrix
[9], color_adjust
;
9745 XColor
*colors
= x_to_xcolors (f
, img
, 1);
9749 for (i
= sum
= 0; i
< 9; ++i
)
9750 sum
+= abs (matrix
[i
]);
9752 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
9754 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
9756 for (y
= 0; y
< img
->height
; ++y
)
9758 p
= COLOR (new, 0, y
);
9759 p
->red
= p
->green
= p
->blue
= 0xffff/2;
9760 p
= COLOR (new, img
->width
- 1, y
);
9761 p
->red
= p
->green
= p
->blue
= 0xffff/2;
9764 for (x
= 1; x
< img
->width
- 1; ++x
)
9766 p
= COLOR (new, x
, 0);
9767 p
->red
= p
->green
= p
->blue
= 0xffff/2;
9768 p
= COLOR (new, x
, img
->height
- 1);
9769 p
->red
= p
->green
= p
->blue
= 0xffff/2;
9772 for (y
= 1; y
< img
->height
- 1; ++y
)
9774 p
= COLOR (new, 1, y
);
9776 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
9778 int r
, g
, b
, y1
, x1
;
9781 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
9782 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
9785 XColor
*t
= COLOR (colors
, x1
, y1
);
9786 r
+= matrix
[i
] * t
->red
;
9787 g
+= matrix
[i
] * t
->green
;
9788 b
+= matrix
[i
] * t
->blue
;
9791 r
= (r
/ sum
+ color_adjust
) & 0xffff;
9792 g
= (g
/ sum
+ color_adjust
) & 0xffff;
9793 b
= (b
/ sum
+ color_adjust
) & 0xffff;
9794 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
9799 x_from_xcolors (f
, img
, new);
9805 /* Perform the pre-defined `emboss' edge-detection on image IMG
9813 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
9817 /* Transform image IMG which is used on frame F with a Laplace
9818 edge-detection algorithm. The result is an image that can be used
9819 to draw disabled buttons, for example. */
9826 x_detect_edges (f
, img
, laplace_matrix
, 45000);
9830 /* Perform edge-detection on image IMG on frame F, with specified
9831 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
9833 MATRIX must be either
9835 - a list of at least 9 numbers in row-major form
9836 - a vector of at least 9 numbers
9838 COLOR_ADJUST nil means use a default; otherwise it must be a
9842 x_edge_detection (f
, img
, matrix
, color_adjust
)
9845 Lisp_Object matrix
, color_adjust
;
9853 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
9854 ++i
, matrix
= XCDR (matrix
))
9855 trans
[i
] = XFLOATINT (XCAR (matrix
));
9857 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
9859 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
9860 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
9863 if (NILP (color_adjust
))
9864 color_adjust
= make_number (0xffff / 2);
9866 if (i
== 9 && NUMBERP (color_adjust
))
9867 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
9871 /* Transform image IMG on frame F so that it looks disabled. */
9874 x_disable_image (f
, img
)
9878 struct w32_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
9880 if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
>= 2)
9882 /* Color (or grayscale). Convert to gray, and equalize. Just
9883 drawing such images with a stipple can look very odd, so
9884 we're using this method instead. */
9885 XColor
*colors
= x_to_xcolors (f
, img
, 1);
9887 const int h
= 15000;
9888 const int l
= 30000;
9890 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
9894 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
9895 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
9896 p
->red
= p
->green
= p
->blue
= i2
;
9899 x_from_xcolors (f
, img
, colors
);
9902 /* Draw a cross over the disabled image, if we must or if we
9904 if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
< 2 || cross_disabled_images
)
9909 hdc
= get_frame_dc (f
);
9910 bmpdc
= CreateCompatibleDC (hdc
);
9911 release_frame_dc (f
, hdc
);
9913 prev
= SelectObject (bmpdc
, img
->pixmap
);
9915 SetTextColor (bmpdc
, BLACK_PIX_DEFAULT (f
));
9916 MoveToEx (bmpdc
, 0, 0, NULL
);
9917 LineTo (bmpdc
, img
->width
- 1, img
->height
- 1);
9918 MoveToEx (bmpdc
, 0, img
->height
- 1, NULL
);
9919 LineTo (bmpdc
, img
->width
- 1, 0);
9923 SelectObject (bmpdc
, img
->mask
);
9924 SetTextColor (bmpdc
, WHITE_PIX_DEFAULT (f
));
9925 MoveToEx (bmpdc
, 0, 0, NULL
);
9926 LineTo (bmpdc
, img
->width
- 1, img
->height
- 1);
9927 MoveToEx (bmpdc
, 0, img
->height
- 1, NULL
);
9928 LineTo (bmpdc
, img
->width
- 1, 0);
9930 SelectObject (bmpdc
, prev
);
9936 /* Build a mask for image IMG which is used on frame F. FILE is the
9937 name of an image file, for error messages. HOW determines how to
9938 determine the background color of IMG. If it is a list '(R G B)',
9939 with R, G, and B being integers >= 0, take that as the color of the
9940 background. Otherwise, determine the background color of IMG
9941 heuristically. Value is non-zero if successful. */
9944 x_build_heuristic_mask (f
, img
, how
)
9949 HDC img_dc
, frame_dc
;
9952 int x
, y
, rc
, use_img_background
;
9953 unsigned long bg
= 0;
9958 DeleteObject (img
->mask
);
9960 img
->background_transparent_valid
= 0;
9963 /* Create the bit array serving as mask. */
9964 row_width
= (img
->width
+ 7) / 8;
9965 mask_img
= xmalloc (row_width
* img
->height
);
9966 bzero (mask_img
, row_width
* img
->height
);
9968 /* Create a memory device context for IMG->pixmap. */
9969 frame_dc
= get_frame_dc (f
);
9970 img_dc
= CreateCompatibleDC (frame_dc
);
9971 release_frame_dc (f
, frame_dc
);
9972 prev
= SelectObject (img_dc
, img
->pixmap
);
9974 /* Determine the background color of img_dc. If HOW is `(R G B)'
9975 take that as color. Otherwise, use the image's background color. */
9976 use_img_background
= 1;
9982 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
9984 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
9988 if (i
== 3 && NILP (how
))
9990 char color_name
[30];
9991 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
9992 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0)
9993 & 0x00ffffff; /* Filter out palette info. */
9994 use_img_background
= 0;
9998 if (use_img_background
)
9999 bg
= four_corners_best (img_dc
, img
->width
, img
->height
);
10001 /* Set all bits in mask_img to 1 whose color in ximg is different
10002 from the background color bg. */
10003 for (y
= 0; y
< img
->height
; ++y
)
10004 for (x
= 0; x
< img
->width
; ++x
)
10006 COLORREF p
= GetPixel (img_dc
, x
, y
);
10008 mask_img
[y
* row_width
+ x
/ 8] |= 1 << (x
% 8);
10011 /* Create the mask image. */
10012 img
->mask
= w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
,
10015 /* Fill in the background_transparent field while we have the mask handy. */
10016 SelectObject (img_dc
, img
->mask
);
10018 image_background_transparent (img
, f
, img_dc
);
10020 /* Put mask_img into img->mask. */
10021 x_destroy_x_image ((XImage
*)mask_img
);
10022 SelectObject (img_dc
, prev
);
10029 /***********************************************************************
10030 PBM (mono, gray, color)
10031 ***********************************************************************/
10033 static int pbm_image_p
P_ ((Lisp_Object object
));
10034 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
10035 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
10037 /* The symbol `pbm' identifying images of this type. */
10041 /* Indices of image specification fields in gs_format, below. */
10043 enum pbm_keyword_index
10052 PBM_HEURISTIC_MASK
,
10059 /* Vector of image_keyword structures describing the format
10060 of valid user-defined image specifications. */
10062 static struct image_keyword pbm_format
[PBM_LAST
] =
10064 {":type", IMAGE_SYMBOL_VALUE
, 1},
10065 {":file", IMAGE_STRING_VALUE
, 0},
10066 {":data", IMAGE_STRING_VALUE
, 0},
10067 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10068 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10069 {":relief", IMAGE_INTEGER_VALUE
, 0},
10070 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10071 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10072 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10073 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
10074 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10077 /* Structure describing the image type `pbm'. */
10079 static struct image_type pbm_type
=
10089 /* Return non-zero if OBJECT is a valid PBM image specification. */
10092 pbm_image_p (object
)
10093 Lisp_Object object
;
10095 struct image_keyword fmt
[PBM_LAST
];
10097 bcopy (pbm_format
, fmt
, sizeof fmt
);
10099 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
10102 /* Must specify either :data or :file. */
10103 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
10107 /* Scan a decimal number from *S and return it. Advance *S while
10108 reading the number. END is the end of the string. Value is -1 at
10112 pbm_scan_number (s
, end
)
10113 unsigned char **s
, *end
;
10119 /* Skip white-space. */
10120 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
10125 /* Skip comment to end of line. */
10126 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
10129 else if (isdigit (c
))
10131 /* Read decimal number. */
10133 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
10134 val
= 10 * val
+ c
- '0';
10145 /* Read FILE into memory. Value is a pointer to a buffer allocated
10146 with xmalloc holding FILE's contents. Value is null if an error
10147 occurred. *SIZE is set to the size of the file. */
10150 pbm_read_file (file
, size
)
10158 if (stat (SDATA (file
), &st
) == 0
10159 && (fp
= fopen (SDATA (file
), "rb")) != NULL
10160 && (buf
= (char *) xmalloc (st
.st_size
),
10161 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
10163 *size
= st
.st_size
;
10181 /* Load PBM image IMG for use on frame F. */
10189 int width
, height
, max_color_idx
= 0;
10191 Lisp_Object file
, specified_file
;
10192 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
10193 struct gcpro gcpro1
;
10194 unsigned char *contents
= NULL
;
10195 unsigned char *end
, *p
;
10198 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10202 if (STRINGP (specified_file
))
10204 file
= x_find_image_file (specified_file
);
10205 if (!STRINGP (file
))
10207 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10212 contents
= slurp_file (SDATA (file
), &size
);
10213 if (contents
== NULL
)
10215 image_error ("Error reading `%s'", file
, Qnil
);
10221 end
= contents
+ size
;
10226 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10228 end
= p
+ SBYTES (data
);
10231 /* Check magic number. */
10232 if (end
- p
< 2 || *p
++ != 'P')
10234 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10244 raw_p
= 0, type
= PBM_MONO
;
10248 raw_p
= 0, type
= PBM_GRAY
;
10252 raw_p
= 0, type
= PBM_COLOR
;
10256 raw_p
= 1, type
= PBM_MONO
;
10260 raw_p
= 1, type
= PBM_GRAY
;
10264 raw_p
= 1, type
= PBM_COLOR
;
10268 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10272 /* Read width, height, maximum color-component. Characters
10273 starting with `#' up to the end of a line are ignored. */
10274 width
= pbm_scan_number (&p
, end
);
10275 height
= pbm_scan_number (&p
, end
);
10277 if (type
!= PBM_MONO
)
10279 max_color_idx
= pbm_scan_number (&p
, end
);
10280 if (raw_p
&& max_color_idx
> 255)
10281 max_color_idx
= 255;
10286 || (type
!= PBM_MONO
&& max_color_idx
< 0))
10289 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10292 #if 0 /* TODO: color tables. */
10293 /* Initialize the color hash table. */
10294 init_color_table ();
10297 if (type
== PBM_MONO
)
10300 struct image_keyword fmt
[PBM_LAST
];
10301 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
10302 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
10304 /* Parse the image specification. */
10305 bcopy (pbm_format
, fmt
, sizeof fmt
);
10306 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
10308 /* Get foreground and background colors, maybe allocate colors. */
10309 if (fmt
[PBM_FOREGROUND
].count
10310 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
10311 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
10312 if (fmt
[PBM_BACKGROUND
].count
10313 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
10315 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
10316 img
->background
= bg
;
10317 img
->background_valid
= 1;
10320 for (y
= 0; y
< height
; ++y
)
10321 for (x
= 0; x
< width
; ++x
)
10331 g
= pbm_scan_number (&p
, end
);
10333 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
10338 for (y
= 0; y
< height
; ++y
)
10339 for (x
= 0; x
< width
; ++x
)
10343 if (type
== PBM_GRAY
)
10344 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
10353 r
= pbm_scan_number (&p
, end
);
10354 g
= pbm_scan_number (&p
, end
);
10355 b
= pbm_scan_number (&p
, end
);
10358 if (r
< 0 || g
< 0 || b
< 0)
10360 x_destroy_x_image (ximg
);
10361 image_error ("Invalid pixel value in image `%s'",
10366 /* RGB values are now in the range 0..max_color_idx.
10367 Scale this to the range 0..0xff supported by W32. */
10368 r
= (int) ((double) r
* 255 / max_color_idx
);
10369 g
= (int) ((double) g
* 255 / max_color_idx
);
10370 b
= (int) ((double) b
* 255 / max_color_idx
);
10371 XPutPixel (ximg
, x
, y
,
10372 #if 0 /* TODO: color tables. */
10373 lookup_rgb_color (f
, r
, g
, b
));
10375 PALETTERGB (r
, g
, b
));
10380 #if 0 /* TODO: color tables. */
10381 /* Store in IMG->colors the colors allocated for the image, and
10382 free the color table. */
10383 img
->colors
= colors_in_color_table (&img
->ncolors
);
10384 free_color_table ();
10386 /* Maybe fill in the background field while we have ximg handy. */
10387 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10388 IMAGE_BACKGROUND (img
, f
, ximg
);
10390 /* Put the image into a pixmap. */
10391 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10392 x_destroy_x_image (ximg
);
10394 img
->width
= width
;
10395 img
->height
= height
;
10403 /***********************************************************************
10405 ***********************************************************************/
10411 /* Function prototypes. */
10413 static int png_image_p
P_ ((Lisp_Object object
));
10414 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
10416 /* The symbol `png' identifying images of this type. */
10420 /* Indices of image specification fields in png_format, below. */
10422 enum png_keyword_index
10431 PNG_HEURISTIC_MASK
,
10437 /* Vector of image_keyword structures describing the format
10438 of valid user-defined image specifications. */
10440 static struct image_keyword png_format
[PNG_LAST
] =
10442 {":type", IMAGE_SYMBOL_VALUE
, 1},
10443 {":data", IMAGE_STRING_VALUE
, 0},
10444 {":file", IMAGE_STRING_VALUE
, 0},
10445 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10446 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10447 {":relief", IMAGE_INTEGER_VALUE
, 0},
10448 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10449 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10450 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10451 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10454 /* Structure describing the image type `png'. */
10456 static struct image_type png_type
=
10465 /* PNG library details. */
10467 DEF_IMGLIB_FN (png_get_io_ptr
);
10468 DEF_IMGLIB_FN (png_check_sig
);
10469 DEF_IMGLIB_FN (png_create_read_struct
);
10470 DEF_IMGLIB_FN (png_create_info_struct
);
10471 DEF_IMGLIB_FN (png_destroy_read_struct
);
10472 DEF_IMGLIB_FN (png_set_read_fn
);
10473 DEF_IMGLIB_FN (png_init_io
);
10474 DEF_IMGLIB_FN (png_set_sig_bytes
);
10475 DEF_IMGLIB_FN (png_read_info
);
10476 DEF_IMGLIB_FN (png_get_IHDR
);
10477 DEF_IMGLIB_FN (png_get_valid
);
10478 DEF_IMGLIB_FN (png_set_strip_16
);
10479 DEF_IMGLIB_FN (png_set_expand
);
10480 DEF_IMGLIB_FN (png_set_gray_to_rgb
);
10481 DEF_IMGLIB_FN (png_set_background
);
10482 DEF_IMGLIB_FN (png_get_bKGD
);
10483 DEF_IMGLIB_FN (png_read_update_info
);
10484 DEF_IMGLIB_FN (png_get_channels
);
10485 DEF_IMGLIB_FN (png_get_rowbytes
);
10486 DEF_IMGLIB_FN (png_read_image
);
10487 DEF_IMGLIB_FN (png_read_end
);
10488 DEF_IMGLIB_FN (png_error
);
10491 init_png_functions (library
)
10494 LOAD_IMGLIB_FN (library
, png_get_io_ptr
);
10495 LOAD_IMGLIB_FN (library
, png_check_sig
);
10496 LOAD_IMGLIB_FN (library
, png_create_read_struct
);
10497 LOAD_IMGLIB_FN (library
, png_create_info_struct
);
10498 LOAD_IMGLIB_FN (library
, png_destroy_read_struct
);
10499 LOAD_IMGLIB_FN (library
, png_set_read_fn
);
10500 LOAD_IMGLIB_FN (library
, png_init_io
);
10501 LOAD_IMGLIB_FN (library
, png_set_sig_bytes
);
10502 LOAD_IMGLIB_FN (library
, png_read_info
);
10503 LOAD_IMGLIB_FN (library
, png_get_IHDR
);
10504 LOAD_IMGLIB_FN (library
, png_get_valid
);
10505 LOAD_IMGLIB_FN (library
, png_set_strip_16
);
10506 LOAD_IMGLIB_FN (library
, png_set_expand
);
10507 LOAD_IMGLIB_FN (library
, png_set_gray_to_rgb
);
10508 LOAD_IMGLIB_FN (library
, png_set_background
);
10509 LOAD_IMGLIB_FN (library
, png_get_bKGD
);
10510 LOAD_IMGLIB_FN (library
, png_read_update_info
);
10511 LOAD_IMGLIB_FN (library
, png_get_channels
);
10512 LOAD_IMGLIB_FN (library
, png_get_rowbytes
);
10513 LOAD_IMGLIB_FN (library
, png_read_image
);
10514 LOAD_IMGLIB_FN (library
, png_read_end
);
10515 LOAD_IMGLIB_FN (library
, png_error
);
10519 /* Return non-zero if OBJECT is a valid PNG image specification. */
10522 png_image_p (object
)
10523 Lisp_Object object
;
10525 struct image_keyword fmt
[PNG_LAST
];
10526 bcopy (png_format
, fmt
, sizeof fmt
);
10528 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
10531 /* Must specify either the :data or :file keyword. */
10532 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
10536 /* Error and warning handlers installed when the PNG library
10540 my_png_error (png_ptr
, msg
)
10541 png_struct
*png_ptr
;
10544 xassert (png_ptr
!= NULL
);
10545 image_error ("PNG error: %s", build_string (msg
), Qnil
);
10546 longjmp (png_ptr
->jmpbuf
, 1);
10551 my_png_warning (png_ptr
, msg
)
10552 png_struct
*png_ptr
;
10555 xassert (png_ptr
!= NULL
);
10556 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
10559 /* Memory source for PNG decoding. */
10561 struct png_memory_storage
10563 unsigned char *bytes
; /* The data */
10564 size_t len
; /* How big is it? */
10565 int index
; /* Where are we? */
10569 /* Function set as reader function when reading PNG image from memory.
10570 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
10571 bytes from the input to DATA. */
10574 png_read_from_memory (png_ptr
, data
, length
)
10575 png_structp png_ptr
;
10579 struct png_memory_storage
*tbr
10580 = (struct png_memory_storage
*) fn_png_get_io_ptr (png_ptr
);
10582 if (length
> tbr
->len
- tbr
->index
)
10583 fn_png_error (png_ptr
, "Read error");
10585 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
10586 tbr
->index
= tbr
->index
+ length
;
10589 /* Load PNG image IMG for use on frame F. Value is non-zero if
10597 Lisp_Object file
, specified_file
;
10598 Lisp_Object specified_data
;
10600 XImage
*ximg
, *mask_img
= NULL
;
10601 struct gcpro gcpro1
;
10602 png_struct
*png_ptr
= NULL
;
10603 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
10604 FILE *volatile fp
= NULL
;
10606 png_byte
* volatile pixels
= NULL
;
10607 png_byte
** volatile rows
= NULL
;
10608 png_uint_32 width
, height
;
10609 int bit_depth
, color_type
, interlace_type
;
10611 png_uint_32 row_bytes
;
10613 double screen_gamma
, image_gamma
;
10615 struct png_memory_storage tbr
; /* Data to be read */
10617 /* Find out what file to load. */
10618 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10619 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10623 if (NILP (specified_data
))
10625 file
= x_find_image_file (specified_file
);
10626 if (!STRINGP (file
))
10628 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10633 /* Open the image file. */
10634 fp
= fopen (SDATA (file
), "rb");
10637 image_error ("Cannot open image file `%s'", file
, Qnil
);
10643 /* Check PNG signature. */
10644 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
10645 || !fn_png_check_sig (sig
, sizeof sig
))
10647 image_error ("Not a PNG file: `%s'", file
, Qnil
);
10655 /* Read from memory. */
10656 tbr
.bytes
= SDATA (specified_data
);
10657 tbr
.len
= SBYTES (specified_data
);
10660 /* Check PNG signature. */
10661 if (tbr
.len
< sizeof sig
10662 || !fn_png_check_sig (tbr
.bytes
, sizeof sig
))
10664 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
10669 /* Need to skip past the signature. */
10670 tbr
.bytes
+= sizeof (sig
);
10673 /* Initialize read and info structs for PNG lib. */
10674 png_ptr
= fn_png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
10675 my_png_error
, my_png_warning
);
10678 if (fp
) fclose (fp
);
10683 info_ptr
= fn_png_create_info_struct (png_ptr
);
10686 fn_png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
10687 if (fp
) fclose (fp
);
10692 end_info
= fn_png_create_info_struct (png_ptr
);
10695 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
10696 if (fp
) fclose (fp
);
10701 /* Set error jump-back. We come back here when the PNG library
10702 detects an error. */
10703 if (setjmp (png_ptr
->jmpbuf
))
10707 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
10710 if (fp
) fclose (fp
);
10715 /* Read image info. */
10716 if (!NILP (specified_data
))
10717 fn_png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
10719 fn_png_init_io (png_ptr
, fp
);
10721 fn_png_set_sig_bytes (png_ptr
, sizeof sig
);
10722 fn_png_read_info (png_ptr
, info_ptr
);
10723 fn_png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
10724 &interlace_type
, NULL
, NULL
);
10726 /* If image contains simply transparency data, we prefer to
10727 construct a clipping mask. */
10728 if (fn_png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
10733 /* This function is easier to write if we only have to handle
10734 one data format: RGB or RGBA with 8 bits per channel. Let's
10735 transform other formats into that format. */
10737 /* Strip more than 8 bits per channel. */
10738 if (bit_depth
== 16)
10739 fn_png_set_strip_16 (png_ptr
);
10741 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
10743 fn_png_set_expand (png_ptr
);
10745 /* Convert grayscale images to RGB. */
10746 if (color_type
== PNG_COLOR_TYPE_GRAY
10747 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
10748 fn_png_set_gray_to_rgb (png_ptr
);
10750 screen_gamma
= (f
->gamma
? 1 / f
->gamma
/ 0.45455 : 2.2);
10752 #if 0 /* Avoid double gamma correction for PNG images. */
10753 /* Tell the PNG lib to handle gamma correction for us. */
10754 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
10755 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
10756 /* The libpng documentation says this is right in this case. */
10757 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
10760 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
10761 /* Image contains gamma information. */
10762 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
10764 /* Use the standard default for the image gamma. */
10765 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
10768 /* Handle alpha channel by combining the image with a background
10769 color. Do this only if a real alpha channel is supplied. For
10770 simple transparency, we prefer a clipping mask. */
10771 if (!transparent_p
)
10773 png_color_16
*image_bg
;
10774 Lisp_Object specified_bg
10775 = image_spec_value (img
->spec
, QCbackground
, NULL
);
10777 if (STRINGP (specified_bg
))
10778 /* The user specified `:background', use that. */
10781 if (w32_defined_color (f
, SDATA (specified_bg
), &color
, 0))
10783 png_color_16 user_bg
;
10785 bzero (&user_bg
, sizeof user_bg
);
10786 user_bg
.red
= 256 * GetRValue (color
);
10787 user_bg
.green
= 256 * GetGValue (color
);
10788 user_bg
.blue
= 256 * GetBValue (color
);
10790 fn_png_set_background (png_ptr
, &user_bg
,
10791 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
10794 else if (fn_png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
10795 /* Image contains a background color with which to
10796 combine the image. */
10797 fn_png_set_background (png_ptr
, image_bg
,
10798 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
10801 /* Image does not contain a background color with which
10802 to combine the image data via an alpha channel. Use
10803 the frame's background instead. */
10805 png_color_16 frame_background
;
10806 color
= FRAME_BACKGROUND_PIXEL (f
);
10807 #if 0 /* TODO : Colormap support. */
10810 cmap
= FRAME_X_COLORMAP (f
);
10811 x_query_color (f
, &color
);
10814 bzero (&frame_background
, sizeof frame_background
);
10815 frame_background
.red
= 256 * GetRValue (color
);
10816 frame_background
.green
= 256 * GetGValue (color
);
10817 frame_background
.blue
= 256 * GetBValue (color
);
10819 fn_png_set_background (png_ptr
, &frame_background
,
10820 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
10824 /* Update info structure. */
10825 fn_png_read_update_info (png_ptr
, info_ptr
);
10827 /* Get number of channels. Valid values are 1 for grayscale images
10828 and images with a palette, 2 for grayscale images with transparency
10829 information (alpha channel), 3 for RGB images, and 4 for RGB
10830 images with alpha channel, i.e. RGBA. If conversions above were
10831 sufficient we should only have 3 or 4 channels here. */
10832 channels
= fn_png_get_channels (png_ptr
, info_ptr
);
10833 xassert (channels
== 3 || channels
== 4);
10835 /* Number of bytes needed for one row of the image. */
10836 row_bytes
= fn_png_get_rowbytes (png_ptr
, info_ptr
);
10838 /* Allocate memory for the image. */
10839 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
10840 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
10841 for (i
= 0; i
< height
; ++i
)
10842 rows
[i
] = pixels
+ i
* row_bytes
;
10844 /* Read the entire image. */
10845 fn_png_read_image (png_ptr
, rows
);
10846 fn_png_read_end (png_ptr
, info_ptr
);
10853 /* Create the X image and pixmap. */
10854 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
10858 /* Create an image and pixmap serving as mask if the PNG image
10859 contains an alpha channel. */
10862 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
10863 &mask_img
, &img
->mask
))
10865 x_destroy_x_image (ximg
);
10866 DeleteObject (img
->pixmap
);
10870 /* Fill the X image and mask from PNG data. */
10871 #if 0 /* TODO: Color tables. */
10872 init_color_table ();
10875 for (y
= 0; y
< height
; ++y
)
10877 png_byte
*p
= rows
[y
];
10879 for (x
= 0; x
< width
; ++x
)
10886 #if 0 /* TODO: Color tables. */
10887 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
10889 XPutPixel (ximg
, x
, y
, PALETTERGB (r
, g
, b
));
10891 /* An alpha channel, aka mask channel, associates variable
10892 transparency with an image. Where other image formats
10893 support binary transparency---fully transparent or fully
10894 opaque---PNG allows up to 254 levels of partial transparency.
10895 The PNG library implements partial transparency by combining
10896 the image with a specified background color.
10898 I'm not sure how to handle this here nicely: because the
10899 background on which the image is displayed may change, for
10900 real alpha channel support, it would be necessary to create
10901 a new image for each possible background.
10903 What I'm doing now is that a mask is created if we have
10904 boolean transparency information. Otherwise I'm using
10905 the frame's background color to combine the image with. */
10910 XPutPixel (mask_img
, x
, y
, *p
> 0);
10916 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10917 /* Set IMG's background color from the PNG image, unless the user
10921 if (fn_png_get_bKGD (png_ptr
, info_ptr
, &bg
))
10923 #if 0 /* TODO: Color tables. */
10924 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
10926 img
->background
= PALETTERGB (bg
->red
/ 256, bg
->green
/ 256,
10929 img
->background_valid
= 1;
10933 #if 0 /* TODO: Color tables. */
10934 /* Remember colors allocated for this image. */
10935 img
->colors
= colors_in_color_table (&img
->ncolors
);
10936 free_color_table ();
10940 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
10944 img
->width
= width
;
10945 img
->height
= height
;
10947 /* Maybe fill in the background field while we have ximg handy. */
10948 IMAGE_BACKGROUND (img
, f
, ximg
);
10950 /* Put the image into the pixmap, then free the X image and its buffer. */
10951 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10952 x_destroy_x_image (ximg
);
10954 /* Same for the mask. */
10957 /* Fill in the background_transparent field while we have the mask
10959 image_background_transparent (img
, f
, mask_img
);
10961 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
10962 x_destroy_x_image (mask_img
);
10969 #endif /* HAVE_PNG != 0 */
10973 /***********************************************************************
10975 ***********************************************************************/
10979 /* Work around a warning about HAVE_STDLIB_H being redefined in
10981 #ifdef HAVE_STDLIB_H
10982 #define HAVE_STDLIB_H_1
10983 #undef HAVE_STDLIB_H
10984 #endif /* HAVE_STLIB_H */
10986 #include <jpeglib.h>
10987 #include <jerror.h>
10988 #include <setjmp.h>
10990 #ifdef HAVE_STLIB_H_1
10991 #define HAVE_STDLIB_H 1
10994 static int jpeg_image_p
P_ ((Lisp_Object object
));
10995 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
10997 /* The symbol `jpeg' identifying images of this type. */
11001 /* Indices of image specification fields in gs_format, below. */
11003 enum jpeg_keyword_index
11012 JPEG_HEURISTIC_MASK
,
11018 /* Vector of image_keyword structures describing the format
11019 of valid user-defined image specifications. */
11021 static struct image_keyword jpeg_format
[JPEG_LAST
] =
11023 {":type", IMAGE_SYMBOL_VALUE
, 1},
11024 {":data", IMAGE_STRING_VALUE
, 0},
11025 {":file", IMAGE_STRING_VALUE
, 0},
11026 {":ascent", IMAGE_ASCENT_VALUE
, 0},
11027 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11028 {":relief", IMAGE_INTEGER_VALUE
, 0},
11029 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11030 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11031 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11032 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11035 /* Structure describing the image type `jpeg'. */
11037 static struct image_type jpeg_type
=
11047 /* JPEG library details. */
11048 DEF_IMGLIB_FN (jpeg_CreateDecompress
);
11049 DEF_IMGLIB_FN (jpeg_start_decompress
);
11050 DEF_IMGLIB_FN (jpeg_finish_decompress
);
11051 DEF_IMGLIB_FN (jpeg_destroy_decompress
);
11052 DEF_IMGLIB_FN (jpeg_read_header
);
11053 DEF_IMGLIB_FN (jpeg_read_scanlines
);
11054 DEF_IMGLIB_FN (jpeg_stdio_src
);
11055 DEF_IMGLIB_FN (jpeg_std_error
);
11056 DEF_IMGLIB_FN (jpeg_resync_to_restart
);
11059 init_jpeg_functions (library
)
11062 LOAD_IMGLIB_FN (library
, jpeg_finish_decompress
);
11063 LOAD_IMGLIB_FN (library
, jpeg_read_scanlines
);
11064 LOAD_IMGLIB_FN (library
, jpeg_start_decompress
);
11065 LOAD_IMGLIB_FN (library
, jpeg_read_header
);
11066 LOAD_IMGLIB_FN (library
, jpeg_stdio_src
);
11067 LOAD_IMGLIB_FN (library
, jpeg_CreateDecompress
);
11068 LOAD_IMGLIB_FN (library
, jpeg_destroy_decompress
);
11069 LOAD_IMGLIB_FN (library
, jpeg_std_error
);
11070 LOAD_IMGLIB_FN (library
, jpeg_resync_to_restart
);
11074 /* Wrapper since we can't directly assign the function pointer
11075 to another function pointer that was declared more completely easily. */
11077 jpeg_resync_to_restart_wrapper(cinfo
, desired
)
11078 j_decompress_ptr cinfo
;
11081 return fn_jpeg_resync_to_restart (cinfo
, desired
);
11085 /* Return non-zero if OBJECT is a valid JPEG image specification. */
11088 jpeg_image_p (object
)
11089 Lisp_Object object
;
11091 struct image_keyword fmt
[JPEG_LAST
];
11093 bcopy (jpeg_format
, fmt
, sizeof fmt
);
11095 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
11098 /* Must specify either the :data or :file keyword. */
11099 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
11103 struct my_jpeg_error_mgr
11105 struct jpeg_error_mgr pub
;
11106 jmp_buf setjmp_buffer
;
11111 my_error_exit (cinfo
)
11112 j_common_ptr cinfo
;
11114 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
11115 longjmp (mgr
->setjmp_buffer
, 1);
11119 /* Init source method for JPEG data source manager. Called by
11120 jpeg_read_header() before any data is actually read. See
11121 libjpeg.doc from the JPEG lib distribution. */
11124 our_init_source (cinfo
)
11125 j_decompress_ptr cinfo
;
11130 /* Fill input buffer method for JPEG data source manager. Called
11131 whenever more data is needed. We read the whole image in one step,
11132 so this only adds a fake end of input marker at the end. */
11135 our_fill_input_buffer (cinfo
)
11136 j_decompress_ptr cinfo
;
11138 /* Insert a fake EOI marker. */
11139 struct jpeg_source_mgr
*src
= cinfo
->src
;
11140 static JOCTET buffer
[2];
11142 buffer
[0] = (JOCTET
) 0xFF;
11143 buffer
[1] = (JOCTET
) JPEG_EOI
;
11145 src
->next_input_byte
= buffer
;
11146 src
->bytes_in_buffer
= 2;
11151 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
11152 is the JPEG data source manager. */
11155 our_skip_input_data (cinfo
, num_bytes
)
11156 j_decompress_ptr cinfo
;
11159 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11163 if (num_bytes
> src
->bytes_in_buffer
)
11164 ERREXIT (cinfo
, JERR_INPUT_EOF
);
11166 src
->bytes_in_buffer
-= num_bytes
;
11167 src
->next_input_byte
+= num_bytes
;
11172 /* Method to terminate data source. Called by
11173 jpeg_finish_decompress() after all data has been processed. */
11176 our_term_source (cinfo
)
11177 j_decompress_ptr cinfo
;
11182 /* Set up the JPEG lib for reading an image from DATA which contains
11183 LEN bytes. CINFO is the decompression info structure created for
11184 reading the image. */
11187 jpeg_memory_src (cinfo
, data
, len
)
11188 j_decompress_ptr cinfo
;
11192 struct jpeg_source_mgr
*src
;
11194 if (cinfo
->src
== NULL
)
11196 /* First time for this JPEG object? */
11197 cinfo
->src
= (struct jpeg_source_mgr
*)
11198 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
11199 sizeof (struct jpeg_source_mgr
));
11200 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11201 src
->next_input_byte
= data
;
11204 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11205 src
->init_source
= our_init_source
;
11206 src
->fill_input_buffer
= our_fill_input_buffer
;
11207 src
->skip_input_data
= our_skip_input_data
;
11208 src
->resync_to_restart
= jpeg_resync_to_restart_wrapper
; /* Use default method. */
11209 src
->term_source
= our_term_source
;
11210 src
->bytes_in_buffer
= len
;
11211 src
->next_input_byte
= data
;
11215 /* Load image IMG for use on frame F. Patterned after example.c
11216 from the JPEG lib. */
11223 struct jpeg_decompress_struct cinfo
;
11224 struct my_jpeg_error_mgr mgr
;
11225 Lisp_Object file
, specified_file
;
11226 Lisp_Object specified_data
;
11227 FILE * volatile fp
= NULL
;
11229 int row_stride
, x
, y
;
11230 XImage
*ximg
= NULL
;
11232 unsigned long *colors
;
11234 struct gcpro gcpro1
;
11236 /* Open the JPEG file. */
11237 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11238 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11242 if (NILP (specified_data
))
11244 file
= x_find_image_file (specified_file
);
11245 if (!STRINGP (file
))
11247 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11252 fp
= fopen (SDATA (file
), "rb");
11255 image_error ("Cannot open `%s'", file
, Qnil
);
11261 /* Customize libjpeg's error handling to call my_error_exit when an
11262 error is detected. This function will perform a longjmp. */
11263 cinfo
.err
= fn_jpeg_std_error (&mgr
.pub
);
11264 mgr
.pub
.error_exit
= my_error_exit
;
11266 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
11270 /* Called from my_error_exit. Display a JPEG error. */
11271 char buffer
[JMSG_LENGTH_MAX
];
11272 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
11273 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
11274 build_string (buffer
));
11277 /* Close the input file and destroy the JPEG object. */
11279 fclose ((FILE *) fp
);
11280 fn_jpeg_destroy_decompress (&cinfo
);
11282 /* If we already have an XImage, free that. */
11283 x_destroy_x_image (ximg
);
11285 /* Free pixmap and colors. */
11286 x_clear_image (f
, img
);
11292 /* Create the JPEG decompression object. Let it read from fp.
11293 Read the JPEG image header. */
11294 fn_jpeg_CreateDecompress (&cinfo
, JPEG_LIB_VERSION
, sizeof (cinfo
));
11296 if (NILP (specified_data
))
11297 fn_jpeg_stdio_src (&cinfo
, (FILE *) fp
);
11299 jpeg_memory_src (&cinfo
, SDATA (specified_data
),
11300 SBYTES (specified_data
));
11302 fn_jpeg_read_header (&cinfo
, TRUE
);
11304 /* Customize decompression so that color quantization will be used.
11305 Start decompression. */
11306 cinfo
.quantize_colors
= TRUE
;
11307 fn_jpeg_start_decompress (&cinfo
);
11308 width
= img
->width
= cinfo
.output_width
;
11309 height
= img
->height
= cinfo
.output_height
;
11311 /* Create X image and pixmap. */
11312 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11313 longjmp (mgr
.setjmp_buffer
, 2);
11315 /* Allocate colors. When color quantization is used,
11316 cinfo.actual_number_of_colors has been set with the number of
11317 colors generated, and cinfo.colormap is a two-dimensional array
11318 of color indices in the range 0..cinfo.actual_number_of_colors.
11319 No more than 255 colors will be generated. */
11323 if (cinfo
.out_color_components
> 2)
11324 ir
= 0, ig
= 1, ib
= 2;
11325 else if (cinfo
.out_color_components
> 1)
11326 ir
= 0, ig
= 1, ib
= 0;
11328 ir
= 0, ig
= 0, ib
= 0;
11330 #if 0 /* TODO: Color tables. */
11331 /* Use the color table mechanism because it handles colors that
11332 cannot be allocated nicely. Such colors will be replaced with
11333 a default color, and we don't have to care about which colors
11334 can be freed safely, and which can't. */
11335 init_color_table ();
11337 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
11340 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
11342 int r
= cinfo
.colormap
[ir
][i
];
11343 int g
= cinfo
.colormap
[ig
][i
];
11344 int b
= cinfo
.colormap
[ib
][i
];
11345 #if 0 /* TODO: Color tables. */
11346 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
11348 colors
[i
] = PALETTERGB (r
, g
, b
);
11352 #if 0 /* TODO: Color tables. */
11353 /* Remember those colors actually allocated. */
11354 img
->colors
= colors_in_color_table (&img
->ncolors
);
11355 free_color_table ();
11360 row_stride
= width
* cinfo
.output_components
;
11361 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
11363 for (y
= 0; y
< height
; ++y
)
11365 fn_jpeg_read_scanlines (&cinfo
, buffer
, 1);
11366 for (x
= 0; x
< cinfo
.output_width
; ++x
)
11367 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
11371 fn_jpeg_finish_decompress (&cinfo
);
11372 fn_jpeg_destroy_decompress (&cinfo
);
11374 fclose ((FILE *) fp
);
11376 /* Maybe fill in the background field while we have ximg handy. */
11377 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11378 IMAGE_BACKGROUND (img
, f
, ximg
);
11380 /* Put the image into the pixmap. */
11381 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11382 x_destroy_x_image (ximg
);
11387 #endif /* HAVE_JPEG */
11391 /***********************************************************************
11393 ***********************************************************************/
11397 #include <tiffio.h>
11399 static int tiff_image_p
P_ ((Lisp_Object object
));
11400 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
11402 /* The symbol `tiff' identifying images of this type. */
11406 /* Indices of image specification fields in tiff_format, below. */
11408 enum tiff_keyword_index
11417 TIFF_HEURISTIC_MASK
,
11423 /* Vector of image_keyword structures describing the format
11424 of valid user-defined image specifications. */
11426 static struct image_keyword tiff_format
[TIFF_LAST
] =
11428 {":type", IMAGE_SYMBOL_VALUE
, 1},
11429 {":data", IMAGE_STRING_VALUE
, 0},
11430 {":file", IMAGE_STRING_VALUE
, 0},
11431 {":ascent", IMAGE_ASCENT_VALUE
, 0},
11432 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11433 {":relief", IMAGE_INTEGER_VALUE
, 0},
11434 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11435 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11436 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11437 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11440 /* Structure describing the image type `tiff'. */
11442 static struct image_type tiff_type
=
11451 /* TIFF library details. */
11452 DEF_IMGLIB_FN (TIFFSetErrorHandler
);
11453 DEF_IMGLIB_FN (TIFFSetWarningHandler
);
11454 DEF_IMGLIB_FN (TIFFOpen
);
11455 DEF_IMGLIB_FN (TIFFClientOpen
);
11456 DEF_IMGLIB_FN (TIFFGetField
);
11457 DEF_IMGLIB_FN (TIFFReadRGBAImage
);
11458 DEF_IMGLIB_FN (TIFFClose
);
11461 init_tiff_functions (library
)
11464 LOAD_IMGLIB_FN (library
, TIFFSetErrorHandler
);
11465 LOAD_IMGLIB_FN (library
, TIFFSetWarningHandler
);
11466 LOAD_IMGLIB_FN (library
, TIFFOpen
);
11467 LOAD_IMGLIB_FN (library
, TIFFClientOpen
);
11468 LOAD_IMGLIB_FN (library
, TIFFGetField
);
11469 LOAD_IMGLIB_FN (library
, TIFFReadRGBAImage
);
11470 LOAD_IMGLIB_FN (library
, TIFFClose
);
11474 /* Return non-zero if OBJECT is a valid TIFF image specification. */
11477 tiff_image_p (object
)
11478 Lisp_Object object
;
11480 struct image_keyword fmt
[TIFF_LAST
];
11481 bcopy (tiff_format
, fmt
, sizeof fmt
);
11483 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
11486 /* Must specify either the :data or :file keyword. */
11487 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
11491 /* Reading from a memory buffer for TIFF images Based on the PNG
11492 memory source, but we have to provide a lot of extra functions.
11495 We really only need to implement read and seek, but I am not
11496 convinced that the TIFF library is smart enough not to destroy
11497 itself if we only hand it the function pointers we need to
11502 unsigned char *bytes
;
11506 tiff_memory_source
;
11509 tiff_read_from_memory (data
, buf
, size
)
11514 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11516 if (size
> src
->len
- src
->index
)
11517 return (size_t) -1;
11518 bcopy (src
->bytes
+ src
->index
, buf
, size
);
11519 src
->index
+= size
;
11524 tiff_write_from_memory (data
, buf
, size
)
11529 return (size_t) -1;
11533 tiff_seek_in_memory (data
, off
, whence
)
11538 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11543 case SEEK_SET
: /* Go from beginning of source. */
11547 case SEEK_END
: /* Go from end of source. */
11548 idx
= src
->len
+ off
;
11551 case SEEK_CUR
: /* Go from current position. */
11552 idx
= src
->index
+ off
;
11555 default: /* Invalid `whence'. */
11559 if (idx
> src
->len
|| idx
< 0)
11567 tiff_close_memory (data
)
11575 tiff_mmap_memory (data
, pbase
, psize
)
11580 /* It is already _IN_ memory. */
11585 tiff_unmap_memory (data
, base
, size
)
11590 /* We don't need to do this. */
11594 tiff_size_of_memory (data
)
11597 return ((tiff_memory_source
*) data
)->len
;
11602 tiff_error_handler (title
, format
, ap
)
11603 const char *title
, *format
;
11609 len
= sprintf (buf
, "TIFF error: %s ", title
);
11610 vsprintf (buf
+ len
, format
, ap
);
11611 add_to_log (buf
, Qnil
, Qnil
);
11616 tiff_warning_handler (title
, format
, ap
)
11617 const char *title
, *format
;
11623 len
= sprintf (buf
, "TIFF warning: %s ", title
);
11624 vsprintf (buf
+ len
, format
, ap
);
11625 add_to_log (buf
, Qnil
, Qnil
);
11629 /* Load TIFF image IMG for use on frame F. Value is non-zero if
11637 Lisp_Object file
, specified_file
;
11638 Lisp_Object specified_data
;
11640 int width
, height
, x
, y
;
11644 struct gcpro gcpro1
;
11645 tiff_memory_source memsrc
;
11647 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11648 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11652 fn_TIFFSetErrorHandler (tiff_error_handler
);
11653 fn_TIFFSetWarningHandler (tiff_warning_handler
);
11655 if (NILP (specified_data
))
11657 /* Read from a file */
11658 file
= x_find_image_file (specified_file
);
11659 if (!STRINGP (file
))
11661 image_error ("Cannot find image file `%s'", file
, Qnil
);
11666 /* Try to open the image file. */
11667 tiff
= fn_TIFFOpen (SDATA (file
), "r");
11670 image_error ("Cannot open `%s'", file
, Qnil
);
11677 /* Memory source! */
11678 memsrc
.bytes
= SDATA (specified_data
);
11679 memsrc
.len
= SBYTES (specified_data
);
11682 tiff
= fn_TIFFClientOpen ("memory_source", "r", &memsrc
,
11683 (TIFFReadWriteProc
) tiff_read_from_memory
,
11684 (TIFFReadWriteProc
) tiff_write_from_memory
,
11685 tiff_seek_in_memory
,
11687 tiff_size_of_memory
,
11689 tiff_unmap_memory
);
11693 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
11699 /* Get width and height of the image, and allocate a raster buffer
11700 of width x height 32-bit values. */
11701 fn_TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
11702 fn_TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
11703 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
11705 rc
= fn_TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
11706 fn_TIFFClose (tiff
);
11709 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
11715 /* Create the X image and pixmap. */
11716 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11723 #if 0 /* TODO: Color tables. */
11724 /* Initialize the color table. */
11725 init_color_table ();
11728 /* Process the pixel raster. Origin is in the lower-left corner. */
11729 for (y
= 0; y
< height
; ++y
)
11731 uint32
*row
= buf
+ y
* width
;
11733 for (x
= 0; x
< width
; ++x
)
11735 uint32 abgr
= row
[x
];
11736 int r
= TIFFGetR (abgr
);
11737 int g
= TIFFGetG (abgr
);
11738 int b
= TIFFGetB (abgr
);
11739 #if 0 /* TODO: Color tables. */
11740 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
11742 XPutPixel (ximg
, x
, height
- 1 - y
, PALETTERGB (r
, g
, b
));
11747 #if 0 /* TODO: Color tables. */
11748 /* Remember the colors allocated for the image. Free the color table. */
11749 img
->colors
= colors_in_color_table (&img
->ncolors
);
11750 free_color_table ();
11753 img
->width
= width
;
11754 img
->height
= height
;
11756 /* Maybe fill in the background field while we have ximg handy. */
11757 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11758 IMAGE_BACKGROUND (img
, f
, ximg
);
11760 /* Put the image into the pixmap, then free the X image and its buffer. */
11761 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11762 x_destroy_x_image (ximg
);
11769 #endif /* HAVE_TIFF != 0 */
11773 /***********************************************************************
11775 ***********************************************************************/
11779 #define DrawText gif_DrawText
11780 #include <gif_lib.h>
11783 static int gif_image_p
P_ ((Lisp_Object object
));
11784 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
11786 /* The symbol `gif' identifying images of this type. */
11790 /* Indices of image specification fields in gif_format, below. */
11792 enum gif_keyword_index
11801 GIF_HEURISTIC_MASK
,
11808 /* Vector of image_keyword structures describing the format
11809 of valid user-defined image specifications. */
11811 static struct image_keyword gif_format
[GIF_LAST
] =
11813 {":type", IMAGE_SYMBOL_VALUE
, 1},
11814 {":data", IMAGE_STRING_VALUE
, 0},
11815 {":file", IMAGE_STRING_VALUE
, 0},
11816 {":ascent", IMAGE_ASCENT_VALUE
, 0},
11817 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11818 {":relief", IMAGE_INTEGER_VALUE
, 0},
11819 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11820 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11821 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11822 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11823 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11826 /* Structure describing the image type `gif'. */
11828 static struct image_type gif_type
=
11838 /* GIF library details. */
11839 DEF_IMGLIB_FN (DGifCloseFile
);
11840 DEF_IMGLIB_FN (DGifSlurp
);
11841 DEF_IMGLIB_FN (DGifOpen
);
11842 DEF_IMGLIB_FN (DGifOpenFileName
);
11845 init_gif_functions (library
)
11848 LOAD_IMGLIB_FN (library
, DGifCloseFile
);
11849 LOAD_IMGLIB_FN (library
, DGifSlurp
);
11850 LOAD_IMGLIB_FN (library
, DGifOpen
);
11851 LOAD_IMGLIB_FN (library
, DGifOpenFileName
);
11856 /* Return non-zero if OBJECT is a valid GIF image specification. */
11859 gif_image_p (object
)
11860 Lisp_Object object
;
11862 struct image_keyword fmt
[GIF_LAST
];
11863 bcopy (gif_format
, fmt
, sizeof fmt
);
11865 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
11868 /* Must specify either the :data or :file keyword. */
11869 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
11872 /* Reading a GIF image from memory
11873 Based on the PNG memory stuff to a certain extent. */
11877 unsigned char *bytes
;
11883 /* Make the current memory source available to gif_read_from_memory.
11884 It's done this way because not all versions of libungif support
11885 a UserData field in the GifFileType structure. */
11886 static gif_memory_source
*current_gif_memory_src
;
11889 gif_read_from_memory (file
, buf
, len
)
11894 gif_memory_source
*src
= current_gif_memory_src
;
11896 if (len
> src
->len
- src
->index
)
11899 bcopy (src
->bytes
+ src
->index
, buf
, len
);
11905 /* Load GIF image IMG for use on frame F. Value is non-zero if
11913 Lisp_Object file
, specified_file
;
11914 Lisp_Object specified_data
;
11915 int rc
, width
, height
, x
, y
, i
;
11917 ColorMapObject
*gif_color_map
;
11918 unsigned long pixel_colors
[256];
11920 struct gcpro gcpro1
;
11922 int ino
, image_left
, image_top
, image_width
, image_height
;
11923 gif_memory_source memsrc
;
11924 unsigned char *raster
;
11926 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11927 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11931 if (NILP (specified_data
))
11933 file
= x_find_image_file (specified_file
);
11934 if (!STRINGP (file
))
11936 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11941 /* Open the GIF file. */
11942 gif
= fn_DGifOpenFileName (SDATA (file
));
11945 image_error ("Cannot open `%s'", file
, Qnil
);
11952 /* Read from memory! */
11953 current_gif_memory_src
= &memsrc
;
11954 memsrc
.bytes
= SDATA (specified_data
);
11955 memsrc
.len
= SBYTES (specified_data
);
11958 gif
= fn_DGifOpen(&memsrc
, gif_read_from_memory
);
11961 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
11967 /* Read entire contents. */
11968 rc
= fn_DGifSlurp (gif
);
11969 if (rc
== GIF_ERROR
)
11971 image_error ("Error reading `%s'", img
->spec
, Qnil
);
11972 fn_DGifCloseFile (gif
);
11977 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
11978 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
11979 if (ino
>= gif
->ImageCount
)
11981 image_error ("Invalid image number `%s' in image `%s'",
11983 fn_DGifCloseFile (gif
);
11988 width
= img
->width
= max (gif
->SWidth
, gif
->Image
.Left
+ gif
->Image
.Width
);
11989 height
= img
->height
= max (gif
->SHeight
, gif
->Image
.Top
+ gif
->Image
.Height
);
11991 /* Create the X image and pixmap. */
11992 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11994 fn_DGifCloseFile (gif
);
11999 /* Allocate colors. */
12000 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
12001 if (!gif_color_map
)
12002 gif_color_map
= gif
->SColorMap
;
12003 #if 0 /* TODO: Color tables */
12004 init_color_table ();
12006 bzero (pixel_colors
, sizeof pixel_colors
);
12008 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
12010 int r
= gif_color_map
->Colors
[i
].Red
;
12011 int g
= gif_color_map
->Colors
[i
].Green
;
12012 int b
= gif_color_map
->Colors
[i
].Blue
;
12013 #if 0 /* TODO: Color tables */
12014 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
12016 pixel_colors
[i
] = PALETTERGB (r
, g
, b
);
12020 #if 0 /* TODO: Color tables */
12021 img
->colors
= colors_in_color_table (&img
->ncolors
);
12022 free_color_table ();
12025 /* Clear the part of the screen image that are not covered by
12026 the image from the GIF file. Full animated GIF support
12027 requires more than can be done here (see the gif89 spec,
12028 disposal methods). Let's simply assume that the part
12029 not covered by a sub-image is in the frame's background color. */
12030 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
12031 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
12032 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
12033 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
12035 for (y
= 0; y
< image_top
; ++y
)
12036 for (x
= 0; x
< width
; ++x
)
12037 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12039 for (y
= image_top
+ image_height
; y
< height
; ++y
)
12040 for (x
= 0; x
< width
; ++x
)
12041 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12043 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
12045 for (x
= 0; x
< image_left
; ++x
)
12046 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12047 for (x
= image_left
+ image_width
; x
< width
; ++x
)
12048 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12051 /* Read the GIF image into the X image. We use a local variable
12052 `raster' here because RasterBits below is a char *, and invites
12053 problems with bytes >= 0x80. */
12054 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
12056 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
12058 static int interlace_start
[] = {0, 4, 2, 1};
12059 static int interlace_increment
[] = {8, 8, 4, 2};
12061 int row
= interlace_start
[0];
12065 for (y
= 0; y
< image_height
; y
++)
12067 if (row
>= image_height
)
12069 row
= interlace_start
[++pass
];
12070 while (row
>= image_height
)
12071 row
= interlace_start
[++pass
];
12074 for (x
= 0; x
< image_width
; x
++)
12076 int i
= raster
[(y
* image_width
) + x
];
12077 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
12081 row
+= interlace_increment
[pass
];
12086 for (y
= 0; y
< image_height
; ++y
)
12087 for (x
= 0; x
< image_width
; ++x
)
12089 int i
= raster
[y
* image_width
+ x
];
12090 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
12094 fn_DGifCloseFile (gif
);
12096 /* Maybe fill in the background field while we have ximg handy. */
12097 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12098 IMAGE_BACKGROUND (img
, f
, ximg
);
12100 /* Put the image into the pixmap, then free the X image and its buffer. */
12101 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12102 x_destroy_x_image (ximg
);
12108 #endif /* HAVE_GIF != 0 */
12112 /***********************************************************************
12114 ***********************************************************************/
12116 Lisp_Object Qpostscript
;
12118 /* Keyword symbols. */
12120 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
12122 #ifdef HAVE_GHOSTSCRIPT
12123 static int gs_image_p
P_ ((Lisp_Object object
));
12124 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
12125 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
12127 /* The symbol `postscript' identifying images of this type. */
12129 /* Keyword symbols. */
12131 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
12133 /* Indices of image specification fields in gs_format, below. */
12135 enum gs_keyword_index
12153 /* Vector of image_keyword structures describing the format
12154 of valid user-defined image specifications. */
12156 static struct image_keyword gs_format
[GS_LAST
] =
12158 {":type", IMAGE_SYMBOL_VALUE
, 1},
12159 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12160 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12161 {":file", IMAGE_STRING_VALUE
, 1},
12162 {":loader", IMAGE_FUNCTION_VALUE
, 0},
12163 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
12164 {":ascent", IMAGE_ASCENT_VALUE
, 0},
12165 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12166 {":relief", IMAGE_INTEGER_VALUE
, 0},
12167 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12168 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12169 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12170 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12173 /* Structure describing the image type `ghostscript'. */
12175 static struct image_type gs_type
=
12185 /* Free X resources of Ghostscript image IMG which is used on frame F. */
12188 gs_clear_image (f
, img
)
12192 /* IMG->data.ptr_val may contain a recorded colormap. */
12193 xfree (img
->data
.ptr_val
);
12194 x_clear_image (f
, img
);
12198 /* Return non-zero if OBJECT is a valid Ghostscript image
12202 gs_image_p (object
)
12203 Lisp_Object object
;
12205 struct image_keyword fmt
[GS_LAST
];
12209 bcopy (gs_format
, fmt
, sizeof fmt
);
12211 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
12214 /* Bounding box must be a list or vector containing 4 integers. */
12215 tem
= fmt
[GS_BOUNDING_BOX
].value
;
12218 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
12219 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
12224 else if (VECTORP (tem
))
12226 if (XVECTOR (tem
)->size
!= 4)
12228 for (i
= 0; i
< 4; ++i
)
12229 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
12239 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
12248 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
12249 struct gcpro gcpro1
, gcpro2
;
12251 double in_width
, in_height
;
12252 Lisp_Object pixel_colors
= Qnil
;
12254 /* Compute pixel size of pixmap needed from the given size in the
12255 image specification. Sizes in the specification are in pt. 1 pt
12256 = 1/72 in, xdpi and ydpi are stored in the frame's X display
12258 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
12259 in_width
= XFASTINT (pt_width
) / 72.0;
12260 img
->width
= in_width
* FRAME_W32_DISPLAY_INFO (f
)->resx
;
12261 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
12262 in_height
= XFASTINT (pt_height
) / 72.0;
12263 img
->height
= in_height
* FRAME_W32_DISPLAY_INFO (f
)->resy
;
12265 /* Create the pixmap. */
12267 xassert (img
->pixmap
== 0);
12268 img
->pixmap
= XCreatePixmap (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12269 img
->width
, img
->height
,
12270 one_w32_display_info
.n_cbits
);
12275 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
12279 /* Call the loader to fill the pixmap. It returns a process object
12280 if successful. We do not record_unwind_protect here because
12281 other places in redisplay like calling window scroll functions
12282 don't either. Let the Lisp loader use `unwind-protect' instead. */
12283 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
12285 sprintf (buffer
, "%lu %lu",
12286 (unsigned long) FRAME_W32_WINDOW (f
),
12287 (unsigned long) img
->pixmap
);
12288 window_and_pixmap_id
= build_string (buffer
);
12290 sprintf (buffer
, "%lu %lu",
12291 FRAME_FOREGROUND_PIXEL (f
),
12292 FRAME_BACKGROUND_PIXEL (f
));
12293 pixel_colors
= build_string (buffer
);
12295 XSETFRAME (frame
, f
);
12296 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
12298 loader
= intern ("gs-load-image");
12300 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
12301 make_number (img
->width
),
12302 make_number (img
->height
),
12303 window_and_pixmap_id
,
12306 return PROCESSP (img
->data
.lisp_val
);
12310 /* Kill the Ghostscript process that was started to fill PIXMAP on
12311 frame F. Called from XTread_socket when receiving an event
12312 telling Emacs that Ghostscript has finished drawing. */
12315 x_kill_gs_process (pixmap
, f
)
12319 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
12323 /* Find the image containing PIXMAP. */
12324 for (i
= 0; i
< c
->used
; ++i
)
12325 if (c
->images
[i
]->pixmap
== pixmap
)
12328 /* Should someone in between have cleared the image cache, for
12329 instance, give up. */
12333 /* Kill the GS process. We should have found PIXMAP in the image
12334 cache and its image should contain a process object. */
12335 img
= c
->images
[i
];
12336 xassert (PROCESSP (img
->data
.lisp_val
));
12337 Fkill_process (img
->data
.lisp_val
, Qnil
);
12338 img
->data
.lisp_val
= Qnil
;
12340 /* On displays with a mutable colormap, figure out the colors
12341 allocated for the image by looking at the pixels of an XImage for
12343 class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
12344 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
12350 /* Try to get an XImage for img->pixmep. */
12351 ximg
= XGetImage (FRAME_W32_DISPLAY (f
), img
->pixmap
,
12352 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
12357 /* Initialize the color table. */
12358 init_color_table ();
12360 /* For each pixel of the image, look its color up in the
12361 color table. After having done so, the color table will
12362 contain an entry for each color used by the image. */
12363 for (y
= 0; y
< img
->height
; ++y
)
12364 for (x
= 0; x
< img
->width
; ++x
)
12366 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
12367 lookup_pixel_color (f
, pixel
);
12370 /* Record colors in the image. Free color table and XImage. */
12371 img
->colors
= colors_in_color_table (&img
->ncolors
);
12372 free_color_table ();
12373 XDestroyImage (ximg
);
12375 #if 0 /* This doesn't seem to be the case. If we free the colors
12376 here, we get a BadAccess later in x_clear_image when
12377 freeing the colors. */
12378 /* We have allocated colors once, but Ghostscript has also
12379 allocated colors on behalf of us. So, to get the
12380 reference counts right, free them once. */
12382 x_free_colors (FRAME_W32_DISPLAY (f
), cmap
,
12383 img
->colors
, img
->ncolors
, 0);
12387 image_error ("Cannot get X image of `%s'; colors will not be freed",
12393 /* Now that we have the pixmap, compute mask and transform the
12394 image if requested. */
12396 postprocess_image (f
, img
);
12400 #endif /* HAVE_GHOSTSCRIPT */
12403 /***********************************************************************
12405 ***********************************************************************/
12407 DEFUN ("x-change-window-property", Fx_change_window_property
,
12408 Sx_change_window_property
, 2, 6, 0,
12409 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
12410 VALUE may be a string or a list of conses, numbers and/or strings.
12411 If an element in the list is a string, it is converted to
12412 an Atom and the value of the Atom is used. If an element is a cons,
12413 it is converted to a 32 bit number where the car is the 16 top bits and the
12414 cdr is the lower 16 bits.
12415 FRAME nil or omitted means use the selected frame.
12416 If TYPE is given and non-nil, it is the name of the type of VALUE.
12417 If TYPE is not given or nil, the type is STRING.
12418 FORMAT gives the size in bits of each element if VALUE is a list.
12419 It must be one of 8, 16 or 32.
12420 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
12421 If OUTER_P is non-nil, the property is changed for the outer X window of
12422 FRAME. Default is to change on the edit X window.
12424 Value is VALUE. */)
12425 (prop
, value
, frame
, type
, format
, outer_p
)
12426 Lisp_Object prop
, value
, frame
, type
, format
, outer_p
;
12428 #if 0 /* TODO : port window properties to W32 */
12429 struct frame
*f
= check_x_frame (frame
);
12432 CHECK_STRING (prop
);
12433 CHECK_STRING (value
);
12436 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
12437 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12438 prop_atom
, XA_STRING
, 8, PropModeReplace
,
12439 SDATA (value
), SCHARS (value
));
12441 /* Make sure the property is set when we return. */
12442 XFlush (FRAME_W32_DISPLAY (f
));
12451 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
12452 Sx_delete_window_property
, 1, 2, 0,
12453 doc
: /* Remove window property PROP from X window of FRAME.
12454 FRAME nil or omitted means use the selected frame. Value is PROP. */)
12456 Lisp_Object prop
, frame
;
12458 #if 0 /* TODO : port window properties to W32 */
12460 struct frame
*f
= check_x_frame (frame
);
12463 CHECK_STRING (prop
);
12465 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
12466 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
12468 /* Make sure the property is removed when we return. */
12469 XFlush (FRAME_W32_DISPLAY (f
));
12477 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
12479 doc
: /* Value is the value of window property PROP on FRAME.
12480 If FRAME is nil or omitted, use the selected frame. Value is nil
12481 if FRAME hasn't a property with name PROP or if PROP has no string
12484 Lisp_Object prop
, frame
;
12486 #if 0 /* TODO : port window properties to W32 */
12488 struct frame
*f
= check_x_frame (frame
);
12491 Lisp_Object prop_value
= Qnil
;
12492 char *tmp_data
= NULL
;
12495 unsigned long actual_size
, bytes_remaining
;
12497 CHECK_STRING (prop
);
12499 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
12500 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12501 prop_atom
, 0, 0, False
, XA_STRING
,
12502 &actual_type
, &actual_format
, &actual_size
,
12503 &bytes_remaining
, (unsigned char **) &tmp_data
);
12506 int size
= bytes_remaining
;
12511 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12512 prop_atom
, 0, bytes_remaining
,
12514 &actual_type
, &actual_format
,
12515 &actual_size
, &bytes_remaining
,
12516 (unsigned char **) &tmp_data
);
12518 prop_value
= make_string (tmp_data
, size
);
12533 /***********************************************************************
12535 ***********************************************************************/
12537 /* If non-null, an asynchronous timer that, when it expires, displays
12538 an hourglass cursor on all frames. */
12540 static struct atimer
*hourglass_atimer
;
12542 /* Non-zero means an hourglass cursor is currently shown. */
12544 static int hourglass_shown_p
;
12546 /* Number of seconds to wait before displaying an hourglass cursor. */
12548 static Lisp_Object Vhourglass_delay
;
12550 /* Default number of seconds to wait before displaying an hourglass
12553 #define DEFAULT_HOURGLASS_DELAY 1
12555 /* Function prototypes. */
12557 static void show_hourglass
P_ ((struct atimer
*));
12558 static void hide_hourglass
P_ ((void));
12561 /* Cancel a currently active hourglass timer, and start a new one. */
12566 #if 0 /* TODO: cursor shape changes. */
12568 int secs
, usecs
= 0;
12570 cancel_hourglass ();
12572 if (INTEGERP (Vhourglass_delay
)
12573 && XINT (Vhourglass_delay
) > 0)
12574 secs
= XFASTINT (Vhourglass_delay
);
12575 else if (FLOATP (Vhourglass_delay
)
12576 && XFLOAT_DATA (Vhourglass_delay
) > 0)
12579 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
12580 secs
= XFASTINT (tem
);
12581 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
12584 secs
= DEFAULT_HOURGLASS_DELAY
;
12586 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
12587 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
12588 show_hourglass
, NULL
);
12593 /* Cancel the hourglass cursor timer if active, hide an hourglass
12594 cursor if shown. */
12597 cancel_hourglass ()
12599 if (hourglass_atimer
)
12601 cancel_atimer (hourglass_atimer
);
12602 hourglass_atimer
= NULL
;
12605 if (hourglass_shown_p
)
12610 /* Timer function of hourglass_atimer. TIMER is equal to
12613 Display an hourglass cursor on all frames by mapping the frames'
12614 hourglass_window. Set the hourglass_p flag in the frames'
12615 output_data.x structure to indicate that an hourglass cursor is
12616 shown on the frames. */
12619 show_hourglass (timer
)
12620 struct atimer
*timer
;
12622 #if 0 /* TODO: cursor shape changes. */
12623 /* The timer implementation will cancel this timer automatically
12624 after this function has run. Set hourglass_atimer to null
12625 so that we know the timer doesn't have to be canceled. */
12626 hourglass_atimer
= NULL
;
12628 if (!hourglass_shown_p
)
12630 Lisp_Object rest
, frame
;
12634 FOR_EACH_FRAME (rest
, frame
)
12635 if (FRAME_W32_P (XFRAME (frame
)))
12637 struct frame
*f
= XFRAME (frame
);
12639 f
->output_data
.w32
->hourglass_p
= 1;
12641 if (!f
->output_data
.w32
->hourglass_window
)
12643 unsigned long mask
= CWCursor
;
12644 XSetWindowAttributes attrs
;
12646 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
12648 f
->output_data
.w32
->hourglass_window
12649 = XCreateWindow (FRAME_X_DISPLAY (f
),
12650 FRAME_OUTER_WINDOW (f
),
12651 0, 0, 32000, 32000, 0, 0,
12657 XMapRaised (FRAME_X_DISPLAY (f
),
12658 f
->output_data
.w32
->hourglass_window
);
12659 XFlush (FRAME_X_DISPLAY (f
));
12662 hourglass_shown_p
= 1;
12669 /* Hide the hourglass cursor on all frames, if it is currently shown. */
12674 #if 0 /* TODO: cursor shape changes. */
12675 if (hourglass_shown_p
)
12677 Lisp_Object rest
, frame
;
12680 FOR_EACH_FRAME (rest
, frame
)
12682 struct frame
*f
= XFRAME (frame
);
12684 if (FRAME_W32_P (f
)
12685 /* Watch out for newly created frames. */
12686 && f
->output_data
.x
->hourglass_window
)
12688 XUnmapWindow (FRAME_X_DISPLAY (f
),
12689 f
->output_data
.x
->hourglass_window
);
12690 /* Sync here because XTread_socket looks at the
12691 hourglass_p flag that is reset to zero below. */
12692 XSync (FRAME_X_DISPLAY (f
), False
);
12693 f
->output_data
.x
->hourglass_p
= 0;
12697 hourglass_shown_p
= 0;
12705 /***********************************************************************
12707 ***********************************************************************/
12709 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
12710 Lisp_Object
, Lisp_Object
));
12711 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
12712 Lisp_Object
, int, int, int *, int *));
12714 /* The frame of a currently visible tooltip. */
12716 Lisp_Object tip_frame
;
12718 /* If non-nil, a timer started that hides the last tooltip when it
12721 Lisp_Object tip_timer
;
12724 /* If non-nil, a vector of 3 elements containing the last args
12725 with which x-show-tip was called. See there. */
12727 Lisp_Object last_show_tip_args
;
12729 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
12731 Lisp_Object Vx_max_tooltip_size
;
12735 unwind_create_tip_frame (frame
)
12738 Lisp_Object deleted
;
12740 deleted
= unwind_create_frame (frame
);
12741 if (EQ (deleted
, Qt
))
12751 /* Create a frame for a tooltip on the display described by DPYINFO.
12752 PARMS is a list of frame parameters. TEXT is the string to
12753 display in the tip frame. Value is the frame.
12755 Note that functions called here, esp. x_default_parameter can
12756 signal errors, for instance when a specified color name is
12757 undefined. We have to make sure that we're in a consistent state
12758 when this happens. */
12761 x_create_tip_frame (dpyinfo
, parms
, text
)
12762 struct w32_display_info
*dpyinfo
;
12763 Lisp_Object parms
, text
;
12766 Lisp_Object frame
, tem
;
12768 long window_prompting
= 0;
12770 int count
= SPECPDL_INDEX ();
12771 struct gcpro gcpro1
, gcpro2
, gcpro3
;
12773 int face_change_count_before
= face_change_count
;
12774 Lisp_Object buffer
;
12775 struct buffer
*old_buffer
;
12779 /* Use this general default value to start with until we know if
12780 this frame has a specified name. */
12781 Vx_resource_name
= Vinvocation_name
;
12783 #ifdef MULTI_KBOARD
12784 kb
= dpyinfo
->kboard
;
12786 kb
= &the_only_kboard
;
12789 /* Get the name of the frame to use for resource lookup. */
12790 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
12791 if (!STRINGP (name
)
12792 && !EQ (name
, Qunbound
)
12794 error ("Invalid frame name--not a string or nil");
12795 Vx_resource_name
= name
;
12798 GCPRO3 (parms
, name
, frame
);
12799 /* Make a frame without minibuffer nor mode-line. */
12800 f
= make_frame (0);
12801 f
->wants_modeline
= 0;
12802 XSETFRAME (frame
, f
);
12804 buffer
= Fget_buffer_create (build_string (" *tip*"));
12805 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
, Qnil
);
12806 old_buffer
= current_buffer
;
12807 set_buffer_internal_1 (XBUFFER (buffer
));
12808 current_buffer
->truncate_lines
= Qnil
;
12810 Finsert (1, &text
);
12811 set_buffer_internal_1 (old_buffer
);
12813 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
12814 record_unwind_protect (unwind_create_tip_frame
, frame
);
12816 /* By setting the output method, we're essentially saying that
12817 the frame is live, as per FRAME_LIVE_P. If we get a signal
12818 from this point on, x_destroy_window might screw up reference
12820 f
->output_method
= output_w32
;
12821 f
->output_data
.w32
=
12822 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
12823 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
12825 FRAME_FONTSET (f
) = -1;
12826 f
->icon_name
= Qnil
;
12828 #if 0 /* GLYPH_DEBUG TODO: image support. */
12829 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
12830 dpyinfo_refcount
= dpyinfo
->reference_count
;
12831 #endif /* GLYPH_DEBUG */
12832 #ifdef MULTI_KBOARD
12833 FRAME_KBOARD (f
) = kb
;
12835 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
12836 f
->output_data
.w32
->explicit_parent
= 0;
12838 /* Set the name; the functions to which we pass f expect the name to
12840 if (EQ (name
, Qunbound
) || NILP (name
))
12842 f
->name
= build_string (dpyinfo
->w32_id_name
);
12843 f
->explicit_name
= 0;
12848 f
->explicit_name
= 1;
12849 /* use the frame's title when getting resources for this frame. */
12850 specbind (Qx_resource_name
, name
);
12853 /* Extract the window parameters from the supplied values
12854 that are needed to determine window geometry. */
12858 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
12861 /* First, try whatever font the caller has specified. */
12862 if (STRINGP (font
))
12864 tem
= Fquery_fontset (font
, Qnil
);
12866 font
= x_new_fontset (f
, SDATA (tem
));
12868 font
= x_new_font (f
, SDATA (font
));
12871 /* Try out a font which we hope has bold and italic variations. */
12872 if (!STRINGP (font
))
12873 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
12874 if (! STRINGP (font
))
12875 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
12876 /* If those didn't work, look for something which will at least work. */
12877 if (! STRINGP (font
))
12878 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
12880 if (! STRINGP (font
))
12881 font
= build_string ("Fixedsys");
12883 x_default_parameter (f
, parms
, Qfont
, font
,
12884 "font", "Font", RES_TYPE_STRING
);
12887 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
12888 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
12889 /* This defaults to 2 in order to match xterm. We recognize either
12890 internalBorderWidth or internalBorder (which is what xterm calls
12892 if (NILP (Fassq (Qinternal_border_width
, parms
)))
12896 value
= w32_get_arg (parms
, Qinternal_border_width
,
12897 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
12898 if (! EQ (value
, Qunbound
))
12899 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
12902 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
12903 "internalBorderWidth", "internalBorderWidth",
12906 /* Also do the stuff which must be set before the window exists. */
12907 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
12908 "foreground", "Foreground", RES_TYPE_STRING
);
12909 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
12910 "background", "Background", RES_TYPE_STRING
);
12911 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
12912 "pointerColor", "Foreground", RES_TYPE_STRING
);
12913 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
12914 "cursorColor", "Foreground", RES_TYPE_STRING
);
12915 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
12916 "borderColor", "BorderColor", RES_TYPE_STRING
);
12918 /* Init faces before x_default_parameter is called for scroll-bar
12919 parameters because that function calls x_set_scroll_bar_width,
12920 which calls change_frame_size, which calls Fset_window_buffer,
12921 which runs hooks, which call Fvertical_motion. At the end, we
12922 end up in init_iterator with a null face cache, which should not
12924 init_frame_faces (f
);
12926 f
->output_data
.w32
->dwStyle
= WS_BORDER
| WS_POPUP
| WS_DISABLED
;
12927 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
12929 window_prompting
= x_figure_window_size (f
, parms
, 0);
12931 /* No fringes on tip frame. */
12932 f
->fringe_cols
= 0;
12933 f
->left_fringe_width
= 0;
12934 f
->right_fringe_width
= 0;
12937 my_create_tip_window (f
);
12942 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
12943 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
12944 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
12945 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
12946 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
12947 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
12949 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
12950 Change will not be effected unless different from the current
12951 FRAME_LINES (f). */
12952 width
= FRAME_COLS (f
);
12953 height
= FRAME_LINES (f
);
12954 FRAME_LINES (f
) = 0;
12955 SET_FRAME_COLS (f
, 0);
12956 change_frame_size (f
, height
, width
, 1, 0, 0);
12958 /* Add `tooltip' frame parameter's default value. */
12959 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
12960 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
12963 /* Set up faces after all frame parameters are known. This call
12964 also merges in face attributes specified for new frames.
12966 Frame parameters may be changed if .Xdefaults contains
12967 specifications for the default font. For example, if there is an
12968 `Emacs.default.attributeBackground: pink', the `background-color'
12969 attribute of the frame get's set, which let's the internal border
12970 of the tooltip frame appear in pink. Prevent this. */
12972 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
12974 /* Set tip_frame here, so that */
12976 call1 (Qface_set_after_frame_default
, frame
);
12978 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
12979 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
12987 /* It is now ok to make the frame official even if we get an error
12988 below. And the frame needs to be on Vframe_list or making it
12989 visible won't work. */
12990 Vframe_list
= Fcons (frame
, Vframe_list
);
12992 /* Now that the frame is official, it counts as a reference to
12994 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
12996 /* Setting attributes of faces of the tooltip frame from resources
12997 and similar will increment face_change_count, which leads to the
12998 clearing of all current matrices. Since this isn't necessary
12999 here, avoid it by resetting face_change_count to the value it
13000 had before we created the tip frame. */
13001 face_change_count
= face_change_count_before
;
13003 /* Discard the unwind_protect. */
13004 return unbind_to (count
, frame
);
13008 /* Compute where to display tip frame F. PARMS is the list of frame
13009 parameters for F. DX and DY are specified offsets from the current
13010 location of the mouse. WIDTH and HEIGHT are the width and height
13011 of the tooltip. Return coordinates relative to the root window of
13012 the display in *ROOT_X, and *ROOT_Y. */
13015 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
13017 Lisp_Object parms
, dx
, dy
;
13019 int *root_x
, *root_y
;
13021 Lisp_Object left
, top
;
13023 /* User-specified position? */
13024 left
= Fcdr (Fassq (Qleft
, parms
));
13025 top
= Fcdr (Fassq (Qtop
, parms
));
13027 /* Move the tooltip window where the mouse pointer is. Resize and
13029 if (!INTEGERP (left
) || !INTEGERP (top
))
13034 GetCursorPos (&pt
);
13040 if (INTEGERP (top
))
13041 *root_y
= XINT (top
);
13042 else if (*root_y
+ XINT (dy
) - height
< 0)
13043 *root_y
-= XINT (dy
);
13047 *root_y
+= XINT (dy
);
13050 if (INTEGERP (left
))
13051 *root_x
= XINT (left
);
13052 else if (*root_x
+ XINT (dx
) + width
<= FRAME_W32_DISPLAY_INFO (f
)->width
)
13053 /* It fits to the right of the pointer. */
13054 *root_x
+= XINT (dx
);
13055 else if (width
+ XINT (dx
) <= *root_x
)
13056 /* It fits to the left of the pointer. */
13057 *root_x
-= width
+ XINT (dx
);
13059 /* Put it left justified on the screen -- it ought to fit that way. */
13064 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
13065 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
13066 A tooltip window is a small window displaying a string.
13068 FRAME nil or omitted means use the selected frame.
13070 PARMS is an optional list of frame parameters which can be
13071 used to change the tooltip's appearance.
13073 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
13074 means use the default timeout of 5 seconds.
13076 If the list of frame parameters PARAMS contains a `left' parameter,
13077 the tooltip is displayed at that x-position. Otherwise it is
13078 displayed at the mouse position, with offset DX added (default is 5 if
13079 DX isn't specified). Likewise for the y-position; if a `top' frame
13080 parameter is specified, it determines the y-position of the tooltip
13081 window, otherwise it is displayed at the mouse position, with offset
13082 DY added (default is -10).
13084 A tooltip's maximum size is specified by `x-max-tooltip-size'.
13085 Text larger than the specified size is clipped. */)
13086 (string
, frame
, parms
, timeout
, dx
, dy
)
13087 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
13091 int root_x
, root_y
;
13092 struct buffer
*old_buffer
;
13093 struct text_pos pos
;
13094 int i
, width
, height
;
13095 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
13096 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
13097 int count
= SPECPDL_INDEX ();
13099 specbind (Qinhibit_redisplay
, Qt
);
13101 GCPRO4 (string
, parms
, frame
, timeout
);
13103 CHECK_STRING (string
);
13104 f
= check_x_frame (frame
);
13105 if (NILP (timeout
))
13106 timeout
= make_number (5);
13108 CHECK_NATNUM (timeout
);
13111 dx
= make_number (5);
13116 dy
= make_number (-10);
13120 if (NILP (last_show_tip_args
))
13121 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
13123 if (!NILP (tip_frame
))
13125 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
13126 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
13127 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
13129 if (EQ (frame
, last_frame
)
13130 && !NILP (Fequal (last_string
, string
))
13131 && !NILP (Fequal (last_parms
, parms
)))
13133 struct frame
*f
= XFRAME (tip_frame
);
13135 /* Only DX and DY have changed. */
13136 if (!NILP (tip_timer
))
13138 Lisp_Object timer
= tip_timer
;
13140 call1 (Qcancel_timer
, timer
);
13144 compute_tip_xy (f
, parms
, dx
, dy
, FRAME_PIXEL_WIDTH (f
),
13145 FRAME_PIXEL_HEIGHT (f
), &root_x
, &root_y
);
13147 /* Put tooltip in topmost group and in position. */
13148 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
13149 root_x
, root_y
, 0, 0,
13150 SWP_NOSIZE
| SWP_NOACTIVATE
);
13152 /* Ensure tooltip is on top of other topmost windows (eg menus). */
13153 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
13155 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
13162 /* Hide a previous tip, if any. */
13165 ASET (last_show_tip_args
, 0, string
);
13166 ASET (last_show_tip_args
, 1, frame
);
13167 ASET (last_show_tip_args
, 2, parms
);
13169 /* Add default values to frame parameters. */
13170 if (NILP (Fassq (Qname
, parms
)))
13171 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
13172 if (NILP (Fassq (Qinternal_border_width
, parms
)))
13173 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
13174 if (NILP (Fassq (Qborder_width
, parms
)))
13175 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
13176 if (NILP (Fassq (Qborder_color
, parms
)))
13177 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
13178 if (NILP (Fassq (Qbackground_color
, parms
)))
13179 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
13182 /* Block input until the tip has been fully drawn, to avoid crashes
13183 when drawing tips in menus. */
13186 /* Create a frame for the tooltip, and record it in the global
13187 variable tip_frame. */
13188 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
, string
);
13189 f
= XFRAME (frame
);
13191 /* Set up the frame's root window. */
13192 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
13193 w
->left_col
= w
->top_line
= make_number (0);
13195 if (CONSP (Vx_max_tooltip_size
)
13196 && INTEGERP (XCAR (Vx_max_tooltip_size
))
13197 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
13198 && INTEGERP (XCDR (Vx_max_tooltip_size
))
13199 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
13201 w
->total_cols
= XCAR (Vx_max_tooltip_size
);
13202 w
->total_lines
= XCDR (Vx_max_tooltip_size
);
13206 w
->total_cols
= make_number (80);
13207 w
->total_lines
= make_number (40);
13210 FRAME_TOTAL_COLS (f
) = XINT (w
->total_cols
);
13212 w
->pseudo_window_p
= 1;
13214 /* Display the tooltip text in a temporary buffer. */
13215 old_buffer
= current_buffer
;
13216 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
13217 current_buffer
->truncate_lines
= Qnil
;
13218 clear_glyph_matrix (w
->desired_matrix
);
13219 clear_glyph_matrix (w
->current_matrix
);
13220 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
13221 try_window (FRAME_ROOT_WINDOW (f
), pos
);
13223 /* Compute width and height of the tooltip. */
13224 width
= height
= 0;
13225 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
13227 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
13228 struct glyph
*last
;
13231 /* Stop at the first empty row at the end. */
13232 if (!row
->enabled_p
|| !row
->displays_text_p
)
13235 /* Let the row go over the full width of the frame. */
13236 row
->full_width_p
= 1;
13238 #ifdef TODO /* Investigate why some fonts need more width than is
13239 calculated for some tooltips. */
13240 /* There's a glyph at the end of rows that is use to place
13241 the cursor there. Don't include the width of this glyph. */
13242 if (row
->used
[TEXT_AREA
])
13244 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
13245 row_width
= row
->pixel_width
- last
->pixel_width
;
13249 row_width
= row
->pixel_width
;
13251 /* TODO: find why tips do not draw along baseline as instructed. */
13252 height
+= row
->height
;
13253 width
= max (width
, row_width
);
13256 /* Add the frame's internal border to the width and height the X
13257 window should have. */
13258 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13259 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13261 /* Move the tooltip window where the mouse pointer is. Resize and
13263 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
13266 /* Adjust Window size to take border into account. */
13268 rect
.left
= rect
.top
= 0;
13269 rect
.right
= width
;
13270 rect
.bottom
= height
;
13271 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
13272 FRAME_EXTERNAL_MENU_BAR (f
));
13274 /* Position and size tooltip, and put it in the topmost group. */
13275 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
13276 root_x
, root_y
, rect
.right
- rect
.left
,
13277 rect
.bottom
- rect
.top
, SWP_NOACTIVATE
);
13279 /* Ensure tooltip is on top of other topmost windows (eg menus). */
13280 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
13282 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
13284 /* Let redisplay know that we have made the frame visible already. */
13285 f
->async_visible
= 1;
13287 ShowWindow (FRAME_W32_WINDOW (f
), SW_SHOWNOACTIVATE
);
13290 /* Draw into the window. */
13291 w
->must_be_updated_p
= 1;
13292 update_single_window (w
, 1);
13296 /* Restore original current buffer. */
13297 set_buffer_internal_1 (old_buffer
);
13298 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
13301 /* Let the tip disappear after timeout seconds. */
13302 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
13303 intern ("x-hide-tip"));
13306 return unbind_to (count
, Qnil
);
13310 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
13311 doc
: /* Hide the current tooltip window, if there is any.
13312 Value is t if tooltip was open, nil otherwise. */)
13316 Lisp_Object deleted
, frame
, timer
;
13317 struct gcpro gcpro1
, gcpro2
;
13319 /* Return quickly if nothing to do. */
13320 if (NILP (tip_timer
) && NILP (tip_frame
))
13325 GCPRO2 (frame
, timer
);
13326 tip_frame
= tip_timer
= deleted
= Qnil
;
13328 count
= SPECPDL_INDEX ();
13329 specbind (Qinhibit_redisplay
, Qt
);
13330 specbind (Qinhibit_quit
, Qt
);
13333 call1 (Qcancel_timer
, timer
);
13335 if (FRAMEP (frame
))
13337 Fdelete_frame (frame
, Qnil
);
13342 return unbind_to (count
, deleted
);
13347 /***********************************************************************
13348 File selection dialog
13349 ***********************************************************************/
13350 extern Lisp_Object Qfile_name_history
;
13352 /* Callback for altering the behaviour of the Open File dialog.
13353 Makes the Filename text field contain "Current Directory" and be
13354 read-only when "Directories" is selected in the filter. This
13355 allows us to work around the fact that the standard Open File
13356 dialog does not support directories. */
13358 file_dialog_callback (hwnd
, msg
, wParam
, lParam
)
13364 if (msg
== WM_NOTIFY
)
13366 OFNOTIFY
* notify
= (OFNOTIFY
*)lParam
;
13367 /* Detect when the Filter dropdown is changed. */
13368 if (notify
->hdr
.code
== CDN_TYPECHANGE
)
13370 HWND dialog
= GetParent (hwnd
);
13371 HWND edit_control
= GetDlgItem (dialog
, FILE_NAME_TEXT_FIELD
);
13373 /* Directories is in index 2. */
13374 if (notify
->lpOFN
->nFilterIndex
== 2)
13376 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
13377 "Current Directory");
13378 EnableWindow (edit_control
, FALSE
);
13382 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
13384 EnableWindow (edit_control
, TRUE
);
13391 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
13392 doc
: /* Read file name, prompting with PROMPT in directory DIR.
13393 Use a file selection dialog.
13394 Select DEFAULT-FILENAME in the dialog's file selection box, if
13395 specified. Ensure that file exists if MUSTMATCH is non-nil. */)
13396 (prompt
, dir
, default_filename
, mustmatch
)
13397 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
13399 struct frame
*f
= SELECTED_FRAME ();
13400 Lisp_Object file
= Qnil
;
13401 int count
= SPECPDL_INDEX ();
13402 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
13403 char filename
[MAX_PATH
+ 1];
13404 char init_dir
[MAX_PATH
+ 1];
13406 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
13407 CHECK_STRING (prompt
);
13408 CHECK_STRING (dir
);
13410 /* Create the dialog with PROMPT as title, using DIR as initial
13411 directory and using "*" as pattern. */
13412 dir
= Fexpand_file_name (dir
, Qnil
);
13413 strncpy (init_dir
, SDATA (dir
), MAX_PATH
);
13414 init_dir
[MAX_PATH
] = '\0';
13415 unixtodos_filename (init_dir
);
13417 if (STRINGP (default_filename
))
13419 char *file_name_only
;
13420 char *full_path_name
= SDATA (default_filename
);
13422 unixtodos_filename (full_path_name
);
13424 file_name_only
= strrchr (full_path_name
, '\\');
13425 if (!file_name_only
)
13426 file_name_only
= full_path_name
;
13432 strncpy (filename
, file_name_only
, MAX_PATH
);
13433 filename
[MAX_PATH
] = '\0';
13436 filename
[0] = '\0';
13439 OPENFILENAME file_details
;
13441 /* Prevent redisplay. */
13442 specbind (Qinhibit_redisplay
, Qt
);
13445 bzero (&file_details
, sizeof (file_details
));
13446 file_details
.lStructSize
= sizeof (file_details
);
13447 file_details
.hwndOwner
= FRAME_W32_WINDOW (f
);
13448 /* Undocumented Bug in Common File Dialog:
13449 If a filter is not specified, shell links are not resolved. */
13450 file_details
.lpstrFilter
= "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
13451 file_details
.lpstrFile
= filename
;
13452 file_details
.nMaxFile
= sizeof (filename
);
13453 file_details
.lpstrInitialDir
= init_dir
;
13454 file_details
.lpstrTitle
= SDATA (prompt
);
13455 file_details
.Flags
= (OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
13456 | OFN_EXPLORER
| OFN_ENABLEHOOK
);
13457 if (!NILP (mustmatch
))
13458 file_details
.Flags
|= OFN_FILEMUSTEXIST
| OFN_PATHMUSTEXIST
;
13460 file_details
.lpfnHook
= (LPOFNHOOKPROC
) file_dialog_callback
;
13462 if (GetOpenFileName (&file_details
))
13464 dostounix_filename (filename
);
13465 if (file_details
.nFilterIndex
== 2)
13467 /* "Folder Only" selected - strip dummy file name. */
13468 char * last
= strrchr (filename
, '/');
13472 file
= DECODE_FILE(build_string (filename
));
13474 /* User cancelled the dialog without making a selection. */
13475 else if (!CommDlgExtendedError ())
13477 /* An error occurred, fallback on reading from the mini-buffer. */
13479 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
13480 dir
, mustmatch
, dir
, Qfile_name_history
,
13481 default_filename
, Qnil
);
13484 file
= unbind_to (count
, file
);
13489 /* Make "Cancel" equivalent to C-g. */
13491 Fsignal (Qquit
, Qnil
);
13493 return unbind_to (count
, file
);
13498 /***********************************************************************
13499 w32 specialized functions
13500 ***********************************************************************/
13502 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 2, 0,
13503 doc
: /* Select a font using the W32 font dialog.
13504 Returns an X font string corresponding to the selection. */)
13505 (frame
, include_proportional
)
13506 Lisp_Object frame
, include_proportional
;
13508 FRAME_PTR f
= check_x_frame (frame
);
13516 bzero (&cf
, sizeof (cf
));
13517 bzero (&lf
, sizeof (lf
));
13519 cf
.lStructSize
= sizeof (cf
);
13520 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
13521 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
13523 /* Unless include_proportional is non-nil, limit the selection to
13524 monospaced fonts. */
13525 if (NILP (include_proportional
))
13526 cf
.Flags
|= CF_FIXEDPITCHONLY
;
13528 cf
.lpLogFont
= &lf
;
13530 /* Initialize as much of the font details as we can from the current
13532 hdc
= GetDC (FRAME_W32_WINDOW (f
));
13533 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
13534 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
13535 if (GetTextMetrics (hdc
, &tm
))
13537 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
13538 lf
.lfWeight
= tm
.tmWeight
;
13539 lf
.lfItalic
= tm
.tmItalic
;
13540 lf
.lfUnderline
= tm
.tmUnderlined
;
13541 lf
.lfStrikeOut
= tm
.tmStruckOut
;
13542 lf
.lfCharSet
= tm
.tmCharSet
;
13543 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
13545 SelectObject (hdc
, oldobj
);
13546 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
13548 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
13551 return build_string (buf
);
13554 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
13555 Sw32_send_sys_command
, 1, 2, 0,
13556 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
13557 Some useful values for command are #xf030 to maximise frame (#xf020
13558 to minimize), #xf120 to restore frame to original size, and #xf100
13559 to activate the menubar for keyboard access. #xf140 activates the
13560 screen saver if defined.
13562 If optional parameter FRAME is not specified, use selected frame. */)
13564 Lisp_Object command
, frame
;
13566 FRAME_PTR f
= check_x_frame (frame
);
13568 CHECK_NUMBER (command
);
13570 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
13575 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
13576 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
13577 This is a wrapper around the ShellExecute system function, which
13578 invokes the application registered to handle OPERATION for DOCUMENT.
13579 OPERATION is typically \"open\", \"print\" or \"explore\" (but can be
13580 nil for the default action), and DOCUMENT is typically the name of a
13581 document file or URL, but can also be a program executable to run or
13582 a directory to open in the Windows Explorer.
13584 If DOCUMENT is a program executable, PARAMETERS can be a string
13585 containing command line parameters, but otherwise should be nil.
13587 SHOW-FLAG can be used to control whether the invoked application is hidden
13588 or minimized. If SHOW-FLAG is nil, the application is displayed normally,
13589 otherwise it is an integer representing a ShowWindow flag:
13593 3 - start maximized
13594 6 - start minimized */)
13595 (operation
, document
, parameters
, show_flag
)
13596 Lisp_Object operation
, document
, parameters
, show_flag
;
13598 Lisp_Object current_dir
;
13600 CHECK_STRING (document
);
13602 /* Encode filename and current directory. */
13603 current_dir
= ENCODE_FILE (current_buffer
->directory
);
13604 document
= ENCODE_FILE (document
);
13605 if ((int) ShellExecute (NULL
,
13606 (STRINGP (operation
) ?
13607 SDATA (operation
) : NULL
),
13609 (STRINGP (parameters
) ?
13610 SDATA (parameters
) : NULL
),
13611 SDATA (current_dir
),
13612 (INTEGERP (show_flag
) ?
13613 XINT (show_flag
) : SW_SHOWDEFAULT
))
13616 error ("ShellExecute failed: %s", w32_strerror (0));
13619 /* Lookup virtual keycode from string representing the name of a
13620 non-ascii keystroke into the corresponding virtual key, using
13621 lispy_function_keys. */
13623 lookup_vk_code (char *key
)
13627 for (i
= 0; i
< 256; i
++)
13628 if (lispy_function_keys
[i
] != 0
13629 && strcmp (lispy_function_keys
[i
], key
) == 0)
13635 /* Convert a one-element vector style key sequence to a hot key
13638 w32_parse_hot_key (key
)
13641 /* Copied from Fdefine_key and store_in_keymap. */
13642 register Lisp_Object c
;
13644 int lisp_modifiers
;
13646 struct gcpro gcpro1
;
13648 CHECK_VECTOR (key
);
13650 if (XFASTINT (Flength (key
)) != 1)
13655 c
= Faref (key
, make_number (0));
13657 if (CONSP (c
) && lucid_event_type_list_p (c
))
13658 c
= Fevent_convert_list (c
);
13662 if (! INTEGERP (c
) && ! SYMBOLP (c
))
13663 error ("Key definition is invalid");
13665 /* Work out the base key and the modifiers. */
13668 c
= parse_modifiers (c
);
13669 lisp_modifiers
= Fcar (Fcdr (c
));
13673 vk_code
= lookup_vk_code (SDATA (SYMBOL_NAME (c
)));
13675 else if (INTEGERP (c
))
13677 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
13678 /* Many ascii characters are their own virtual key code. */
13679 vk_code
= XINT (c
) & CHARACTERBITS
;
13682 if (vk_code
< 0 || vk_code
> 255)
13685 if ((lisp_modifiers
& meta_modifier
) != 0
13686 && !NILP (Vw32_alt_is_meta
))
13687 lisp_modifiers
|= alt_modifier
;
13689 /* Supply defs missing from mingw32. */
13691 #define MOD_ALT 0x0001
13692 #define MOD_CONTROL 0x0002
13693 #define MOD_SHIFT 0x0004
13694 #define MOD_WIN 0x0008
13697 /* Convert lisp modifiers to Windows hot-key form. */
13698 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
13699 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
13700 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
13701 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
13703 return HOTKEY (vk_code
, w32_modifiers
);
13706 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
13707 Sw32_register_hot_key
, 1, 1, 0,
13708 doc
: /* Register KEY as a hot-key combination.
13709 Certain key combinations like Alt-Tab are reserved for system use on
13710 Windows, and therefore are normally intercepted by the system. However,
13711 most of these key combinations can be received by registering them as
13712 hot-keys, overriding their special meaning.
13714 KEY must be a one element key definition in vector form that would be
13715 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
13716 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
13717 is always interpreted as the Windows modifier keys.
13719 The return value is the hotkey-id if registered, otherwise nil. */)
13723 key
= w32_parse_hot_key (key
);
13725 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
13727 /* Reuse an empty slot if possible. */
13728 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
13730 /* Safe to add new key to list, even if we have focus. */
13732 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
13734 XSETCAR (item
, key
);
13736 /* Notify input thread about new hot-key definition, so that it
13737 takes effect without needing to switch focus. */
13738 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
13745 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
13746 Sw32_unregister_hot_key
, 1, 1, 0,
13747 doc
: /* Unregister HOTKEY as a hot-key combination. */)
13753 if (!INTEGERP (key
))
13754 key
= w32_parse_hot_key (key
);
13756 item
= Fmemq (key
, w32_grabbed_keys
);
13760 /* Notify input thread about hot-key definition being removed, so
13761 that it takes effect without needing focus switch. */
13762 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
13763 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
13766 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
13773 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
13774 Sw32_registered_hot_keys
, 0, 0, 0,
13775 doc
: /* Return list of registered hot-key IDs. */)
13778 return Fcopy_sequence (w32_grabbed_keys
);
13781 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
13782 Sw32_reconstruct_hot_key
, 1, 1, 0,
13783 doc
: /* Convert hot-key ID to a lisp key combination. */)
13785 Lisp_Object hotkeyid
;
13787 int vk_code
, w32_modifiers
;
13790 CHECK_NUMBER (hotkeyid
);
13792 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
13793 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
13795 if (lispy_function_keys
[vk_code
])
13796 key
= intern (lispy_function_keys
[vk_code
]);
13798 key
= make_number (vk_code
);
13800 key
= Fcons (key
, Qnil
);
13801 if (w32_modifiers
& MOD_SHIFT
)
13802 key
= Fcons (Qshift
, key
);
13803 if (w32_modifiers
& MOD_CONTROL
)
13804 key
= Fcons (Qctrl
, key
);
13805 if (w32_modifiers
& MOD_ALT
)
13806 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
13807 if (w32_modifiers
& MOD_WIN
)
13808 key
= Fcons (Qhyper
, key
);
13813 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
13814 Sw32_toggle_lock_key
, 1, 2, 0,
13815 doc
: /* Toggle the state of the lock key KEY.
13816 KEY can be `capslock', `kp-numlock', or `scroll'.
13817 If the optional parameter NEW-STATE is a number, then the state of KEY
13818 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
13820 Lisp_Object key
, new_state
;
13824 if (EQ (key
, intern ("capslock")))
13825 vk_code
= VK_CAPITAL
;
13826 else if (EQ (key
, intern ("kp-numlock")))
13827 vk_code
= VK_NUMLOCK
;
13828 else if (EQ (key
, intern ("scroll")))
13829 vk_code
= VK_SCROLL
;
13833 if (!dwWindowsThreadId
)
13834 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
13836 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
13837 (WPARAM
) vk_code
, (LPARAM
) new_state
))
13840 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
13841 return make_number (msg
.wParam
);
13846 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
13847 doc
: /* Return storage information about the file system FILENAME is on.
13848 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
13849 storage of the file system, FREE is the free storage, and AVAIL is the
13850 storage available to a non-superuser. All 3 numbers are in bytes.
13851 If the underlying system call fails, value is nil. */)
13853 Lisp_Object filename
;
13855 Lisp_Object encoded
, value
;
13857 CHECK_STRING (filename
);
13858 filename
= Fexpand_file_name (filename
, Qnil
);
13859 encoded
= ENCODE_FILE (filename
);
13863 /* Determining the required information on Windows turns out, sadly,
13864 to be more involved than one would hope. The original Win32 api
13865 call for this will return bogus information on some systems, but we
13866 must dynamically probe for the replacement api, since that was
13867 added rather late on. */
13869 HMODULE hKernel
= GetModuleHandle ("kernel32");
13870 BOOL (*pfn_GetDiskFreeSpaceEx
)
13871 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
13872 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
13874 /* On Windows, we may need to specify the root directory of the
13875 volume holding FILENAME. */
13876 char rootname
[MAX_PATH
];
13877 char *name
= SDATA (encoded
);
13879 /* find the root name of the volume if given */
13880 if (isalpha (name
[0]) && name
[1] == ':')
13882 rootname
[0] = name
[0];
13883 rootname
[1] = name
[1];
13884 rootname
[2] = '\\';
13887 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
13889 char *str
= rootname
;
13893 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
13903 if (pfn_GetDiskFreeSpaceEx
)
13905 /* Unsigned large integers cannot be cast to double, so
13906 use signed ones instead. */
13907 LARGE_INTEGER availbytes
;
13908 LARGE_INTEGER freebytes
;
13909 LARGE_INTEGER totalbytes
;
13911 if (pfn_GetDiskFreeSpaceEx(rootname
,
13912 (ULARGE_INTEGER
*)&availbytes
,
13913 (ULARGE_INTEGER
*)&totalbytes
,
13914 (ULARGE_INTEGER
*)&freebytes
))
13915 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
13916 make_float ((double) freebytes
.QuadPart
),
13917 make_float ((double) availbytes
.QuadPart
));
13921 DWORD sectors_per_cluster
;
13922 DWORD bytes_per_sector
;
13923 DWORD free_clusters
;
13924 DWORD total_clusters
;
13926 if (GetDiskFreeSpace(rootname
,
13927 §ors_per_cluster
,
13931 value
= list3 (make_float ((double) total_clusters
13932 * sectors_per_cluster
* bytes_per_sector
),
13933 make_float ((double) free_clusters
13934 * sectors_per_cluster
* bytes_per_sector
),
13935 make_float ((double) free_clusters
13936 * sectors_per_cluster
* bytes_per_sector
));
13943 DEFUN ("default-printer-name", Fdefault_printer_name
, Sdefault_printer_name
,
13944 0, 0, 0, doc
: /* Return the name of Windows default printer device. */)
13947 static char pname_buf
[256];
13950 PRINTER_INFO_2
*ppi2
= NULL
;
13951 DWORD dwNeeded
= 0, dwReturned
= 0;
13953 /* Retrieve the default string from Win.ini (the registry).
13954 * String will be in form "printername,drivername,portname".
13955 * This is the most portable way to get the default printer. */
13956 if (GetProfileString ("windows", "device", ",,", pname_buf
, sizeof (pname_buf
)) <= 0)
13958 /* printername precedes first "," character */
13959 strtok (pname_buf
, ",");
13960 /* We want to know more than the printer name */
13961 if (!OpenPrinter (pname_buf
, &hPrn
, NULL
))
13963 GetPrinter (hPrn
, 2, NULL
, 0, &dwNeeded
);
13966 ClosePrinter (hPrn
);
13969 /* Allocate memory for the PRINTER_INFO_2 struct */
13970 ppi2
= (PRINTER_INFO_2
*) xmalloc (dwNeeded
);
13973 ClosePrinter (hPrn
);
13976 /* Call GetPrinter() again with big enouth memory block */
13977 err
= GetPrinter (hPrn
, 2, (LPBYTE
)ppi2
, dwNeeded
, &dwReturned
);
13978 ClosePrinter (hPrn
);
13987 if (ppi2
->Attributes
& PRINTER_ATTRIBUTE_SHARED
&& ppi2
->pServerName
)
13989 /* a remote printer */
13990 if (*ppi2
->pServerName
== '\\')
13991 _snprintf(pname_buf
, sizeof (pname_buf
), "%s\\%s", ppi2
->pServerName
,
13994 _snprintf(pname_buf
, sizeof (pname_buf
), "\\\\%s\\%s", ppi2
->pServerName
,
13996 pname_buf
[sizeof (pname_buf
) - 1] = '\0';
14000 /* a local printer */
14001 strncpy(pname_buf
, ppi2
->pPortName
, sizeof (pname_buf
));
14002 pname_buf
[sizeof (pname_buf
) - 1] = '\0';
14003 /* `pPortName' can include several ports, delimited by ','.
14004 * we only use the first one. */
14005 strtok(pname_buf
, ",");
14010 return build_string (pname_buf
);
14013 /***********************************************************************
14015 ***********************************************************************/
14017 /* Keep this list in the same order as frame_parms in frame.c.
14018 Use 0 for unsupported frame parameters. */
14020 frame_parm_handler w32_frame_parm_handlers
[] =
14024 x_set_background_color
,
14025 x_set_border_color
,
14026 x_set_border_width
,
14027 x_set_cursor_color
,
14030 x_set_foreground_color
,
14033 x_set_internal_border_width
,
14034 x_set_menu_bar_lines
,
14036 x_explicitly_set_name
,
14037 x_set_scroll_bar_width
,
14039 x_set_unsplittable
,
14040 x_set_vertical_scroll_bars
,
14042 x_set_tool_bar_lines
,
14043 0, /* x_set_scroll_bar_foreground, */
14044 0, /* x_set_scroll_bar_background, */
14045 x_set_screen_gamma
,
14046 x_set_line_spacing
,
14047 x_set_fringe_width
,
14048 x_set_fringe_width
,
14049 0, /* x_set_wait_for_wm, */
14056 globals_of_w32fns ();
14057 /* This is zero if not using MS-Windows. */
14059 track_mouse_window
= NULL
;
14061 w32_visible_system_caret_hwnd
= NULL
;
14063 Qnone
= intern ("none");
14064 staticpro (&Qnone
);
14065 Qsuppress_icon
= intern ("suppress-icon");
14066 staticpro (&Qsuppress_icon
);
14067 Qundefined_color
= intern ("undefined-color");
14068 staticpro (&Qundefined_color
);
14069 Qcenter
= intern ("center");
14070 staticpro (&Qcenter
);
14071 Qcancel_timer
= intern ("cancel-timer");
14072 staticpro (&Qcancel_timer
);
14074 Qhyper
= intern ("hyper");
14075 staticpro (&Qhyper
);
14076 Qsuper
= intern ("super");
14077 staticpro (&Qsuper
);
14078 Qmeta
= intern ("meta");
14079 staticpro (&Qmeta
);
14080 Qalt
= intern ("alt");
14082 Qctrl
= intern ("ctrl");
14083 staticpro (&Qctrl
);
14084 Qcontrol
= intern ("control");
14085 staticpro (&Qcontrol
);
14086 Qshift
= intern ("shift");
14087 staticpro (&Qshift
);
14088 /* This is the end of symbol initialization. */
14090 /* Text property `display' should be nonsticky by default. */
14091 Vtext_property_default_nonsticky
14092 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
14095 Qlaplace
= intern ("laplace");
14096 staticpro (&Qlaplace
);
14097 Qemboss
= intern ("emboss");
14098 staticpro (&Qemboss
);
14099 Qedge_detection
= intern ("edge-detection");
14100 staticpro (&Qedge_detection
);
14101 Qheuristic
= intern ("heuristic");
14102 staticpro (&Qheuristic
);
14103 QCmatrix
= intern (":matrix");
14104 staticpro (&QCmatrix
);
14105 QCcolor_adjustment
= intern (":color-adjustment");
14106 staticpro (&QCcolor_adjustment
);
14107 QCmask
= intern (":mask");
14108 staticpro (&QCmask
);
14110 Fput (Qundefined_color
, Qerror_conditions
,
14111 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
14112 Fput (Qundefined_color
, Qerror_message
,
14113 build_string ("Undefined color"));
14115 staticpro (&w32_grabbed_keys
);
14116 w32_grabbed_keys
= Qnil
;
14118 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
14119 doc
: /* An array of color name mappings for windows. */);
14120 Vw32_color_map
= Qnil
;
14122 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
14123 doc
: /* Non-nil if alt key presses are passed on to Windows.
14124 When non-nil, for example, alt pressed and released and then space will
14125 open the System menu. When nil, Emacs silently swallows alt key events. */);
14126 Vw32_pass_alt_to_system
= Qnil
;
14128 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
14129 doc
: /* Non-nil if the alt key is to be considered the same as the meta key.
14130 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta. */);
14131 Vw32_alt_is_meta
= Qt
;
14133 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
14134 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
14135 XSETINT (Vw32_quit_key
, 0);
14137 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14138 &Vw32_pass_lwindow_to_system
,
14139 doc
: /* Non-nil if the left \"Windows\" key is passed on to Windows.
14140 When non-nil, the Start menu is opened by tapping the key. */);
14141 Vw32_pass_lwindow_to_system
= Qt
;
14143 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14144 &Vw32_pass_rwindow_to_system
,
14145 doc
: /* Non-nil if the right \"Windows\" key is passed on to Windows.
14146 When non-nil, the Start menu is opened by tapping the key. */);
14147 Vw32_pass_rwindow_to_system
= Qt
;
14149 DEFVAR_INT ("w32-phantom-key-code",
14150 &Vw32_phantom_key_code
,
14151 doc
: /* Virtual key code used to generate \"phantom\" key presses.
14152 Value is a number between 0 and 255.
14154 Phantom key presses are generated in order to stop the system from
14155 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
14156 `w32-pass-rwindow-to-system' is nil. */);
14157 /* Although 255 is technically not a valid key code, it works and
14158 means that this hack won't interfere with any real key code. */
14159 Vw32_phantom_key_code
= 255;
14161 DEFVAR_LISP ("w32-enable-num-lock",
14162 &Vw32_enable_num_lock
,
14163 doc
: /* Non-nil if Num Lock should act normally.
14164 Set to nil to see Num Lock as the key `kp-numlock'. */);
14165 Vw32_enable_num_lock
= Qt
;
14167 DEFVAR_LISP ("w32-enable-caps-lock",
14168 &Vw32_enable_caps_lock
,
14169 doc
: /* Non-nil if Caps Lock should act normally.
14170 Set to nil to see Caps Lock as the key `capslock'. */);
14171 Vw32_enable_caps_lock
= Qt
;
14173 DEFVAR_LISP ("w32-scroll-lock-modifier",
14174 &Vw32_scroll_lock_modifier
,
14175 doc
: /* Modifier to use for the Scroll Lock on state.
14176 The value can be hyper, super, meta, alt, control or shift for the
14177 respective modifier, or nil to see Scroll Lock as the key `scroll'.
14178 Any other value will cause the key to be ignored. */);
14179 Vw32_scroll_lock_modifier
= Qt
;
14181 DEFVAR_LISP ("w32-lwindow-modifier",
14182 &Vw32_lwindow_modifier
,
14183 doc
: /* Modifier to use for the left \"Windows\" key.
14184 The value can be hyper, super, meta, alt, control or shift for the
14185 respective modifier, or nil to appear as the key `lwindow'.
14186 Any other value will cause the key to be ignored. */);
14187 Vw32_lwindow_modifier
= Qnil
;
14189 DEFVAR_LISP ("w32-rwindow-modifier",
14190 &Vw32_rwindow_modifier
,
14191 doc
: /* Modifier to use for the right \"Windows\" key.
14192 The value can be hyper, super, meta, alt, control or shift for the
14193 respective modifier, or nil to appear as the key `rwindow'.
14194 Any other value will cause the key to be ignored. */);
14195 Vw32_rwindow_modifier
= Qnil
;
14197 DEFVAR_LISP ("w32-apps-modifier",
14198 &Vw32_apps_modifier
,
14199 doc
: /* Modifier to use for the \"Apps\" key.
14200 The value can be hyper, super, meta, alt, control or shift for the
14201 respective modifier, or nil to appear as the key `apps'.
14202 Any other value will cause the key to be ignored. */);
14203 Vw32_apps_modifier
= Qnil
;
14205 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts
,
14206 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
14207 w32_enable_synthesized_fonts
= 0;
14209 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
14210 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
14211 Vw32_enable_palette
= Qt
;
14213 DEFVAR_INT ("w32-mouse-button-tolerance",
14214 &Vw32_mouse_button_tolerance
,
14215 doc
: /* Analogue of double click interval for faking middle mouse events.
14216 The value is the minimum time in milliseconds that must elapse between
14217 left/right button down events before they are considered distinct events.
14218 If both mouse buttons are depressed within this interval, a middle mouse
14219 button down event is generated instead. */);
14220 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
14222 DEFVAR_INT ("w32-mouse-move-interval",
14223 &Vw32_mouse_move_interval
,
14224 doc
: /* Minimum interval between mouse move events.
14225 The value is the minimum time in milliseconds that must elapse between
14226 successive mouse move (or scroll bar drag) events before they are
14227 reported as lisp events. */);
14228 XSETINT (Vw32_mouse_move_interval
, 0);
14230 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
14231 &w32_pass_extra_mouse_buttons_to_system
,
14232 doc
: /* Non-nil if the fourth and fifth mouse buttons are passed to Windows.
14233 Recent versions of Windows support mice with up to five buttons.
14234 Since most applications don't support these extra buttons, most mouse
14235 drivers will allow you to map them to functions at the system level.
14236 If this variable is non-nil, Emacs will pass them on, allowing the
14237 system to handle them. */);
14238 w32_pass_extra_mouse_buttons_to_system
= 0;
14240 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
14241 doc
: /* List of directories to search for window system bitmap files. */);
14242 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
14244 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
14245 doc
: /* The shape of the pointer when over text.
14246 Changing the value does not affect existing frames
14247 unless you set the mouse color. */);
14248 Vx_pointer_shape
= Qnil
;
14250 Vx_nontext_pointer_shape
= Qnil
;
14252 Vx_mode_pointer_shape
= Qnil
;
14254 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
14255 doc
: /* The shape of the pointer when Emacs is busy.
14256 This variable takes effect when you create a new frame
14257 or when you set the mouse color. */);
14258 Vx_hourglass_pointer_shape
= Qnil
;
14260 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
14261 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
14262 display_hourglass_p
= 1;
14264 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
14265 doc
: /* *Seconds to wait before displaying an hourglass pointer.
14266 Value must be an integer or float. */);
14267 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
14269 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
14270 &Vx_sensitive_text_pointer_shape
,
14271 doc
: /* The shape of the pointer when over mouse-sensitive text.
14272 This variable takes effect when you create a new frame
14273 or when you set the mouse color. */);
14274 Vx_sensitive_text_pointer_shape
= Qnil
;
14276 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
14277 &Vx_window_horizontal_drag_shape
,
14278 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
14279 This variable takes effect when you create a new frame
14280 or when you set the mouse color. */);
14281 Vx_window_horizontal_drag_shape
= Qnil
;
14283 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
14284 doc
: /* A string indicating the foreground color of the cursor box. */);
14285 Vx_cursor_fore_pixel
= Qnil
;
14287 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
14288 doc
: /* Maximum size for tooltips.
14289 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
14290 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
14292 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
14293 doc
: /* Non-nil if no window manager is in use.
14294 Emacs doesn't try to figure this out; this is always nil
14295 unless you set it to something else. */);
14296 /* We don't have any way to find this out, so set it to nil
14297 and maybe the user would like to set it to t. */
14298 Vx_no_window_manager
= Qnil
;
14300 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
14301 &Vx_pixel_size_width_font_regexp
,
14302 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
14304 Since Emacs gets width of a font matching with this regexp from
14305 PIXEL_SIZE field of the name, font finding mechanism gets faster for
14306 such a font. This is especially effective for such large fonts as
14307 Chinese, Japanese, and Korean. */);
14308 Vx_pixel_size_width_font_regexp
= Qnil
;
14310 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
14311 doc
: /* Time after which cached images are removed from the cache.
14312 When an image has not been displayed this many seconds, remove it
14313 from the image cache. Value must be an integer or nil with nil
14314 meaning don't clear the cache. */);
14315 Vimage_cache_eviction_delay
= make_number (30 * 60);
14317 DEFVAR_LISP ("w32-bdf-filename-alist",
14318 &Vw32_bdf_filename_alist
,
14319 doc
: /* List of bdf fonts and their corresponding filenames. */);
14320 Vw32_bdf_filename_alist
= Qnil
;
14322 DEFVAR_BOOL ("w32-strict-fontnames",
14323 &w32_strict_fontnames
,
14324 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
14325 Default is nil, which allows old fontnames that are not XLFD compliant,
14326 and allows third-party CJK display to work by specifying false charset
14327 fields to trick Emacs into translating to Big5, SJIS etc.
14328 Setting this to t will prevent wrong fonts being selected when
14329 fontsets are automatically created. */);
14330 w32_strict_fontnames
= 0;
14332 DEFVAR_BOOL ("w32-strict-painting",
14333 &w32_strict_painting
,
14334 doc
: /* Non-nil means use strict rules for repainting frames.
14335 Set this to nil to get the old behaviour for repainting; this should
14336 only be necessary if the default setting causes problems. */);
14337 w32_strict_painting
= 1;
14339 DEFVAR_LISP ("w32-charset-info-alist",
14340 &Vw32_charset_info_alist
,
14341 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
14342 Each entry should be of the form:
14344 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
14346 where CHARSET_NAME is a string used in font names to identify the charset,
14347 WINDOWS_CHARSET is a symbol that can be one of:
14348 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
14349 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
14350 w32-charset-chinesebig5,
14351 w32-charset-johab, w32-charset-hebrew,
14352 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
14353 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
14354 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
14355 w32-charset-unicode,
14356 or w32-charset-oem.
14357 CODEPAGE should be an integer specifying the codepage that should be used
14358 to display the character set, t to do no translation and output as Unicode,
14359 or nil to do no translation and output as 8 bit (or multibyte on far-east
14360 versions of Windows) characters. */);
14361 Vw32_charset_info_alist
= Qnil
;
14363 staticpro (&Qw32_charset_ansi
);
14364 Qw32_charset_ansi
= intern ("w32-charset-ansi");
14365 staticpro (&Qw32_charset_symbol
);
14366 Qw32_charset_symbol
= intern ("w32-charset-symbol");
14367 staticpro (&Qw32_charset_shiftjis
);
14368 Qw32_charset_shiftjis
= intern ("w32-charset-shiftjis");
14369 staticpro (&Qw32_charset_hangeul
);
14370 Qw32_charset_hangeul
= intern ("w32-charset-hangeul");
14371 staticpro (&Qw32_charset_chinesebig5
);
14372 Qw32_charset_chinesebig5
= intern ("w32-charset-chinesebig5");
14373 staticpro (&Qw32_charset_gb2312
);
14374 Qw32_charset_gb2312
= intern ("w32-charset-gb2312");
14375 staticpro (&Qw32_charset_oem
);
14376 Qw32_charset_oem
= intern ("w32-charset-oem");
14378 #ifdef JOHAB_CHARSET
14380 static int w32_extra_charsets_defined
= 1;
14381 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
14382 doc
: /* Internal variable. */);
14384 staticpro (&Qw32_charset_johab
);
14385 Qw32_charset_johab
= intern ("w32-charset-johab");
14386 staticpro (&Qw32_charset_easteurope
);
14387 Qw32_charset_easteurope
= intern ("w32-charset-easteurope");
14388 staticpro (&Qw32_charset_turkish
);
14389 Qw32_charset_turkish
= intern ("w32-charset-turkish");
14390 staticpro (&Qw32_charset_baltic
);
14391 Qw32_charset_baltic
= intern ("w32-charset-baltic");
14392 staticpro (&Qw32_charset_russian
);
14393 Qw32_charset_russian
= intern ("w32-charset-russian");
14394 staticpro (&Qw32_charset_arabic
);
14395 Qw32_charset_arabic
= intern ("w32-charset-arabic");
14396 staticpro (&Qw32_charset_greek
);
14397 Qw32_charset_greek
= intern ("w32-charset-greek");
14398 staticpro (&Qw32_charset_hebrew
);
14399 Qw32_charset_hebrew
= intern ("w32-charset-hebrew");
14400 staticpro (&Qw32_charset_vietnamese
);
14401 Qw32_charset_vietnamese
= intern ("w32-charset-vietnamese");
14402 staticpro (&Qw32_charset_thai
);
14403 Qw32_charset_thai
= intern ("w32-charset-thai");
14404 staticpro (&Qw32_charset_mac
);
14405 Qw32_charset_mac
= intern ("w32-charset-mac");
14409 #ifdef UNICODE_CHARSET
14411 static int w32_unicode_charset_defined
= 1;
14412 DEFVAR_BOOL ("w32-unicode-charset-defined",
14413 &w32_unicode_charset_defined
,
14414 doc
: /* Internal variable. */);
14416 staticpro (&Qw32_charset_unicode
);
14417 Qw32_charset_unicode
= intern ("w32-charset-unicode");
14420 #if 0 /* TODO: Port to W32 */
14421 defsubr (&Sx_change_window_property
);
14422 defsubr (&Sx_delete_window_property
);
14423 defsubr (&Sx_window_property
);
14425 defsubr (&Sxw_display_color_p
);
14426 defsubr (&Sx_display_grayscale_p
);
14427 defsubr (&Sxw_color_defined_p
);
14428 defsubr (&Sxw_color_values
);
14429 defsubr (&Sx_server_max_request_size
);
14430 defsubr (&Sx_server_vendor
);
14431 defsubr (&Sx_server_version
);
14432 defsubr (&Sx_display_pixel_width
);
14433 defsubr (&Sx_display_pixel_height
);
14434 defsubr (&Sx_display_mm_width
);
14435 defsubr (&Sx_display_mm_height
);
14436 defsubr (&Sx_display_screens
);
14437 defsubr (&Sx_display_planes
);
14438 defsubr (&Sx_display_color_cells
);
14439 defsubr (&Sx_display_visual_class
);
14440 defsubr (&Sx_display_backing_store
);
14441 defsubr (&Sx_display_save_under
);
14442 defsubr (&Sx_create_frame
);
14443 defsubr (&Sx_open_connection
);
14444 defsubr (&Sx_close_connection
);
14445 defsubr (&Sx_display_list
);
14446 defsubr (&Sx_synchronize
);
14448 /* W32 specific functions */
14450 defsubr (&Sw32_focus_frame
);
14451 defsubr (&Sw32_select_font
);
14452 defsubr (&Sw32_define_rgb_color
);
14453 defsubr (&Sw32_default_color_map
);
14454 defsubr (&Sw32_load_color_file
);
14455 defsubr (&Sw32_send_sys_command
);
14456 defsubr (&Sw32_shell_execute
);
14457 defsubr (&Sw32_register_hot_key
);
14458 defsubr (&Sw32_unregister_hot_key
);
14459 defsubr (&Sw32_registered_hot_keys
);
14460 defsubr (&Sw32_reconstruct_hot_key
);
14461 defsubr (&Sw32_toggle_lock_key
);
14462 defsubr (&Sw32_find_bdf_fonts
);
14464 defsubr (&Sfile_system_info
);
14465 defsubr (&Sdefault_printer_name
);
14467 /* Setting callback functions for fontset handler. */
14468 get_font_info_func
= w32_get_font_info
;
14470 #if 0 /* This function pointer doesn't seem to be used anywhere.
14471 And the pointer assigned has the wrong type, anyway. */
14472 list_fonts_func
= w32_list_fonts
;
14475 load_font_func
= w32_load_font
;
14476 find_ccl_program_func
= w32_find_ccl_program
;
14477 query_font_func
= w32_query_font
;
14478 set_frame_fontset_func
= x_set_font
;
14479 check_window_system_func
= check_w32
;
14482 Qxbm
= intern ("xbm");
14484 QCconversion
= intern (":conversion");
14485 staticpro (&QCconversion
);
14486 QCheuristic_mask
= intern (":heuristic-mask");
14487 staticpro (&QCheuristic_mask
);
14488 QCcolor_symbols
= intern (":color-symbols");
14489 staticpro (&QCcolor_symbols
);
14490 QCascent
= intern (":ascent");
14491 staticpro (&QCascent
);
14492 QCmargin
= intern (":margin");
14493 staticpro (&QCmargin
);
14494 QCrelief
= intern (":relief");
14495 staticpro (&QCrelief
);
14496 Qpostscript
= intern ("postscript");
14497 staticpro (&Qpostscript
);
14498 QCloader
= intern (":loader");
14499 staticpro (&QCloader
);
14500 QCbounding_box
= intern (":bounding-box");
14501 staticpro (&QCbounding_box
);
14502 QCpt_width
= intern (":pt-width");
14503 staticpro (&QCpt_width
);
14504 QCpt_height
= intern (":pt-height");
14505 staticpro (&QCpt_height
);
14506 QCindex
= intern (":index");
14507 staticpro (&QCindex
);
14508 Qpbm
= intern ("pbm");
14512 Qxpm
= intern ("xpm");
14517 Qjpeg
= intern ("jpeg");
14518 staticpro (&Qjpeg
);
14522 Qtiff
= intern ("tiff");
14523 staticpro (&Qtiff
);
14527 Qgif
= intern ("gif");
14532 Qpng
= intern ("png");
14536 defsubr (&Sclear_image_cache
);
14537 defsubr (&Simage_size
);
14538 defsubr (&Simage_mask_p
);
14540 hourglass_atimer
= NULL
;
14541 hourglass_shown_p
= 0;
14542 defsubr (&Sx_show_tip
);
14543 defsubr (&Sx_hide_tip
);
14545 staticpro (&tip_timer
);
14547 staticpro (&tip_frame
);
14549 last_show_tip_args
= Qnil
;
14550 staticpro (&last_show_tip_args
);
14552 defsubr (&Sx_file_dialog
);
14557 globals_of_w32fns is used to initialize those global variables that
14558 must always be initialized on startup even when the global variable
14559 initialized is non zero (see the function main in emacs.c).
14560 globals_of_w32fns is called from syms_of_w32fns when the global
14561 variable initialized is 0 and directly from main when initialized
14564 void globals_of_w32fns ()
14566 HMODULE user32_lib
= GetModuleHandle ("user32.dll");
14568 TrackMouseEvent not available in all versions of Windows, so must load
14569 it dynamically. Do it once, here, instead of every time it is used.
14571 track_mouse_event_fn
= (TrackMouseEvent_Proc
)
14572 GetProcAddress (user32_lib
, "TrackMouseEvent");
14573 /* ditto for GetClipboardSequenceNumber. */
14574 clipboard_sequence_fn
= (ClipboardSequence_Proc
)
14575 GetProcAddress (user32_lib
, "GetClipboardSequenceNumber");
14578 /* Initialize image types. Based on which libraries are available. */
14580 init_external_image_libraries ()
14585 if ((library
= LoadLibrary ("libXpm.dll")))
14587 if (init_xpm_functions (library
))
14588 define_image_type (&xpm_type
);
14594 /* Try loading jpeg library under probable names. */
14595 if ((library
= LoadLibrary ("libjpeg.dll"))
14596 || (library
= LoadLibrary ("jpeg-62.dll"))
14597 || (library
= LoadLibrary ("jpeg.dll")))
14599 if (init_jpeg_functions (library
))
14600 define_image_type (&jpeg_type
);
14605 if (library
= LoadLibrary ("libtiff.dll"))
14607 if (init_tiff_functions (library
))
14608 define_image_type (&tiff_type
);
14613 if (library
= LoadLibrary ("libungif.dll"))
14615 if (init_gif_functions (library
))
14616 define_image_type (&gif_type
);
14621 /* Ensure zlib is loaded. Try debug version first. */
14622 if (!LoadLibrary ("zlibd.dll"))
14623 LoadLibrary ("zlib.dll");
14625 /* Try loading libpng under probable names. */
14626 if ((library
= LoadLibrary ("libpng13d.dll"))
14627 || (library
= LoadLibrary ("libpng13.dll"))
14628 || (library
= LoadLibrary ("libpng12d.dll"))
14629 || (library
= LoadLibrary ("libpng12.dll"))
14630 || (library
= LoadLibrary ("libpng.dll")))
14632 if (init_png_functions (library
))
14633 define_image_type (&png_type
);
14641 image_types
= NULL
;
14642 Vimage_types
= Qnil
;
14644 define_image_type (&pbm_type
);
14645 define_image_type (&xbm_type
);
14647 #if 0 /* TODO : Ghostscript support for W32 */
14648 define_image_type (&gs_type
);
14651 /* Image types that rely on external libraries are loaded dynamically
14652 if the library is available. */
14653 init_external_image_libraries ();
14662 button
= MessageBox (NULL
,
14663 "A fatal error has occurred!\n\n"
14664 "Select Abort to exit, Retry to debug, Ignore to continue",
14665 "Emacs Abort Dialog",
14666 MB_ICONEXCLAMATION
| MB_TASKMODAL
14667 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
14682 /* For convenience when debugging. */
14686 return GetLastError ();
14689 /* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
14690 (do not change this comment) */