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 */
36 #include "intervals.h"
37 #include "dispextern.h"
39 #include "blockinput.h"
41 #include "character.h"
47 #include "termhooks.h"
50 #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
, 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 fontp
->charset
= -1;
4795 charset
= xlfd_charset_of_font (fontname
);
4797 /* Cache the W32 codepage for a font. This makes w32_encode_char
4798 (called for every glyph during redisplay) much faster. */
4799 fontp
->codepage
= codepage
;
4801 /* Work out the font's full name. */
4802 full_name
= (char *)xmalloc (100);
4803 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
4804 fontp
->full_name
= full_name
;
4807 /* If all else fails - just use the name we used to load it. */
4809 fontp
->full_name
= fontp
->name
;
4812 fontp
->size
= FONT_WIDTH (font
);
4813 fontp
->height
= FONT_HEIGHT (font
);
4815 /* The slot `encoding' specifies how to map a character
4816 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
4817 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
4818 (0:0x20..0x7F, 1:0xA0..0xFF,
4819 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4820 2:0xA020..0xFF7F). For the moment, we don't know which charset
4821 uses this font. So, we set information in fontp->encoding_type
4822 which is never used by any charset. If mapping can't be
4823 decided, set FONT_ENCODING_NOT_DECIDED. */
4825 /* SJIS fonts need to be set to type 4, all others seem to work as
4826 type FONT_ENCODING_NOT_DECIDED. */
4827 encoding
= strrchr (fontp
->name
, '-');
4828 if (encoding
&& strnicmp (encoding
+1, "sjis", 4) == 0)
4829 fontp
->encoding_type
= 4;
4831 fontp
->encoding_type
= FONT_ENCODING_NOT_DECIDED
;
4833 /* The following three values are set to 0 under W32, which is
4834 what they get set to if XGetFontProperty fails under X. */
4835 fontp
->baseline_offset
= 0;
4836 fontp
->relative_compose
= 0;
4837 fontp
->default_ascent
= 0;
4839 /* Set global flag fonts_changed_p to non-zero if the font loaded
4840 has a character with a smaller width than any other character
4841 before, or if the font loaded has a smaller height than any
4842 other font loaded before. If this happens, it will make a
4843 glyph matrix reallocation necessary. */
4844 fonts_changed_p
|= x_compute_min_glyph_bounds (f
);
4850 /* Load font named FONTNAME of size SIZE for frame F, and return a
4851 pointer to the structure font_info while allocating it dynamically.
4852 If loading fails, return NULL. */
4854 w32_load_font (f
,fontname
,size
)
4859 Lisp_Object bdf_fonts
;
4860 struct font_info
*retval
= NULL
;
4862 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
4864 while (!retval
&& CONSP (bdf_fonts
))
4866 char *bdf_name
, *bdf_file
;
4867 Lisp_Object bdf_pair
;
4869 bdf_name
= SDATA (XCAR (bdf_fonts
));
4870 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
4871 bdf_file
= SDATA (XCDR (bdf_pair
));
4873 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
4875 bdf_fonts
= XCDR (bdf_fonts
);
4881 return w32_load_system_font(f
, fontname
, size
);
4886 w32_unload_font (dpyinfo
, font
)
4887 struct w32_display_info
*dpyinfo
;
4892 if (font
->per_char
) xfree (font
->per_char
);
4893 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
4895 if (font
->hfont
) DeleteObject(font
->hfont
);
4900 /* The font conversion stuff between x and w32 */
4902 /* X font string is as follows (from faces.el)
4906 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4907 * (weight\? "\\([^-]*\\)") ; 1
4908 * (slant "\\([ior]\\)") ; 2
4909 * (slant\? "\\([^-]?\\)") ; 2
4910 * (swidth "\\([^-]*\\)") ; 3
4911 * (adstyle "[^-]*") ; 4
4912 * (pixelsize "[0-9]+")
4913 * (pointsize "[0-9][0-9]+")
4914 * (resx "[0-9][0-9]+")
4915 * (resy "[0-9][0-9]+")
4916 * (spacing "[cmp?*]")
4917 * (avgwidth "[0-9]+")
4918 * (registry "[^-]+")
4919 * (encoding "[^-]+")
4924 x_to_w32_weight (lpw
)
4927 if (!lpw
) return (FW_DONTCARE
);
4929 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
4930 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
4931 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
4932 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
4933 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
4934 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
4935 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
4936 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
4937 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
4938 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
4945 w32_to_x_weight (fnweight
)
4948 if (fnweight
>= FW_HEAVY
) return "heavy";
4949 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
4950 if (fnweight
>= FW_BOLD
) return "bold";
4951 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
4952 if (fnweight
>= FW_MEDIUM
) return "medium";
4953 if (fnweight
>= FW_NORMAL
) return "normal";
4954 if (fnweight
>= FW_LIGHT
) return "light";
4955 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
4956 if (fnweight
>= FW_THIN
) return "thin";
4962 x_to_w32_charset (lpcs
)
4965 Lisp_Object this_entry
, w32_charset
;
4967 int len
= strlen (lpcs
);
4969 /* Support "*-#nnn" format for unknown charsets. */
4970 if (strncmp (lpcs
, "*-#", 3) == 0)
4971 return atoi (lpcs
+ 3);
4973 /* All Windows fonts qualify as unicode. */
4974 if (!strncmp (lpcs
, "iso10646", 8))
4975 return DEFAULT_CHARSET
;
4977 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
4978 charset
= alloca (len
+ 1);
4979 strcpy (charset
, lpcs
);
4980 lpcs
= strchr (charset
, '*');
4984 /* Look through w32-charset-info-alist for the character set.
4985 Format of each entry is
4986 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
4988 this_entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
4990 if (NILP(this_entry
))
4992 /* At startup, we want iso8859-1 fonts to come up properly. */
4993 if (stricmp(charset
, "iso8859-1") == 0)
4994 return ANSI_CHARSET
;
4996 return DEFAULT_CHARSET
;
4999 w32_charset
= Fcar (Fcdr (this_entry
));
5001 /* Translate Lisp symbol to number. */
5002 if (w32_charset
== Qw32_charset_ansi
)
5003 return ANSI_CHARSET
;
5004 if (w32_charset
== Qw32_charset_symbol
)
5005 return SYMBOL_CHARSET
;
5006 if (w32_charset
== Qw32_charset_shiftjis
)
5007 return SHIFTJIS_CHARSET
;
5008 if (w32_charset
== Qw32_charset_hangeul
)
5009 return HANGEUL_CHARSET
;
5010 if (w32_charset
== Qw32_charset_chinesebig5
)
5011 return CHINESEBIG5_CHARSET
;
5012 if (w32_charset
== Qw32_charset_gb2312
)
5013 return GB2312_CHARSET
;
5014 if (w32_charset
== Qw32_charset_oem
)
5016 #ifdef JOHAB_CHARSET
5017 if (w32_charset
== Qw32_charset_johab
)
5018 return JOHAB_CHARSET
;
5019 if (w32_charset
== Qw32_charset_easteurope
)
5020 return EASTEUROPE_CHARSET
;
5021 if (w32_charset
== Qw32_charset_turkish
)
5022 return TURKISH_CHARSET
;
5023 if (w32_charset
== Qw32_charset_baltic
)
5024 return BALTIC_CHARSET
;
5025 if (w32_charset
== Qw32_charset_russian
)
5026 return RUSSIAN_CHARSET
;
5027 if (w32_charset
== Qw32_charset_arabic
)
5028 return ARABIC_CHARSET
;
5029 if (w32_charset
== Qw32_charset_greek
)
5030 return GREEK_CHARSET
;
5031 if (w32_charset
== Qw32_charset_hebrew
)
5032 return HEBREW_CHARSET
;
5033 if (w32_charset
== Qw32_charset_vietnamese
)
5034 return VIETNAMESE_CHARSET
;
5035 if (w32_charset
== Qw32_charset_thai
)
5036 return THAI_CHARSET
;
5037 if (w32_charset
== Qw32_charset_mac
)
5039 #endif /* JOHAB_CHARSET */
5040 #ifdef UNICODE_CHARSET
5041 if (w32_charset
== Qw32_charset_unicode
)
5042 return UNICODE_CHARSET
;
5045 return DEFAULT_CHARSET
;
5050 w32_to_x_charset (fncharset
, matching
)
5054 static char buf
[32];
5055 Lisp_Object charset_type
;
5060 /* If fully specified, accept it as it is. Otherwise use a
5062 char *wildcard
= strchr (matching
, '*');
5065 else if (strchr (matching
, '-'))
5068 match_len
= strlen (matching
);
5074 /* Handle startup case of w32-charset-info-alist not
5075 being set up yet. */
5076 if (NILP(Vw32_charset_info_alist
))
5078 charset_type
= Qw32_charset_ansi
;
5080 case DEFAULT_CHARSET
:
5081 charset_type
= Qw32_charset_default
;
5083 case SYMBOL_CHARSET
:
5084 charset_type
= Qw32_charset_symbol
;
5086 case SHIFTJIS_CHARSET
:
5087 charset_type
= Qw32_charset_shiftjis
;
5089 case HANGEUL_CHARSET
:
5090 charset_type
= Qw32_charset_hangeul
;
5092 case GB2312_CHARSET
:
5093 charset_type
= Qw32_charset_gb2312
;
5095 case CHINESEBIG5_CHARSET
:
5096 charset_type
= Qw32_charset_chinesebig5
;
5099 charset_type
= Qw32_charset_oem
;
5102 /* More recent versions of Windows (95 and NT4.0) define more
5104 #ifdef EASTEUROPE_CHARSET
5105 case EASTEUROPE_CHARSET
:
5106 charset_type
= Qw32_charset_easteurope
;
5108 case TURKISH_CHARSET
:
5109 charset_type
= Qw32_charset_turkish
;
5111 case BALTIC_CHARSET
:
5112 charset_type
= Qw32_charset_baltic
;
5114 case RUSSIAN_CHARSET
:
5115 charset_type
= Qw32_charset_russian
;
5117 case ARABIC_CHARSET
:
5118 charset_type
= Qw32_charset_arabic
;
5121 charset_type
= Qw32_charset_greek
;
5123 case HEBREW_CHARSET
:
5124 charset_type
= Qw32_charset_hebrew
;
5126 case VIETNAMESE_CHARSET
:
5127 charset_type
= Qw32_charset_vietnamese
;
5130 charset_type
= Qw32_charset_thai
;
5133 charset_type
= Qw32_charset_mac
;
5136 charset_type
= Qw32_charset_johab
;
5140 #ifdef UNICODE_CHARSET
5141 case UNICODE_CHARSET
:
5142 charset_type
= Qw32_charset_unicode
;
5146 /* Encode numerical value of unknown charset. */
5147 sprintf (buf
, "*-#%u", fncharset
);
5153 char * best_match
= NULL
;
5154 int matching_found
= 0;
5156 /* Look through w32-charset-info-alist for the character set.
5157 Prefer ISO codepages, and prefer lower numbers in the ISO
5158 range. Only return charsets for codepages which are installed.
5160 Format of each entry is
5161 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5163 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5166 Lisp_Object w32_charset
;
5167 Lisp_Object codepage
;
5169 Lisp_Object this_entry
= XCAR (rest
);
5171 /* Skip invalid entries in alist. */
5172 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5173 || !CONSP (XCDR (this_entry
))
5174 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5177 x_charset
= SDATA (XCAR (this_entry
));
5178 w32_charset
= XCAR (XCDR (this_entry
));
5179 codepage
= XCDR (XCDR (this_entry
));
5181 /* Look for Same charset and a valid codepage (or non-int
5182 which means ignore). */
5183 if (w32_charset
== charset_type
5184 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
5185 || IsValidCodePage (XINT (codepage
))))
5187 /* If we don't have a match already, then this is the
5191 best_match
= x_charset
;
5192 if (matching
&& !strnicmp (x_charset
, matching
, match_len
))
5195 /* If we already found a match for MATCHING, then
5196 only consider other matches. */
5197 else if (matching_found
5198 && strnicmp (x_charset
, matching
, match_len
))
5200 /* If this matches what we want, and the best so far doesn't,
5201 then this is better. */
5202 else if (!matching_found
&& matching
5203 && !strnicmp (x_charset
, matching
, match_len
))
5205 best_match
= x_charset
;
5208 /* If this is fully specified, and the best so far isn't,
5209 then this is better. */
5210 else if ((!strchr (best_match
, '-') && strchr (x_charset
, '-'))
5211 /* If this is an ISO codepage, and the best so far isn't,
5212 then this is better, but only if it fully specifies the
5214 || (strnicmp (best_match
, "iso", 3) != 0
5215 && strnicmp (x_charset
, "iso", 3) == 0
5216 && strchr (x_charset
, '-')))
5217 best_match
= x_charset
;
5218 /* If both are ISO8859 codepages, choose the one with the
5219 lowest number in the encoding field. */
5220 else if (strnicmp (best_match
, "iso8859-", 8) == 0
5221 && strnicmp (x_charset
, "iso8859-", 8) == 0)
5223 int best_enc
= atoi (best_match
+ 8);
5224 int this_enc
= atoi (x_charset
+ 8);
5225 if (this_enc
> 0 && this_enc
< best_enc
)
5226 best_match
= x_charset
;
5231 /* If no match, encode the numeric value. */
5234 sprintf (buf
, "*-#%u", fncharset
);
5238 strncpy (buf
, best_match
, 31);
5239 /* If the charset is not fully specified, put -0 on the end. */
5240 if (!strchr (best_match
, '-'))
5242 int pos
= strlen (best_match
);
5243 /* Charset specifiers shouldn't be very long. If it is a made
5244 up one, truncating it should not do any harm since it isn't
5245 recognized anyway. */
5248 strcpy (buf
+ pos
, "-0");
5256 /* Return all the X charsets that map to a font. */
5258 w32_to_all_x_charsets (fncharset
)
5261 static char buf
[32];
5262 Lisp_Object charset_type
;
5263 Lisp_Object retval
= Qnil
;
5268 /* Handle startup case of w32-charset-info-alist not
5269 being set up yet. */
5270 if (NILP(Vw32_charset_info_alist
))
5271 return Fcons (build_string ("iso8859-1"), Qnil
);
5273 charset_type
= Qw32_charset_ansi
;
5275 case DEFAULT_CHARSET
:
5276 charset_type
= Qw32_charset_default
;
5278 case SYMBOL_CHARSET
:
5279 charset_type
= Qw32_charset_symbol
;
5281 case SHIFTJIS_CHARSET
:
5282 charset_type
= Qw32_charset_shiftjis
;
5284 case HANGEUL_CHARSET
:
5285 charset_type
= Qw32_charset_hangeul
;
5287 case GB2312_CHARSET
:
5288 charset_type
= Qw32_charset_gb2312
;
5290 case CHINESEBIG5_CHARSET
:
5291 charset_type
= Qw32_charset_chinesebig5
;
5294 charset_type
= Qw32_charset_oem
;
5297 /* More recent versions of Windows (95 and NT4.0) define more
5299 #ifdef EASTEUROPE_CHARSET
5300 case EASTEUROPE_CHARSET
:
5301 charset_type
= Qw32_charset_easteurope
;
5303 case TURKISH_CHARSET
:
5304 charset_type
= Qw32_charset_turkish
;
5306 case BALTIC_CHARSET
:
5307 charset_type
= Qw32_charset_baltic
;
5309 case RUSSIAN_CHARSET
:
5310 charset_type
= Qw32_charset_russian
;
5312 case ARABIC_CHARSET
:
5313 charset_type
= Qw32_charset_arabic
;
5316 charset_type
= Qw32_charset_greek
;
5318 case HEBREW_CHARSET
:
5319 charset_type
= Qw32_charset_hebrew
;
5321 case VIETNAMESE_CHARSET
:
5322 charset_type
= Qw32_charset_vietnamese
;
5325 charset_type
= Qw32_charset_thai
;
5328 charset_type
= Qw32_charset_mac
;
5331 charset_type
= Qw32_charset_johab
;
5335 #ifdef UNICODE_CHARSET
5336 case UNICODE_CHARSET
:
5337 charset_type
= Qw32_charset_unicode
;
5341 /* Encode numerical value of unknown charset. */
5342 sprintf (buf
, "*-#%u", fncharset
);
5343 return Fcons (build_string (buf
), Qnil
);
5348 /* Look through w32-charset-info-alist for the character set.
5349 Only return fully specified charsets for codepages which are
5352 Format of each entry in Vw32_charset_info_alist is
5353 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5355 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5357 Lisp_Object x_charset
;
5358 Lisp_Object w32_charset
;
5359 Lisp_Object codepage
;
5361 Lisp_Object this_entry
= XCAR (rest
);
5363 /* Skip invalid entries in alist. */
5364 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5365 || !CONSP (XCDR (this_entry
))
5366 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5369 x_charset
= XCAR (this_entry
);
5370 w32_charset
= XCAR (XCDR (this_entry
));
5371 codepage
= XCDR (XCDR (this_entry
));
5373 if (!strchr (SDATA (x_charset
), '-'))
5376 /* Look for Same charset and a valid codepage (or non-int
5377 which means ignore). */
5378 if (w32_charset
== charset_type
5379 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
5380 || IsValidCodePage (XINT (codepage
))))
5382 retval
= Fcons (x_charset
, retval
);
5386 /* If no match, encode the numeric value. */
5389 sprintf (buf
, "*-#%u", fncharset
);
5390 return Fcons (build_string (buf
), Qnil
);
5397 /* Get the Windows codepage corresponding to the specified font. The
5398 charset info in the font name is used to look up
5399 w32-charset-to-codepage-alist. */
5401 w32_codepage_for_font (char *fontname
)
5403 Lisp_Object codepage
, entry
;
5404 char *charset_str
, *charset
, *end
;
5406 /* Extract charset part of font string. */
5407 charset
= xlfd_charset_of_font (fontname
);
5412 charset_str
= (char *) alloca (strlen (charset
) + 1);
5413 strcpy (charset_str
, charset
);
5416 /* Remove leading "*-". */
5417 if (strncmp ("*-", charset_str
, 2) == 0)
5418 charset
= charset_str
+ 2;
5421 charset
= charset_str
;
5423 /* Stop match at wildcard (including preceding '-'). */
5424 if (end
= strchr (charset
, '*'))
5426 if (end
> charset
&& *(end
-1) == '-')
5431 if (!strcmp (charset
, "iso10646"))
5434 if (NILP (Vw32_charset_info_alist
))
5437 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
5441 codepage
= Fcdr (Fcdr (entry
));
5443 if (NILP (codepage
))
5445 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
5447 else if (INTEGERP (codepage
))
5448 return XINT (codepage
);
5455 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
5456 LOGFONT
* lplogfont
;
5459 char * specific_charset
;
5463 char height_pixels
[8];
5465 char width_pixels
[8];
5466 char *fontname_dash
;
5467 int display_resy
= (int) one_w32_display_info
.resy
;
5468 int display_resx
= (int) one_w32_display_info
.resx
;
5469 struct coding_system coding
;
5471 if (!lpxstr
) abort ();
5476 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
5477 fonttype
= "raster";
5478 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
5479 fonttype
= "outline";
5481 fonttype
= "unknown";
5483 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system
),
5485 coding
.src_multibyte
= 0;
5486 coding
.dst_multibyte
= 1;
5487 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5488 /* We explicitely disable composition handling because selection
5489 data should not contain any composition sequence. */
5490 coding
.common_flags
&= ~CODING_ANNOTATION_MASK
;
5492 coding
.dst_bytes
= LF_FACESIZE
* 2;
5493 coding
.destination
= (unsigned char *) xmalloc (coding
.dst_bytes
+ 1);
5494 decode_coding_c_string (&coding
, lplogfont
->lfFaceName
,
5495 strlen(lplogfont
->lfFaceName
), Qnil
);
5496 fontname
= coding
.destination
;
5498 *(fontname
+ coding
.produced
) = '\0';
5500 /* Replace dashes with underscores so the dashes are not
5502 fontname_dash
= fontname
;
5503 while (fontname_dash
= strchr (fontname_dash
, '-'))
5504 *fontname_dash
= '_';
5506 if (lplogfont
->lfHeight
)
5508 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
5509 sprintf (height_dpi
, "%u",
5510 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
5514 strcpy (height_pixels
, "*");
5515 strcpy (height_dpi
, "*");
5517 if (lplogfont
->lfWidth
)
5518 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
5520 strcpy (width_pixels
, "*");
5522 _snprintf (lpxstr
, len
- 1,
5523 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5524 fonttype
, /* foundry */
5525 fontname
, /* family */
5526 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
5527 lplogfont
->lfItalic
?'i':'r', /* slant */
5529 /* add style name */
5530 height_pixels
, /* pixel size */
5531 height_dpi
, /* point size */
5532 display_resx
, /* resx */
5533 display_resy
, /* resy */
5534 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
5535 ? 'p' : 'c', /* spacing */
5536 width_pixels
, /* avg width */
5537 w32_to_x_charset (lplogfont
->lfCharSet
, specific_charset
)
5538 /* charset registry and encoding */
5541 lpxstr
[len
- 1] = 0; /* just to be sure */
5546 x_to_w32_font (lpxstr
, lplogfont
)
5548 LOGFONT
* lplogfont
;
5550 struct coding_system coding
;
5552 if (!lplogfont
) return (FALSE
);
5554 memset (lplogfont
, 0, sizeof (*lplogfont
));
5556 /* Set default value for each field. */
5558 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
5559 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
5560 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
5562 /* go for maximum quality */
5563 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
5564 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
5565 lplogfont
->lfQuality
= PROOF_QUALITY
;
5568 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
5569 lplogfont
->lfWeight
= FW_DONTCARE
;
5570 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
5575 /* Provide a simple escape mechanism for specifying Windows font names
5576 * directly -- if font spec does not beginning with '-', assume this
5578 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5584 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
5585 width
[10], resy
[10], remainder
[50];
5587 int dpi
= (int) one_w32_display_info
.resy
;
5589 fields
= sscanf (lpxstr
,
5590 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
5591 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
5595 /* In the general case when wildcards cover more than one field,
5596 we don't know which field is which, so don't fill any in.
5597 However, we need to cope with this particular form, which is
5598 generated by font_list_1 (invoked by try_font_list):
5599 "-raster-6x10-*-gb2312*-*"
5600 and make sure to correctly parse the charset field. */
5603 fields
= sscanf (lpxstr
,
5604 "-%*[^-]-%49[^-]-*-%49s",
5607 else if (fields
< 9)
5613 if (fields
> 0 && name
[0] != '*')
5616 (Fcheck_coding_system (Vlocale_coding_system
), &coding
);
5617 coding
.src_multibyte
= 1;
5618 coding
.dst_multibyte
= 1;
5619 coding
.dst_bytes
= strlen (name
) * 2;
5620 coding
.destination
= (unsigned char *) xmalloc (coding
.dst_bytes
);
5621 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5622 encode_coding_object (&coding
, build_string (name
), 0, 0,
5623 strlen (name
), coding
.dst_bytes
, Qnil
);
5624 if (coding
.produced
>= LF_FACESIZE
)
5625 coding
.produced
= LF_FACESIZE
- 1;
5627 coding
.destination
[coding
.produced
] = '\0';
5629 strcpy (lplogfont
->lfFaceName
, coding
.destination
);
5630 xfree (coding
.destination
);
5634 lplogfont
->lfFaceName
[0] = '\0';
5639 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5643 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
5647 if (fields
> 0 && pixels
[0] != '*')
5648 lplogfont
->lfHeight
= atoi (pixels
);
5652 if (fields
> 0 && resy
[0] != '*')
5655 if (tem
> 0) dpi
= tem
;
5658 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
5659 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
5662 lplogfont
->lfPitchAndFamily
=
5663 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
5667 if (fields
> 0 && width
[0] != '*')
5668 lplogfont
->lfWidth
= atoi (width
) / 10;
5672 /* Strip the trailing '-' if present. (it shouldn't be, as it
5673 fails the test against xlfd-tight-regexp in fontset.el). */
5675 int len
= strlen (remainder
);
5676 if (len
> 0 && remainder
[len
-1] == '-')
5677 remainder
[len
-1] = 0;
5679 encoding
= remainder
;
5681 if (strncmp (encoding
, "*-", 2) == 0)
5684 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
5689 char name
[100], height
[10], width
[10], weight
[20];
5691 fields
= sscanf (lpxstr
,
5692 "%99[^:]:%9[^:]:%9[^:]:%19s",
5693 name
, height
, width
, weight
);
5695 if (fields
== EOF
) return (FALSE
);
5699 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
5700 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
5704 lplogfont
->lfFaceName
[0] = 0;
5710 lplogfont
->lfHeight
= atoi (height
);
5715 lplogfont
->lfWidth
= atoi (width
);
5719 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5722 /* This makes TrueType fonts work better. */
5723 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
5728 /* Strip the pixel height and point height from the given xlfd, and
5729 return the pixel height. If no pixel height is specified, calculate
5730 one from the point height, or if that isn't defined either, return
5731 0 (which usually signifies a scalable font).
5734 xlfd_strip_height (char *fontname
)
5736 int pixel_height
, field_number
;
5737 char *read_from
, *write_to
;
5741 pixel_height
= field_number
= 0;
5744 /* Look for height fields. */
5745 for (read_from
= fontname
; *read_from
; read_from
++)
5747 if (*read_from
== '-')
5750 if (field_number
== 7) /* Pixel height. */
5753 write_to
= read_from
;
5755 /* Find end of field. */
5756 for (;*read_from
&& *read_from
!= '-'; read_from
++)
5759 /* Split the fontname at end of field. */
5765 pixel_height
= atoi (write_to
);
5766 /* Blank out field. */
5767 if (read_from
> write_to
)
5772 /* If the pixel height field is at the end (partial xlfd),
5775 return pixel_height
;
5777 /* If we got a pixel height, the point height can be
5778 ignored. Just blank it out and break now. */
5781 /* Find end of point size field. */
5782 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5788 /* Blank out the point size field. */
5789 if (read_from
> write_to
)
5795 return pixel_height
;
5799 /* If the point height is already blank, break now. */
5800 if (*read_from
== '-')
5806 else if (field_number
== 8)
5808 /* If we didn't get a pixel height, try to get the point
5809 height and convert that. */
5811 char *point_size_start
= read_from
++;
5813 /* Find end of field. */
5814 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5823 point_size
= atoi (point_size_start
);
5825 /* Convert to pixel height. */
5826 pixel_height
= point_size
5827 * one_w32_display_info
.height_in
/ 720;
5829 /* Blank out this field and break. */
5837 /* Shift the rest of the font spec into place. */
5838 if (write_to
&& read_from
> write_to
)
5840 for (; *read_from
; read_from
++, write_to
++)
5841 *write_to
= *read_from
;
5845 return pixel_height
;
5848 /* Assume parameter 1 is fully qualified, no wildcards. */
5850 w32_font_match (fontname
, pattern
)
5854 char *regex
= alloca (strlen (pattern
) * 2 + 3);
5855 char *font_name_copy
= alloca (strlen (fontname
) + 1);
5858 /* Copy fontname so we can modify it during comparison. */
5859 strcpy (font_name_copy
, fontname
);
5864 /* Turn pattern into a regexp and do a regexp match. */
5865 for (; *pattern
; pattern
++)
5867 if (*pattern
== '?')
5869 else if (*pattern
== '*')
5880 /* Strip out font heights and compare them seperately, since
5881 rounding error can cause mismatches. This also allows a
5882 comparison between a font that declares only a pixel height and a
5883 pattern that declares the point height.
5886 int font_height
, pattern_height
;
5888 font_height
= xlfd_strip_height (font_name_copy
);
5889 pattern_height
= xlfd_strip_height (regex
);
5891 /* Compare now, and don't bother doing expensive regexp matching
5892 if the heights differ. */
5893 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
5897 return (fast_c_string_match_ignore_case (build_string (regex
),
5898 font_name_copy
) >= 0);
5901 /* Callback functions, and a structure holding info they need, for
5902 listing system fonts on W32. We need one set of functions to do the
5903 job properly, but these don't work on NT 3.51 and earlier, so we
5904 have a second set which don't handle character sets properly to
5907 In both cases, there are two passes made. The first pass gets one
5908 font from each family, the second pass lists all the fonts from
5911 typedef struct enumfont_t
5916 XFontStruct
*size_ref
;
5917 Lisp_Object pattern
;
5923 enum_font_maybe_add_to_list (enumfont_t
*, LOGFONT
*, char *, Lisp_Object
);
5927 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
5929 NEWTEXTMETRIC
* lptm
;
5933 /* Ignore struck out and underlined versions of fonts. */
5934 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
5937 /* Only return fonts with names starting with @ if they were
5938 explicitly specified, since Microsoft uses an initial @ to
5939 denote fonts for vertical writing, without providing a more
5940 convenient way of identifying them. */
5941 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
5942 && lpef
->logfont
.lfFaceName
[0] != '@')
5945 /* Check that the character set matches if it was specified */
5946 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
5947 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
5950 if (FontType
== RASTER_FONTTYPE
)
5952 /* DBCS raster fonts have problems displaying, so skip them. */
5953 int charset
= lplf
->elfLogFont
.lfCharSet
;
5954 if (charset
== SHIFTJIS_CHARSET
5955 || charset
== HANGEUL_CHARSET
5956 || charset
== CHINESEBIG5_CHARSET
5957 || charset
== GB2312_CHARSET
5958 #ifdef JOHAB_CHARSET
5959 || charset
== JOHAB_CHARSET
5967 Lisp_Object width
= Qnil
;
5968 Lisp_Object charset_list
= Qnil
;
5969 char *charset
= NULL
;
5971 /* Truetype fonts do not report their true metrics until loaded */
5972 if (FontType
!= RASTER_FONTTYPE
)
5974 if (!NILP (lpef
->pattern
))
5976 /* Scalable fonts are as big as you want them to be. */
5977 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
5978 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
5979 width
= make_number (lpef
->logfont
.lfWidth
);
5983 lplf
->elfLogFont
.lfHeight
= 0;
5984 lplf
->elfLogFont
.lfWidth
= 0;
5988 /* Make sure the height used here is the same as everywhere
5989 else (ie character height, not cell height). */
5990 if (lplf
->elfLogFont
.lfHeight
> 0)
5992 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
5993 if (FontType
== RASTER_FONTTYPE
)
5994 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
5996 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
5999 if (!NILP (lpef
->pattern
))
6001 charset
= xlfd_charset_of_font (SDATA (lpef
->pattern
));
6003 /* We already checked charsets above, but DEFAULT_CHARSET
6004 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
6006 && strncmp (charset
, "*-*", 3) != 0
6007 && lpef
->logfont
.lfCharSet
== DEFAULT_CHARSET
6008 && strcmp (charset
, w32_to_x_charset (DEFAULT_CHARSET
, NULL
)) != 0)
6013 charset_list
= Fcons (build_string (charset
), Qnil
);
6015 /* Always prefer unicode. */
6017 = Fcons (build_string ("iso10646-1"),
6018 w32_to_all_x_charsets (lplf
->elfLogFont
.lfCharSet
));
6020 /* Loop through the charsets. */
6021 for ( ; CONSP (charset_list
); charset_list
= Fcdr (charset_list
))
6023 Lisp_Object this_charset
= Fcar (charset_list
);
6024 charset
= SDATA (this_charset
);
6026 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6029 /* List bold and italic variations if w32-enable-synthesized-fonts
6030 is non-nil and this is a plain font. */
6031 if (w32_enable_synthesized_fonts
6032 && lplf
->elfLogFont
.lfWeight
== FW_NORMAL
6033 && lplf
->elfLogFont
.lfItalic
== FALSE
)
6036 lplf
->elfLogFont
.lfWeight
= FW_BOLD
;
6037 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6040 lplf
->elfLogFont
.lfItalic
= TRUE
;
6041 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6044 lplf
->elfLogFont
.lfWeight
= FW_NORMAL
;
6045 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6055 enum_font_maybe_add_to_list (lpef
, logfont
, match_charset
, width
)
6058 char * match_charset
;
6063 if (!w32_to_x_font (logfont
, buf
, 100, match_charset
))
6066 if (NILP (lpef
->pattern
)
6067 || w32_font_match (buf
, SDATA (lpef
->pattern
)))
6069 /* Check if we already listed this font. This may happen if
6070 w32_enable_synthesized_fonts is non-nil, and there are real
6071 bold and italic versions of the font. */
6072 Lisp_Object font_name
= build_string (buf
);
6073 if (NILP (Fmember (font_name
, lpef
->list
)))
6075 Lisp_Object entry
= Fcons (font_name
, width
);
6076 lpef
->list
= Fcons (entry
, lpef
->list
);
6084 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
6086 NEWTEXTMETRIC
* lptm
;
6090 return EnumFontFamilies (lpef
->hdc
,
6091 lplf
->elfLogFont
.lfFaceName
,
6092 (FONTENUMPROC
) enum_font_cb2
,
6098 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
6099 ENUMLOGFONTEX
* lplf
;
6100 NEWTEXTMETRICEX
* lptm
;
6104 /* We are not interested in the extra info we get back from the 'Ex
6105 version - only the fact that we get character set variations
6106 enumerated seperately. */
6107 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
6112 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
6113 ENUMLOGFONTEX
* lplf
;
6114 NEWTEXTMETRICEX
* lptm
;
6118 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6119 FARPROC enum_font_families_ex
6120 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6121 /* We don't really expect EnumFontFamiliesEx to disappear once we
6122 get here, so don't bother handling it gracefully. */
6123 if (enum_font_families_ex
== NULL
)
6124 error ("gdi32.dll has disappeared!");
6125 return enum_font_families_ex (lpef
->hdc
,
6127 (FONTENUMPROC
) enum_fontex_cb2
,
6131 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6132 and xterm.c in Emacs 20.3) */
6134 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
6136 char *fontname
, *ptnstr
;
6137 Lisp_Object list
, tem
, newlist
= Qnil
;
6140 list
= Vw32_bdf_filename_alist
;
6141 ptnstr
= SDATA (pattern
);
6143 for ( ; CONSP (list
); list
= XCDR (list
))
6147 fontname
= SDATA (XCAR (tem
));
6148 else if (STRINGP (tem
))
6149 fontname
= SDATA (tem
);
6153 if (w32_font_match (fontname
, ptnstr
))
6155 newlist
= Fcons (XCAR (tem
), newlist
);
6157 if (max_names
>= 0 && n_fonts
>= max_names
)
6166 /* Return a list of names of available fonts matching PATTERN on frame
6167 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6168 to be listed. Frame F NULL means we have not yet created any
6169 frame, which means we can't get proper size info, as we don't have
6170 a device context to use for GetTextMetrics.
6171 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
6172 negative, then all matching fonts are returned. */
6175 w32_list_fonts (f
, pattern
, size
, maxnames
)
6177 Lisp_Object pattern
;
6181 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
6182 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
6183 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
6186 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
6187 if (NILP (patterns
))
6188 patterns
= Fcons (pattern
, Qnil
);
6190 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
6195 tpat
= XCAR (patterns
);
6197 if (!STRINGP (tpat
))
6200 /* Avoid expensive EnumFontFamilies functions if we are not
6201 going to be able to output one of these anyway. */
6202 codepage
= w32_codepage_for_font (SDATA (tpat
));
6203 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
6204 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
6205 && !IsValidCodePage(codepage
))
6208 /* See if we cached the result for this particular query.
6209 The cache is an alist of the form:
6210 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6212 if (tem
= XCDR (dpyinfo
->name_list_element
),
6213 !NILP (list
= Fassoc (tpat
, tem
)))
6215 list
= Fcdr_safe (list
);
6216 /* We have a cached list. Don't have to get the list again. */
6221 /* At first, put PATTERN in the cache. */
6226 /* Use EnumFontFamiliesEx where it is available, as it knows
6227 about character sets. Fall back to EnumFontFamilies for
6228 older versions of NT that don't support the 'Ex function. */
6229 x_to_w32_font (SDATA (tpat
), &ef
.logfont
);
6231 LOGFONT font_match_pattern
;
6232 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6233 FARPROC enum_font_families_ex
6234 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6236 /* We do our own pattern matching so we can handle wildcards. */
6237 font_match_pattern
.lfFaceName
[0] = 0;
6238 font_match_pattern
.lfPitchAndFamily
= 0;
6239 /* We can use the charset, because if it is a wildcard it will
6240 be DEFAULT_CHARSET anyway. */
6241 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
6243 ef
.hdc
= GetDC (dpyinfo
->root_window
);
6245 if (enum_font_families_ex
)
6246 enum_font_families_ex (ef
.hdc
,
6247 &font_match_pattern
,
6248 (FONTENUMPROC
) enum_fontex_cb1
,
6251 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
6254 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
6260 /* Make a list of the fonts we got back.
6261 Store that in the font cache for the display. */
6262 XSETCDR (dpyinfo
->name_list_element
,
6263 Fcons (Fcons (tpat
, list
),
6264 XCDR (dpyinfo
->name_list_element
)));
6267 if (NILP (list
)) continue; /* Try the remaining alternatives. */
6269 newlist
= second_best
= Qnil
;
6271 /* Make a list of the fonts that have the right width. */
6272 for (; CONSP (list
); list
= XCDR (list
))
6279 if (NILP (XCAR (tem
)))
6283 newlist
= Fcons (XCAR (tem
), newlist
);
6285 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6290 if (!INTEGERP (XCDR (tem
)))
6292 /* Since we don't yet know the size of the font, we must
6293 load it and try GetTextMetrics. */
6294 W32FontStruct thisinfo
;
6299 if (!x_to_w32_font (SDATA (XCAR (tem
)), &lf
))
6303 thisinfo
.bdf
= NULL
;
6304 thisinfo
.hfont
= CreateFontIndirect (&lf
);
6305 if (thisinfo
.hfont
== NULL
)
6308 hdc
= GetDC (dpyinfo
->root_window
);
6309 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
6310 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
6311 XSETCDR (tem
, make_number (FONT_WIDTH (&thisinfo
)));
6313 XSETCDR (tem
, make_number (0));
6314 SelectObject (hdc
, oldobj
);
6315 ReleaseDC (dpyinfo
->root_window
, hdc
);
6316 DeleteObject(thisinfo
.hfont
);
6319 found_size
= XINT (XCDR (tem
));
6320 if (found_size
== size
)
6322 newlist
= Fcons (XCAR (tem
), newlist
);
6324 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6327 /* keep track of the closest matching size in case
6328 no exact match is found. */
6329 else if (found_size
> 0)
6331 if (NILP (second_best
))
6334 else if (found_size
< size
)
6336 if (XINT (XCDR (second_best
)) > size
6337 || XINT (XCDR (second_best
)) < found_size
)
6342 if (XINT (XCDR (second_best
)) > size
6343 && XINT (XCDR (second_best
)) >
6350 if (!NILP (newlist
))
6352 else if (!NILP (second_best
))
6354 newlist
= Fcons (XCAR (second_best
), Qnil
);
6359 /* Include any bdf fonts. */
6360 if (n_fonts
< maxnames
|| maxnames
< 0)
6362 Lisp_Object combined
[2];
6363 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
6364 combined
[1] = newlist
;
6365 newlist
= Fnconc(2, combined
);
6372 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6374 w32_get_font_info (f
, font_idx
)
6378 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
6383 w32_query_font (struct frame
*f
, char *fontname
)
6386 struct font_info
*pfi
;
6388 pfi
= FRAME_W32_FONT_TABLE (f
);
6390 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
6392 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
6398 /* Find a CCL program for a font specified by FONTP, and set the member
6399 `encoder' of the structure. */
6402 w32_find_ccl_program (fontp
)
6403 struct font_info
*fontp
;
6405 Lisp_Object list
, elt
;
6407 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
6411 && STRINGP (XCAR (elt
))
6412 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
6418 struct ccl_program
*ccl
6419 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
6421 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
6424 fontp
->font_encoder
= ccl
;
6429 /* Find BDF files in a specified directory. (use GCPRO when calling,
6430 as this calls lisp to get a directory listing). */
6432 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
6434 Lisp_Object filelist
, list
= Qnil
;
6437 if (!STRINGP(directory
))
6440 filelist
= Fdirectory_files (directory
, Qt
,
6441 build_string (".*\\.[bB][dD][fF]"), Qt
);
6443 for ( ; CONSP(filelist
); filelist
= XCDR (filelist
))
6445 Lisp_Object filename
= XCAR (filelist
);
6446 if (w32_BDF_to_x_font (SDATA (filename
), fontname
, 100))
6447 store_in_alist (&list
, build_string (fontname
), filename
);
6452 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
6454 doc
: /* Return a list of BDF fonts in DIR.
6455 The list is suitable for appending to w32-bdf-filename-alist. Fonts
6456 which do not contain an xlfd description will not be included in the
6457 list. DIR may be a list of directories. */)
6459 Lisp_Object directory
;
6461 Lisp_Object list
= Qnil
;
6462 struct gcpro gcpro1
, gcpro2
;
6464 if (!CONSP (directory
))
6465 return w32_find_bdf_fonts_in_dir (directory
);
6467 for ( ; CONSP (directory
); directory
= XCDR (directory
))
6469 Lisp_Object pair
[2];
6472 GCPRO2 (directory
, list
);
6473 pair
[1] = w32_find_bdf_fonts_in_dir( XCAR (directory
) );
6474 list
= Fnconc( 2, pair
);
6481 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
6482 doc
: /* Internal function called by `color-defined-p', which see. */)
6484 Lisp_Object color
, frame
;
6487 FRAME_PTR f
= check_x_frame (frame
);
6489 CHECK_STRING (color
);
6491 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6497 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
6498 doc
: /* Internal function called by `color-values', which see. */)
6500 Lisp_Object color
, frame
;
6503 FRAME_PTR f
= check_x_frame (frame
);
6505 CHECK_STRING (color
);
6507 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6511 rgb
[0] = make_number ((GetRValue (foo
.pixel
) << 8)
6512 | GetRValue (foo
.pixel
));
6513 rgb
[1] = make_number ((GetGValue (foo
.pixel
) << 8)
6514 | GetGValue (foo
.pixel
));
6515 rgb
[2] = make_number ((GetBValue (foo
.pixel
) << 8)
6516 | GetBValue (foo
.pixel
));
6517 return Flist (3, rgb
);
6523 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
6524 doc
: /* Internal function called by `display-color-p', which see. */)
6526 Lisp_Object display
;
6528 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6530 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
6536 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
6537 Sx_display_grayscale_p
, 0, 1, 0,
6538 doc
: /* Return t if the X display supports shades of gray.
6539 Note that color displays do support shades of gray.
6540 The optional argument DISPLAY specifies which display to ask about.
6541 DISPLAY should be either a frame or a display name (a string).
6542 If omitted or nil, that stands for the selected frame's display. */)
6544 Lisp_Object display
;
6546 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6548 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
6554 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
6555 Sx_display_pixel_width
, 0, 1, 0,
6556 doc
: /* Returns the width in pixels of DISPLAY.
6557 The optional argument DISPLAY specifies which display to ask about.
6558 DISPLAY should be either a frame or a display name (a string).
6559 If omitted or nil, that stands for the selected frame's display. */)
6561 Lisp_Object display
;
6563 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6565 return make_number (dpyinfo
->width
);
6568 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
6569 Sx_display_pixel_height
, 0, 1, 0,
6570 doc
: /* Returns the height in pixels 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 (dpyinfo
->height
);
6582 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
6584 doc
: /* Returns the number of bitplanes of DISPLAY.
6585 The optional argument DISPLAY specifies which display to ask about.
6586 DISPLAY should be either a frame or a display name (a string).
6587 If omitted or nil, that stands for the selected frame's display. */)
6589 Lisp_Object display
;
6591 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6593 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
6596 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
6598 doc
: /* Returns the number of color cells of DISPLAY.
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 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6609 hdc
= GetDC (dpyinfo
->root_window
);
6610 if (dpyinfo
->has_palette
)
6611 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
6613 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
6615 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
6616 and because probably is more meaningful on Windows anyway */
6618 cap
= 1 << min(dpyinfo
->n_planes
* dpyinfo
->n_cbits
, 24);
6620 ReleaseDC (dpyinfo
->root_window
, hdc
);
6622 return make_number (cap
);
6625 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
6626 Sx_server_max_request_size
,
6628 doc
: /* Returns the maximum request size of the server of DISPLAY.
6629 The optional argument DISPLAY specifies which display to ask about.
6630 DISPLAY should be either a frame or a display name (a string).
6631 If omitted or nil, that stands for the selected frame's display. */)
6633 Lisp_Object display
;
6635 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6637 return make_number (1);
6640 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
6641 doc
: /* Returns the vendor ID string of the W32 system (Microsoft).
6642 The optional argument DISPLAY specifies which display to ask about.
6643 DISPLAY should be either a frame or a display name (a string).
6644 If omitted or nil, that stands for the selected frame's display. */)
6646 Lisp_Object display
;
6648 return build_string ("Microsoft Corp.");
6651 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
6652 doc
: /* Returns the version numbers of the server of DISPLAY.
6653 The value is a list of three integers: the major and minor
6654 version numbers, and the vendor-specific release
6655 number. See also the function `x-server-vendor'.
6657 The optional argument DISPLAY specifies which display to ask about.
6658 DISPLAY should be either a frame or a display name (a string).
6659 If omitted or nil, that stands for the selected frame's display. */)
6661 Lisp_Object display
;
6663 return Fcons (make_number (w32_major_version
),
6664 Fcons (make_number (w32_minor_version
),
6665 Fcons (make_number (w32_build_number
), Qnil
)));
6668 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
6669 doc
: /* Returns the number of screens on the server of DISPLAY.
6670 The optional argument DISPLAY specifies which display to ask about.
6671 DISPLAY should be either a frame or a display name (a string).
6672 If omitted or nil, that stands for the selected frame's display. */)
6674 Lisp_Object display
;
6676 return make_number (1);
6679 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
6680 Sx_display_mm_height
, 0, 1, 0,
6681 doc
: /* Returns the height in millimeters of DISPLAY.
6682 The optional argument DISPLAY specifies which display to ask about.
6683 DISPLAY should be either a frame or a display name (a string).
6684 If omitted or nil, that stands for the selected frame's display. */)
6686 Lisp_Object display
;
6688 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6692 hdc
= GetDC (dpyinfo
->root_window
);
6694 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
6696 ReleaseDC (dpyinfo
->root_window
, hdc
);
6698 return make_number (cap
);
6701 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
6702 doc
: /* Returns the width in millimeters of DISPLAY.
6703 The optional argument DISPLAY specifies which display to ask about.
6704 DISPLAY should be either a frame or a display name (a string).
6705 If omitted or nil, that stands for the selected frame's display. */)
6707 Lisp_Object display
;
6709 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6714 hdc
= GetDC (dpyinfo
->root_window
);
6716 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
6718 ReleaseDC (dpyinfo
->root_window
, hdc
);
6720 return make_number (cap
);
6723 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
6724 Sx_display_backing_store
, 0, 1, 0,
6725 doc
: /* Returns an indication of whether DISPLAY does backing store.
6726 The value may be `always', `when-mapped', or `not-useful'.
6727 The optional argument DISPLAY specifies which display to ask about.
6728 DISPLAY should be either a frame or a display name (a string).
6729 If omitted or nil, that stands for the selected frame's display. */)
6731 Lisp_Object display
;
6733 return intern ("not-useful");
6736 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
6737 Sx_display_visual_class
, 0, 1, 0,
6738 doc
: /* Returns the visual class of DISPLAY.
6739 The value is one of the symbols `static-gray', `gray-scale',
6740 `static-color', `pseudo-color', `true-color', or `direct-color'.
6742 The optional argument DISPLAY specifies which display to ask about.
6743 DISPLAY should be either a frame or a display name (a string).
6744 If omitted or nil, that stands for the selected frame's display. */)
6746 Lisp_Object display
;
6748 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6749 Lisp_Object result
= Qnil
;
6751 if (dpyinfo
->has_palette
)
6752 result
= intern ("pseudo-color");
6753 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
6754 result
= intern ("static-grey");
6755 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
6756 result
= intern ("static-color");
6757 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
6758 result
= intern ("true-color");
6763 DEFUN ("x-display-save-under", Fx_display_save_under
,
6764 Sx_display_save_under
, 0, 1, 0,
6765 doc
: /* Returns t if DISPLAY supports the save-under feature.
6766 The optional argument DISPLAY specifies which display to ask about.
6767 DISPLAY should be either a frame or a display name (a string).
6768 If omitted or nil, that stands for the selected frame's display. */)
6770 Lisp_Object display
;
6777 register struct frame
*f
;
6779 return FRAME_PIXEL_WIDTH (f
);
6784 register struct frame
*f
;
6786 return FRAME_PIXEL_HEIGHT (f
);
6791 register struct frame
*f
;
6793 return FRAME_COLUMN_WIDTH (f
);
6798 register struct frame
*f
;
6800 return FRAME_LINE_HEIGHT (f
);
6805 register struct frame
*f
;
6807 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
6810 /* Return the display structure for the display named NAME.
6811 Open a new connection if necessary. */
6813 struct w32_display_info
*
6814 x_display_info_for_name (name
)
6818 struct w32_display_info
*dpyinfo
;
6820 CHECK_STRING (name
);
6822 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
6824 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
6827 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
6832 /* Use this general default value to start with. */
6833 Vx_resource_name
= Vinvocation_name
;
6835 validate_x_resource_name ();
6837 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
6838 (char *) SDATA (Vx_resource_name
));
6841 error ("Cannot connect to server %s", SDATA (name
));
6844 XSETFASTINT (Vwindow_system_version
, 3);
6849 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
6850 1, 3, 0, doc
: /* Open a connection to a server.
6851 DISPLAY is the name of the display to connect to.
6852 Optional second arg XRM-STRING is a string of resources in xrdb format.
6853 If the optional third arg MUST-SUCCEED is non-nil,
6854 terminate Emacs if we can't open the connection. */)
6855 (display
, xrm_string
, must_succeed
)
6856 Lisp_Object display
, xrm_string
, must_succeed
;
6858 unsigned char *xrm_option
;
6859 struct w32_display_info
*dpyinfo
;
6861 /* If initialization has already been done, return now to avoid
6862 overwriting critical parts of one_w32_display_info. */
6866 CHECK_STRING (display
);
6867 if (! NILP (xrm_string
))
6868 CHECK_STRING (xrm_string
);
6870 if (! EQ (Vwindow_system
, intern ("w32")))
6871 error ("Not using Microsoft Windows");
6873 /* Allow color mapping to be defined externally; first look in user's
6874 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6876 Lisp_Object color_file
;
6877 struct gcpro gcpro1
;
6879 color_file
= build_string("~/rgb.txt");
6881 GCPRO1 (color_file
);
6883 if (NILP (Ffile_readable_p (color_file
)))
6885 Fexpand_file_name (build_string ("rgb.txt"),
6886 Fsymbol_value (intern ("data-directory")));
6888 Vw32_color_map
= Fw32_load_color_file (color_file
);
6892 if (NILP (Vw32_color_map
))
6893 Vw32_color_map
= Fw32_default_color_map ();
6895 /* Merge in system logical colors. */
6896 add_system_logical_colors_to_map (&Vw32_color_map
);
6898 if (! NILP (xrm_string
))
6899 xrm_option
= (unsigned char *) SDATA (xrm_string
);
6901 xrm_option
= (unsigned char *) 0;
6903 /* Use this general default value to start with. */
6904 /* First remove .exe suffix from invocation-name - it looks ugly. */
6906 char basename
[ MAX_PATH
], *str
;
6908 strcpy (basename
, SDATA (Vinvocation_name
));
6909 str
= strrchr (basename
, '.');
6911 Vinvocation_name
= build_string (basename
);
6913 Vx_resource_name
= Vinvocation_name
;
6915 validate_x_resource_name ();
6917 /* This is what opens the connection and sets x_current_display.
6918 This also initializes many symbols, such as those used for input. */
6919 dpyinfo
= w32_term_init (display
, xrm_option
,
6920 (char *) SDATA (Vx_resource_name
));
6924 if (!NILP (must_succeed
))
6925 fatal ("Cannot connect to server %s.\n",
6928 error ("Cannot connect to server %s", SDATA (display
));
6933 XSETFASTINT (Vwindow_system_version
, 3);
6937 DEFUN ("x-close-connection", Fx_close_connection
,
6938 Sx_close_connection
, 1, 1, 0,
6939 doc
: /* Close the connection to DISPLAY's server.
6940 For DISPLAY, specify either a frame or a display name (a string).
6941 If DISPLAY is nil, that stands for the selected frame's display. */)
6943 Lisp_Object display
;
6945 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6948 if (dpyinfo
->reference_count
> 0)
6949 error ("Display still has frames on it");
6952 /* Free the fonts in the font table. */
6953 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
6954 if (dpyinfo
->font_table
[i
].name
)
6956 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
6957 xfree (dpyinfo
->font_table
[i
].full_name
);
6958 xfree (dpyinfo
->font_table
[i
].name
);
6959 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
6961 x_destroy_all_bitmaps (dpyinfo
);
6963 x_delete_display (dpyinfo
);
6969 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
6970 doc
: /* Return the list of display names that Emacs has connections to. */)
6973 Lisp_Object tail
, result
;
6976 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
6977 result
= Fcons (XCAR (XCAR (tail
)), result
);
6982 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
6983 doc
: /* This is a noop on W32 systems. */)
6985 Lisp_Object display
, on
;
6991 /***********************************************************************
6993 ***********************************************************************/
6995 /* Value is the number of elements of vector VECTOR. */
6997 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
6999 /* List of supported image types. Use define_image_type to add new
7000 types. Use lookup_image_type to find a type for a given symbol. */
7002 static struct image_type
*image_types
;
7004 /* The symbol `image' which is the car of the lists used to represent
7007 extern Lisp_Object Qimage
;
7009 /* The symbol `xbm' which is used as the type symbol for XBM images. */
7015 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
7016 extern Lisp_Object QCdata
, QCtype
;
7017 Lisp_Object QCascent
, QCmargin
, QCrelief
;
7018 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
7019 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
7021 /* Other symbols. */
7023 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
7025 /* Time in seconds after which images should be removed from the cache
7026 if not displayed. */
7028 Lisp_Object Vimage_cache_eviction_delay
;
7030 /* Function prototypes. */
7032 static void define_image_type
P_ ((struct image_type
*type
));
7033 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
7034 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
7035 static void x_laplace
P_ ((struct frame
*, struct image
*));
7036 static void x_emboss
P_ ((struct frame
*, struct image
*));
7037 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
7041 /* Define a new image type from TYPE. This adds a copy of TYPE to
7042 image_types and adds the symbol *TYPE->type to Vimage_types. */
7045 define_image_type (type
)
7046 struct image_type
*type
;
7048 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7049 The initialized data segment is read-only. */
7050 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
7051 bcopy (type
, p
, sizeof *p
);
7052 p
->next
= image_types
;
7054 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
7058 /* Look up image type SYMBOL, and return a pointer to its image_type
7059 structure. Value is null if SYMBOL is not a known image type. */
7061 static INLINE
struct image_type
*
7062 lookup_image_type (symbol
)
7065 struct image_type
*type
;
7067 for (type
= image_types
; type
; type
= type
->next
)
7068 if (EQ (symbol
, *type
->type
))
7075 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
7076 valid image specification is a list whose car is the symbol
7077 `image', and whose rest is a property list. The property list must
7078 contain a value for key `:type'. That value must be the name of a
7079 supported image type. The rest of the property list depends on the
7083 valid_image_p (object
)
7088 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
7092 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
7093 if (EQ (XCAR (tem
), QCtype
))
7096 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
7098 struct image_type
*type
;
7099 type
= lookup_image_type (XCAR (tem
));
7101 valid_p
= type
->valid_p (object
);
7112 /* Log error message with format string FORMAT and argument ARG.
7113 Signaling an error, e.g. when an image cannot be loaded, is not a
7114 good idea because this would interrupt redisplay, and the error
7115 message display would lead to another redisplay. This function
7116 therefore simply displays a message. */
7119 image_error (format
, arg1
, arg2
)
7121 Lisp_Object arg1
, arg2
;
7123 add_to_log (format
, arg1
, arg2
);
7128 /***********************************************************************
7129 Image specifications
7130 ***********************************************************************/
7132 enum image_value_type
7134 IMAGE_DONT_CHECK_VALUE_TYPE
,
7136 IMAGE_STRING_OR_NIL_VALUE
,
7138 IMAGE_POSITIVE_INTEGER_VALUE
,
7139 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
7140 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
7142 IMAGE_INTEGER_VALUE
,
7143 IMAGE_FUNCTION_VALUE
,
7148 /* Structure used when parsing image specifications. */
7150 struct image_keyword
7152 /* Name of keyword. */
7155 /* The type of value allowed. */
7156 enum image_value_type type
;
7158 /* Non-zero means key must be present. */
7161 /* Used to recognize duplicate keywords in a property list. */
7164 /* The value that was found. */
7169 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
7171 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
7174 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
7175 has the format (image KEYWORD VALUE ...). One of the keyword/
7176 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7177 image_keywords structures of size NKEYWORDS describing other
7178 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7181 parse_image_spec (spec
, keywords
, nkeywords
, type
)
7183 struct image_keyword
*keywords
;
7190 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
7193 plist
= XCDR (spec
);
7194 while (CONSP (plist
))
7196 Lisp_Object key
, value
;
7198 /* First element of a pair must be a symbol. */
7200 plist
= XCDR (plist
);
7204 /* There must follow a value. */
7207 value
= XCAR (plist
);
7208 plist
= XCDR (plist
);
7210 /* Find key in KEYWORDS. Error if not found. */
7211 for (i
= 0; i
< nkeywords
; ++i
)
7212 if (strcmp (keywords
[i
].name
, SDATA (SYMBOL_NAME (key
))) == 0)
7218 /* Record that we recognized the keyword. If a keywords
7219 was found more than once, it's an error. */
7220 keywords
[i
].value
= value
;
7221 ++keywords
[i
].count
;
7223 if (keywords
[i
].count
> 1)
7226 /* Check type of value against allowed type. */
7227 switch (keywords
[i
].type
)
7229 case IMAGE_STRING_VALUE
:
7230 if (!STRINGP (value
))
7234 case IMAGE_STRING_OR_NIL_VALUE
:
7235 if (!STRINGP (value
) && !NILP (value
))
7239 case IMAGE_SYMBOL_VALUE
:
7240 if (!SYMBOLP (value
))
7244 case IMAGE_POSITIVE_INTEGER_VALUE
:
7245 if (!INTEGERP (value
) || XINT (value
) <= 0)
7249 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
7250 if (INTEGERP (value
) && XINT (value
) >= 0)
7253 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
7254 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
7258 case IMAGE_ASCENT_VALUE
:
7259 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
7261 else if (INTEGERP (value
)
7262 && XINT (value
) >= 0
7263 && XINT (value
) <= 100)
7267 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
7268 if (!INTEGERP (value
) || XINT (value
) < 0)
7272 case IMAGE_DONT_CHECK_VALUE_TYPE
:
7275 case IMAGE_FUNCTION_VALUE
:
7276 value
= indirect_function (value
);
7278 || COMPILEDP (value
)
7279 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
7283 case IMAGE_NUMBER_VALUE
:
7284 if (!INTEGERP (value
) && !FLOATP (value
))
7288 case IMAGE_INTEGER_VALUE
:
7289 if (!INTEGERP (value
))
7293 case IMAGE_BOOL_VALUE
:
7294 if (!NILP (value
) && !EQ (value
, Qt
))
7303 if (EQ (key
, QCtype
) && !EQ (type
, value
))
7307 /* Check that all mandatory fields are present. */
7308 for (i
= 0; i
< nkeywords
; ++i
)
7309 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
7312 return NILP (plist
);
7316 /* Return the value of KEY in image specification SPEC. Value is nil
7317 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
7318 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
7321 image_spec_value (spec
, key
, found
)
7322 Lisp_Object spec
, key
;
7327 xassert (valid_image_p (spec
));
7329 for (tail
= XCDR (spec
);
7330 CONSP (tail
) && CONSP (XCDR (tail
));
7331 tail
= XCDR (XCDR (tail
)))
7333 if (EQ (XCAR (tail
), key
))
7337 return XCAR (XCDR (tail
));
7347 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
7348 doc
: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
7349 PIXELS non-nil means return the size in pixels, otherwise return the
7350 size in canonical character units.
7351 FRAME is the frame on which the image will be displayed. FRAME nil
7352 or omitted means use the selected frame. */)
7353 (spec
, pixels
, frame
)
7354 Lisp_Object spec
, pixels
, frame
;
7359 if (valid_image_p (spec
))
7361 struct frame
*f
= check_x_frame (frame
);
7362 int id
= lookup_image (f
, spec
);
7363 struct image
*img
= IMAGE_FROM_ID (f
, id
);
7364 int width
= img
->width
+ 2 * img
->hmargin
;
7365 int height
= img
->height
+ 2 * img
->vmargin
;
7368 size
= Fcons (make_float ((double) width
/ FRAME_COLUMN_WIDTH (f
)),
7369 make_float ((double) height
/ FRAME_LINE_HEIGHT (f
)));
7371 size
= Fcons (make_number (width
), make_number (height
));
7374 error ("Invalid image specification");
7380 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
7381 doc
: /* Return t if image SPEC has a mask bitmap.
7382 FRAME is the frame on which the image will be displayed. FRAME nil
7383 or omitted means use the selected frame. */)
7385 Lisp_Object spec
, frame
;
7390 if (valid_image_p (spec
))
7392 struct frame
*f
= check_x_frame (frame
);
7393 int id
= lookup_image (f
, spec
);
7394 struct image
*img
= IMAGE_FROM_ID (f
, id
);
7399 error ("Invalid image specification");
7405 /***********************************************************************
7406 Image type independent image structures
7407 ***********************************************************************/
7409 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
7410 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
7411 static void x_destroy_x_image
P_ ((XImage
*));
7414 /* Allocate and return a new image structure for image specification
7415 SPEC. SPEC has a hash value of HASH. */
7417 static struct image
*
7418 make_image (spec
, hash
)
7422 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
7424 xassert (valid_image_p (spec
));
7425 bzero (img
, sizeof *img
);
7426 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
7427 xassert (img
->type
!= NULL
);
7429 img
->data
.lisp_val
= Qnil
;
7430 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
7436 /* Free image IMG which was used on frame F, including its resources. */
7445 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
7447 /* Remove IMG from the hash table of its cache. */
7449 img
->prev
->next
= img
->next
;
7451 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
7454 img
->next
->prev
= img
->prev
;
7456 c
->images
[img
->id
] = NULL
;
7458 /* Free resources, then free IMG. */
7459 img
->type
->free (f
, img
);
7465 /* Prepare image IMG for display on frame F. Must be called before
7466 drawing an image. */
7469 prepare_image_for_display (f
, img
)
7475 /* We're about to display IMG, so set its timestamp to `now'. */
7477 img
->timestamp
= EMACS_SECS (t
);
7479 /* If IMG doesn't have a pixmap yet, load it now, using the image
7480 type dependent loader function. */
7481 if (img
->pixmap
== 0 && !img
->load_failed_p
)
7482 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
7486 /* Value is the number of pixels for the ascent of image IMG when
7487 drawn in face FACE. */
7490 image_ascent (img
, face
)
7494 int height
= img
->height
+ img
->vmargin
;
7497 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
7500 ascent
= height
/ 2 - (FONT_DESCENT(face
->font
)
7501 - FONT_BASE(face
->font
)) / 2;
7503 ascent
= height
/ 2;
7506 ascent
= (int) (height
* img
->ascent
/ 100.0);
7513 /* Image background colors. */
7515 /* Find the "best" corner color of a bitmap. XIMG is assumed to a device
7516 context with the bitmap selected. */
7518 four_corners_best (img_dc
, width
, height
)
7520 unsigned long width
, height
;
7522 COLORREF corners
[4], best
;
7525 /* Get the colors at the corners of img_dc. */
7526 corners
[0] = GetPixel (img_dc
, 0, 0);
7527 corners
[1] = GetPixel (img_dc
, width
- 1, 0);
7528 corners
[2] = GetPixel (img_dc
, width
- 1, height
- 1);
7529 corners
[3] = GetPixel (img_dc
, 0, height
- 1);
7531 /* Choose the most frequently found color as background. */
7532 for (i
= best_count
= 0; i
< 4; ++i
)
7536 for (j
= n
= 0; j
< 4; ++j
)
7537 if (corners
[i
] == corners
[j
])
7541 best
= corners
[i
], best_count
= n
;
7547 /* Return the `background' field of IMG. If IMG doesn't have one yet,
7548 it is guessed heuristically. If non-zero, IMG_DC is an existing
7549 device context with the image selected to use for the heuristic. */
7552 image_background (img
, f
, img_dc
)
7557 if (! img
->background_valid
)
7558 /* IMG doesn't have a background yet, try to guess a reasonable value. */
7560 int free_ximg
= !img_dc
;
7565 HDC frame_dc
= get_frame_dc (f
);
7566 img_dc
= CreateCompatibleDC (frame_dc
);
7567 release_frame_dc (f
, frame_dc
);
7569 prev
= SelectObject (img_dc
, img
->pixmap
);
7572 img
->background
= four_corners_best (img_dc
, img
->width
, img
->height
);
7576 SelectObject (img_dc
, prev
);
7580 img
->background_valid
= 1;
7583 return img
->background
;
7586 /* Return the `background_transparent' field of IMG. If IMG doesn't
7587 have one yet, it is guessed heuristically. If non-zero, MASK is an
7588 existing XImage object to use for the heuristic. */
7591 image_background_transparent (img
, f
, mask
)
7596 if (! img
->background_transparent_valid
)
7597 /* IMG doesn't have a background yet, try to guess a reasonable value. */
7601 int free_mask
= !mask
;
7606 HDC frame_dc
= get_frame_dc (f
);
7607 mask
= CreateCompatibleDC (frame_dc
);
7608 release_frame_dc (f
, frame_dc
);
7610 prev
= SelectObject (mask
, img
->mask
);
7613 img
->background_transparent
7614 = !four_corners_best (mask
, img
->width
, img
->height
);
7618 SelectObject (mask
, prev
);
7623 img
->background_transparent
= 0;
7625 img
->background_transparent_valid
= 1;
7628 return img
->background_transparent
;
7632 /***********************************************************************
7633 Helper functions for X image types
7634 ***********************************************************************/
7636 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
7638 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
7639 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
7641 Lisp_Object color_name
,
7642 unsigned long dflt
));
7645 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
7646 free the pixmap if any. MASK_P non-zero means clear the mask
7647 pixmap if any. COLORS_P non-zero means free colors allocated for
7648 the image, if any. */
7651 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
7654 int pixmap_p
, mask_p
, colors_p
;
7656 if (pixmap_p
&& img
->pixmap
)
7658 DeleteObject (img
->pixmap
);
7660 img
->background_valid
= 0;
7663 if (mask_p
&& img
->mask
)
7665 DeleteObject (img
->mask
);
7667 img
->background_transparent_valid
= 0;
7670 if (colors_p
&& img
->ncolors
)
7672 #if 0 /* TODO: color table support. */
7673 x_free_colors (f
, img
->colors
, img
->ncolors
);
7675 xfree (img
->colors
);
7681 /* Free X resources of image IMG which is used on frame F. */
7684 x_clear_image (f
, img
)
7691 DeleteObject (img
->pixmap
);
7698 #if 0 /* TODO: color table support */
7700 int class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
7702 /* If display has an immutable color map, freeing colors is not
7703 necessary and some servers don't allow it. So don't do it. */
7704 if (class != StaticColor
7705 && class != StaticGray
7706 && class != TrueColor
)
7710 cmap
= DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f
)->screen
);
7711 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
, img
->colors
,
7717 xfree (img
->colors
);
7724 /* Allocate color COLOR_NAME for image IMG on frame F. If color
7725 cannot be allocated, use DFLT. Add a newly allocated color to
7726 IMG->colors, so that it can be freed again. Value is the pixel
7729 static unsigned long
7730 x_alloc_image_color (f
, img
, color_name
, dflt
)
7733 Lisp_Object color_name
;
7737 unsigned long result
;
7739 xassert (STRINGP (color_name
));
7741 if (w32_defined_color (f
, SDATA (color_name
), &color
, 1))
7743 /* This isn't called frequently so we get away with simply
7744 reallocating the color vector to the needed size, here. */
7747 (unsigned long *) xrealloc (img
->colors
,
7748 img
->ncolors
* sizeof *img
->colors
);
7749 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
7750 result
= color
.pixel
;
7759 /***********************************************************************
7761 ***********************************************************************/
7763 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
7764 static void postprocess_image
P_ ((struct frame
*, struct image
*));
7765 static void x_disable_image
P_ ((struct frame
*, struct image
*));
7768 /* Return a new, initialized image cache that is allocated from the
7769 heap. Call free_image_cache to free an image cache. */
7771 struct image_cache
*
7774 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
7777 bzero (c
, sizeof *c
);
7779 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
7780 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
7781 c
->buckets
= (struct image
**) xmalloc (size
);
7782 bzero (c
->buckets
, size
);
7787 /* Free image cache of frame F. Be aware that X frames share images
7791 free_image_cache (f
)
7794 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
7799 /* Cache should not be referenced by any frame when freed. */
7800 xassert (c
->refcount
== 0);
7802 for (i
= 0; i
< c
->used
; ++i
)
7803 free_image (f
, c
->images
[i
]);
7807 FRAME_X_IMAGE_CACHE (f
) = NULL
;
7812 /* Clear image cache of frame F. FORCE_P non-zero means free all
7813 images. FORCE_P zero means clear only images that haven't been
7814 displayed for some time. Should be called from time to time to
7815 reduce the number of loaded images. If image-eviction-seconds is
7816 non-nil, this frees images in the cache which weren't displayed for
7817 at least that many seconds. */
7820 clear_image_cache (f
, force_p
)
7824 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
7826 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
7833 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
7835 /* Block input so that we won't be interrupted by a SIGIO
7836 while being in an inconsistent state. */
7839 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
7841 struct image
*img
= c
->images
[i
];
7843 && (force_p
|| (img
->timestamp
< old
)))
7845 free_image (f
, img
);
7850 /* We may be clearing the image cache because, for example,
7851 Emacs was iconified for a longer period of time. In that
7852 case, current matrices may still contain references to
7853 images freed above. So, clear these matrices. */
7856 Lisp_Object tail
, frame
;
7858 FOR_EACH_FRAME (tail
, frame
)
7860 struct frame
*f
= XFRAME (frame
);
7862 && FRAME_X_IMAGE_CACHE (f
) == c
)
7863 clear_current_matrices (f
);
7866 ++windows_or_buffers_changed
;
7874 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
7876 doc
: /* Clear the image cache of FRAME.
7877 FRAME nil or omitted means use the selected frame.
7878 FRAME t means clear the image caches of all frames. */)
7886 FOR_EACH_FRAME (tail
, frame
)
7887 if (FRAME_W32_P (XFRAME (frame
)))
7888 clear_image_cache (XFRAME (frame
), 1);
7891 clear_image_cache (check_x_frame (frame
), 1);
7897 /* Compute masks and transform image IMG on frame F, as specified
7898 by the image's specification, */
7901 postprocess_image (f
, img
)
7905 /* Manipulation of the image's mask. */
7908 Lisp_Object conversion
, spec
;
7913 /* `:heuristic-mask t'
7915 means build a mask heuristically.
7916 `:heuristic-mask (R G B)'
7917 `:mask (heuristic (R G B))'
7918 means build a mask from color (R G B) in the
7921 means remove a mask, if any. */
7923 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
7925 x_build_heuristic_mask (f
, img
, mask
);
7930 mask
= image_spec_value (spec
, QCmask
, &found_p
);
7932 if (EQ (mask
, Qheuristic
))
7933 x_build_heuristic_mask (f
, img
, Qt
);
7934 else if (CONSP (mask
)
7935 && EQ (XCAR (mask
), Qheuristic
))
7937 if (CONSP (XCDR (mask
)))
7938 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
7940 x_build_heuristic_mask (f
, img
, XCDR (mask
));
7942 else if (NILP (mask
) && found_p
&& img
->mask
)
7944 DeleteObject (img
->mask
);
7950 /* Should we apply an image transformation algorithm? */
7951 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
7952 if (EQ (conversion
, Qdisabled
))
7953 x_disable_image (f
, img
);
7954 else if (EQ (conversion
, Qlaplace
))
7956 else if (EQ (conversion
, Qemboss
))
7958 else if (CONSP (conversion
)
7959 && EQ (XCAR (conversion
), Qedge_detection
))
7962 tem
= XCDR (conversion
);
7964 x_edge_detection (f
, img
,
7965 Fplist_get (tem
, QCmatrix
),
7966 Fplist_get (tem
, QCcolor_adjustment
));
7972 /* Return the id of image with Lisp specification SPEC on frame F.
7973 SPEC must be a valid Lisp image specification (see valid_image_p). */
7976 lookup_image (f
, spec
)
7980 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
7984 struct gcpro gcpro1
;
7987 /* F must be a window-system frame, and SPEC must be a valid image
7989 xassert (FRAME_WINDOW_P (f
));
7990 xassert (valid_image_p (spec
));
7994 /* Look up SPEC in the hash table of the image cache. */
7995 hash
= sxhash (spec
, 0);
7996 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
7998 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
7999 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
8002 /* If not found, create a new image and cache it. */
8005 extern Lisp_Object Qpostscript
;
8008 img
= make_image (spec
, hash
);
8009 cache_image (f
, img
);
8010 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8012 /* If we can't load the image, and we don't have a width and
8013 height, use some arbitrary width and height so that we can
8014 draw a rectangle for it. */
8015 if (img
->load_failed_p
)
8019 value
= image_spec_value (spec
, QCwidth
, NULL
);
8020 img
->width
= (INTEGERP (value
)
8021 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
8022 value
= image_spec_value (spec
, QCheight
, NULL
);
8023 img
->height
= (INTEGERP (value
)
8024 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
8028 /* Handle image type independent image attributes
8029 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
8030 `:background COLOR'. */
8031 Lisp_Object ascent
, margin
, relief
, bg
;
8033 ascent
= image_spec_value (spec
, QCascent
, NULL
);
8034 if (INTEGERP (ascent
))
8035 img
->ascent
= XFASTINT (ascent
);
8036 else if (EQ (ascent
, Qcenter
))
8037 img
->ascent
= CENTERED_IMAGE_ASCENT
;
8039 margin
= image_spec_value (spec
, QCmargin
, NULL
);
8040 if (INTEGERP (margin
) && XINT (margin
) >= 0)
8041 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
8042 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
8043 && INTEGERP (XCDR (margin
)))
8045 if (XINT (XCAR (margin
)) > 0)
8046 img
->hmargin
= XFASTINT (XCAR (margin
));
8047 if (XINT (XCDR (margin
)) > 0)
8048 img
->vmargin
= XFASTINT (XCDR (margin
));
8051 relief
= image_spec_value (spec
, QCrelief
, NULL
);
8052 if (INTEGERP (relief
))
8054 img
->relief
= XINT (relief
);
8055 img
->hmargin
+= abs (img
->relief
);
8056 img
->vmargin
+= abs (img
->relief
);
8059 if (! img
->background_valid
)
8061 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
8065 = x_alloc_image_color (f
, img
, bg
,
8066 FRAME_BACKGROUND_PIXEL (f
));
8067 img
->background_valid
= 1;
8071 /* Do image transformations and compute masks, unless we
8072 don't have the image yet. */
8073 if (!EQ (*img
->type
->type
, Qpostscript
))
8074 postprocess_image (f
, img
);
8078 xassert (!interrupt_input_blocked
);
8081 /* We're using IMG, so set its timestamp to `now'. */
8082 EMACS_GET_TIME (now
);
8083 img
->timestamp
= EMACS_SECS (now
);
8087 /* Value is the image id. */
8092 /* Cache image IMG in the image cache of frame F. */
8095 cache_image (f
, img
)
8099 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8102 /* Find a free slot in c->images. */
8103 for (i
= 0; i
< c
->used
; ++i
)
8104 if (c
->images
[i
] == NULL
)
8107 /* If no free slot found, maybe enlarge c->images. */
8108 if (i
== c
->used
&& c
->used
== c
->size
)
8111 c
->images
= (struct image
**) xrealloc (c
->images
,
8112 c
->size
* sizeof *c
->images
);
8115 /* Add IMG to c->images, and assign IMG an id. */
8121 /* Add IMG to the cache's hash table. */
8122 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8123 img
->next
= c
->buckets
[i
];
8125 img
->next
->prev
= img
;
8127 c
->buckets
[i
] = img
;
8131 /* Call FN on every image in the image cache of frame F. Used to mark
8132 Lisp Objects in the image cache. */
8135 forall_images_in_image_cache (f
, fn
)
8137 void (*fn
) P_ ((struct image
*img
));
8139 if (FRAME_LIVE_P (f
) && FRAME_W32_P (f
))
8141 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8145 for (i
= 0; i
< c
->used
; ++i
)
8154 /***********************************************************************
8156 ***********************************************************************/
8158 /* Macro for defining functions that will be loaded from image DLLs. */
8159 #define DEF_IMGLIB_FN(func) FARPROC fn_##func
8161 /* Macro for loading those image functions from the library. */
8162 #define LOAD_IMGLIB_FN(lib,func) { \
8163 fn_##func = (void *) GetProcAddress (lib, #func); \
8164 if (!fn_##func) return 0; \
8167 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
8168 XImage
**, Pixmap
*));
8169 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
8172 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
8173 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
8174 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
8175 via xmalloc. DEPTH of zero signifies a 24 bit image, otherwise
8176 DEPTH should indicate the bit depth of the image. Print error
8177 messages via image_error if an error occurs. Value is non-zero if
8181 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
8183 int width
, height
, depth
;
8187 BITMAPINFOHEADER
*header
;
8189 int scanline_width_bits
;
8191 int palette_colors
= 0;
8196 if (depth
!= 1 && depth
!= 4 && depth
!= 8
8197 && depth
!= 16 && depth
!= 24 && depth
!= 32)
8199 image_error ("Invalid image bit depth specified", Qnil
, Qnil
);
8203 scanline_width_bits
= width
* depth
;
8204 remainder
= scanline_width_bits
% 32;
8207 scanline_width_bits
+= 32 - remainder
;
8209 /* Bitmaps with a depth less than 16 need a palette. */
8210 /* BITMAPINFO structure already contains the first RGBQUAD. */
8212 palette_colors
= 1 << depth
- 1;
8214 *ximg
= xmalloc (sizeof (XImage
) + palette_colors
* sizeof (RGBQUAD
));
8217 image_error ("Unable to allocate memory for XImage", Qnil
, Qnil
);
8221 header
= &((*ximg
)->info
.bmiHeader
);
8222 bzero (&((*ximg
)->info
), sizeof (BITMAPINFO
));
8223 header
->biSize
= sizeof (*header
);
8224 header
->biWidth
= width
;
8225 header
->biHeight
= -height
; /* negative indicates a top-down bitmap. */
8226 header
->biPlanes
= 1;
8227 header
->biBitCount
= depth
;
8228 header
->biCompression
= BI_RGB
;
8229 header
->biClrUsed
= palette_colors
;
8231 /* TODO: fill in palette. */
8234 (*ximg
)->info
.bmiColors
[0].rgbBlue
= 0;
8235 (*ximg
)->info
.bmiColors
[0].rgbGreen
= 0;
8236 (*ximg
)->info
.bmiColors
[0].rgbRed
= 0;
8237 (*ximg
)->info
.bmiColors
[0].rgbReserved
= 0;
8238 (*ximg
)->info
.bmiColors
[1].rgbBlue
= 255;
8239 (*ximg
)->info
.bmiColors
[1].rgbGreen
= 255;
8240 (*ximg
)->info
.bmiColors
[1].rgbRed
= 255;
8241 (*ximg
)->info
.bmiColors
[1].rgbReserved
= 0;
8244 hdc
= get_frame_dc (f
);
8246 /* Create a DIBSection and raster array for the bitmap,
8247 and store its handle in *pixmap. */
8248 *pixmap
= CreateDIBSection (hdc
, &((*ximg
)->info
),
8249 (depth
< 16) ? DIB_PAL_COLORS
: DIB_RGB_COLORS
,
8250 &((*ximg
)->data
), NULL
, 0);
8252 /* Realize display palette and garbage all frames. */
8253 release_frame_dc (f
, hdc
);
8255 if (*pixmap
== NULL
)
8257 DWORD err
= GetLastError();
8258 Lisp_Object errcode
;
8259 /* All system errors are < 10000, so the following is safe. */
8260 XSETINT (errcode
, (int) err
);
8261 image_error ("Unable to create bitmap, error code %d", errcode
, Qnil
);
8262 x_destroy_x_image (*ximg
);
8270 /* Destroy XImage XIMG. Free XIMG->data. */
8273 x_destroy_x_image (ximg
)
8276 xassert (interrupt_input_blocked
);
8279 /* Data will be freed by DestroyObject. */
8286 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
8287 are width and height of both the image and pixmap. */
8290 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
8296 #if 0 /* I don't think this is necessary looking at where it is used. */
8297 HDC hdc
= get_frame_dc (f
);
8298 SetDIBits (hdc
, pixmap
, 0, height
, ximg
->data
, &(ximg
->info
), DIB_RGB_COLORS
);
8299 release_frame_dc (f
, hdc
);
8304 /***********************************************************************
8306 ***********************************************************************/
8308 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
8309 static char *slurp_file
P_ ((char *, int *));
8312 /* Find image file FILE. Look in data-directory, then
8313 x-bitmap-file-path. Value is the full name of the file found, or
8314 nil if not found. */
8317 x_find_image_file (file
)
8320 Lisp_Object file_found
, search_path
;
8321 struct gcpro gcpro1
, gcpro2
;
8325 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
8326 GCPRO2 (file_found
, search_path
);
8328 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
8329 fd
= openp (search_path
, file
, Qnil
, &file_found
, Qnil
);
8341 /* Read FILE into memory. Value is a pointer to a buffer allocated
8342 with xmalloc holding FILE's contents. Value is null if an error
8343 occurred. *SIZE is set to the size of the file. */
8346 slurp_file (file
, size
)
8354 if (stat (file
, &st
) == 0
8355 && (fp
= fopen (file
, "rb")) != NULL
8356 && (buf
= (char *) xmalloc (st
.st_size
),
8357 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
8378 /***********************************************************************
8380 ***********************************************************************/
8382 static int xbm_scan
P_ ((char **, char *, char *, int *));
8383 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
8384 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
8386 static int xbm_image_p
P_ ((Lisp_Object object
));
8387 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
8389 static int xbm_file_p
P_ ((Lisp_Object
));
8392 /* Indices of image specification fields in xbm_format, below. */
8394 enum xbm_keyword_index
8412 /* Vector of image_keyword structures describing the format
8413 of valid XBM image specifications. */
8415 static struct image_keyword xbm_format
[XBM_LAST
] =
8417 {":type", IMAGE_SYMBOL_VALUE
, 1},
8418 {":file", IMAGE_STRING_VALUE
, 0},
8419 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8420 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8421 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8422 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
8423 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
8424 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8425 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8426 {":relief", IMAGE_INTEGER_VALUE
, 0},
8427 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8428 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8429 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8432 /* Structure describing the image type XBM. */
8434 static struct image_type xbm_type
=
8443 /* Tokens returned from xbm_scan. */
8452 /* Return non-zero if OBJECT is a valid XBM-type image specification.
8453 A valid specification is a list starting with the symbol `image'
8454 The rest of the list is a property list which must contain an
8457 If the specification specifies a file to load, it must contain
8458 an entry `:file FILENAME' where FILENAME is a string.
8460 If the specification is for a bitmap loaded from memory it must
8461 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
8462 WIDTH and HEIGHT are integers > 0. DATA may be:
8464 1. a string large enough to hold the bitmap data, i.e. it must
8465 have a size >= (WIDTH + 7) / 8 * HEIGHT
8467 2. a bool-vector of size >= WIDTH * HEIGHT
8469 3. a vector of strings or bool-vectors, one for each line of the
8472 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
8473 may not be specified in this case because they are defined in the
8476 Both the file and data forms may contain the additional entries
8477 `:background COLOR' and `:foreground COLOR'. If not present,
8478 foreground and background of the frame on which the image is
8479 displayed is used. */
8482 xbm_image_p (object
)
8485 struct image_keyword kw
[XBM_LAST
];
8487 bcopy (xbm_format
, kw
, sizeof kw
);
8488 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
8491 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
8493 if (kw
[XBM_FILE
].count
)
8495 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
8498 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
8500 /* In-memory XBM file. */
8501 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
8509 /* Entries for `:width', `:height' and `:data' must be present. */
8510 if (!kw
[XBM_WIDTH
].count
8511 || !kw
[XBM_HEIGHT
].count
8512 || !kw
[XBM_DATA
].count
)
8515 data
= kw
[XBM_DATA
].value
;
8516 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
8517 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
8519 /* Check type of data, and width and height against contents of
8525 /* Number of elements of the vector must be >= height. */
8526 if (XVECTOR (data
)->size
< height
)
8529 /* Each string or bool-vector in data must be large enough
8530 for one line of the image. */
8531 for (i
= 0; i
< height
; ++i
)
8533 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
8538 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
8541 else if (BOOL_VECTOR_P (elt
))
8543 if (XBOOL_VECTOR (elt
)->size
< width
)
8550 else if (STRINGP (data
))
8553 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
8556 else if (BOOL_VECTOR_P (data
))
8558 if (XBOOL_VECTOR (data
)->size
< width
* height
)
8569 /* Scan a bitmap file. FP is the stream to read from. Value is
8570 either an enumerator from enum xbm_token, or a character for a
8571 single-character token, or 0 at end of file. If scanning an
8572 identifier, store the lexeme of the identifier in SVAL. If
8573 scanning a number, store its value in *IVAL. */
8576 xbm_scan (s
, end
, sval
, ival
)
8585 /* Skip white space. */
8586 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8591 else if (isdigit (c
))
8593 int value
= 0, digit
;
8595 if (c
== '0' && *s
< end
)
8598 if (c
== 'x' || c
== 'X')
8605 else if (c
>= 'a' && c
<= 'f')
8606 digit
= c
- 'a' + 10;
8607 else if (c
>= 'A' && c
<= 'F')
8608 digit
= c
- 'A' + 10;
8611 value
= 16 * value
+ digit
;
8614 else if (isdigit (c
))
8618 && (c
= *(*s
)++, isdigit (c
)))
8619 value
= 8 * value
+ c
- '0';
8626 && (c
= *(*s
)++, isdigit (c
)))
8627 value
= 10 * value
+ c
- '0';
8635 else if (isalpha (c
) || c
== '_')
8639 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
8646 else if (c
== '/' && **s
== '*')
8648 /* C-style comment. */
8650 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
8663 /* XBM bits seem to be backward within bytes compared with how
8664 Windows does things. */
8665 static unsigned char reflect_byte (unsigned char orig
)
8668 unsigned char reflected
= 0x00;
8669 for (i
= 0; i
< 8; i
++)
8671 if (orig
& (0x01 << i
))
8672 reflected
|= 0x80 >> i
;
8678 /* Create a Windows bitmap from X bitmap data. */
8680 w32_create_pixmap_from_bitmap_data (int width
, int height
, char *data
)
8686 w1
= (width
+ 7) / 8; /* nb of 8bits elt in X bitmap */
8687 w2
= ((width
+ 15) / 16) * 2; /* nb of 16bits elt in W32 bitmap */
8688 bits
= (char *) alloca (height
* w2
);
8689 bzero (bits
, height
* w2
);
8690 for (i
= 0; i
< height
; i
++)
8693 for (j
= 0; j
< w1
; j
++)
8694 *p
++ = reflect_byte(*data
++);
8696 bmp
= CreateBitmap (width
, height
, 1, 1, bits
);
8702 /* Replacement for XReadBitmapFileData which isn't available under old
8703 X versions. CONTENTS is a pointer to a buffer to parse; END is the
8704 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
8705 the image. Return in *DATA the bitmap data allocated with xmalloc.
8706 Value is non-zero if successful. DATA null means just test if
8707 CONTENTS looks like an in-memory XBM file. */
8710 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
8711 char *contents
, *end
;
8712 int *width
, *height
;
8713 unsigned char **data
;
8716 char buffer
[BUFSIZ
];
8719 int bytes_per_line
, i
, nbytes
;
8725 LA1 = xbm_scan (&s, end, buffer, &value)
8727 #define expect(TOKEN) \
8728 if (LA1 != (TOKEN)) \
8733 #define expect_ident(IDENT) \
8734 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
8739 *width
= *height
= -1;
8742 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
8744 /* Parse defines for width, height and hot-spots. */
8748 expect_ident ("define");
8749 expect (XBM_TK_IDENT
);
8751 if (LA1
== XBM_TK_NUMBER
);
8753 char *p
= strrchr (buffer
, '_');
8754 p
= p
? p
+ 1 : buffer
;
8755 if (strcmp (p
, "width") == 0)
8757 else if (strcmp (p
, "height") == 0)
8760 expect (XBM_TK_NUMBER
);
8763 if (*width
< 0 || *height
< 0)
8765 else if (data
== NULL
)
8768 /* Parse bits. Must start with `static'. */
8769 expect_ident ("static");
8770 if (LA1
== XBM_TK_IDENT
)
8772 if (strcmp (buffer
, "unsigned") == 0)
8775 expect_ident ("char");
8777 else if (strcmp (buffer
, "short") == 0)
8781 if (*width
% 16 && *width
% 16 < 9)
8784 else if (strcmp (buffer
, "char") == 0)
8792 expect (XBM_TK_IDENT
);
8798 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
8799 nbytes
= bytes_per_line
* *height
;
8800 p
= *data
= (char *) xmalloc (nbytes
);
8804 for (i
= 0; i
< nbytes
; i
+= 2)
8807 expect (XBM_TK_NUMBER
);
8810 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
8811 *p
++ = ~ (value
>> 8);
8813 if (LA1
== ',' || LA1
== '}')
8821 for (i
= 0; i
< nbytes
; ++i
)
8824 expect (XBM_TK_NUMBER
);
8828 if (LA1
== ',' || LA1
== '}')
8852 static void convert_mono_to_color_image (f
, img
, foreground
, background
)
8855 COLORREF foreground
, background
;
8857 HDC hdc
, old_img_dc
, new_img_dc
;
8858 HGDIOBJ old_prev
, new_prev
;
8861 hdc
= get_frame_dc (f
);
8862 old_img_dc
= CreateCompatibleDC (hdc
);
8863 new_img_dc
= CreateCompatibleDC (hdc
);
8864 new_pixmap
= CreateCompatibleBitmap (hdc
, img
->width
, img
->height
);
8865 release_frame_dc (f
, hdc
);
8866 old_prev
= SelectObject (old_img_dc
, img
->pixmap
);
8867 new_prev
= SelectObject (new_img_dc
, new_pixmap
);
8868 SetTextColor (new_img_dc
, foreground
);
8869 SetBkColor (new_img_dc
, background
);
8871 BitBlt (new_img_dc
, 0, 0, img
->width
, img
->height
, old_img_dc
,
8874 SelectObject (old_img_dc
, old_prev
);
8875 SelectObject (new_img_dc
, new_prev
);
8876 DeleteDC (old_img_dc
);
8877 DeleteDC (new_img_dc
);
8878 DeleteObject (img
->pixmap
);
8879 if (new_pixmap
== 0)
8880 fprintf (stderr
, "Failed to convert image to color.\n");
8882 img
->pixmap
= new_pixmap
;
8885 /* Load XBM image IMG which will be displayed on frame F from buffer
8886 CONTENTS. END is the end of the buffer. Value is non-zero if
8890 xbm_load_image (f
, img
, contents
, end
)
8893 char *contents
, *end
;
8896 unsigned char *data
;
8899 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
8902 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
8903 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
8904 int non_default_colors
= 0;
8907 xassert (img
->width
> 0 && img
->height
> 0);
8909 /* Get foreground and background colors, maybe allocate colors. */
8910 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
8913 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
8914 non_default_colors
= 1;
8916 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
8919 background
= x_alloc_image_color (f
, img
, value
, background
);
8920 img
->background
= background
;
8921 img
->background_valid
= 1;
8922 non_default_colors
= 1;
8925 = w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
, data
);
8927 /* If colors were specified, transfer the bitmap to a color one. */
8928 if (non_default_colors
)
8929 convert_mono_to_color_image (f
, img
, foreground
, background
);
8933 if (img
->pixmap
== 0)
8935 x_clear_image (f
, img
);
8936 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
8942 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
8948 /* Value is non-zero if DATA looks like an in-memory XBM file. */
8955 return (STRINGP (data
)
8956 && xbm_read_bitmap_data (SDATA (data
),
8963 /* Fill image IMG which is used on frame F with pixmap data. Value is
8964 non-zero if successful. */
8972 Lisp_Object file_name
;
8974 xassert (xbm_image_p (img
->spec
));
8976 /* If IMG->spec specifies a file name, create a non-file spec from it. */
8977 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
8978 if (STRINGP (file_name
))
8983 struct gcpro gcpro1
;
8985 file
= x_find_image_file (file_name
);
8987 if (!STRINGP (file
))
8989 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
8994 contents
= slurp_file (SDATA (file
), &size
);
8995 if (contents
== NULL
)
8997 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
9002 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
9007 struct image_keyword fmt
[XBM_LAST
];
9009 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
9010 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
9011 int non_default_colors
= 0;
9014 int in_memory_file_p
= 0;
9016 /* See if data looks like an in-memory XBM file. */
9017 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9018 in_memory_file_p
= xbm_file_p (data
);
9020 /* Parse the image specification. */
9021 bcopy (xbm_format
, fmt
, sizeof fmt
);
9022 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
9025 /* Get specified width, and height. */
9026 if (!in_memory_file_p
)
9028 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
9029 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
9030 xassert (img
->width
> 0 && img
->height
> 0);
9033 /* Get foreground and background colors, maybe allocate colors. */
9034 if (fmt
[XBM_FOREGROUND
].count
9035 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
9037 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
9039 non_default_colors
= 1;
9042 if (fmt
[XBM_BACKGROUND
].count
9043 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
9045 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
9047 non_default_colors
= 1;
9050 if (in_memory_file_p
)
9051 success_p
= xbm_load_image (f
, img
, SDATA (data
),
9060 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
9062 p
= bits
= (char *) alloca (nbytes
* img
->height
);
9063 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
9065 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
9067 bcopy (SDATA (line
), p
, nbytes
);
9069 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
9072 else if (STRINGP (data
))
9073 bits
= SDATA (data
);
9075 bits
= XBOOL_VECTOR (data
)->data
;
9077 /* Create the pixmap. */
9079 = w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
,
9082 /* If colors were specified, transfer the bitmap to a color one. */
9083 if (non_default_colors
)
9084 convert_mono_to_color_image (f
, img
, foreground
, background
);
9090 image_error ("Unable to create pixmap for XBM image `%s'",
9092 x_clear_image (f
, img
);
9102 /***********************************************************************
9104 ***********************************************************************/
9108 static int xpm_image_p
P_ ((Lisp_Object object
));
9109 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
9110 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
9112 /* Indicate to xpm.h that we don't have Xlib. */
9114 /* simx.h in xpm defines XColor and XImage differently than Emacs. */
9115 #define XColor xpm_XColor
9116 #define XImage xpm_XImage
9117 #define PIXEL_ALREADY_TYPEDEFED
9118 #include "X11/xpm.h"
9122 #undef PIXEL_ALREADY_TYPEDEFED
9124 /* The symbol `xpm' identifying XPM-format images. */
9128 /* Indices of image specification fields in xpm_format, below. */
9130 enum xpm_keyword_index
9146 /* Vector of image_keyword structures describing the format
9147 of valid XPM image specifications. */
9149 static struct image_keyword xpm_format
[XPM_LAST
] =
9151 {":type", IMAGE_SYMBOL_VALUE
, 1},
9152 {":file", IMAGE_STRING_VALUE
, 0},
9153 {":data", IMAGE_STRING_VALUE
, 0},
9154 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9155 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9156 {":relief", IMAGE_INTEGER_VALUE
, 0},
9157 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9158 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9159 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9160 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9161 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9164 /* Structure describing the image type XPM. */
9166 static struct image_type xpm_type
=
9176 /* XPM library details. */
9178 DEF_IMGLIB_FN (XpmFreeAttributes
);
9179 DEF_IMGLIB_FN (XpmCreateImageFromBuffer
);
9180 DEF_IMGLIB_FN (XpmReadFileToImage
);
9181 DEF_IMGLIB_FN (XImageFree
);
9185 init_xpm_functions (library
)
9188 LOAD_IMGLIB_FN (library
, XpmFreeAttributes
);
9189 LOAD_IMGLIB_FN (library
, XpmCreateImageFromBuffer
);
9190 LOAD_IMGLIB_FN (library
, XpmReadFileToImage
);
9191 LOAD_IMGLIB_FN (library
, XImageFree
);
9196 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
9197 for XPM images. Such a list must consist of conses whose car and
9201 xpm_valid_color_symbols_p (color_symbols
)
9202 Lisp_Object color_symbols
;
9204 while (CONSP (color_symbols
))
9206 Lisp_Object sym
= XCAR (color_symbols
);
9208 || !STRINGP (XCAR (sym
))
9209 || !STRINGP (XCDR (sym
)))
9211 color_symbols
= XCDR (color_symbols
);
9214 return NILP (color_symbols
);
9218 /* Value is non-zero if OBJECT is a valid XPM image specification. */
9221 xpm_image_p (object
)
9224 struct image_keyword fmt
[XPM_LAST
];
9225 bcopy (xpm_format
, fmt
, sizeof fmt
);
9226 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
9227 /* Either `:file' or `:data' must be present. */
9228 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
9229 /* Either no `:color-symbols' or it's a list of conses
9230 whose car and cdr are strings. */
9231 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
9232 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
9236 /* Load image IMG which will be displayed on frame F. Value is
9237 non-zero if successful. */
9246 XpmAttributes attrs
;
9247 Lisp_Object specified_file
, color_symbols
;
9248 xpm_XImage
* xpm_image
, * xpm_mask
;
9250 /* Configure the XPM lib. Use the visual of frame F. Allocate
9251 close colors. Return colors allocated. */
9252 bzero (&attrs
, sizeof attrs
);
9253 xpm_image
= xpm_mask
= NULL
;
9256 attrs
.visual
= FRAME_X_VISUAL (f
);
9257 attrs
.colormap
= FRAME_X_COLORMAP (f
);
9258 attrs
.valuemask
|= XpmVisual
;
9259 attrs
.valuemask
|= XpmColormap
;
9261 attrs
.valuemask
|= XpmReturnAllocPixels
;
9262 #ifdef XpmAllocCloseColors
9263 attrs
.alloc_close_colors
= 1;
9264 attrs
.valuemask
|= XpmAllocCloseColors
;
9266 attrs
.closeness
= 600;
9267 attrs
.valuemask
|= XpmCloseness
;
9270 /* If image specification contains symbolic color definitions, add
9271 these to `attrs'. */
9272 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
9273 if (CONSP (color_symbols
))
9276 XpmColorSymbol
*xpm_syms
;
9279 attrs
.valuemask
|= XpmColorSymbols
;
9281 /* Count number of symbols. */
9282 attrs
.numsymbols
= 0;
9283 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
9286 /* Allocate an XpmColorSymbol array. */
9287 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
9288 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
9289 bzero (xpm_syms
, size
);
9290 attrs
.colorsymbols
= xpm_syms
;
9292 /* Fill the color symbol array. */
9293 for (tail
= color_symbols
, i
= 0;
9295 ++i
, tail
= XCDR (tail
))
9297 Lisp_Object name
= XCAR (XCAR (tail
));
9298 Lisp_Object color
= XCDR (XCAR (tail
));
9299 xpm_syms
[i
].name
= (char *) alloca (SCHARS (name
) + 1);
9300 strcpy (xpm_syms
[i
].name
, SDATA (name
));
9301 xpm_syms
[i
].value
= (char *) alloca (SCHARS (color
) + 1);
9302 strcpy (xpm_syms
[i
].value
, SDATA (color
));
9306 /* Create a pixmap for the image, either from a file, or from a
9307 string buffer containing data in the same format as an XPM file. */
9309 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9312 HDC frame_dc
= get_frame_dc (f
);
9313 hdc
= CreateCompatibleDC (frame_dc
);
9314 release_frame_dc (f
, frame_dc
);
9317 if (STRINGP (specified_file
))
9319 Lisp_Object file
= x_find_image_file (specified_file
);
9320 if (!STRINGP (file
))
9322 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9326 /* XpmReadFileToPixmap is not available in the Windows port of
9327 libxpm. But XpmReadFileToImage almost does what we want. */
9328 rc
= fn_XpmReadFileToImage (&hdc
, SDATA (file
),
9329 &xpm_image
, &xpm_mask
,
9334 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
9335 /* XpmCreatePixmapFromBuffer is not available in the Windows port
9336 of libxpm. But XpmCreateImageFromBuffer almost does what we want. */
9337 rc
= fn_XpmCreateImageFromBuffer (&hdc
, SDATA (buffer
),
9338 &xpm_image
, &xpm_mask
,
9342 if (rc
== XpmSuccess
)
9346 /* W32 XPM uses XImage to wrap what W32 Emacs calls a Pixmap,
9347 plus some duplicate attributes. */
9348 if (xpm_image
&& xpm_image
->bitmap
)
9350 img
->pixmap
= xpm_image
->bitmap
;
9351 /* XImageFree in libXpm frees XImage struct without destroying
9352 the bitmap, which is what we want. */
9353 fn_XImageFree (xpm_image
);
9355 if (xpm_mask
&& xpm_mask
->bitmap
)
9357 /* The mask appears to be inverted compared with what we expect.
9358 TODO: invert our expectations. See other places where we
9359 have to invert bits because our idea of masks is backwards. */
9361 old_obj
= SelectObject (hdc
, xpm_mask
->bitmap
);
9363 PatBlt (hdc
, 0, 0, xpm_mask
->width
, xpm_mask
->height
, DSTINVERT
);
9364 SelectObject (hdc
, old_obj
);
9366 img
->mask
= xpm_mask
->bitmap
;
9367 fn_XImageFree (xpm_mask
);
9373 /* Remember allocated colors. */
9374 img
->ncolors
= attrs
.nalloc_pixels
;
9375 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
9376 * sizeof *img
->colors
);
9377 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
9378 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
9380 img
->width
= attrs
.width
;
9381 img
->height
= attrs
.height
;
9382 xassert (img
->width
> 0 && img
->height
> 0);
9384 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
9385 fn_XpmFreeAttributes (&attrs
);
9394 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
9397 case XpmFileInvalid
:
9398 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
9402 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
9405 case XpmColorFailed
:
9406 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
9410 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
9415 return rc
== XpmSuccess
;
9418 #endif /* HAVE_XPM != 0 */
9421 #if 0 /* TODO : Color tables on W32. */
9422 /***********************************************************************
9424 ***********************************************************************/
9426 /* An entry in the color table mapping an RGB color to a pixel color. */
9431 unsigned long pixel
;
9433 /* Next in color table collision list. */
9434 struct ct_color
*next
;
9437 /* The bucket vector size to use. Must be prime. */
9441 /* Value is a hash of the RGB color given by R, G, and B. */
9443 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
9445 /* The color hash table. */
9447 struct ct_color
**ct_table
;
9449 /* Number of entries in the color table. */
9451 int ct_colors_allocated
;
9453 /* Function prototypes. */
9455 static void init_color_table
P_ ((void));
9456 static void free_color_table
P_ ((void));
9457 static unsigned long *colors_in_color_table
P_ ((int *n
));
9458 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
9459 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
9462 /* Initialize the color table. */
9467 int size
= CT_SIZE
* sizeof (*ct_table
);
9468 ct_table
= (struct ct_color
**) xmalloc (size
);
9469 bzero (ct_table
, size
);
9470 ct_colors_allocated
= 0;
9474 /* Free memory associated with the color table. */
9480 struct ct_color
*p
, *next
;
9482 for (i
= 0; i
< CT_SIZE
; ++i
)
9483 for (p
= ct_table
[i
]; p
; p
= next
)
9494 /* Value is a pixel color for RGB color R, G, B on frame F. If an
9495 entry for that color already is in the color table, return the
9496 pixel color of that entry. Otherwise, allocate a new color for R,
9497 G, B, and make an entry in the color table. */
9499 static unsigned long
9500 lookup_rgb_color (f
, r
, g
, b
)
9504 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
9505 int i
= hash
% CT_SIZE
;
9508 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9509 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
9518 color
= PALETTERGB (r
, g
, b
);
9520 ++ct_colors_allocated
;
9522 p
= (struct ct_color
*) xmalloc (sizeof *p
);
9527 p
->next
= ct_table
[i
];
9535 /* Look up pixel color PIXEL which is used on frame F in the color
9536 table. If not already present, allocate it. Value is PIXEL. */
9538 static unsigned long
9539 lookup_pixel_color (f
, pixel
)
9541 unsigned long pixel
;
9543 int i
= pixel
% CT_SIZE
;
9546 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9547 if (p
->pixel
== pixel
)
9558 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9559 color
.pixel
= pixel
;
9560 XQueryColor (NULL
, cmap
, &color
);
9561 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
9566 ++ct_colors_allocated
;
9568 p
= (struct ct_color
*) xmalloc (sizeof *p
);
9573 p
->next
= ct_table
[i
];
9577 return FRAME_FOREGROUND_PIXEL (f
);
9583 /* Value is a vector of all pixel colors contained in the color table,
9584 allocated via xmalloc. Set *N to the number of colors. */
9586 static unsigned long *
9587 colors_in_color_table (n
)
9592 unsigned long *colors
;
9594 if (ct_colors_allocated
== 0)
9601 colors
= (unsigned long *) xmalloc (ct_colors_allocated
9603 *n
= ct_colors_allocated
;
9605 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
9606 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9607 colors
[j
++] = p
->pixel
;
9616 /***********************************************************************
9618 ***********************************************************************/
9619 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
9620 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
9621 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
9622 static void XPutPixel (XImage
*, int, int, COLORREF
);
9624 /* Non-zero means draw a cross on images having `:conversion
9627 int cross_disabled_images
;
9629 /* Edge detection matrices for different edge-detection
9632 static int emboss_matrix
[9] = {
9634 2, -1, 0, /* y - 1 */
9636 0, 1, -2 /* y + 1 */
9639 static int laplace_matrix
[9] = {
9641 1, 0, 0, /* y - 1 */
9643 0, 0, -1 /* y + 1 */
9646 /* Value is the intensity of the color whose red/green/blue values
9649 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
9652 /* On frame F, return an array of XColor structures describing image
9653 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
9654 non-zero means also fill the red/green/blue members of the XColor
9655 structures. Value is a pointer to the array of XColors structures,
9656 allocated with xmalloc; it must be freed by the caller. */
9659 x_to_xcolors (f
, img
, rgb_p
)
9669 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
9671 /* Load the image into a memory device context. */
9672 hdc
= get_frame_dc (f
);
9673 bmpdc
= CreateCompatibleDC (hdc
);
9674 release_frame_dc (f
, hdc
);
9675 prev
= SelectObject (bmpdc
, img
->pixmap
);
9677 /* Fill the `pixel' members of the XColor array. I wished there
9678 were an easy and portable way to circumvent XGetPixel. */
9680 for (y
= 0; y
< img
->height
; ++y
)
9684 for (x
= 0; x
< img
->width
; ++x
, ++p
)
9686 /* TODO: palette support needed here? */
9687 p
->pixel
= GetPixel (bmpdc
, x
, y
);
9691 p
->red
= 256 * GetRValue (p
->pixel
);
9692 p
->green
= 256 * GetGValue (p
->pixel
);
9693 p
->blue
= 256 * GetBValue (p
->pixel
);
9698 SelectObject (bmpdc
, prev
);
9704 /* Put a pixel of COLOR at position X, Y in XIMG. XIMG must have been
9705 created with CreateDIBSection, with the pointer to the bit values
9706 stored in ximg->data. */
9708 static void XPutPixel (ximg
, x
, y
, color
)
9713 int width
= ximg
->info
.bmiHeader
.biWidth
;
9714 int height
= ximg
->info
.bmiHeader
.biHeight
;
9715 unsigned char * pixel
;
9717 /* True color images. */
9718 if (ximg
->info
.bmiHeader
.biBitCount
== 24)
9720 int rowbytes
= width
* 3;
9721 /* Ensure scanlines are aligned on 4 byte boundaries. */
9723 rowbytes
+= 4 - (rowbytes
% 4);
9725 pixel
= ximg
->data
+ y
* rowbytes
+ x
* 3;
9726 /* Windows bitmaps are in BGR order. */
9727 *pixel
= GetBValue (color
);
9728 *(pixel
+ 1) = GetGValue (color
);
9729 *(pixel
+ 2) = GetRValue (color
);
9731 /* Monochrome images. */
9732 else if (ximg
->info
.bmiHeader
.biBitCount
== 1)
9734 int rowbytes
= width
/ 8;
9735 /* Ensure scanlines are aligned on 4 byte boundaries. */
9737 rowbytes
+= 4 - (rowbytes
% 4);
9738 pixel
= ximg
->data
+ y
* rowbytes
+ x
/ 8;
9739 /* Filter out palette info. */
9740 if (color
& 0x00ffffff)
9741 *pixel
= *pixel
| (1 << x
% 8);
9743 *pixel
= *pixel
& ~(1 << x
% 8);
9746 image_error ("XPutPixel: palette image not supported.", Qnil
, Qnil
);
9749 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
9750 RGB members are set. F is the frame on which this all happens.
9751 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
9754 x_from_xcolors (f
, img
, colors
)
9763 #if 0 /* TODO: color tables. */
9764 init_color_table ();
9766 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
9769 for (y
= 0; y
< img
->height
; ++y
)
9770 for (x
= 0; x
< img
->width
; ++x
, ++p
)
9772 unsigned long pixel
;
9773 #if 0 /* TODO: color tables. */
9774 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
9776 pixel
= PALETTERGB (p
->red
/ 256, p
->green
/ 256, p
->blue
/ 256);
9778 XPutPixel (oimg
, x
, y
, pixel
);
9782 x_clear_image_1 (f
, img
, 1, 0, 1);
9784 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
9785 x_destroy_x_image (oimg
);
9786 img
->pixmap
= pixmap
;
9787 #if 0 /* TODO: color tables. */
9788 img
->colors
= colors_in_color_table (&img
->ncolors
);
9789 free_color_table ();
9794 /* On frame F, perform edge-detection on image IMG.
9796 MATRIX is a nine-element array specifying the transformation
9797 matrix. See emboss_matrix for an example.
9799 COLOR_ADJUST is a color adjustment added to each pixel of the
9803 x_detect_edges (f
, img
, matrix
, color_adjust
)
9806 int matrix
[9], color_adjust
;
9808 XColor
*colors
= x_to_xcolors (f
, img
, 1);
9812 for (i
= sum
= 0; i
< 9; ++i
)
9813 sum
+= abs (matrix
[i
]);
9815 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
9817 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
9819 for (y
= 0; y
< img
->height
; ++y
)
9821 p
= COLOR (new, 0, y
);
9822 p
->red
= p
->green
= p
->blue
= 0xffff/2;
9823 p
= COLOR (new, img
->width
- 1, y
);
9824 p
->red
= p
->green
= p
->blue
= 0xffff/2;
9827 for (x
= 1; x
< img
->width
- 1; ++x
)
9829 p
= COLOR (new, x
, 0);
9830 p
->red
= p
->green
= p
->blue
= 0xffff/2;
9831 p
= COLOR (new, x
, img
->height
- 1);
9832 p
->red
= p
->green
= p
->blue
= 0xffff/2;
9835 for (y
= 1; y
< img
->height
- 1; ++y
)
9837 p
= COLOR (new, 1, y
);
9839 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
9841 int r
, g
, b
, y1
, x1
;
9844 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
9845 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
9848 XColor
*t
= COLOR (colors
, x1
, y1
);
9849 r
+= matrix
[i
] * t
->red
;
9850 g
+= matrix
[i
] * t
->green
;
9851 b
+= matrix
[i
] * t
->blue
;
9854 r
= (r
/ sum
+ color_adjust
) & 0xffff;
9855 g
= (g
/ sum
+ color_adjust
) & 0xffff;
9856 b
= (b
/ sum
+ color_adjust
) & 0xffff;
9857 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
9862 x_from_xcolors (f
, img
, new);
9868 /* Perform the pre-defined `emboss' edge-detection on image IMG
9876 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
9880 /* Transform image IMG which is used on frame F with a Laplace
9881 edge-detection algorithm. The result is an image that can be used
9882 to draw disabled buttons, for example. */
9889 x_detect_edges (f
, img
, laplace_matrix
, 45000);
9893 /* Perform edge-detection on image IMG on frame F, with specified
9894 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
9896 MATRIX must be either
9898 - a list of at least 9 numbers in row-major form
9899 - a vector of at least 9 numbers
9901 COLOR_ADJUST nil means use a default; otherwise it must be a
9905 x_edge_detection (f
, img
, matrix
, color_adjust
)
9908 Lisp_Object matrix
, color_adjust
;
9916 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
9917 ++i
, matrix
= XCDR (matrix
))
9918 trans
[i
] = XFLOATINT (XCAR (matrix
));
9920 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
9922 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
9923 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
9926 if (NILP (color_adjust
))
9927 color_adjust
= make_number (0xffff / 2);
9929 if (i
== 9 && NUMBERP (color_adjust
))
9930 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
9934 /* Transform image IMG on frame F so that it looks disabled. */
9937 x_disable_image (f
, img
)
9941 struct w32_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
9943 if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
>= 2)
9945 /* Color (or grayscale). Convert to gray, and equalize. Just
9946 drawing such images with a stipple can look very odd, so
9947 we're using this method instead. */
9948 XColor
*colors
= x_to_xcolors (f
, img
, 1);
9950 const int h
= 15000;
9951 const int l
= 30000;
9953 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
9957 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
9958 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
9959 p
->red
= p
->green
= p
->blue
= i2
;
9962 x_from_xcolors (f
, img
, colors
);
9965 /* Draw a cross over the disabled image, if we must or if we
9967 if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
< 2 || cross_disabled_images
)
9972 hdc
= get_frame_dc (f
);
9973 bmpdc
= CreateCompatibleDC (hdc
);
9974 release_frame_dc (f
, hdc
);
9976 prev
= SelectObject (bmpdc
, img
->pixmap
);
9978 SetTextColor (bmpdc
, BLACK_PIX_DEFAULT (f
));
9979 MoveToEx (bmpdc
, 0, 0, NULL
);
9980 LineTo (bmpdc
, img
->width
- 1, img
->height
- 1);
9981 MoveToEx (bmpdc
, 0, img
->height
- 1, NULL
);
9982 LineTo (bmpdc
, img
->width
- 1, 0);
9986 SelectObject (bmpdc
, img
->mask
);
9987 SetTextColor (bmpdc
, WHITE_PIX_DEFAULT (f
));
9988 MoveToEx (bmpdc
, 0, 0, NULL
);
9989 LineTo (bmpdc
, img
->width
- 1, img
->height
- 1);
9990 MoveToEx (bmpdc
, 0, img
->height
- 1, NULL
);
9991 LineTo (bmpdc
, img
->width
- 1, 0);
9993 SelectObject (bmpdc
, prev
);
9999 /* Build a mask for image IMG which is used on frame F. FILE is the
10000 name of an image file, for error messages. HOW determines how to
10001 determine the background color of IMG. If it is a list '(R G B)',
10002 with R, G, and B being integers >= 0, take that as the color of the
10003 background. Otherwise, determine the background color of IMG
10004 heuristically. Value is non-zero if successful. */
10007 x_build_heuristic_mask (f
, img
, how
)
10012 HDC img_dc
, frame_dc
;
10015 int x
, y
, rc
, use_img_background
;
10016 unsigned long bg
= 0;
10021 DeleteObject (img
->mask
);
10023 img
->background_transparent_valid
= 0;
10026 /* Create the bit array serving as mask. */
10027 row_width
= (img
->width
+ 7) / 8;
10028 mask_img
= xmalloc (row_width
* img
->height
);
10029 bzero (mask_img
, row_width
* img
->height
);
10031 /* Create a memory device context for IMG->pixmap. */
10032 frame_dc
= get_frame_dc (f
);
10033 img_dc
= CreateCompatibleDC (frame_dc
);
10034 release_frame_dc (f
, frame_dc
);
10035 prev
= SelectObject (img_dc
, img
->pixmap
);
10037 /* Determine the background color of img_dc. If HOW is `(R G B)'
10038 take that as color. Otherwise, use the image's background color. */
10039 use_img_background
= 1;
10045 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
10047 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
10051 if (i
== 3 && NILP (how
))
10053 char color_name
[30];
10054 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
10055 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0)
10056 & 0x00ffffff; /* Filter out palette info. */
10057 use_img_background
= 0;
10061 if (use_img_background
)
10062 bg
= four_corners_best (img_dc
, img
->width
, img
->height
);
10064 /* Set all bits in mask_img to 1 whose color in ximg is different
10065 from the background color bg. */
10066 for (y
= 0; y
< img
->height
; ++y
)
10067 for (x
= 0; x
< img
->width
; ++x
)
10069 COLORREF p
= GetPixel (img_dc
, x
, y
);
10071 mask_img
[y
* row_width
+ x
/ 8] |= 1 << (x
% 8);
10074 /* Create the mask image. */
10075 img
->mask
= w32_create_pixmap_from_bitmap_data (img
->width
, img
->height
,
10078 /* Fill in the background_transparent field while we have the mask handy. */
10079 SelectObject (img_dc
, img
->mask
);
10081 image_background_transparent (img
, f
, img_dc
);
10083 /* Put mask_img into img->mask. */
10084 x_destroy_x_image ((XImage
*)mask_img
);
10085 SelectObject (img_dc
, prev
);
10092 /***********************************************************************
10093 PBM (mono, gray, color)
10094 ***********************************************************************/
10096 static int pbm_image_p
P_ ((Lisp_Object object
));
10097 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
10098 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
10100 /* The symbol `pbm' identifying images of this type. */
10104 /* Indices of image specification fields in gs_format, below. */
10106 enum pbm_keyword_index
10115 PBM_HEURISTIC_MASK
,
10122 /* Vector of image_keyword structures describing the format
10123 of valid user-defined image specifications. */
10125 static struct image_keyword pbm_format
[PBM_LAST
] =
10127 {":type", IMAGE_SYMBOL_VALUE
, 1},
10128 {":file", IMAGE_STRING_VALUE
, 0},
10129 {":data", IMAGE_STRING_VALUE
, 0},
10130 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10131 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10132 {":relief", IMAGE_INTEGER_VALUE
, 0},
10133 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10134 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10135 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10136 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
10137 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10140 /* Structure describing the image type `pbm'. */
10142 static struct image_type pbm_type
=
10152 /* Return non-zero if OBJECT is a valid PBM image specification. */
10155 pbm_image_p (object
)
10156 Lisp_Object object
;
10158 struct image_keyword fmt
[PBM_LAST
];
10160 bcopy (pbm_format
, fmt
, sizeof fmt
);
10162 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
10165 /* Must specify either :data or :file. */
10166 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
10170 /* Scan a decimal number from *S and return it. Advance *S while
10171 reading the number. END is the end of the string. Value is -1 at
10175 pbm_scan_number (s
, end
)
10176 unsigned char **s
, *end
;
10182 /* Skip white-space. */
10183 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
10188 /* Skip comment to end of line. */
10189 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
10192 else if (isdigit (c
))
10194 /* Read decimal number. */
10196 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
10197 val
= 10 * val
+ c
- '0';
10208 /* Read FILE into memory. Value is a pointer to a buffer allocated
10209 with xmalloc holding FILE's contents. Value is null if an error
10210 occurred. *SIZE is set to the size of the file. */
10213 pbm_read_file (file
, size
)
10221 if (stat (SDATA (file
), &st
) == 0
10222 && (fp
= fopen (SDATA (file
), "rb")) != NULL
10223 && (buf
= (char *) xmalloc (st
.st_size
),
10224 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
10226 *size
= st
.st_size
;
10244 /* Load PBM image IMG for use on frame F. */
10252 int width
, height
, max_color_idx
= 0;
10254 Lisp_Object file
, specified_file
;
10255 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
10256 struct gcpro gcpro1
;
10257 unsigned char *contents
= NULL
;
10258 unsigned char *end
, *p
;
10261 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10265 if (STRINGP (specified_file
))
10267 file
= x_find_image_file (specified_file
);
10268 if (!STRINGP (file
))
10270 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10275 contents
= slurp_file (SDATA (file
), &size
);
10276 if (contents
== NULL
)
10278 image_error ("Error reading `%s'", file
, Qnil
);
10284 end
= contents
+ size
;
10289 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10291 end
= p
+ SBYTES (data
);
10294 /* Check magic number. */
10295 if (end
- p
< 2 || *p
++ != 'P')
10297 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10307 raw_p
= 0, type
= PBM_MONO
;
10311 raw_p
= 0, type
= PBM_GRAY
;
10315 raw_p
= 0, type
= PBM_COLOR
;
10319 raw_p
= 1, type
= PBM_MONO
;
10323 raw_p
= 1, type
= PBM_GRAY
;
10327 raw_p
= 1, type
= PBM_COLOR
;
10331 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10335 /* Read width, height, maximum color-component. Characters
10336 starting with `#' up to the end of a line are ignored. */
10337 width
= pbm_scan_number (&p
, end
);
10338 height
= pbm_scan_number (&p
, end
);
10340 if (type
!= PBM_MONO
)
10342 max_color_idx
= pbm_scan_number (&p
, end
);
10343 if (raw_p
&& max_color_idx
> 255)
10344 max_color_idx
= 255;
10349 || (type
!= PBM_MONO
&& max_color_idx
< 0))
10352 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
10355 #if 0 /* TODO: color tables. */
10356 /* Initialize the color hash table. */
10357 init_color_table ();
10360 if (type
== PBM_MONO
)
10363 struct image_keyword fmt
[PBM_LAST
];
10364 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
10365 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
10367 /* Parse the image specification. */
10368 bcopy (pbm_format
, fmt
, sizeof fmt
);
10369 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
10371 /* Get foreground and background colors, maybe allocate colors. */
10372 if (fmt
[PBM_FOREGROUND
].count
10373 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
10374 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
10375 if (fmt
[PBM_BACKGROUND
].count
10376 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
10378 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
10379 img
->background
= bg
;
10380 img
->background_valid
= 1;
10383 for (y
= 0; y
< height
; ++y
)
10384 for (x
= 0; x
< width
; ++x
)
10394 g
= pbm_scan_number (&p
, end
);
10396 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
10401 for (y
= 0; y
< height
; ++y
)
10402 for (x
= 0; x
< width
; ++x
)
10406 if (type
== PBM_GRAY
)
10407 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
10416 r
= pbm_scan_number (&p
, end
);
10417 g
= pbm_scan_number (&p
, end
);
10418 b
= pbm_scan_number (&p
, end
);
10421 if (r
< 0 || g
< 0 || b
< 0)
10423 x_destroy_x_image (ximg
);
10424 image_error ("Invalid pixel value in image `%s'",
10429 /* RGB values are now in the range 0..max_color_idx.
10430 Scale this to the range 0..0xff supported by W32. */
10431 r
= (int) ((double) r
* 255 / max_color_idx
);
10432 g
= (int) ((double) g
* 255 / max_color_idx
);
10433 b
= (int) ((double) b
* 255 / max_color_idx
);
10434 XPutPixel (ximg
, x
, y
,
10435 #if 0 /* TODO: color tables. */
10436 lookup_rgb_color (f
, r
, g
, b
));
10438 PALETTERGB (r
, g
, b
));
10443 #if 0 /* TODO: color tables. */
10444 /* Store in IMG->colors the colors allocated for the image, and
10445 free the color table. */
10446 img
->colors
= colors_in_color_table (&img
->ncolors
);
10447 free_color_table ();
10449 /* Maybe fill in the background field while we have ximg handy. */
10450 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10451 IMAGE_BACKGROUND (img
, f
, ximg
);
10453 /* Put the image into a pixmap. */
10454 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10455 x_destroy_x_image (ximg
);
10457 img
->width
= width
;
10458 img
->height
= height
;
10466 /***********************************************************************
10468 ***********************************************************************/
10474 /* Function prototypes. */
10476 static int png_image_p
P_ ((Lisp_Object object
));
10477 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
10479 /* The symbol `png' identifying images of this type. */
10483 /* Indices of image specification fields in png_format, below. */
10485 enum png_keyword_index
10494 PNG_HEURISTIC_MASK
,
10500 /* Vector of image_keyword structures describing the format
10501 of valid user-defined image specifications. */
10503 static struct image_keyword png_format
[PNG_LAST
] =
10505 {":type", IMAGE_SYMBOL_VALUE
, 1},
10506 {":data", IMAGE_STRING_VALUE
, 0},
10507 {":file", IMAGE_STRING_VALUE
, 0},
10508 {":ascent", IMAGE_ASCENT_VALUE
, 0},
10509 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10510 {":relief", IMAGE_INTEGER_VALUE
, 0},
10511 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10512 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10513 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10514 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10517 /* Structure describing the image type `png'. */
10519 static struct image_type png_type
=
10528 /* PNG library details. */
10530 DEF_IMGLIB_FN (png_get_io_ptr
);
10531 DEF_IMGLIB_FN (png_check_sig
);
10532 DEF_IMGLIB_FN (png_create_read_struct
);
10533 DEF_IMGLIB_FN (png_create_info_struct
);
10534 DEF_IMGLIB_FN (png_destroy_read_struct
);
10535 DEF_IMGLIB_FN (png_set_read_fn
);
10536 DEF_IMGLIB_FN (png_init_io
);
10537 DEF_IMGLIB_FN (png_set_sig_bytes
);
10538 DEF_IMGLIB_FN (png_read_info
);
10539 DEF_IMGLIB_FN (png_get_IHDR
);
10540 DEF_IMGLIB_FN (png_get_valid
);
10541 DEF_IMGLIB_FN (png_set_strip_16
);
10542 DEF_IMGLIB_FN (png_set_expand
);
10543 DEF_IMGLIB_FN (png_set_gray_to_rgb
);
10544 DEF_IMGLIB_FN (png_set_background
);
10545 DEF_IMGLIB_FN (png_get_bKGD
);
10546 DEF_IMGLIB_FN (png_read_update_info
);
10547 DEF_IMGLIB_FN (png_get_channels
);
10548 DEF_IMGLIB_FN (png_get_rowbytes
);
10549 DEF_IMGLIB_FN (png_read_image
);
10550 DEF_IMGLIB_FN (png_read_end
);
10551 DEF_IMGLIB_FN (png_error
);
10554 init_png_functions (library
)
10557 LOAD_IMGLIB_FN (library
, png_get_io_ptr
);
10558 LOAD_IMGLIB_FN (library
, png_check_sig
);
10559 LOAD_IMGLIB_FN (library
, png_create_read_struct
);
10560 LOAD_IMGLIB_FN (library
, png_create_info_struct
);
10561 LOAD_IMGLIB_FN (library
, png_destroy_read_struct
);
10562 LOAD_IMGLIB_FN (library
, png_set_read_fn
);
10563 LOAD_IMGLIB_FN (library
, png_init_io
);
10564 LOAD_IMGLIB_FN (library
, png_set_sig_bytes
);
10565 LOAD_IMGLIB_FN (library
, png_read_info
);
10566 LOAD_IMGLIB_FN (library
, png_get_IHDR
);
10567 LOAD_IMGLIB_FN (library
, png_get_valid
);
10568 LOAD_IMGLIB_FN (library
, png_set_strip_16
);
10569 LOAD_IMGLIB_FN (library
, png_set_expand
);
10570 LOAD_IMGLIB_FN (library
, png_set_gray_to_rgb
);
10571 LOAD_IMGLIB_FN (library
, png_set_background
);
10572 LOAD_IMGLIB_FN (library
, png_get_bKGD
);
10573 LOAD_IMGLIB_FN (library
, png_read_update_info
);
10574 LOAD_IMGLIB_FN (library
, png_get_channels
);
10575 LOAD_IMGLIB_FN (library
, png_get_rowbytes
);
10576 LOAD_IMGLIB_FN (library
, png_read_image
);
10577 LOAD_IMGLIB_FN (library
, png_read_end
);
10578 LOAD_IMGLIB_FN (library
, png_error
);
10582 /* Return non-zero if OBJECT is a valid PNG image specification. */
10585 png_image_p (object
)
10586 Lisp_Object object
;
10588 struct image_keyword fmt
[PNG_LAST
];
10589 bcopy (png_format
, fmt
, sizeof fmt
);
10591 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
10594 /* Must specify either the :data or :file keyword. */
10595 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
10599 /* Error and warning handlers installed when the PNG library
10603 my_png_error (png_ptr
, msg
)
10604 png_struct
*png_ptr
;
10607 xassert (png_ptr
!= NULL
);
10608 image_error ("PNG error: %s", build_string (msg
), Qnil
);
10609 longjmp (png_ptr
->jmpbuf
, 1);
10614 my_png_warning (png_ptr
, msg
)
10615 png_struct
*png_ptr
;
10618 xassert (png_ptr
!= NULL
);
10619 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
10622 /* Memory source for PNG decoding. */
10624 struct png_memory_storage
10626 unsigned char *bytes
; /* The data */
10627 size_t len
; /* How big is it? */
10628 int index
; /* Where are we? */
10632 /* Function set as reader function when reading PNG image from memory.
10633 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
10634 bytes from the input to DATA. */
10637 png_read_from_memory (png_ptr
, data
, length
)
10638 png_structp png_ptr
;
10642 struct png_memory_storage
*tbr
10643 = (struct png_memory_storage
*) fn_png_get_io_ptr (png_ptr
);
10645 if (length
> tbr
->len
- tbr
->index
)
10646 fn_png_error (png_ptr
, "Read error");
10648 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
10649 tbr
->index
= tbr
->index
+ length
;
10652 /* Load PNG image IMG for use on frame F. Value is non-zero if
10660 Lisp_Object file
, specified_file
;
10661 Lisp_Object specified_data
;
10663 XImage
*ximg
, *mask_img
= NULL
;
10664 struct gcpro gcpro1
;
10665 png_struct
*png_ptr
= NULL
;
10666 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
10667 FILE *volatile fp
= NULL
;
10669 png_byte
* volatile pixels
= NULL
;
10670 png_byte
** volatile rows
= NULL
;
10671 png_uint_32 width
, height
;
10672 int bit_depth
, color_type
, interlace_type
;
10674 png_uint_32 row_bytes
;
10676 double screen_gamma
, image_gamma
;
10678 struct png_memory_storage tbr
; /* Data to be read */
10680 /* Find out what file to load. */
10681 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10682 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10686 if (NILP (specified_data
))
10688 file
= x_find_image_file (specified_file
);
10689 if (!STRINGP (file
))
10691 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10696 /* Open the image file. */
10697 fp
= fopen (SDATA (file
), "rb");
10700 image_error ("Cannot open image file `%s'", file
, Qnil
);
10706 /* Check PNG signature. */
10707 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
10708 || !fn_png_check_sig (sig
, sizeof sig
))
10710 image_error ("Not a PNG file: `%s'", file
, Qnil
);
10718 /* Read from memory. */
10719 tbr
.bytes
= SDATA (specified_data
);
10720 tbr
.len
= SBYTES (specified_data
);
10723 /* Check PNG signature. */
10724 if (tbr
.len
< sizeof sig
10725 || !fn_png_check_sig (tbr
.bytes
, sizeof sig
))
10727 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
10732 /* Need to skip past the signature. */
10733 tbr
.bytes
+= sizeof (sig
);
10736 /* Initialize read and info structs for PNG lib. */
10737 png_ptr
= fn_png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
10738 my_png_error
, my_png_warning
);
10741 if (fp
) fclose (fp
);
10746 info_ptr
= fn_png_create_info_struct (png_ptr
);
10749 fn_png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
10750 if (fp
) fclose (fp
);
10755 end_info
= fn_png_create_info_struct (png_ptr
);
10758 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
10759 if (fp
) fclose (fp
);
10764 /* Set error jump-back. We come back here when the PNG library
10765 detects an error. */
10766 if (setjmp (png_ptr
->jmpbuf
))
10770 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
10773 if (fp
) fclose (fp
);
10778 /* Read image info. */
10779 if (!NILP (specified_data
))
10780 fn_png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
10782 fn_png_init_io (png_ptr
, fp
);
10784 fn_png_set_sig_bytes (png_ptr
, sizeof sig
);
10785 fn_png_read_info (png_ptr
, info_ptr
);
10786 fn_png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
10787 &interlace_type
, NULL
, NULL
);
10789 /* If image contains simply transparency data, we prefer to
10790 construct a clipping mask. */
10791 if (fn_png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
10796 /* This function is easier to write if we only have to handle
10797 one data format: RGB or RGBA with 8 bits per channel. Let's
10798 transform other formats into that format. */
10800 /* Strip more than 8 bits per channel. */
10801 if (bit_depth
== 16)
10802 fn_png_set_strip_16 (png_ptr
);
10804 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
10806 fn_png_set_expand (png_ptr
);
10808 /* Convert grayscale images to RGB. */
10809 if (color_type
== PNG_COLOR_TYPE_GRAY
10810 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
10811 fn_png_set_gray_to_rgb (png_ptr
);
10813 screen_gamma
= (f
->gamma
? 1 / f
->gamma
/ 0.45455 : 2.2);
10815 #if 0 /* Avoid double gamma correction for PNG images. */
10816 /* Tell the PNG lib to handle gamma correction for us. */
10817 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
10818 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
10819 /* The libpng documentation says this is right in this case. */
10820 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
10823 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
10824 /* Image contains gamma information. */
10825 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
10827 /* Use the standard default for the image gamma. */
10828 png_set_gamma (png_ptr
, screen_gamma
, 0.45455);
10831 /* Handle alpha channel by combining the image with a background
10832 color. Do this only if a real alpha channel is supplied. For
10833 simple transparency, we prefer a clipping mask. */
10834 if (!transparent_p
)
10836 png_color_16
*image_bg
;
10837 Lisp_Object specified_bg
10838 = image_spec_value (img
->spec
, QCbackground
, NULL
);
10840 if (STRINGP (specified_bg
))
10841 /* The user specified `:background', use that. */
10844 if (w32_defined_color (f
, SDATA (specified_bg
), &color
, 0))
10846 png_color_16 user_bg
;
10848 bzero (&user_bg
, sizeof user_bg
);
10849 user_bg
.red
= 256 * GetRValue (color
);
10850 user_bg
.green
= 256 * GetGValue (color
);
10851 user_bg
.blue
= 256 * GetBValue (color
);
10853 fn_png_set_background (png_ptr
, &user_bg
,
10854 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
10857 else if (fn_png_get_bKGD (png_ptr
, info_ptr
, &image_bg
))
10858 /* Image contains a background color with which to
10859 combine the image. */
10860 fn_png_set_background (png_ptr
, image_bg
,
10861 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
10864 /* Image does not contain a background color with which
10865 to combine the image data via an alpha channel. Use
10866 the frame's background instead. */
10868 png_color_16 frame_background
;
10869 color
= FRAME_BACKGROUND_PIXEL (f
);
10870 #if 0 /* TODO : Colormap support. */
10873 cmap
= FRAME_X_COLORMAP (f
);
10874 x_query_color (f
, &color
);
10877 bzero (&frame_background
, sizeof frame_background
);
10878 frame_background
.red
= 256 * GetRValue (color
);
10879 frame_background
.green
= 256 * GetGValue (color
);
10880 frame_background
.blue
= 256 * GetBValue (color
);
10882 fn_png_set_background (png_ptr
, &frame_background
,
10883 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
10887 /* Update info structure. */
10888 fn_png_read_update_info (png_ptr
, info_ptr
);
10890 /* Get number of channels. Valid values are 1 for grayscale images
10891 and images with a palette, 2 for grayscale images with transparency
10892 information (alpha channel), 3 for RGB images, and 4 for RGB
10893 images with alpha channel, i.e. RGBA. If conversions above were
10894 sufficient we should only have 3 or 4 channels here. */
10895 channels
= fn_png_get_channels (png_ptr
, info_ptr
);
10896 xassert (channels
== 3 || channels
== 4);
10898 /* Number of bytes needed for one row of the image. */
10899 row_bytes
= fn_png_get_rowbytes (png_ptr
, info_ptr
);
10901 /* Allocate memory for the image. */
10902 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
10903 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
10904 for (i
= 0; i
< height
; ++i
)
10905 rows
[i
] = pixels
+ i
* row_bytes
;
10907 /* Read the entire image. */
10908 fn_png_read_image (png_ptr
, rows
);
10909 fn_png_read_end (png_ptr
, info_ptr
);
10916 /* Create the X image and pixmap. */
10917 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
10921 /* Create an image and pixmap serving as mask if the PNG image
10922 contains an alpha channel. */
10925 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
10926 &mask_img
, &img
->mask
))
10928 x_destroy_x_image (ximg
);
10929 DeleteObject (img
->pixmap
);
10933 /* Fill the X image and mask from PNG data. */
10934 #if 0 /* TODO: Color tables. */
10935 init_color_table ();
10938 for (y
= 0; y
< height
; ++y
)
10940 png_byte
*p
= rows
[y
];
10942 for (x
= 0; x
< width
; ++x
)
10949 #if 0 /* TODO: Color tables. */
10950 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
10952 XPutPixel (ximg
, x
, y
, PALETTERGB (r
, g
, b
));
10954 /* An alpha channel, aka mask channel, associates variable
10955 transparency with an image. Where other image formats
10956 support binary transparency---fully transparent or fully
10957 opaque---PNG allows up to 254 levels of partial transparency.
10958 The PNG library implements partial transparency by combining
10959 the image with a specified background color.
10961 I'm not sure how to handle this here nicely: because the
10962 background on which the image is displayed may change, for
10963 real alpha channel support, it would be necessary to create
10964 a new image for each possible background.
10966 What I'm doing now is that a mask is created if we have
10967 boolean transparency information. Otherwise I'm using
10968 the frame's background color to combine the image with. */
10973 XPutPixel (mask_img
, x
, y
, *p
> 0);
10979 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10980 /* Set IMG's background color from the PNG image, unless the user
10984 if (fn_png_get_bKGD (png_ptr
, info_ptr
, &bg
))
10986 #if 0 /* TODO: Color tables. */
10987 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
10989 img
->background
= PALETTERGB (bg
->red
/ 256, bg
->green
/ 256,
10992 img
->background_valid
= 1;
10996 #if 0 /* TODO: Color tables. */
10997 /* Remember colors allocated for this image. */
10998 img
->colors
= colors_in_color_table (&img
->ncolors
);
10999 free_color_table ();
11003 fn_png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
11007 img
->width
= width
;
11008 img
->height
= height
;
11010 /* Maybe fill in the background field while we have ximg handy. */
11011 IMAGE_BACKGROUND (img
, f
, ximg
);
11013 /* Put the image into the pixmap, then free the X image and its buffer. */
11014 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11015 x_destroy_x_image (ximg
);
11017 /* Same for the mask. */
11020 /* Fill in the background_transparent field while we have the mask
11022 image_background_transparent (img
, f
, mask_img
);
11024 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
11025 x_destroy_x_image (mask_img
);
11032 #endif /* HAVE_PNG != 0 */
11036 /***********************************************************************
11038 ***********************************************************************/
11042 /* Work around a warning about HAVE_STDLIB_H being redefined in
11044 #ifdef HAVE_STDLIB_H
11045 #define HAVE_STDLIB_H_1
11046 #undef HAVE_STDLIB_H
11047 #endif /* HAVE_STLIB_H */
11049 #include <jpeglib.h>
11050 #include <jerror.h>
11051 #include <setjmp.h>
11053 #ifdef HAVE_STLIB_H_1
11054 #define HAVE_STDLIB_H 1
11057 static int jpeg_image_p
P_ ((Lisp_Object object
));
11058 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
11060 /* The symbol `jpeg' identifying images of this type. */
11064 /* Indices of image specification fields in gs_format, below. */
11066 enum jpeg_keyword_index
11075 JPEG_HEURISTIC_MASK
,
11081 /* Vector of image_keyword structures describing the format
11082 of valid user-defined image specifications. */
11084 static struct image_keyword jpeg_format
[JPEG_LAST
] =
11086 {":type", IMAGE_SYMBOL_VALUE
, 1},
11087 {":data", IMAGE_STRING_VALUE
, 0},
11088 {":file", IMAGE_STRING_VALUE
, 0},
11089 {":ascent", IMAGE_ASCENT_VALUE
, 0},
11090 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11091 {":relief", IMAGE_INTEGER_VALUE
, 0},
11092 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11093 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11094 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11095 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11098 /* Structure describing the image type `jpeg'. */
11100 static struct image_type jpeg_type
=
11110 /* JPEG library details. */
11111 DEF_IMGLIB_FN (jpeg_CreateDecompress
);
11112 DEF_IMGLIB_FN (jpeg_start_decompress
);
11113 DEF_IMGLIB_FN (jpeg_finish_decompress
);
11114 DEF_IMGLIB_FN (jpeg_destroy_decompress
);
11115 DEF_IMGLIB_FN (jpeg_read_header
);
11116 DEF_IMGLIB_FN (jpeg_read_scanlines
);
11117 DEF_IMGLIB_FN (jpeg_stdio_src
);
11118 DEF_IMGLIB_FN (jpeg_std_error
);
11119 DEF_IMGLIB_FN (jpeg_resync_to_restart
);
11122 init_jpeg_functions (library
)
11125 LOAD_IMGLIB_FN (library
, jpeg_finish_decompress
);
11126 LOAD_IMGLIB_FN (library
, jpeg_read_scanlines
);
11127 LOAD_IMGLIB_FN (library
, jpeg_start_decompress
);
11128 LOAD_IMGLIB_FN (library
, jpeg_read_header
);
11129 LOAD_IMGLIB_FN (library
, jpeg_stdio_src
);
11130 LOAD_IMGLIB_FN (library
, jpeg_CreateDecompress
);
11131 LOAD_IMGLIB_FN (library
, jpeg_destroy_decompress
);
11132 LOAD_IMGLIB_FN (library
, jpeg_std_error
);
11133 LOAD_IMGLIB_FN (library
, jpeg_resync_to_restart
);
11137 /* Wrapper since we can't directly assign the function pointer
11138 to another function pointer that was declared more completely easily. */
11140 jpeg_resync_to_restart_wrapper(cinfo
, desired
)
11141 j_decompress_ptr cinfo
;
11144 return fn_jpeg_resync_to_restart (cinfo
, desired
);
11148 /* Return non-zero if OBJECT is a valid JPEG image specification. */
11151 jpeg_image_p (object
)
11152 Lisp_Object object
;
11154 struct image_keyword fmt
[JPEG_LAST
];
11156 bcopy (jpeg_format
, fmt
, sizeof fmt
);
11158 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
11161 /* Must specify either the :data or :file keyword. */
11162 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
11166 struct my_jpeg_error_mgr
11168 struct jpeg_error_mgr pub
;
11169 jmp_buf setjmp_buffer
;
11174 my_error_exit (cinfo
)
11175 j_common_ptr cinfo
;
11177 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
11178 longjmp (mgr
->setjmp_buffer
, 1);
11182 /* Init source method for JPEG data source manager. Called by
11183 jpeg_read_header() before any data is actually read. See
11184 libjpeg.doc from the JPEG lib distribution. */
11187 our_init_source (cinfo
)
11188 j_decompress_ptr cinfo
;
11193 /* Fill input buffer method for JPEG data source manager. Called
11194 whenever more data is needed. We read the whole image in one step,
11195 so this only adds a fake end of input marker at the end. */
11198 our_fill_input_buffer (cinfo
)
11199 j_decompress_ptr cinfo
;
11201 /* Insert a fake EOI marker. */
11202 struct jpeg_source_mgr
*src
= cinfo
->src
;
11203 static JOCTET buffer
[2];
11205 buffer
[0] = (JOCTET
) 0xFF;
11206 buffer
[1] = (JOCTET
) JPEG_EOI
;
11208 src
->next_input_byte
= buffer
;
11209 src
->bytes_in_buffer
= 2;
11214 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
11215 is the JPEG data source manager. */
11218 our_skip_input_data (cinfo
, num_bytes
)
11219 j_decompress_ptr cinfo
;
11222 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11226 if (num_bytes
> src
->bytes_in_buffer
)
11227 ERREXIT (cinfo
, JERR_INPUT_EOF
);
11229 src
->bytes_in_buffer
-= num_bytes
;
11230 src
->next_input_byte
+= num_bytes
;
11235 /* Method to terminate data source. Called by
11236 jpeg_finish_decompress() after all data has been processed. */
11239 our_term_source (cinfo
)
11240 j_decompress_ptr cinfo
;
11245 /* Set up the JPEG lib for reading an image from DATA which contains
11246 LEN bytes. CINFO is the decompression info structure created for
11247 reading the image. */
11250 jpeg_memory_src (cinfo
, data
, len
)
11251 j_decompress_ptr cinfo
;
11255 struct jpeg_source_mgr
*src
;
11257 if (cinfo
->src
== NULL
)
11259 /* First time for this JPEG object? */
11260 cinfo
->src
= (struct jpeg_source_mgr
*)
11261 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
11262 sizeof (struct jpeg_source_mgr
));
11263 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11264 src
->next_input_byte
= data
;
11267 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11268 src
->init_source
= our_init_source
;
11269 src
->fill_input_buffer
= our_fill_input_buffer
;
11270 src
->skip_input_data
= our_skip_input_data
;
11271 src
->resync_to_restart
= jpeg_resync_to_restart_wrapper
; /* Use default method. */
11272 src
->term_source
= our_term_source
;
11273 src
->bytes_in_buffer
= len
;
11274 src
->next_input_byte
= data
;
11278 /* Load image IMG for use on frame F. Patterned after example.c
11279 from the JPEG lib. */
11286 struct jpeg_decompress_struct cinfo
;
11287 struct my_jpeg_error_mgr mgr
;
11288 Lisp_Object file
, specified_file
;
11289 Lisp_Object specified_data
;
11290 FILE * volatile fp
= NULL
;
11292 int row_stride
, x
, y
;
11293 XImage
*ximg
= NULL
;
11295 unsigned long *colors
;
11297 struct gcpro gcpro1
;
11299 /* Open the JPEG file. */
11300 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11301 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11305 if (NILP (specified_data
))
11307 file
= x_find_image_file (specified_file
);
11308 if (!STRINGP (file
))
11310 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11315 fp
= fopen (SDATA (file
), "rb");
11318 image_error ("Cannot open `%s'", file
, Qnil
);
11324 /* Customize libjpeg's error handling to call my_error_exit when an
11325 error is detected. This function will perform a longjmp. */
11326 cinfo
.err
= fn_jpeg_std_error (&mgr
.pub
);
11327 mgr
.pub
.error_exit
= my_error_exit
;
11329 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
11333 /* Called from my_error_exit. Display a JPEG error. */
11334 char buffer
[JMSG_LENGTH_MAX
];
11335 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
11336 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
11337 build_string (buffer
));
11340 /* Close the input file and destroy the JPEG object. */
11342 fclose ((FILE *) fp
);
11343 fn_jpeg_destroy_decompress (&cinfo
);
11345 /* If we already have an XImage, free that. */
11346 x_destroy_x_image (ximg
);
11348 /* Free pixmap and colors. */
11349 x_clear_image (f
, img
);
11355 /* Create the JPEG decompression object. Let it read from fp.
11356 Read the JPEG image header. */
11357 fn_jpeg_CreateDecompress (&cinfo
, JPEG_LIB_VERSION
, sizeof (cinfo
));
11359 if (NILP (specified_data
))
11360 fn_jpeg_stdio_src (&cinfo
, (FILE *) fp
);
11362 jpeg_memory_src (&cinfo
, SDATA (specified_data
),
11363 SBYTES (specified_data
));
11365 fn_jpeg_read_header (&cinfo
, TRUE
);
11367 /* Customize decompression so that color quantization will be used.
11368 Start decompression. */
11369 cinfo
.quantize_colors
= TRUE
;
11370 fn_jpeg_start_decompress (&cinfo
);
11371 width
= img
->width
= cinfo
.output_width
;
11372 height
= img
->height
= cinfo
.output_height
;
11374 /* Create X image and pixmap. */
11375 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11376 longjmp (mgr
.setjmp_buffer
, 2);
11378 /* Allocate colors. When color quantization is used,
11379 cinfo.actual_number_of_colors has been set with the number of
11380 colors generated, and cinfo.colormap is a two-dimensional array
11381 of color indices in the range 0..cinfo.actual_number_of_colors.
11382 No more than 255 colors will be generated. */
11386 if (cinfo
.out_color_components
> 2)
11387 ir
= 0, ig
= 1, ib
= 2;
11388 else if (cinfo
.out_color_components
> 1)
11389 ir
= 0, ig
= 1, ib
= 0;
11391 ir
= 0, ig
= 0, ib
= 0;
11393 #if 0 /* TODO: Color tables. */
11394 /* Use the color table mechanism because it handles colors that
11395 cannot be allocated nicely. Such colors will be replaced with
11396 a default color, and we don't have to care about which colors
11397 can be freed safely, and which can't. */
11398 init_color_table ();
11400 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
11403 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
11405 int r
= cinfo
.colormap
[ir
][i
];
11406 int g
= cinfo
.colormap
[ig
][i
];
11407 int b
= cinfo
.colormap
[ib
][i
];
11408 #if 0 /* TODO: Color tables. */
11409 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
11411 colors
[i
] = PALETTERGB (r
, g
, b
);
11415 #if 0 /* TODO: Color tables. */
11416 /* Remember those colors actually allocated. */
11417 img
->colors
= colors_in_color_table (&img
->ncolors
);
11418 free_color_table ();
11423 row_stride
= width
* cinfo
.output_components
;
11424 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
11426 for (y
= 0; y
< height
; ++y
)
11428 fn_jpeg_read_scanlines (&cinfo
, buffer
, 1);
11429 for (x
= 0; x
< cinfo
.output_width
; ++x
)
11430 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
11434 fn_jpeg_finish_decompress (&cinfo
);
11435 fn_jpeg_destroy_decompress (&cinfo
);
11437 fclose ((FILE *) fp
);
11439 /* Maybe fill in the background field while we have ximg handy. */
11440 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11441 IMAGE_BACKGROUND (img
, f
, ximg
);
11443 /* Put the image into the pixmap. */
11444 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11445 x_destroy_x_image (ximg
);
11450 #endif /* HAVE_JPEG */
11454 /***********************************************************************
11456 ***********************************************************************/
11460 #include <tiffio.h>
11462 static int tiff_image_p
P_ ((Lisp_Object object
));
11463 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
11465 /* The symbol `tiff' identifying images of this type. */
11469 /* Indices of image specification fields in tiff_format, below. */
11471 enum tiff_keyword_index
11480 TIFF_HEURISTIC_MASK
,
11486 /* Vector of image_keyword structures describing the format
11487 of valid user-defined image specifications. */
11489 static struct image_keyword tiff_format
[TIFF_LAST
] =
11491 {":type", IMAGE_SYMBOL_VALUE
, 1},
11492 {":data", IMAGE_STRING_VALUE
, 0},
11493 {":file", IMAGE_STRING_VALUE
, 0},
11494 {":ascent", IMAGE_ASCENT_VALUE
, 0},
11495 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11496 {":relief", IMAGE_INTEGER_VALUE
, 0},
11497 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11498 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11499 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11500 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11503 /* Structure describing the image type `tiff'. */
11505 static struct image_type tiff_type
=
11514 /* TIFF library details. */
11515 DEF_IMGLIB_FN (TIFFSetErrorHandler
);
11516 DEF_IMGLIB_FN (TIFFSetWarningHandler
);
11517 DEF_IMGLIB_FN (TIFFOpen
);
11518 DEF_IMGLIB_FN (TIFFClientOpen
);
11519 DEF_IMGLIB_FN (TIFFGetField
);
11520 DEF_IMGLIB_FN (TIFFReadRGBAImage
);
11521 DEF_IMGLIB_FN (TIFFClose
);
11524 init_tiff_functions (library
)
11527 LOAD_IMGLIB_FN (library
, TIFFSetErrorHandler
);
11528 LOAD_IMGLIB_FN (library
, TIFFSetWarningHandler
);
11529 LOAD_IMGLIB_FN (library
, TIFFOpen
);
11530 LOAD_IMGLIB_FN (library
, TIFFClientOpen
);
11531 LOAD_IMGLIB_FN (library
, TIFFGetField
);
11532 LOAD_IMGLIB_FN (library
, TIFFReadRGBAImage
);
11533 LOAD_IMGLIB_FN (library
, TIFFClose
);
11537 /* Return non-zero if OBJECT is a valid TIFF image specification. */
11540 tiff_image_p (object
)
11541 Lisp_Object object
;
11543 struct image_keyword fmt
[TIFF_LAST
];
11544 bcopy (tiff_format
, fmt
, sizeof fmt
);
11546 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
11549 /* Must specify either the :data or :file keyword. */
11550 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
11554 /* Reading from a memory buffer for TIFF images Based on the PNG
11555 memory source, but we have to provide a lot of extra functions.
11558 We really only need to implement read and seek, but I am not
11559 convinced that the TIFF library is smart enough not to destroy
11560 itself if we only hand it the function pointers we need to
11565 unsigned char *bytes
;
11569 tiff_memory_source
;
11572 tiff_read_from_memory (data
, buf
, size
)
11577 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11579 if (size
> src
->len
- src
->index
)
11580 return (size_t) -1;
11581 bcopy (src
->bytes
+ src
->index
, buf
, size
);
11582 src
->index
+= size
;
11587 tiff_write_from_memory (data
, buf
, size
)
11592 return (size_t) -1;
11596 tiff_seek_in_memory (data
, off
, whence
)
11601 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11606 case SEEK_SET
: /* Go from beginning of source. */
11610 case SEEK_END
: /* Go from end of source. */
11611 idx
= src
->len
+ off
;
11614 case SEEK_CUR
: /* Go from current position. */
11615 idx
= src
->index
+ off
;
11618 default: /* Invalid `whence'. */
11622 if (idx
> src
->len
|| idx
< 0)
11630 tiff_close_memory (data
)
11638 tiff_mmap_memory (data
, pbase
, psize
)
11643 /* It is already _IN_ memory. */
11648 tiff_unmap_memory (data
, base
, size
)
11653 /* We don't need to do this. */
11657 tiff_size_of_memory (data
)
11660 return ((tiff_memory_source
*) data
)->len
;
11665 tiff_error_handler (title
, format
, ap
)
11666 const char *title
, *format
;
11672 len
= sprintf (buf
, "TIFF error: %s ", title
);
11673 vsprintf (buf
+ len
, format
, ap
);
11674 add_to_log (buf
, Qnil
, Qnil
);
11679 tiff_warning_handler (title
, format
, ap
)
11680 const char *title
, *format
;
11686 len
= sprintf (buf
, "TIFF warning: %s ", title
);
11687 vsprintf (buf
+ len
, format
, ap
);
11688 add_to_log (buf
, Qnil
, Qnil
);
11692 /* Load TIFF image IMG for use on frame F. Value is non-zero if
11700 Lisp_Object file
, specified_file
;
11701 Lisp_Object specified_data
;
11703 int width
, height
, x
, y
;
11707 struct gcpro gcpro1
;
11708 tiff_memory_source memsrc
;
11710 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11711 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11715 fn_TIFFSetErrorHandler (tiff_error_handler
);
11716 fn_TIFFSetWarningHandler (tiff_warning_handler
);
11718 if (NILP (specified_data
))
11720 /* Read from a file */
11721 file
= x_find_image_file (specified_file
);
11722 if (!STRINGP (file
))
11724 image_error ("Cannot find image file `%s'", file
, Qnil
);
11729 /* Try to open the image file. */
11730 tiff
= fn_TIFFOpen (SDATA (file
), "r");
11733 image_error ("Cannot open `%s'", file
, Qnil
);
11740 /* Memory source! */
11741 memsrc
.bytes
= SDATA (specified_data
);
11742 memsrc
.len
= SBYTES (specified_data
);
11745 tiff
= fn_TIFFClientOpen ("memory_source", "r", &memsrc
,
11746 (TIFFReadWriteProc
) tiff_read_from_memory
,
11747 (TIFFReadWriteProc
) tiff_write_from_memory
,
11748 tiff_seek_in_memory
,
11750 tiff_size_of_memory
,
11752 tiff_unmap_memory
);
11756 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
11762 /* Get width and height of the image, and allocate a raster buffer
11763 of width x height 32-bit values. */
11764 fn_TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
11765 fn_TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
11766 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
11768 rc
= fn_TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
11769 fn_TIFFClose (tiff
);
11772 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
11778 /* Create the X image and pixmap. */
11779 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11786 #if 0 /* TODO: Color tables. */
11787 /* Initialize the color table. */
11788 init_color_table ();
11791 /* Process the pixel raster. Origin is in the lower-left corner. */
11792 for (y
= 0; y
< height
; ++y
)
11794 uint32
*row
= buf
+ y
* width
;
11796 for (x
= 0; x
< width
; ++x
)
11798 uint32 abgr
= row
[x
];
11799 int r
= TIFFGetR (abgr
);
11800 int g
= TIFFGetG (abgr
);
11801 int b
= TIFFGetB (abgr
);
11802 #if 0 /* TODO: Color tables. */
11803 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
11805 XPutPixel (ximg
, x
, height
- 1 - y
, PALETTERGB (r
, g
, b
));
11810 #if 0 /* TODO: Color tables. */
11811 /* Remember the colors allocated for the image. Free the color table. */
11812 img
->colors
= colors_in_color_table (&img
->ncolors
);
11813 free_color_table ();
11816 img
->width
= width
;
11817 img
->height
= height
;
11819 /* Maybe fill in the background field while we have ximg handy. */
11820 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11821 IMAGE_BACKGROUND (img
, f
, ximg
);
11823 /* Put the image into the pixmap, then free the X image and its buffer. */
11824 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11825 x_destroy_x_image (ximg
);
11832 #endif /* HAVE_TIFF != 0 */
11836 /***********************************************************************
11838 ***********************************************************************/
11842 #define DrawText gif_DrawText
11843 #include <gif_lib.h>
11846 static int gif_image_p
P_ ((Lisp_Object object
));
11847 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
11849 /* The symbol `gif' identifying images of this type. */
11853 /* Indices of image specification fields in gif_format, below. */
11855 enum gif_keyword_index
11864 GIF_HEURISTIC_MASK
,
11871 /* Vector of image_keyword structures describing the format
11872 of valid user-defined image specifications. */
11874 static struct image_keyword gif_format
[GIF_LAST
] =
11876 {":type", IMAGE_SYMBOL_VALUE
, 1},
11877 {":data", IMAGE_STRING_VALUE
, 0},
11878 {":file", IMAGE_STRING_VALUE
, 0},
11879 {":ascent", IMAGE_ASCENT_VALUE
, 0},
11880 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11881 {":relief", IMAGE_INTEGER_VALUE
, 0},
11882 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11883 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11884 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11885 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11886 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11889 /* Structure describing the image type `gif'. */
11891 static struct image_type gif_type
=
11901 /* GIF library details. */
11902 DEF_IMGLIB_FN (DGifCloseFile
);
11903 DEF_IMGLIB_FN (DGifSlurp
);
11904 DEF_IMGLIB_FN (DGifOpen
);
11905 DEF_IMGLIB_FN (DGifOpenFileName
);
11908 init_gif_functions (library
)
11911 LOAD_IMGLIB_FN (library
, DGifCloseFile
);
11912 LOAD_IMGLIB_FN (library
, DGifSlurp
);
11913 LOAD_IMGLIB_FN (library
, DGifOpen
);
11914 LOAD_IMGLIB_FN (library
, DGifOpenFileName
);
11919 /* Return non-zero if OBJECT is a valid GIF image specification. */
11922 gif_image_p (object
)
11923 Lisp_Object object
;
11925 struct image_keyword fmt
[GIF_LAST
];
11926 bcopy (gif_format
, fmt
, sizeof fmt
);
11928 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
11931 /* Must specify either the :data or :file keyword. */
11932 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
11935 /* Reading a GIF image from memory
11936 Based on the PNG memory stuff to a certain extent. */
11940 unsigned char *bytes
;
11946 /* Make the current memory source available to gif_read_from_memory.
11947 It's done this way because not all versions of libungif support
11948 a UserData field in the GifFileType structure. */
11949 static gif_memory_source
*current_gif_memory_src
;
11952 gif_read_from_memory (file
, buf
, len
)
11957 gif_memory_source
*src
= current_gif_memory_src
;
11959 if (len
> src
->len
- src
->index
)
11962 bcopy (src
->bytes
+ src
->index
, buf
, len
);
11968 /* Load GIF image IMG for use on frame F. Value is non-zero if
11976 Lisp_Object file
, specified_file
;
11977 Lisp_Object specified_data
;
11978 int rc
, width
, height
, x
, y
, i
;
11980 ColorMapObject
*gif_color_map
;
11981 unsigned long pixel_colors
[256];
11983 struct gcpro gcpro1
;
11985 int ino
, image_left
, image_top
, image_width
, image_height
;
11986 gif_memory_source memsrc
;
11987 unsigned char *raster
;
11989 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11990 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11994 if (NILP (specified_data
))
11996 file
= x_find_image_file (specified_file
);
11997 if (!STRINGP (file
))
11999 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
12004 /* Open the GIF file. */
12005 gif
= fn_DGifOpenFileName (SDATA (file
));
12008 image_error ("Cannot open `%s'", file
, Qnil
);
12015 /* Read from memory! */
12016 current_gif_memory_src
= &memsrc
;
12017 memsrc
.bytes
= SDATA (specified_data
);
12018 memsrc
.len
= SBYTES (specified_data
);
12021 gif
= fn_DGifOpen(&memsrc
, gif_read_from_memory
);
12024 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
12030 /* Read entire contents. */
12031 rc
= fn_DGifSlurp (gif
);
12032 if (rc
== GIF_ERROR
)
12034 image_error ("Error reading `%s'", img
->spec
, Qnil
);
12035 fn_DGifCloseFile (gif
);
12040 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
12041 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
12042 if (ino
>= gif
->ImageCount
)
12044 image_error ("Invalid image number `%s' in image `%s'",
12046 fn_DGifCloseFile (gif
);
12051 width
= img
->width
= max (gif
->SWidth
, gif
->Image
.Left
+ gif
->Image
.Width
);
12052 height
= img
->height
= max (gif
->SHeight
, gif
->Image
.Top
+ gif
->Image
.Height
);
12054 /* Create the X image and pixmap. */
12055 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12057 fn_DGifCloseFile (gif
);
12062 /* Allocate colors. */
12063 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
12064 if (!gif_color_map
)
12065 gif_color_map
= gif
->SColorMap
;
12066 #if 0 /* TODO: Color tables */
12067 init_color_table ();
12069 bzero (pixel_colors
, sizeof pixel_colors
);
12071 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
12073 int r
= gif_color_map
->Colors
[i
].Red
;
12074 int g
= gif_color_map
->Colors
[i
].Green
;
12075 int b
= gif_color_map
->Colors
[i
].Blue
;
12076 #if 0 /* TODO: Color tables */
12077 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
12079 pixel_colors
[i
] = PALETTERGB (r
, g
, b
);
12083 #if 0 /* TODO: Color tables */
12084 img
->colors
= colors_in_color_table (&img
->ncolors
);
12085 free_color_table ();
12088 /* Clear the part of the screen image that are not covered by
12089 the image from the GIF file. Full animated GIF support
12090 requires more than can be done here (see the gif89 spec,
12091 disposal methods). Let's simply assume that the part
12092 not covered by a sub-image is in the frame's background color. */
12093 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
12094 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
12095 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
12096 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
12098 for (y
= 0; y
< image_top
; ++y
)
12099 for (x
= 0; x
< width
; ++x
)
12100 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12102 for (y
= image_top
+ image_height
; y
< height
; ++y
)
12103 for (x
= 0; x
< width
; ++x
)
12104 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12106 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
12108 for (x
= 0; x
< image_left
; ++x
)
12109 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12110 for (x
= image_left
+ image_width
; x
< width
; ++x
)
12111 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12114 /* Read the GIF image into the X image. We use a local variable
12115 `raster' here because RasterBits below is a char *, and invites
12116 problems with bytes >= 0x80. */
12117 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
12119 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
12121 static int interlace_start
[] = {0, 4, 2, 1};
12122 static int interlace_increment
[] = {8, 8, 4, 2};
12124 int row
= interlace_start
[0];
12128 for (y
= 0; y
< image_height
; y
++)
12130 if (row
>= image_height
)
12132 row
= interlace_start
[++pass
];
12133 while (row
>= image_height
)
12134 row
= interlace_start
[++pass
];
12137 for (x
= 0; x
< image_width
; x
++)
12139 int i
= raster
[(y
* image_width
) + x
];
12140 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
12144 row
+= interlace_increment
[pass
];
12149 for (y
= 0; y
< image_height
; ++y
)
12150 for (x
= 0; x
< image_width
; ++x
)
12152 int i
= raster
[y
* image_width
+ x
];
12153 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
12157 fn_DGifCloseFile (gif
);
12159 /* Maybe fill in the background field while we have ximg handy. */
12160 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12161 IMAGE_BACKGROUND (img
, f
, ximg
);
12163 /* Put the image into the pixmap, then free the X image and its buffer. */
12164 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12165 x_destroy_x_image (ximg
);
12171 #endif /* HAVE_GIF != 0 */
12175 /***********************************************************************
12177 ***********************************************************************/
12179 Lisp_Object Qpostscript
;
12181 /* Keyword symbols. */
12183 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
12185 #ifdef HAVE_GHOSTSCRIPT
12186 static int gs_image_p
P_ ((Lisp_Object object
));
12187 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
12188 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
12190 /* The symbol `postscript' identifying images of this type. */
12192 /* Keyword symbols. */
12194 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
12196 /* Indices of image specification fields in gs_format, below. */
12198 enum gs_keyword_index
12216 /* Vector of image_keyword structures describing the format
12217 of valid user-defined image specifications. */
12219 static struct image_keyword gs_format
[GS_LAST
] =
12221 {":type", IMAGE_SYMBOL_VALUE
, 1},
12222 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12223 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12224 {":file", IMAGE_STRING_VALUE
, 1},
12225 {":loader", IMAGE_FUNCTION_VALUE
, 0},
12226 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
12227 {":ascent", IMAGE_ASCENT_VALUE
, 0},
12228 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12229 {":relief", IMAGE_INTEGER_VALUE
, 0},
12230 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12231 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12232 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12233 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12236 /* Structure describing the image type `ghostscript'. */
12238 static struct image_type gs_type
=
12248 /* Free X resources of Ghostscript image IMG which is used on frame F. */
12251 gs_clear_image (f
, img
)
12255 /* IMG->data.ptr_val may contain a recorded colormap. */
12256 xfree (img
->data
.ptr_val
);
12257 x_clear_image (f
, img
);
12261 /* Return non-zero if OBJECT is a valid Ghostscript image
12265 gs_image_p (object
)
12266 Lisp_Object object
;
12268 struct image_keyword fmt
[GS_LAST
];
12272 bcopy (gs_format
, fmt
, sizeof fmt
);
12274 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
12277 /* Bounding box must be a list or vector containing 4 integers. */
12278 tem
= fmt
[GS_BOUNDING_BOX
].value
;
12281 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
12282 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
12287 else if (VECTORP (tem
))
12289 if (XVECTOR (tem
)->size
!= 4)
12291 for (i
= 0; i
< 4; ++i
)
12292 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
12302 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
12311 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
12312 struct gcpro gcpro1
, gcpro2
;
12314 double in_width
, in_height
;
12315 Lisp_Object pixel_colors
= Qnil
;
12317 /* Compute pixel size of pixmap needed from the given size in the
12318 image specification. Sizes in the specification are in pt. 1 pt
12319 = 1/72 in, xdpi and ydpi are stored in the frame's X display
12321 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
12322 in_width
= XFASTINT (pt_width
) / 72.0;
12323 img
->width
= in_width
* FRAME_W32_DISPLAY_INFO (f
)->resx
;
12324 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
12325 in_height
= XFASTINT (pt_height
) / 72.0;
12326 img
->height
= in_height
* FRAME_W32_DISPLAY_INFO (f
)->resy
;
12328 /* Create the pixmap. */
12330 xassert (img
->pixmap
== 0);
12331 img
->pixmap
= XCreatePixmap (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12332 img
->width
, img
->height
,
12333 one_w32_display_info
.n_cbits
);
12338 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
12342 /* Call the loader to fill the pixmap. It returns a process object
12343 if successful. We do not record_unwind_protect here because
12344 other places in redisplay like calling window scroll functions
12345 don't either. Let the Lisp loader use `unwind-protect' instead. */
12346 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
12348 sprintf (buffer
, "%lu %lu",
12349 (unsigned long) FRAME_W32_WINDOW (f
),
12350 (unsigned long) img
->pixmap
);
12351 window_and_pixmap_id
= build_string (buffer
);
12353 sprintf (buffer
, "%lu %lu",
12354 FRAME_FOREGROUND_PIXEL (f
),
12355 FRAME_BACKGROUND_PIXEL (f
));
12356 pixel_colors
= build_string (buffer
);
12358 XSETFRAME (frame
, f
);
12359 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
12361 loader
= intern ("gs-load-image");
12363 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
12364 make_number (img
->width
),
12365 make_number (img
->height
),
12366 window_and_pixmap_id
,
12369 return PROCESSP (img
->data
.lisp_val
);
12373 /* Kill the Ghostscript process that was started to fill PIXMAP on
12374 frame F. Called from XTread_socket when receiving an event
12375 telling Emacs that Ghostscript has finished drawing. */
12378 x_kill_gs_process (pixmap
, f
)
12382 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
12386 /* Find the image containing PIXMAP. */
12387 for (i
= 0; i
< c
->used
; ++i
)
12388 if (c
->images
[i
]->pixmap
== pixmap
)
12391 /* Should someone in between have cleared the image cache, for
12392 instance, give up. */
12396 /* Kill the GS process. We should have found PIXMAP in the image
12397 cache and its image should contain a process object. */
12398 img
= c
->images
[i
];
12399 xassert (PROCESSP (img
->data
.lisp_val
));
12400 Fkill_process (img
->data
.lisp_val
, Qnil
);
12401 img
->data
.lisp_val
= Qnil
;
12403 /* On displays with a mutable colormap, figure out the colors
12404 allocated for the image by looking at the pixels of an XImage for
12406 class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
12407 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
12413 /* Try to get an XImage for img->pixmep. */
12414 ximg
= XGetImage (FRAME_W32_DISPLAY (f
), img
->pixmap
,
12415 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
12420 /* Initialize the color table. */
12421 init_color_table ();
12423 /* For each pixel of the image, look its color up in the
12424 color table. After having done so, the color table will
12425 contain an entry for each color used by the image. */
12426 for (y
= 0; y
< img
->height
; ++y
)
12427 for (x
= 0; x
< img
->width
; ++x
)
12429 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
12430 lookup_pixel_color (f
, pixel
);
12433 /* Record colors in the image. Free color table and XImage. */
12434 img
->colors
= colors_in_color_table (&img
->ncolors
);
12435 free_color_table ();
12436 XDestroyImage (ximg
);
12438 #if 0 /* This doesn't seem to be the case. If we free the colors
12439 here, we get a BadAccess later in x_clear_image when
12440 freeing the colors. */
12441 /* We have allocated colors once, but Ghostscript has also
12442 allocated colors on behalf of us. So, to get the
12443 reference counts right, free them once. */
12445 x_free_colors (FRAME_W32_DISPLAY (f
), cmap
,
12446 img
->colors
, img
->ncolors
, 0);
12450 image_error ("Cannot get X image of `%s'; colors will not be freed",
12456 /* Now that we have the pixmap, compute mask and transform the
12457 image if requested. */
12459 postprocess_image (f
, img
);
12463 #endif /* HAVE_GHOSTSCRIPT */
12466 /***********************************************************************
12468 ***********************************************************************/
12470 DEFUN ("x-change-window-property", Fx_change_window_property
,
12471 Sx_change_window_property
, 2, 3, 0,
12472 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
12473 PROP and VALUE must be strings. FRAME nil or omitted means use the
12474 selected frame. Value is VALUE. */)
12475 (prop
, value
, frame
)
12476 Lisp_Object frame
, prop
, value
;
12478 #if 0 /* TODO : port window properties to W32 */
12479 struct frame
*f
= check_x_frame (frame
);
12482 CHECK_STRING (prop
);
12483 CHECK_STRING (value
);
12486 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
12487 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12488 prop_atom
, XA_STRING
, 8, PropModeReplace
,
12489 SDATA (value
), SCHARS (value
));
12491 /* Make sure the property is set when we return. */
12492 XFlush (FRAME_W32_DISPLAY (f
));
12501 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
12502 Sx_delete_window_property
, 1, 2, 0,
12503 doc
: /* Remove window property PROP from X window of FRAME.
12504 FRAME nil or omitted means use the selected frame. Value is PROP. */)
12506 Lisp_Object prop
, frame
;
12508 #if 0 /* TODO : port window properties to W32 */
12510 struct frame
*f
= check_x_frame (frame
);
12513 CHECK_STRING (prop
);
12515 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
12516 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
12518 /* Make sure the property is removed when we return. */
12519 XFlush (FRAME_W32_DISPLAY (f
));
12527 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
12529 doc
: /* Value is the value of window property PROP on FRAME.
12530 If FRAME is nil or omitted, use the selected frame. Value is nil
12531 if FRAME hasn't a property with name PROP or if PROP has no string
12534 Lisp_Object prop
, frame
;
12536 #if 0 /* TODO : port window properties to W32 */
12538 struct frame
*f
= check_x_frame (frame
);
12541 Lisp_Object prop_value
= Qnil
;
12542 char *tmp_data
= NULL
;
12545 unsigned long actual_size
, bytes_remaining
;
12547 CHECK_STRING (prop
);
12549 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
12550 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12551 prop_atom
, 0, 0, False
, XA_STRING
,
12552 &actual_type
, &actual_format
, &actual_size
,
12553 &bytes_remaining
, (unsigned char **) &tmp_data
);
12556 int size
= bytes_remaining
;
12561 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12562 prop_atom
, 0, bytes_remaining
,
12564 &actual_type
, &actual_format
,
12565 &actual_size
, &bytes_remaining
,
12566 (unsigned char **) &tmp_data
);
12568 prop_value
= make_string (tmp_data
, size
);
12583 /***********************************************************************
12585 ***********************************************************************/
12587 /* If non-null, an asynchronous timer that, when it expires, displays
12588 an hourglass cursor on all frames. */
12590 static struct atimer
*hourglass_atimer
;
12592 /* Non-zero means an hourglass cursor is currently shown. */
12594 static int hourglass_shown_p
;
12596 /* Number of seconds to wait before displaying an hourglass cursor. */
12598 static Lisp_Object Vhourglass_delay
;
12600 /* Default number of seconds to wait before displaying an hourglass
12603 #define DEFAULT_HOURGLASS_DELAY 1
12605 /* Function prototypes. */
12607 static void show_hourglass
P_ ((struct atimer
*));
12608 static void hide_hourglass
P_ ((void));
12611 /* Cancel a currently active hourglass timer, and start a new one. */
12616 #if 0 /* TODO: cursor shape changes. */
12618 int secs
, usecs
= 0;
12620 cancel_hourglass ();
12622 if (INTEGERP (Vhourglass_delay
)
12623 && XINT (Vhourglass_delay
) > 0)
12624 secs
= XFASTINT (Vhourglass_delay
);
12625 else if (FLOATP (Vhourglass_delay
)
12626 && XFLOAT_DATA (Vhourglass_delay
) > 0)
12629 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
12630 secs
= XFASTINT (tem
);
12631 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
12634 secs
= DEFAULT_HOURGLASS_DELAY
;
12636 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
12637 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
12638 show_hourglass
, NULL
);
12643 /* Cancel the hourglass cursor timer if active, hide an hourglass
12644 cursor if shown. */
12647 cancel_hourglass ()
12649 if (hourglass_atimer
)
12651 cancel_atimer (hourglass_atimer
);
12652 hourglass_atimer
= NULL
;
12655 if (hourglass_shown_p
)
12660 /* Timer function of hourglass_atimer. TIMER is equal to
12663 Display an hourglass cursor on all frames by mapping the frames'
12664 hourglass_window. Set the hourglass_p flag in the frames'
12665 output_data.x structure to indicate that an hourglass cursor is
12666 shown on the frames. */
12669 show_hourglass (timer
)
12670 struct atimer
*timer
;
12672 #if 0 /* TODO: cursor shape changes. */
12673 /* The timer implementation will cancel this timer automatically
12674 after this function has run. Set hourglass_atimer to null
12675 so that we know the timer doesn't have to be canceled. */
12676 hourglass_atimer
= NULL
;
12678 if (!hourglass_shown_p
)
12680 Lisp_Object rest
, frame
;
12684 FOR_EACH_FRAME (rest
, frame
)
12685 if (FRAME_W32_P (XFRAME (frame
)))
12687 struct frame
*f
= XFRAME (frame
);
12689 f
->output_data
.w32
->hourglass_p
= 1;
12691 if (!f
->output_data
.w32
->hourglass_window
)
12693 unsigned long mask
= CWCursor
;
12694 XSetWindowAttributes attrs
;
12696 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
12698 f
->output_data
.w32
->hourglass_window
12699 = XCreateWindow (FRAME_X_DISPLAY (f
),
12700 FRAME_OUTER_WINDOW (f
),
12701 0, 0, 32000, 32000, 0, 0,
12707 XMapRaised (FRAME_X_DISPLAY (f
),
12708 f
->output_data
.w32
->hourglass_window
);
12709 XFlush (FRAME_X_DISPLAY (f
));
12712 hourglass_shown_p
= 1;
12719 /* Hide the hourglass cursor on all frames, if it is currently shown. */
12724 #if 0 /* TODO: cursor shape changes. */
12725 if (hourglass_shown_p
)
12727 Lisp_Object rest
, frame
;
12730 FOR_EACH_FRAME (rest
, frame
)
12732 struct frame
*f
= XFRAME (frame
);
12734 if (FRAME_W32_P (f
)
12735 /* Watch out for newly created frames. */
12736 && f
->output_data
.x
->hourglass_window
)
12738 XUnmapWindow (FRAME_X_DISPLAY (f
),
12739 f
->output_data
.x
->hourglass_window
);
12740 /* Sync here because XTread_socket looks at the
12741 hourglass_p flag that is reset to zero below. */
12742 XSync (FRAME_X_DISPLAY (f
), False
);
12743 f
->output_data
.x
->hourglass_p
= 0;
12747 hourglass_shown_p
= 0;
12755 /***********************************************************************
12757 ***********************************************************************/
12759 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
12760 Lisp_Object
, Lisp_Object
));
12761 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
12762 Lisp_Object
, int, int, int *, int *));
12764 /* The frame of a currently visible tooltip. */
12766 Lisp_Object tip_frame
;
12768 /* If non-nil, a timer started that hides the last tooltip when it
12771 Lisp_Object tip_timer
;
12774 /* If non-nil, a vector of 3 elements containing the last args
12775 with which x-show-tip was called. See there. */
12777 Lisp_Object last_show_tip_args
;
12779 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
12781 Lisp_Object Vx_max_tooltip_size
;
12785 unwind_create_tip_frame (frame
)
12788 Lisp_Object deleted
;
12790 deleted
= unwind_create_frame (frame
);
12791 if (EQ (deleted
, Qt
))
12801 /* Create a frame for a tooltip on the display described by DPYINFO.
12802 PARMS is a list of frame parameters. TEXT is the string to
12803 display in the tip frame. Value is the frame.
12805 Note that functions called here, esp. x_default_parameter can
12806 signal errors, for instance when a specified color name is
12807 undefined. We have to make sure that we're in a consistent state
12808 when this happens. */
12811 x_create_tip_frame (dpyinfo
, parms
, text
)
12812 struct w32_display_info
*dpyinfo
;
12813 Lisp_Object parms
, text
;
12816 Lisp_Object frame
, tem
;
12818 long window_prompting
= 0;
12820 int count
= SPECPDL_INDEX ();
12821 struct gcpro gcpro1
, gcpro2
, gcpro3
;
12823 int face_change_count_before
= face_change_count
;
12824 Lisp_Object buffer
;
12825 struct buffer
*old_buffer
;
12829 /* Use this general default value to start with until we know if
12830 this frame has a specified name. */
12831 Vx_resource_name
= Vinvocation_name
;
12833 #ifdef MULTI_KBOARD
12834 kb
= dpyinfo
->kboard
;
12836 kb
= &the_only_kboard
;
12839 /* Get the name of the frame to use for resource lookup. */
12840 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
12841 if (!STRINGP (name
)
12842 && !EQ (name
, Qunbound
)
12844 error ("Invalid frame name--not a string or nil");
12845 Vx_resource_name
= name
;
12848 GCPRO3 (parms
, name
, frame
);
12849 /* Make a frame without minibuffer nor mode-line. */
12850 f
= make_frame (0);
12851 f
->wants_modeline
= 0;
12852 XSETFRAME (frame
, f
);
12854 buffer
= Fget_buffer_create (build_string (" *tip*"));
12855 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
, Qnil
);
12856 old_buffer
= current_buffer
;
12857 set_buffer_internal_1 (XBUFFER (buffer
));
12858 current_buffer
->truncate_lines
= Qnil
;
12860 Finsert (1, &text
);
12861 set_buffer_internal_1 (old_buffer
);
12863 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
12864 record_unwind_protect (unwind_create_tip_frame
, frame
);
12866 /* By setting the output method, we're essentially saying that
12867 the frame is live, as per FRAME_LIVE_P. If we get a signal
12868 from this point on, x_destroy_window might screw up reference
12870 f
->output_method
= output_w32
;
12871 f
->output_data
.w32
=
12872 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
12873 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
12875 FRAME_FONTSET (f
) = -1;
12876 f
->icon_name
= Qnil
;
12878 #if 0 /* GLYPH_DEBUG TODO: image support. */
12879 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
12880 dpyinfo_refcount
= dpyinfo
->reference_count
;
12881 #endif /* GLYPH_DEBUG */
12882 #ifdef MULTI_KBOARD
12883 FRAME_KBOARD (f
) = kb
;
12885 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
12886 f
->output_data
.w32
->explicit_parent
= 0;
12888 /* Set the name; the functions to which we pass f expect the name to
12890 if (EQ (name
, Qunbound
) || NILP (name
))
12892 f
->name
= build_string (dpyinfo
->w32_id_name
);
12893 f
->explicit_name
= 0;
12898 f
->explicit_name
= 1;
12899 /* use the frame's title when getting resources for this frame. */
12900 specbind (Qx_resource_name
, name
);
12903 /* Extract the window parameters from the supplied values
12904 that are needed to determine window geometry. */
12908 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
12911 /* First, try whatever font the caller has specified. */
12912 if (STRINGP (font
))
12914 tem
= Fquery_fontset (font
, Qnil
);
12916 font
= x_new_fontset (f
, tem
);
12918 font
= x_new_font (f
, SDATA (font
));
12921 /* Try out a font which we hope has bold and italic variations. */
12922 if (!STRINGP (font
))
12923 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
12924 if (! STRINGP (font
))
12925 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
12926 /* If those didn't work, look for something which will at least work. */
12927 if (! STRINGP (font
))
12928 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
12930 if (! STRINGP (font
))
12931 font
= build_string ("Fixedsys");
12933 x_default_parameter (f
, parms
, Qfont
, font
,
12934 "font", "Font", RES_TYPE_STRING
);
12937 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
12938 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
12939 /* This defaults to 2 in order to match xterm. We recognize either
12940 internalBorderWidth or internalBorder (which is what xterm calls
12942 if (NILP (Fassq (Qinternal_border_width
, parms
)))
12946 value
= w32_get_arg (parms
, Qinternal_border_width
,
12947 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
12948 if (! EQ (value
, Qunbound
))
12949 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
12952 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
12953 "internalBorderWidth", "internalBorderWidth",
12956 /* Also do the stuff which must be set before the window exists. */
12957 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
12958 "foreground", "Foreground", RES_TYPE_STRING
);
12959 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
12960 "background", "Background", RES_TYPE_STRING
);
12961 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
12962 "pointerColor", "Foreground", RES_TYPE_STRING
);
12963 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
12964 "cursorColor", "Foreground", RES_TYPE_STRING
);
12965 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
12966 "borderColor", "BorderColor", RES_TYPE_STRING
);
12968 /* Init faces before x_default_parameter is called for scroll-bar
12969 parameters because that function calls x_set_scroll_bar_width,
12970 which calls change_frame_size, which calls Fset_window_buffer,
12971 which runs hooks, which call Fvertical_motion. At the end, we
12972 end up in init_iterator with a null face cache, which should not
12974 init_frame_faces (f
);
12976 f
->output_data
.w32
->dwStyle
= WS_BORDER
| WS_POPUP
| WS_DISABLED
;
12977 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
12979 window_prompting
= x_figure_window_size (f
, parms
, 0);
12981 /* No fringes on tip frame. */
12982 f
->fringe_cols
= 0;
12983 f
->left_fringe_width
= 0;
12984 f
->right_fringe_width
= 0;
12987 my_create_tip_window (f
);
12992 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
12993 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
12994 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
12995 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
12996 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
12997 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
12999 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
13000 Change will not be effected unless different from the current
13001 FRAME_LINES (f). */
13002 width
= FRAME_COLS (f
);
13003 height
= FRAME_LINES (f
);
13004 FRAME_LINES (f
) = 0;
13005 SET_FRAME_COLS (f
, 0);
13006 change_frame_size (f
, height
, width
, 1, 0, 0);
13008 /* Add `tooltip' frame parameter's default value. */
13009 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
13010 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
13013 /* Set up faces after all frame parameters are known. This call
13014 also merges in face attributes specified for new frames.
13016 Frame parameters may be changed if .Xdefaults contains
13017 specifications for the default font. For example, if there is an
13018 `Emacs.default.attributeBackground: pink', the `background-color'
13019 attribute of the frame get's set, which let's the internal border
13020 of the tooltip frame appear in pink. Prevent this. */
13022 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
13024 /* Set tip_frame here, so that */
13026 call1 (Qface_set_after_frame_default
, frame
);
13028 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
13029 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
13037 /* It is now ok to make the frame official even if we get an error
13038 below. And the frame needs to be on Vframe_list or making it
13039 visible won't work. */
13040 Vframe_list
= Fcons (frame
, Vframe_list
);
13042 /* Now that the frame is official, it counts as a reference to
13044 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
13046 /* Setting attributes of faces of the tooltip frame from resources
13047 and similar will increment face_change_count, which leads to the
13048 clearing of all current matrices. Since this isn't necessary
13049 here, avoid it by resetting face_change_count to the value it
13050 had before we created the tip frame. */
13051 face_change_count
= face_change_count_before
;
13053 /* Discard the unwind_protect. */
13054 return unbind_to (count
, frame
);
13058 /* Compute where to display tip frame F. PARMS is the list of frame
13059 parameters for F. DX and DY are specified offsets from the current
13060 location of the mouse. WIDTH and HEIGHT are the width and height
13061 of the tooltip. Return coordinates relative to the root window of
13062 the display in *ROOT_X, and *ROOT_Y. */
13065 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
13067 Lisp_Object parms
, dx
, dy
;
13069 int *root_x
, *root_y
;
13071 Lisp_Object left
, top
;
13073 /* User-specified position? */
13074 left
= Fcdr (Fassq (Qleft
, parms
));
13075 top
= Fcdr (Fassq (Qtop
, parms
));
13077 /* Move the tooltip window where the mouse pointer is. Resize and
13079 if (!INTEGERP (left
) || !INTEGERP (top
))
13084 GetCursorPos (&pt
);
13090 if (INTEGERP (top
))
13091 *root_y
= XINT (top
);
13092 else if (*root_y
+ XINT (dy
) - height
< 0)
13093 *root_y
-= XINT (dy
);
13097 *root_y
+= XINT (dy
);
13100 if (INTEGERP (left
))
13101 *root_x
= XINT (left
);
13102 else if (*root_x
+ XINT (dx
) + width
<= FRAME_W32_DISPLAY_INFO (f
)->width
)
13103 /* It fits to the right of the pointer. */
13104 *root_x
+= XINT (dx
);
13105 else if (width
+ XINT (dx
) <= *root_x
)
13106 /* It fits to the left of the pointer. */
13107 *root_x
-= width
+ XINT (dx
);
13109 /* Put it left justified on the screen -- it ought to fit that way. */
13114 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
13115 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
13116 A tooltip window is a small window displaying a string.
13118 FRAME nil or omitted means use the selected frame.
13120 PARMS is an optional list of frame parameters which can be
13121 used to change the tooltip's appearance.
13123 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
13124 means use the default timeout of 5 seconds.
13126 If the list of frame parameters PARAMS contains a `left' parameter,
13127 the tooltip is displayed at that x-position. Otherwise it is
13128 displayed at the mouse position, with offset DX added (default is 5 if
13129 DX isn't specified). Likewise for the y-position; if a `top' frame
13130 parameter is specified, it determines the y-position of the tooltip
13131 window, otherwise it is displayed at the mouse position, with offset
13132 DY added (default is -10).
13134 A tooltip's maximum size is specified by `x-max-tooltip-size'.
13135 Text larger than the specified size is clipped. */)
13136 (string
, frame
, parms
, timeout
, dx
, dy
)
13137 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
13141 int root_x
, root_y
;
13142 struct buffer
*old_buffer
;
13143 struct text_pos pos
;
13144 int i
, width
, height
;
13145 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
13146 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
13147 int count
= SPECPDL_INDEX ();
13149 specbind (Qinhibit_redisplay
, Qt
);
13151 GCPRO4 (string
, parms
, frame
, timeout
);
13153 CHECK_STRING (string
);
13154 f
= check_x_frame (frame
);
13155 if (NILP (timeout
))
13156 timeout
= make_number (5);
13158 CHECK_NATNUM (timeout
);
13161 dx
= make_number (5);
13166 dy
= make_number (-10);
13170 if (NILP (last_show_tip_args
))
13171 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
13173 if (!NILP (tip_frame
))
13175 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
13176 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
13177 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
13179 if (EQ (frame
, last_frame
)
13180 && !NILP (Fequal (last_string
, string
))
13181 && !NILP (Fequal (last_parms
, parms
)))
13183 struct frame
*f
= XFRAME (tip_frame
);
13185 /* Only DX and DY have changed. */
13186 if (!NILP (tip_timer
))
13188 Lisp_Object timer
= tip_timer
;
13190 call1 (Qcancel_timer
, timer
);
13194 compute_tip_xy (f
, parms
, dx
, dy
, FRAME_PIXEL_WIDTH (f
),
13195 FRAME_PIXEL_HEIGHT (f
), &root_x
, &root_y
);
13197 /* Put tooltip in topmost group and in position. */
13198 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
13199 root_x
, root_y
, 0, 0,
13200 SWP_NOSIZE
| SWP_NOACTIVATE
);
13202 /* Ensure tooltip is on top of other topmost windows (eg menus). */
13203 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
13205 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
13212 /* Hide a previous tip, if any. */
13215 ASET (last_show_tip_args
, 0, string
);
13216 ASET (last_show_tip_args
, 1, frame
);
13217 ASET (last_show_tip_args
, 2, parms
);
13219 /* Add default values to frame parameters. */
13220 if (NILP (Fassq (Qname
, parms
)))
13221 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
13222 if (NILP (Fassq (Qinternal_border_width
, parms
)))
13223 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
13224 if (NILP (Fassq (Qborder_width
, parms
)))
13225 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
13226 if (NILP (Fassq (Qborder_color
, parms
)))
13227 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
13228 if (NILP (Fassq (Qbackground_color
, parms
)))
13229 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
13232 /* Block input until the tip has been fully drawn, to avoid crashes
13233 when drawing tips in menus. */
13236 /* Create a frame for the tooltip, and record it in the global
13237 variable tip_frame. */
13238 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
, string
);
13239 f
= XFRAME (frame
);
13241 /* Set up the frame's root window. */
13242 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
13243 w
->left_col
= w
->top_line
= make_number (0);
13245 if (CONSP (Vx_max_tooltip_size
)
13246 && INTEGERP (XCAR (Vx_max_tooltip_size
))
13247 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
13248 && INTEGERP (XCDR (Vx_max_tooltip_size
))
13249 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
13251 w
->total_cols
= XCAR (Vx_max_tooltip_size
);
13252 w
->total_lines
= XCDR (Vx_max_tooltip_size
);
13256 w
->total_cols
= make_number (80);
13257 w
->total_lines
= make_number (40);
13260 FRAME_TOTAL_COLS (f
) = XINT (w
->total_cols
);
13262 w
->pseudo_window_p
= 1;
13264 /* Display the tooltip text in a temporary buffer. */
13265 old_buffer
= current_buffer
;
13266 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
13267 current_buffer
->truncate_lines
= Qnil
;
13268 clear_glyph_matrix (w
->desired_matrix
);
13269 clear_glyph_matrix (w
->current_matrix
);
13270 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
13271 try_window (FRAME_ROOT_WINDOW (f
), pos
);
13273 /* Compute width and height of the tooltip. */
13274 width
= height
= 0;
13275 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
13277 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
13278 struct glyph
*last
;
13281 /* Stop at the first empty row at the end. */
13282 if (!row
->enabled_p
|| !row
->displays_text_p
)
13285 /* Let the row go over the full width of the frame. */
13286 row
->full_width_p
= 1;
13288 #ifdef TODO /* Investigate why some fonts need more width than is
13289 calculated for some tooltips. */
13290 /* There's a glyph at the end of rows that is use to place
13291 the cursor there. Don't include the width of this glyph. */
13292 if (row
->used
[TEXT_AREA
])
13294 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
13295 row_width
= row
->pixel_width
- last
->pixel_width
;
13299 row_width
= row
->pixel_width
;
13301 /* TODO: find why tips do not draw along baseline as instructed. */
13302 height
+= row
->height
;
13303 width
= max (width
, row_width
);
13306 /* Add the frame's internal border to the width and height the X
13307 window should have. */
13308 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13309 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13311 /* Move the tooltip window where the mouse pointer is. Resize and
13313 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
13316 /* Adjust Window size to take border into account. */
13318 rect
.left
= rect
.top
= 0;
13319 rect
.right
= width
;
13320 rect
.bottom
= height
;
13321 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
13322 FRAME_EXTERNAL_MENU_BAR (f
));
13324 /* Position and size tooltip, and put it in the topmost group. */
13325 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
13326 root_x
, root_y
, rect
.right
- rect
.left
,
13327 rect
.bottom
- rect
.top
, SWP_NOACTIVATE
);
13329 /* Ensure tooltip is on top of other topmost windows (eg menus). */
13330 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
13332 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
13334 /* Let redisplay know that we have made the frame visible already. */
13335 f
->async_visible
= 1;
13337 ShowWindow (FRAME_W32_WINDOW (f
), SW_SHOWNOACTIVATE
);
13340 /* Draw into the window. */
13341 w
->must_be_updated_p
= 1;
13342 update_single_window (w
, 1);
13346 /* Restore original current buffer. */
13347 set_buffer_internal_1 (old_buffer
);
13348 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
13351 /* Let the tip disappear after timeout seconds. */
13352 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
13353 intern ("x-hide-tip"));
13356 return unbind_to (count
, Qnil
);
13360 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
13361 doc
: /* Hide the current tooltip window, if there is any.
13362 Value is t if tooltip was open, nil otherwise. */)
13366 Lisp_Object deleted
, frame
, timer
;
13367 struct gcpro gcpro1
, gcpro2
;
13369 /* Return quickly if nothing to do. */
13370 if (NILP (tip_timer
) && NILP (tip_frame
))
13375 GCPRO2 (frame
, timer
);
13376 tip_frame
= tip_timer
= deleted
= Qnil
;
13378 count
= SPECPDL_INDEX ();
13379 specbind (Qinhibit_redisplay
, Qt
);
13380 specbind (Qinhibit_quit
, Qt
);
13383 call1 (Qcancel_timer
, timer
);
13385 if (FRAMEP (frame
))
13387 Fdelete_frame (frame
, Qnil
);
13392 return unbind_to (count
, deleted
);
13397 /***********************************************************************
13398 File selection dialog
13399 ***********************************************************************/
13400 extern Lisp_Object Qfile_name_history
;
13402 /* Callback for altering the behaviour of the Open File dialog.
13403 Makes the Filename text field contain "Current Directory" and be
13404 read-only when "Directories" is selected in the filter. This
13405 allows us to work around the fact that the standard Open File
13406 dialog does not support directories. */
13408 file_dialog_callback (hwnd
, msg
, wParam
, lParam
)
13414 if (msg
== WM_NOTIFY
)
13416 OFNOTIFY
* notify
= (OFNOTIFY
*)lParam
;
13417 /* Detect when the Filter dropdown is changed. */
13418 if (notify
->hdr
.code
== CDN_TYPECHANGE
)
13420 HWND dialog
= GetParent (hwnd
);
13421 HWND edit_control
= GetDlgItem (dialog
, FILE_NAME_TEXT_FIELD
);
13423 /* Directories is in index 2. */
13424 if (notify
->lpOFN
->nFilterIndex
== 2)
13426 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
13427 "Current Directory");
13428 EnableWindow (edit_control
, FALSE
);
13432 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
13434 EnableWindow (edit_control
, TRUE
);
13441 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
13442 doc
: /* Read file name, prompting with PROMPT in directory DIR.
13443 Use a file selection dialog.
13444 Select DEFAULT-FILENAME in the dialog's file selection box, if
13445 specified. Ensure that file exists if MUSTMATCH is non-nil. */)
13446 (prompt
, dir
, default_filename
, mustmatch
)
13447 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
13449 struct frame
*f
= SELECTED_FRAME ();
13450 Lisp_Object file
= Qnil
;
13451 int count
= SPECPDL_INDEX ();
13452 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
13453 char filename
[MAX_PATH
+ 1];
13454 char init_dir
[MAX_PATH
+ 1];
13456 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
13457 CHECK_STRING (prompt
);
13458 CHECK_STRING (dir
);
13460 /* Create the dialog with PROMPT as title, using DIR as initial
13461 directory and using "*" as pattern. */
13462 dir
= Fexpand_file_name (dir
, Qnil
);
13463 strncpy (init_dir
, SDATA (dir
), MAX_PATH
);
13464 init_dir
[MAX_PATH
] = '\0';
13465 unixtodos_filename (init_dir
);
13467 if (STRINGP (default_filename
))
13469 char *file_name_only
;
13470 char *full_path_name
= SDATA (default_filename
);
13472 unixtodos_filename (full_path_name
);
13474 file_name_only
= strrchr (full_path_name
, '\\');
13475 if (!file_name_only
)
13476 file_name_only
= full_path_name
;
13482 strncpy (filename
, file_name_only
, MAX_PATH
);
13483 filename
[MAX_PATH
] = '\0';
13486 filename
[0] = '\0';
13489 OPENFILENAME file_details
;
13491 /* Prevent redisplay. */
13492 specbind (Qinhibit_redisplay
, Qt
);
13495 bzero (&file_details
, sizeof (file_details
));
13496 file_details
.lStructSize
= sizeof (file_details
);
13497 file_details
.hwndOwner
= FRAME_W32_WINDOW (f
);
13498 /* Undocumented Bug in Common File Dialog:
13499 If a filter is not specified, shell links are not resolved. */
13500 file_details
.lpstrFilter
= "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
13501 file_details
.lpstrFile
= filename
;
13502 file_details
.nMaxFile
= sizeof (filename
);
13503 file_details
.lpstrInitialDir
= init_dir
;
13504 file_details
.lpstrTitle
= SDATA (prompt
);
13505 file_details
.Flags
= (OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
13506 | OFN_EXPLORER
| OFN_ENABLEHOOK
);
13507 if (!NILP (mustmatch
))
13508 file_details
.Flags
|= OFN_FILEMUSTEXIST
| OFN_PATHMUSTEXIST
;
13510 file_details
.lpfnHook
= (LPOFNHOOKPROC
) file_dialog_callback
;
13512 if (GetOpenFileName (&file_details
))
13514 dostounix_filename (filename
);
13515 if (file_details
.nFilterIndex
== 2)
13517 /* "Folder Only" selected - strip dummy file name. */
13518 char * last
= strrchr (filename
, '/');
13522 file
= DECODE_FILE(build_string (filename
));
13524 /* User cancelled the dialog without making a selection. */
13525 else if (!CommDlgExtendedError ())
13527 /* An error occurred, fallback on reading from the mini-buffer. */
13529 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
13530 dir
, mustmatch
, dir
, Qfile_name_history
,
13531 default_filename
, Qnil
);
13534 file
= unbind_to (count
, file
);
13539 /* Make "Cancel" equivalent to C-g. */
13541 Fsignal (Qquit
, Qnil
);
13543 return unbind_to (count
, file
);
13548 /***********************************************************************
13549 w32 specialized functions
13550 ***********************************************************************/
13552 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 2, 0,
13553 doc
: /* Select a font using the W32 font dialog.
13554 Returns an X font string corresponding to the selection. */)
13555 (frame
, include_proportional
)
13556 Lisp_Object frame
, include_proportional
;
13558 FRAME_PTR f
= check_x_frame (frame
);
13566 bzero (&cf
, sizeof (cf
));
13567 bzero (&lf
, sizeof (lf
));
13569 cf
.lStructSize
= sizeof (cf
);
13570 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
13571 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
13573 /* Unless include_proportional is non-nil, limit the selection to
13574 monospaced fonts. */
13575 if (NILP (include_proportional
))
13576 cf
.Flags
|= CF_FIXEDPITCHONLY
;
13578 cf
.lpLogFont
= &lf
;
13580 /* Initialize as much of the font details as we can from the current
13582 hdc
= GetDC (FRAME_W32_WINDOW (f
));
13583 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
13584 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
13585 if (GetTextMetrics (hdc
, &tm
))
13587 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
13588 lf
.lfWeight
= tm
.tmWeight
;
13589 lf
.lfItalic
= tm
.tmItalic
;
13590 lf
.lfUnderline
= tm
.tmUnderlined
;
13591 lf
.lfStrikeOut
= tm
.tmStruckOut
;
13592 lf
.lfCharSet
= tm
.tmCharSet
;
13593 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
13595 SelectObject (hdc
, oldobj
);
13596 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
13598 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
13601 return build_string (buf
);
13604 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
13605 Sw32_send_sys_command
, 1, 2, 0,
13606 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
13607 Some useful values for command are #xf030 to maximise frame (#xf020
13608 to minimize), #xf120 to restore frame to original size, and #xf100
13609 to activate the menubar for keyboard access. #xf140 activates the
13610 screen saver if defined.
13612 If optional parameter FRAME is not specified, use selected frame. */)
13614 Lisp_Object command
, frame
;
13616 FRAME_PTR f
= check_x_frame (frame
);
13618 CHECK_NUMBER (command
);
13620 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
13625 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
13626 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
13627 This is a wrapper around the ShellExecute system function, which
13628 invokes the application registered to handle OPERATION for DOCUMENT.
13629 OPERATION is typically \"open\", \"print\" or \"explore\" (but can be
13630 nil for the default action), and DOCUMENT is typically the name of a
13631 document file or URL, but can also be a program executable to run or
13632 a directory to open in the Windows Explorer.
13634 If DOCUMENT is a program executable, PARAMETERS can be a string
13635 containing command line parameters, but otherwise should be nil.
13637 SHOW-FLAG can be used to control whether the invoked application is hidden
13638 or minimized. If SHOW-FLAG is nil, the application is displayed normally,
13639 otherwise it is an integer representing a ShowWindow flag:
13643 3 - start maximized
13644 6 - start minimized */)
13645 (operation
, document
, parameters
, show_flag
)
13646 Lisp_Object operation
, document
, parameters
, show_flag
;
13648 Lisp_Object current_dir
;
13650 CHECK_STRING (document
);
13652 /* Encode filename and current directory. */
13653 current_dir
= ENCODE_FILE (current_buffer
->directory
);
13654 document
= ENCODE_FILE (document
);
13655 if ((int) ShellExecute (NULL
,
13656 (STRINGP (operation
) ?
13657 SDATA (operation
) : NULL
),
13659 (STRINGP (parameters
) ?
13660 SDATA (parameters
) : NULL
),
13661 SDATA (current_dir
),
13662 (INTEGERP (show_flag
) ?
13663 XINT (show_flag
) : SW_SHOWDEFAULT
))
13666 error ("ShellExecute failed: %s", w32_strerror (0));
13669 /* Lookup virtual keycode from string representing the name of a
13670 non-ascii keystroke into the corresponding virtual key, using
13671 lispy_function_keys. */
13673 lookup_vk_code (char *key
)
13677 for (i
= 0; i
< 256; i
++)
13678 if (lispy_function_keys
[i
] != 0
13679 && strcmp (lispy_function_keys
[i
], key
) == 0)
13685 /* Convert a one-element vector style key sequence to a hot key
13688 w32_parse_hot_key (key
)
13691 /* Copied from Fdefine_key and store_in_keymap. */
13692 register Lisp_Object c
;
13694 int lisp_modifiers
;
13696 struct gcpro gcpro1
;
13698 CHECK_VECTOR (key
);
13700 if (XFASTINT (Flength (key
)) != 1)
13705 c
= Faref (key
, make_number (0));
13707 if (CONSP (c
) && lucid_event_type_list_p (c
))
13708 c
= Fevent_convert_list (c
);
13712 if (! INTEGERP (c
) && ! SYMBOLP (c
))
13713 error ("Key definition is invalid");
13715 /* Work out the base key and the modifiers. */
13718 c
= parse_modifiers (c
);
13719 lisp_modifiers
= Fcar (Fcdr (c
));
13723 vk_code
= lookup_vk_code (SDATA (SYMBOL_NAME (c
)));
13725 else if (INTEGERP (c
))
13727 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
13728 /* Many ascii characters are their own virtual key code. */
13729 vk_code
= XINT (c
) & CHARACTERBITS
;
13732 if (vk_code
< 0 || vk_code
> 255)
13735 if ((lisp_modifiers
& meta_modifier
) != 0
13736 && !NILP (Vw32_alt_is_meta
))
13737 lisp_modifiers
|= alt_modifier
;
13739 /* Supply defs missing from mingw32. */
13741 #define MOD_ALT 0x0001
13742 #define MOD_CONTROL 0x0002
13743 #define MOD_SHIFT 0x0004
13744 #define MOD_WIN 0x0008
13747 /* Convert lisp modifiers to Windows hot-key form. */
13748 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
13749 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
13750 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
13751 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
13753 return HOTKEY (vk_code
, w32_modifiers
);
13756 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
13757 Sw32_register_hot_key
, 1, 1, 0,
13758 doc
: /* Register KEY as a hot-key combination.
13759 Certain key combinations like Alt-Tab are reserved for system use on
13760 Windows, and therefore are normally intercepted by the system. However,
13761 most of these key combinations can be received by registering them as
13762 hot-keys, overriding their special meaning.
13764 KEY must be a one element key definition in vector form that would be
13765 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
13766 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
13767 is always interpreted as the Windows modifier keys.
13769 The return value is the hotkey-id if registered, otherwise nil. */)
13773 key
= w32_parse_hot_key (key
);
13775 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
13777 /* Reuse an empty slot if possible. */
13778 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
13780 /* Safe to add new key to list, even if we have focus. */
13782 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
13784 XSETCAR (item
, key
);
13786 /* Notify input thread about new hot-key definition, so that it
13787 takes effect without needing to switch focus. */
13788 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
13795 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
13796 Sw32_unregister_hot_key
, 1, 1, 0,
13797 doc
: /* Unregister HOTKEY as a hot-key combination. */)
13803 if (!INTEGERP (key
))
13804 key
= w32_parse_hot_key (key
);
13806 item
= Fmemq (key
, w32_grabbed_keys
);
13810 /* Notify input thread about hot-key definition being removed, so
13811 that it takes effect without needing focus switch. */
13812 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
13813 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
13816 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
13823 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
13824 Sw32_registered_hot_keys
, 0, 0, 0,
13825 doc
: /* Return list of registered hot-key IDs. */)
13828 return Fcopy_sequence (w32_grabbed_keys
);
13831 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
13832 Sw32_reconstruct_hot_key
, 1, 1, 0,
13833 doc
: /* Convert hot-key ID to a lisp key combination. */)
13835 Lisp_Object hotkeyid
;
13837 int vk_code
, w32_modifiers
;
13840 CHECK_NUMBER (hotkeyid
);
13842 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
13843 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
13845 if (lispy_function_keys
[vk_code
])
13846 key
= intern (lispy_function_keys
[vk_code
]);
13848 key
= make_number (vk_code
);
13850 key
= Fcons (key
, Qnil
);
13851 if (w32_modifiers
& MOD_SHIFT
)
13852 key
= Fcons (Qshift
, key
);
13853 if (w32_modifiers
& MOD_CONTROL
)
13854 key
= Fcons (Qctrl
, key
);
13855 if (w32_modifiers
& MOD_ALT
)
13856 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
13857 if (w32_modifiers
& MOD_WIN
)
13858 key
= Fcons (Qhyper
, key
);
13863 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
13864 Sw32_toggle_lock_key
, 1, 2, 0,
13865 doc
: /* Toggle the state of the lock key KEY.
13866 KEY can be `capslock', `kp-numlock', or `scroll'.
13867 If the optional parameter NEW-STATE is a number, then the state of KEY
13868 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
13870 Lisp_Object key
, new_state
;
13874 if (EQ (key
, intern ("capslock")))
13875 vk_code
= VK_CAPITAL
;
13876 else if (EQ (key
, intern ("kp-numlock")))
13877 vk_code
= VK_NUMLOCK
;
13878 else if (EQ (key
, intern ("scroll")))
13879 vk_code
= VK_SCROLL
;
13883 if (!dwWindowsThreadId
)
13884 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
13886 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
13887 (WPARAM
) vk_code
, (LPARAM
) new_state
))
13890 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
13891 return make_number (msg
.wParam
);
13896 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
13897 doc
: /* Return storage information about the file system FILENAME is on.
13898 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
13899 storage of the file system, FREE is the free storage, and AVAIL is the
13900 storage available to a non-superuser. All 3 numbers are in bytes.
13901 If the underlying system call fails, value is nil. */)
13903 Lisp_Object filename
;
13905 Lisp_Object encoded
, value
;
13907 CHECK_STRING (filename
);
13908 filename
= Fexpand_file_name (filename
, Qnil
);
13909 encoded
= ENCODE_FILE (filename
);
13913 /* Determining the required information on Windows turns out, sadly,
13914 to be more involved than one would hope. The original Win32 api
13915 call for this will return bogus information on some systems, but we
13916 must dynamically probe for the replacement api, since that was
13917 added rather late on. */
13919 HMODULE hKernel
= GetModuleHandle ("kernel32");
13920 BOOL (*pfn_GetDiskFreeSpaceEx
)
13921 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
13922 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
13924 /* On Windows, we may need to specify the root directory of the
13925 volume holding FILENAME. */
13926 char rootname
[MAX_PATH
];
13927 char *name
= SDATA (encoded
);
13929 /* find the root name of the volume if given */
13930 if (isalpha (name
[0]) && name
[1] == ':')
13932 rootname
[0] = name
[0];
13933 rootname
[1] = name
[1];
13934 rootname
[2] = '\\';
13937 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
13939 char *str
= rootname
;
13943 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
13953 if (pfn_GetDiskFreeSpaceEx
)
13955 /* Unsigned large integers cannot be cast to double, so
13956 use signed ones instead. */
13957 LARGE_INTEGER availbytes
;
13958 LARGE_INTEGER freebytes
;
13959 LARGE_INTEGER totalbytes
;
13961 if (pfn_GetDiskFreeSpaceEx(rootname
,
13962 (ULARGE_INTEGER
*)&availbytes
,
13963 (ULARGE_INTEGER
*)&totalbytes
,
13964 (ULARGE_INTEGER
*)&freebytes
))
13965 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
13966 make_float ((double) freebytes
.QuadPart
),
13967 make_float ((double) availbytes
.QuadPart
));
13971 DWORD sectors_per_cluster
;
13972 DWORD bytes_per_sector
;
13973 DWORD free_clusters
;
13974 DWORD total_clusters
;
13976 if (GetDiskFreeSpace(rootname
,
13977 §ors_per_cluster
,
13981 value
= list3 (make_float ((double) total_clusters
13982 * sectors_per_cluster
* bytes_per_sector
),
13983 make_float ((double) free_clusters
13984 * sectors_per_cluster
* bytes_per_sector
),
13985 make_float ((double) free_clusters
13986 * sectors_per_cluster
* bytes_per_sector
));
13993 /***********************************************************************
13995 ***********************************************************************/
13997 /* Keep this list in the same order as frame_parms in frame.c.
13998 Use 0 for unsupported frame parameters. */
14000 frame_parm_handler w32_frame_parm_handlers
[] =
14004 x_set_background_color
,
14005 x_set_border_color
,
14006 x_set_border_width
,
14007 x_set_cursor_color
,
14010 x_set_foreground_color
,
14013 x_set_internal_border_width
,
14014 x_set_menu_bar_lines
,
14016 x_explicitly_set_name
,
14017 x_set_scroll_bar_width
,
14019 x_set_unsplittable
,
14020 x_set_vertical_scroll_bars
,
14022 x_set_tool_bar_lines
,
14023 0, /* x_set_scroll_bar_foreground, */
14024 0, /* x_set_scroll_bar_background, */
14025 x_set_screen_gamma
,
14026 x_set_line_spacing
,
14027 x_set_fringe_width
,
14028 x_set_fringe_width
,
14029 0, /* x_set_wait_for_wm, */
14036 globals_of_w32fns ();
14037 /* This is zero if not using MS-Windows. */
14039 track_mouse_window
= NULL
;
14041 w32_visible_system_caret_hwnd
= NULL
;
14043 Qnone
= intern ("none");
14044 staticpro (&Qnone
);
14045 Qsuppress_icon
= intern ("suppress-icon");
14046 staticpro (&Qsuppress_icon
);
14047 Qundefined_color
= intern ("undefined-color");
14048 staticpro (&Qundefined_color
);
14049 Qcenter
= intern ("center");
14050 staticpro (&Qcenter
);
14051 Qcancel_timer
= intern ("cancel-timer");
14052 staticpro (&Qcancel_timer
);
14054 Qhyper
= intern ("hyper");
14055 staticpro (&Qhyper
);
14056 Qsuper
= intern ("super");
14057 staticpro (&Qsuper
);
14058 Qmeta
= intern ("meta");
14059 staticpro (&Qmeta
);
14060 Qalt
= intern ("alt");
14062 Qctrl
= intern ("ctrl");
14063 staticpro (&Qctrl
);
14064 Qcontrol
= intern ("control");
14065 staticpro (&Qcontrol
);
14066 Qshift
= intern ("shift");
14067 staticpro (&Qshift
);
14068 /* This is the end of symbol initialization. */
14070 /* Text property `display' should be nonsticky by default. */
14071 Vtext_property_default_nonsticky
14072 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
14075 Qlaplace
= intern ("laplace");
14076 staticpro (&Qlaplace
);
14077 Qemboss
= intern ("emboss");
14078 staticpro (&Qemboss
);
14079 Qedge_detection
= intern ("edge-detection");
14080 staticpro (&Qedge_detection
);
14081 Qheuristic
= intern ("heuristic");
14082 staticpro (&Qheuristic
);
14083 QCmatrix
= intern (":matrix");
14084 staticpro (&QCmatrix
);
14085 QCcolor_adjustment
= intern (":color-adjustment");
14086 staticpro (&QCcolor_adjustment
);
14087 QCmask
= intern (":mask");
14088 staticpro (&QCmask
);
14090 Fput (Qundefined_color
, Qerror_conditions
,
14091 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
14092 Fput (Qundefined_color
, Qerror_message
,
14093 build_string ("Undefined color"));
14095 staticpro (&w32_grabbed_keys
);
14096 w32_grabbed_keys
= Qnil
;
14098 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
14099 doc
: /* An array of color name mappings for windows. */);
14100 Vw32_color_map
= Qnil
;
14102 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
14103 doc
: /* Non-nil if alt key presses are passed on to Windows.
14104 When non-nil, for example, alt pressed and released and then space will
14105 open the System menu. When nil, Emacs silently swallows alt key events. */);
14106 Vw32_pass_alt_to_system
= Qnil
;
14108 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
14109 doc
: /* Non-nil if the alt key is to be considered the same as the meta key.
14110 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta. */);
14111 Vw32_alt_is_meta
= Qt
;
14113 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
14114 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
14115 XSETINT (Vw32_quit_key
, 0);
14117 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14118 &Vw32_pass_lwindow_to_system
,
14119 doc
: /* Non-nil if the left \"Windows\" key is passed on to Windows.
14120 When non-nil, the Start menu is opened by tapping the key. */);
14121 Vw32_pass_lwindow_to_system
= Qt
;
14123 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14124 &Vw32_pass_rwindow_to_system
,
14125 doc
: /* Non-nil if the right \"Windows\" key is passed on to Windows.
14126 When non-nil, the Start menu is opened by tapping the key. */);
14127 Vw32_pass_rwindow_to_system
= Qt
;
14129 DEFVAR_INT ("w32-phantom-key-code",
14130 &Vw32_phantom_key_code
,
14131 doc
: /* Virtual key code used to generate \"phantom\" key presses.
14132 Value is a number between 0 and 255.
14134 Phantom key presses are generated in order to stop the system from
14135 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
14136 `w32-pass-rwindow-to-system' is nil. */);
14137 /* Although 255 is technically not a valid key code, it works and
14138 means that this hack won't interfere with any real key code. */
14139 Vw32_phantom_key_code
= 255;
14141 DEFVAR_LISP ("w32-enable-num-lock",
14142 &Vw32_enable_num_lock
,
14143 doc
: /* Non-nil if Num Lock should act normally.
14144 Set to nil to see Num Lock as the key `kp-numlock'. */);
14145 Vw32_enable_num_lock
= Qt
;
14147 DEFVAR_LISP ("w32-enable-caps-lock",
14148 &Vw32_enable_caps_lock
,
14149 doc
: /* Non-nil if Caps Lock should act normally.
14150 Set to nil to see Caps Lock as the key `capslock'. */);
14151 Vw32_enable_caps_lock
= Qt
;
14153 DEFVAR_LISP ("w32-scroll-lock-modifier",
14154 &Vw32_scroll_lock_modifier
,
14155 doc
: /* Modifier to use for the Scroll Lock on state.
14156 The value can be hyper, super, meta, alt, control or shift for the
14157 respective modifier, or nil to see Scroll Lock as the key `scroll'.
14158 Any other value will cause the key to be ignored. */);
14159 Vw32_scroll_lock_modifier
= Qt
;
14161 DEFVAR_LISP ("w32-lwindow-modifier",
14162 &Vw32_lwindow_modifier
,
14163 doc
: /* Modifier to use for the left \"Windows\" key.
14164 The value can be hyper, super, meta, alt, control or shift for the
14165 respective modifier, or nil to appear as the key `lwindow'.
14166 Any other value will cause the key to be ignored. */);
14167 Vw32_lwindow_modifier
= Qnil
;
14169 DEFVAR_LISP ("w32-rwindow-modifier",
14170 &Vw32_rwindow_modifier
,
14171 doc
: /* Modifier to use for the right \"Windows\" key.
14172 The value can be hyper, super, meta, alt, control or shift for the
14173 respective modifier, or nil to appear as the key `rwindow'.
14174 Any other value will cause the key to be ignored. */);
14175 Vw32_rwindow_modifier
= Qnil
;
14177 DEFVAR_LISP ("w32-apps-modifier",
14178 &Vw32_apps_modifier
,
14179 doc
: /* Modifier to use for the \"Apps\" key.
14180 The value can be hyper, super, meta, alt, control or shift for the
14181 respective modifier, or nil to appear as the key `apps'.
14182 Any other value will cause the key to be ignored. */);
14183 Vw32_apps_modifier
= Qnil
;
14185 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts
,
14186 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
14187 w32_enable_synthesized_fonts
= 0;
14189 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
14190 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
14191 Vw32_enable_palette
= Qt
;
14193 DEFVAR_INT ("w32-mouse-button-tolerance",
14194 &Vw32_mouse_button_tolerance
,
14195 doc
: /* Analogue of double click interval for faking middle mouse events.
14196 The value is the minimum time in milliseconds that must elapse between
14197 left/right button down events before they are considered distinct events.
14198 If both mouse buttons are depressed within this interval, a middle mouse
14199 button down event is generated instead. */);
14200 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
14202 DEFVAR_INT ("w32-mouse-move-interval",
14203 &Vw32_mouse_move_interval
,
14204 doc
: /* Minimum interval between mouse move events.
14205 The value is the minimum time in milliseconds that must elapse between
14206 successive mouse move (or scroll bar drag) events before they are
14207 reported as lisp events. */);
14208 XSETINT (Vw32_mouse_move_interval
, 0);
14210 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
14211 &w32_pass_extra_mouse_buttons_to_system
,
14212 doc
: /* Non-nil if the fourth and fifth mouse buttons are passed to Windows.
14213 Recent versions of Windows support mice with up to five buttons.
14214 Since most applications don't support these extra buttons, most mouse
14215 drivers will allow you to map them to functions at the system level.
14216 If this variable is non-nil, Emacs will pass them on, allowing the
14217 system to handle them. */);
14218 w32_pass_extra_mouse_buttons_to_system
= 0;
14220 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
14221 doc
: /* List of directories to search for window system bitmap files. */);
14222 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
14224 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
14225 doc
: /* The shape of the pointer when over text.
14226 Changing the value does not affect existing frames
14227 unless you set the mouse color. */);
14228 Vx_pointer_shape
= Qnil
;
14230 Vx_nontext_pointer_shape
= Qnil
;
14232 Vx_mode_pointer_shape
= Qnil
;
14234 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
14235 doc
: /* The shape of the pointer when Emacs is busy.
14236 This variable takes effect when you create a new frame
14237 or when you set the mouse color. */);
14238 Vx_hourglass_pointer_shape
= Qnil
;
14240 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
14241 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
14242 display_hourglass_p
= 1;
14244 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
14245 doc
: /* *Seconds to wait before displaying an hourglass pointer.
14246 Value must be an integer or float. */);
14247 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
14249 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
14250 &Vx_sensitive_text_pointer_shape
,
14251 doc
: /* The shape of the pointer when over mouse-sensitive text.
14252 This variable takes effect when you create a new frame
14253 or when you set the mouse color. */);
14254 Vx_sensitive_text_pointer_shape
= Qnil
;
14256 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
14257 &Vx_window_horizontal_drag_shape
,
14258 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
14259 This variable takes effect when you create a new frame
14260 or when you set the mouse color. */);
14261 Vx_window_horizontal_drag_shape
= Qnil
;
14263 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
14264 doc
: /* A string indicating the foreground color of the cursor box. */);
14265 Vx_cursor_fore_pixel
= Qnil
;
14267 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
14268 doc
: /* Maximum size for tooltips.
14269 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
14270 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
14272 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
14273 doc
: /* Non-nil if no window manager is in use.
14274 Emacs doesn't try to figure this out; this is always nil
14275 unless you set it to something else. */);
14276 /* We don't have any way to find this out, so set it to nil
14277 and maybe the user would like to set it to t. */
14278 Vx_no_window_manager
= Qnil
;
14280 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
14281 &Vx_pixel_size_width_font_regexp
,
14282 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
14284 Since Emacs gets width of a font matching with this regexp from
14285 PIXEL_SIZE field of the name, font finding mechanism gets faster for
14286 such a font. This is especially effective for such large fonts as
14287 Chinese, Japanese, and Korean. */);
14288 Vx_pixel_size_width_font_regexp
= Qnil
;
14290 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
14291 doc
: /* Time after which cached images are removed from the cache.
14292 When an image has not been displayed this many seconds, remove it
14293 from the image cache. Value must be an integer or nil with nil
14294 meaning don't clear the cache. */);
14295 Vimage_cache_eviction_delay
= make_number (30 * 60);
14297 DEFVAR_LISP ("w32-bdf-filename-alist",
14298 &Vw32_bdf_filename_alist
,
14299 doc
: /* List of bdf fonts and their corresponding filenames. */);
14300 Vw32_bdf_filename_alist
= Qnil
;
14302 DEFVAR_BOOL ("w32-strict-fontnames",
14303 &w32_strict_fontnames
,
14304 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
14305 Default is nil, which allows old fontnames that are not XLFD compliant,
14306 and allows third-party CJK display to work by specifying false charset
14307 fields to trick Emacs into translating to Big5, SJIS etc.
14308 Setting this to t will prevent wrong fonts being selected when
14309 fontsets are automatically created. */);
14310 w32_strict_fontnames
= 0;
14312 DEFVAR_BOOL ("w32-strict-painting",
14313 &w32_strict_painting
,
14314 doc
: /* Non-nil means use strict rules for repainting frames.
14315 Set this to nil to get the old behaviour for repainting; this should
14316 only be necessary if the default setting causes problems. */);
14317 w32_strict_painting
= 1;
14319 DEFVAR_LISP ("w32-charset-info-alist",
14320 &Vw32_charset_info_alist
,
14321 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
14322 Each entry should be of the form:
14324 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
14326 where CHARSET_NAME is a string used in font names to identify the charset,
14327 WINDOWS_CHARSET is a symbol that can be one of:
14328 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
14329 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
14330 w32-charset-chinesebig5,
14331 w32-charset-johab, w32-charset-hebrew,
14332 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
14333 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
14334 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
14335 w32-charset-unicode,
14336 or w32-charset-oem.
14337 CODEPAGE should be an integer specifying the codepage that should be used
14338 to display the character set, t to do no translation and output as Unicode,
14339 or nil to do no translation and output as 8 bit (or multibyte on far-east
14340 versions of Windows) characters. */);
14341 Vw32_charset_info_alist
= Qnil
;
14343 staticpro (&Qw32_charset_ansi
);
14344 Qw32_charset_ansi
= intern ("w32-charset-ansi");
14345 staticpro (&Qw32_charset_symbol
);
14346 Qw32_charset_symbol
= intern ("w32-charset-symbol");
14347 staticpro (&Qw32_charset_shiftjis
);
14348 Qw32_charset_shiftjis
= intern ("w32-charset-shiftjis");
14349 staticpro (&Qw32_charset_hangeul
);
14350 Qw32_charset_hangeul
= intern ("w32-charset-hangeul");
14351 staticpro (&Qw32_charset_chinesebig5
);
14352 Qw32_charset_chinesebig5
= intern ("w32-charset-chinesebig5");
14353 staticpro (&Qw32_charset_gb2312
);
14354 Qw32_charset_gb2312
= intern ("w32-charset-gb2312");
14355 staticpro (&Qw32_charset_oem
);
14356 Qw32_charset_oem
= intern ("w32-charset-oem");
14358 #ifdef JOHAB_CHARSET
14360 static int w32_extra_charsets_defined
= 1;
14361 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
14362 doc
: /* Internal variable. */);
14364 staticpro (&Qw32_charset_johab
);
14365 Qw32_charset_johab
= intern ("w32-charset-johab");
14366 staticpro (&Qw32_charset_easteurope
);
14367 Qw32_charset_easteurope
= intern ("w32-charset-easteurope");
14368 staticpro (&Qw32_charset_turkish
);
14369 Qw32_charset_turkish
= intern ("w32-charset-turkish");
14370 staticpro (&Qw32_charset_baltic
);
14371 Qw32_charset_baltic
= intern ("w32-charset-baltic");
14372 staticpro (&Qw32_charset_russian
);
14373 Qw32_charset_russian
= intern ("w32-charset-russian");
14374 staticpro (&Qw32_charset_arabic
);
14375 Qw32_charset_arabic
= intern ("w32-charset-arabic");
14376 staticpro (&Qw32_charset_greek
);
14377 Qw32_charset_greek
= intern ("w32-charset-greek");
14378 staticpro (&Qw32_charset_hebrew
);
14379 Qw32_charset_hebrew
= intern ("w32-charset-hebrew");
14380 staticpro (&Qw32_charset_vietnamese
);
14381 Qw32_charset_vietnamese
= intern ("w32-charset-vietnamese");
14382 staticpro (&Qw32_charset_thai
);
14383 Qw32_charset_thai
= intern ("w32-charset-thai");
14384 staticpro (&Qw32_charset_mac
);
14385 Qw32_charset_mac
= intern ("w32-charset-mac");
14389 #ifdef UNICODE_CHARSET
14391 static int w32_unicode_charset_defined
= 1;
14392 DEFVAR_BOOL ("w32-unicode-charset-defined",
14393 &w32_unicode_charset_defined
,
14394 doc
: /* Internal variable. */);
14396 staticpro (&Qw32_charset_unicode
);
14397 Qw32_charset_unicode
= intern ("w32-charset-unicode");
14400 #if 0 /* TODO: Port to W32 */
14401 defsubr (&Sx_change_window_property
);
14402 defsubr (&Sx_delete_window_property
);
14403 defsubr (&Sx_window_property
);
14405 defsubr (&Sxw_display_color_p
);
14406 defsubr (&Sx_display_grayscale_p
);
14407 defsubr (&Sxw_color_defined_p
);
14408 defsubr (&Sxw_color_values
);
14409 defsubr (&Sx_server_max_request_size
);
14410 defsubr (&Sx_server_vendor
);
14411 defsubr (&Sx_server_version
);
14412 defsubr (&Sx_display_pixel_width
);
14413 defsubr (&Sx_display_pixel_height
);
14414 defsubr (&Sx_display_mm_width
);
14415 defsubr (&Sx_display_mm_height
);
14416 defsubr (&Sx_display_screens
);
14417 defsubr (&Sx_display_planes
);
14418 defsubr (&Sx_display_color_cells
);
14419 defsubr (&Sx_display_visual_class
);
14420 defsubr (&Sx_display_backing_store
);
14421 defsubr (&Sx_display_save_under
);
14422 defsubr (&Sx_create_frame
);
14423 defsubr (&Sx_open_connection
);
14424 defsubr (&Sx_close_connection
);
14425 defsubr (&Sx_display_list
);
14426 defsubr (&Sx_synchronize
);
14428 /* W32 specific functions */
14430 defsubr (&Sw32_focus_frame
);
14431 defsubr (&Sw32_select_font
);
14432 defsubr (&Sw32_define_rgb_color
);
14433 defsubr (&Sw32_default_color_map
);
14434 defsubr (&Sw32_load_color_file
);
14435 defsubr (&Sw32_send_sys_command
);
14436 defsubr (&Sw32_shell_execute
);
14437 defsubr (&Sw32_register_hot_key
);
14438 defsubr (&Sw32_unregister_hot_key
);
14439 defsubr (&Sw32_registered_hot_keys
);
14440 defsubr (&Sw32_reconstruct_hot_key
);
14441 defsubr (&Sw32_toggle_lock_key
);
14442 defsubr (&Sw32_find_bdf_fonts
);
14444 defsubr (&Sfile_system_info
);
14446 /* Setting callback functions for fontset handler. */
14447 get_font_info_func
= w32_get_font_info
;
14449 #if 0 /* This function pointer doesn't seem to be used anywhere.
14450 And the pointer assigned has the wrong type, anyway. */
14451 list_fonts_func
= w32_list_fonts
;
14454 load_font_func
= w32_load_font
;
14455 find_ccl_program_func
= w32_find_ccl_program
;
14456 query_font_func
= w32_query_font
;
14457 set_frame_fontset_func
= x_set_font
;
14458 get_font_repertory_func
= x_get_font_repertory
;
14459 check_window_system_func
= check_w32
;
14462 Qxbm
= intern ("xbm");
14464 QCconversion
= intern (":conversion");
14465 staticpro (&QCconversion
);
14466 QCheuristic_mask
= intern (":heuristic-mask");
14467 staticpro (&QCheuristic_mask
);
14468 QCcolor_symbols
= intern (":color-symbols");
14469 staticpro (&QCcolor_symbols
);
14470 QCascent
= intern (":ascent");
14471 staticpro (&QCascent
);
14472 QCmargin
= intern (":margin");
14473 staticpro (&QCmargin
);
14474 QCrelief
= intern (":relief");
14475 staticpro (&QCrelief
);
14476 Qpostscript
= intern ("postscript");
14477 staticpro (&Qpostscript
);
14478 QCloader
= intern (":loader");
14479 staticpro (&QCloader
);
14480 QCbounding_box
= intern (":bounding-box");
14481 staticpro (&QCbounding_box
);
14482 QCpt_width
= intern (":pt-width");
14483 staticpro (&QCpt_width
);
14484 QCpt_height
= intern (":pt-height");
14485 staticpro (&QCpt_height
);
14486 QCindex
= intern (":index");
14487 staticpro (&QCindex
);
14488 Qpbm
= intern ("pbm");
14492 Qxpm
= intern ("xpm");
14497 Qjpeg
= intern ("jpeg");
14498 staticpro (&Qjpeg
);
14502 Qtiff
= intern ("tiff");
14503 staticpro (&Qtiff
);
14507 Qgif
= intern ("gif");
14512 Qpng
= intern ("png");
14516 defsubr (&Sclear_image_cache
);
14517 defsubr (&Simage_size
);
14518 defsubr (&Simage_mask_p
);
14521 defsubr (&Simagep
);
14522 defsubr (&Slookup_image
);
14525 hourglass_atimer
= NULL
;
14526 hourglass_shown_p
= 0;
14527 defsubr (&Sx_show_tip
);
14528 defsubr (&Sx_hide_tip
);
14530 staticpro (&tip_timer
);
14532 staticpro (&tip_frame
);
14534 last_show_tip_args
= Qnil
;
14535 staticpro (&last_show_tip_args
);
14537 defsubr (&Sx_file_dialog
);
14542 globals_of_w32fns is used to initialize those global variables that
14543 must always be initialized on startup even when the global variable
14544 initialized is non zero (see the function main in emacs.c).
14545 globals_of_w32fns is called from syms_of_w32fns when the global
14546 variable initialized is 0 and directly from main when initialized
14549 void globals_of_w32fns ()
14551 HMODULE user32_lib
= GetModuleHandle ("user32.dll");
14553 TrackMouseEvent not available in all versions of Windows, so must load
14554 it dynamically. Do it once, here, instead of every time it is used.
14556 track_mouse_event_fn
= (TrackMouseEvent_Proc
)
14557 GetProcAddress (user32_lib
, "TrackMouseEvent");
14558 /* ditto for GetClipboardSequenceNumber. */
14559 clipboard_sequence_fn
= (ClipboardSequence_Proc
)
14560 GetProcAddress (user32_lib
, "GetClipboardSequenceNumber");
14563 /* Initialize image types. Based on which libraries are available. */
14565 init_external_image_libraries ()
14570 if ((library
= LoadLibrary ("libXpm.dll")))
14572 if (init_xpm_functions (library
))
14573 define_image_type (&xpm_type
);
14579 /* Try loading jpeg library under probable names. */
14580 if ((library
= LoadLibrary ("libjpeg.dll"))
14581 || (library
= LoadLibrary ("jpeg-62.dll"))
14582 || (library
= LoadLibrary ("jpeg.dll")))
14584 if (init_jpeg_functions (library
))
14585 define_image_type (&jpeg_type
);
14590 if (library
= LoadLibrary ("libtiff.dll"))
14592 if (init_tiff_functions (library
))
14593 define_image_type (&tiff_type
);
14598 if (library
= LoadLibrary ("libungif.dll"))
14600 if (init_gif_functions (library
))
14601 define_image_type (&gif_type
);
14606 /* Ensure zlib is loaded. Try debug version first. */
14607 if (!LoadLibrary ("zlibd.dll"))
14608 LoadLibrary ("zlib.dll");
14610 /* Try loading libpng under probable names. */
14611 if ((library
= LoadLibrary ("libpng13d.dll"))
14612 || (library
= LoadLibrary ("libpng13.dll"))
14613 || (library
= LoadLibrary ("libpng12d.dll"))
14614 || (library
= LoadLibrary ("libpng12.dll"))
14615 || (library
= LoadLibrary ("libpng.dll")))
14617 if (init_png_functions (library
))
14618 define_image_type (&png_type
);
14626 image_types
= NULL
;
14627 Vimage_types
= Qnil
;
14629 define_image_type (&pbm_type
);
14630 define_image_type (&xbm_type
);
14632 #if 0 /* TODO : Ghostscript support for W32 */
14633 define_image_type (&gs_type
);
14636 /* Image types that rely on external libraries are loaded dynamically
14637 if the library is available. */
14638 init_external_image_libraries ();
14647 button
= MessageBox (NULL
,
14648 "A fatal error has occurred!\n\n"
14649 "Select Abort to exit, Retry to debug, Ignore to continue",
14650 "Emacs Abort Dialog",
14651 MB_ICONEXCLAMATION
| MB_TASKMODAL
14652 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
14667 /* For convenience when debugging. */
14671 return GetLastError ();