1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 92, 93, 94, 95, 1996, 1997, 1998, 1999, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Added by Kevin Gallo */
33 #include "dispextern.h"
40 #include "intervals.h"
41 #include "blockinput.h"
44 #include "termhooks.h"
49 #include "bitmaps/gray.xbm"
55 extern void free_frame_menubar ();
56 extern void x_compute_fringe_widths
P_ ((struct frame
*, int));
57 extern double atof ();
58 extern int w32_console_toggle_lock_key
P_ ((int, Lisp_Object
));
59 extern void w32_menu_display_help
P_ ((HWND
, HMENU
, UINT
, UINT
));
60 extern void w32_free_menu_strings
P_ ((HWND
));
64 /* A definition of XColor for non-X frames. */
65 #ifndef HAVE_X_WINDOWS
68 unsigned short red
, green
, blue
;
74 extern char *lispy_function_keys
[];
76 /* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
77 it, and including `bitmaps/gray' more than once is a problem when
78 config.h defines `static' as an empty replacement string. */
80 int gray_bitmap_width
= gray_width
;
81 int gray_bitmap_height
= gray_height
;
82 unsigned char *gray_bitmap_bits
= gray_bits
;
84 /* The colormap for converting color names to RGB values */
85 Lisp_Object Vw32_color_map
;
87 /* Non nil if alt key presses are passed on to Windows. */
88 Lisp_Object Vw32_pass_alt_to_system
;
90 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
92 Lisp_Object Vw32_alt_is_meta
;
94 /* If non-zero, the windows virtual key code for an alternative quit key. */
95 Lisp_Object Vw32_quit_key
;
97 /* Non nil if left window key events are passed on to Windows (this only
98 affects whether "tapping" the key opens the Start menu). */
99 Lisp_Object Vw32_pass_lwindow_to_system
;
101 /* Non nil if right window key events are passed on to Windows (this
102 only affects whether "tapping" the key opens the Start menu). */
103 Lisp_Object Vw32_pass_rwindow_to_system
;
105 /* Virtual key code used to generate "phantom" key presses in order
106 to stop system from acting on Windows key events. */
107 Lisp_Object Vw32_phantom_key_code
;
109 /* Modifier associated with the left "Windows" key, or nil to act as a
111 Lisp_Object Vw32_lwindow_modifier
;
113 /* Modifier associated with the right "Windows" key, or nil to act as a
115 Lisp_Object Vw32_rwindow_modifier
;
117 /* Modifier associated with the "Apps" key, or nil to act as a normal
119 Lisp_Object Vw32_apps_modifier
;
121 /* Value is nil if Num Lock acts as a function key. */
122 Lisp_Object Vw32_enable_num_lock
;
124 /* Value is nil if Caps Lock acts as a function key. */
125 Lisp_Object Vw32_enable_caps_lock
;
127 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
128 Lisp_Object Vw32_scroll_lock_modifier
;
130 /* Switch to control whether we inhibit requests for synthesized bold
131 and italic versions of fonts. */
132 Lisp_Object Vw32_enable_synthesized_fonts
;
134 /* Enable palette management. */
135 Lisp_Object Vw32_enable_palette
;
137 /* Control how close left/right button down events must be to
138 be converted to a middle button down event. */
139 Lisp_Object Vw32_mouse_button_tolerance
;
141 /* Minimum interval between mouse movement (and scroll bar drag)
142 events that are passed on to the event loop. */
143 Lisp_Object Vw32_mouse_move_interval
;
145 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
146 int w32_pass_extra_mouse_buttons_to_system
;
148 /* The name we're using in resource queries. */
149 Lisp_Object Vx_resource_name
;
151 /* Non nil if no window manager is in use. */
152 Lisp_Object Vx_no_window_manager
;
154 /* Non-zero means we're allowed to display a hourglass pointer. */
156 int display_hourglass_p
;
158 /* The background and shape of the mouse pointer, and shape when not
159 over text or in the modeline. */
161 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
162 Lisp_Object Vx_hourglass_pointer_shape
, Vx_window_horizontal_drag_shape
;
164 /* The shape when over mouse-sensitive text. */
166 Lisp_Object Vx_sensitive_text_pointer_shape
;
168 /* Color of chars displayed in cursor box. */
170 Lisp_Object Vx_cursor_fore_pixel
;
172 /* Nonzero if using Windows. */
174 static int w32_in_use
;
176 /* Search path for bitmap files. */
178 Lisp_Object Vx_bitmap_file_path
;
180 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
182 Lisp_Object Vx_pixel_size_width_font_regexp
;
184 /* Alist of bdf fonts and the files that define them. */
185 Lisp_Object Vw32_bdf_filename_alist
;
187 /* A flag to control whether fonts are matched strictly or not. */
188 int w32_strict_fontnames
;
190 /* A flag to control whether we should only repaint if GetUpdateRect
191 indicates there is an update region. */
192 int w32_strict_painting
;
194 /* Associative list linking character set strings to Windows codepages. */
195 Lisp_Object Vw32_charset_info_alist
;
197 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
198 #ifndef VIETNAMESE_CHARSET
199 #define VIETNAMESE_CHARSET 163
202 Lisp_Object Qauto_raise
;
203 Lisp_Object Qauto_lower
;
205 Lisp_Object Qborder_color
;
206 Lisp_Object Qborder_width
;
208 Lisp_Object Qcursor_color
;
209 Lisp_Object Qcursor_type
;
210 Lisp_Object Qgeometry
;
211 Lisp_Object Qicon_left
;
212 Lisp_Object Qicon_top
;
213 Lisp_Object Qicon_type
;
214 Lisp_Object Qicon_name
;
215 Lisp_Object Qinternal_border_width
;
218 Lisp_Object Qmouse_color
;
220 Lisp_Object Qparent_id
;
221 Lisp_Object Qscroll_bar_width
;
222 Lisp_Object Qsuppress_icon
;
223 Lisp_Object Qundefined_color
;
224 Lisp_Object Qvertical_scroll_bars
;
225 Lisp_Object Qvisibility
;
226 Lisp_Object Qwindow_id
;
227 Lisp_Object Qx_frame_parameter
;
228 Lisp_Object Qx_resource_name
;
229 Lisp_Object Quser_position
;
230 Lisp_Object Quser_size
;
231 Lisp_Object Qscreen_gamma
;
232 Lisp_Object Qline_spacing
;
234 Lisp_Object Qcancel_timer
;
240 Lisp_Object Qcontrol
;
243 Lisp_Object Qw32_charset_ansi
;
244 Lisp_Object Qw32_charset_default
;
245 Lisp_Object Qw32_charset_symbol
;
246 Lisp_Object Qw32_charset_shiftjis
;
247 Lisp_Object Qw32_charset_hangeul
;
248 Lisp_Object Qw32_charset_gb2312
;
249 Lisp_Object Qw32_charset_chinesebig5
;
250 Lisp_Object Qw32_charset_oem
;
252 #ifndef JOHAB_CHARSET
253 #define JOHAB_CHARSET 130
256 Lisp_Object Qw32_charset_easteurope
;
257 Lisp_Object Qw32_charset_turkish
;
258 Lisp_Object Qw32_charset_baltic
;
259 Lisp_Object Qw32_charset_russian
;
260 Lisp_Object Qw32_charset_arabic
;
261 Lisp_Object Qw32_charset_greek
;
262 Lisp_Object Qw32_charset_hebrew
;
263 Lisp_Object Qw32_charset_vietnamese
;
264 Lisp_Object Qw32_charset_thai
;
265 Lisp_Object Qw32_charset_johab
;
266 Lisp_Object Qw32_charset_mac
;
269 #ifdef UNICODE_CHARSET
270 Lisp_Object Qw32_charset_unicode
;
273 extern Lisp_Object Qtop
;
274 extern Lisp_Object Qdisplay
;
275 extern Lisp_Object Qtool_bar_lines
;
277 /* State variables for emulating a three button mouse. */
282 static int button_state
= 0;
283 static W32Msg saved_mouse_button_msg
;
284 static unsigned mouse_button_timer
; /* non-zero when timer is active */
285 static W32Msg saved_mouse_move_msg
;
286 static unsigned mouse_move_timer
;
288 /* Window that is tracking the mouse. */
289 static HWND track_mouse_window
;
290 FARPROC track_mouse_event_fn
;
292 /* W95 mousewheel handler */
293 unsigned int msh_mousewheel
= 0;
295 #define MOUSE_BUTTON_ID 1
296 #define MOUSE_MOVE_ID 2
298 /* The below are defined in frame.c. */
300 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
301 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
302 extern Lisp_Object Qtool_bar_lines
;
304 extern Lisp_Object Vwindow_system_version
;
306 Lisp_Object Qface_set_after_frame_default
;
309 int image_cache_refcount
, dpyinfo_refcount
;
313 /* From w32term.c. */
314 extern Lisp_Object Vw32_num_mouse_buttons
;
315 extern Lisp_Object Vw32_recognize_altgr
;
317 extern HWND w32_system_caret_hwnd
;
318 extern int w32_system_caret_width
;
319 extern int w32_system_caret_height
;
320 extern int w32_system_caret_x
;
321 extern int w32_system_caret_y
;
324 /* Error if we are not connected to MS-Windows. */
329 error ("MS-Windows not in use or not initialized");
332 /* Nonzero if we can use mouse menus.
333 You should not call this unless HAVE_MENUS is defined. */
341 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
342 and checking validity for W32. */
345 check_x_frame (frame
)
351 frame
= selected_frame
;
352 CHECK_LIVE_FRAME (frame
);
354 if (! FRAME_W32_P (f
))
355 error ("non-w32 frame used");
359 /* Let the user specify an display with a frame.
360 nil stands for the selected frame--or, if that is not a w32 frame,
361 the first display on the list. */
363 static struct w32_display_info
*
364 check_x_display_info (frame
)
369 struct frame
*sf
= XFRAME (selected_frame
);
371 if (FRAME_W32_P (sf
) && FRAME_LIVE_P (sf
))
372 return FRAME_W32_DISPLAY_INFO (sf
);
374 return &one_w32_display_info
;
376 else if (STRINGP (frame
))
377 return x_display_info_for_name (frame
);
382 CHECK_LIVE_FRAME (frame
);
384 if (! FRAME_W32_P (f
))
385 error ("non-w32 frame used");
386 return FRAME_W32_DISPLAY_INFO (f
);
390 /* Return the Emacs frame-object corresponding to an w32 window.
391 It could be the frame's main window or an icon window. */
393 /* This function can be called during GC, so use GC_xxx type test macros. */
396 x_window_to_frame (dpyinfo
, wdesc
)
397 struct w32_display_info
*dpyinfo
;
400 Lisp_Object tail
, frame
;
403 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
406 if (!GC_FRAMEP (frame
))
409 if (!FRAME_W32_P (f
) || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
411 if (f
->output_data
.w32
->hourglass_window
== wdesc
)
414 if (FRAME_W32_WINDOW (f
) == wdesc
)
422 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
423 id, which is just an int that this section returns. Bitmaps are
424 reference counted so they can be shared among frames.
426 Bitmap indices are guaranteed to be > 0, so a negative number can
427 be used to indicate no bitmap.
429 If you use x_create_bitmap_from_data, then you must keep track of
430 the bitmaps yourself. That is, creating a bitmap from the same
431 data more than once will not be caught. */
434 /* Functions to access the contents of a bitmap, given an id. */
437 x_bitmap_height (f
, id
)
441 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
445 x_bitmap_width (f
, id
)
449 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
453 x_bitmap_pixmap (f
, id
)
457 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
461 /* Allocate a new bitmap record. Returns index of new record. */
464 x_allocate_bitmap_record (f
)
467 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
470 if (dpyinfo
->bitmaps
== NULL
)
472 dpyinfo
->bitmaps_size
= 10;
474 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
475 dpyinfo
->bitmaps_last
= 1;
479 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
480 return ++dpyinfo
->bitmaps_last
;
482 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
483 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
486 dpyinfo
->bitmaps_size
*= 2;
488 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
489 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
490 return ++dpyinfo
->bitmaps_last
;
493 /* Add one reference to the reference count of the bitmap with id ID. */
496 x_reference_bitmap (f
, id
)
500 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
503 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
506 x_create_bitmap_from_data (f
, bits
, width
, height
)
509 unsigned int width
, height
;
511 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
515 bitmap
= CreateBitmap (width
, height
,
516 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
517 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
523 id
= x_allocate_bitmap_record (f
);
524 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
525 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
526 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
527 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
528 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
529 dpyinfo
->bitmaps
[id
- 1].height
= height
;
530 dpyinfo
->bitmaps
[id
- 1].width
= width
;
535 /* Create bitmap from file FILE for frame F. */
538 x_create_bitmap_from_file (f
, file
)
543 #if 0 /* TODO : bitmap support */
544 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
545 unsigned int width
, height
;
547 int xhot
, yhot
, result
, id
;
553 /* Look for an existing bitmap with the same name. */
554 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
556 if (dpyinfo
->bitmaps
[id
].refcount
557 && dpyinfo
->bitmaps
[id
].file
558 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
560 ++dpyinfo
->bitmaps
[id
].refcount
;
565 /* Search bitmap-file-path for the file, if appropriate. */
566 fd
= openp (Vx_bitmap_file_path
, file
, Qnil
, &found
, 0);
571 filename
= (char *) XSTRING (found
)->data
;
573 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
579 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
580 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
581 if (result
!= BitmapSuccess
)
584 id
= x_allocate_bitmap_record (f
);
585 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
586 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
587 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
588 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
589 dpyinfo
->bitmaps
[id
- 1].height
= height
;
590 dpyinfo
->bitmaps
[id
- 1].width
= width
;
591 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
597 /* Remove reference to bitmap with id number ID. */
600 x_destroy_bitmap (f
, id
)
604 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
608 --dpyinfo
->bitmaps
[id
- 1].refcount
;
609 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
612 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
613 if (dpyinfo
->bitmaps
[id
- 1].file
)
615 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
616 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
623 /* Free all the bitmaps for the display specified by DPYINFO. */
626 x_destroy_all_bitmaps (dpyinfo
)
627 struct w32_display_info
*dpyinfo
;
630 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
631 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
633 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
634 if (dpyinfo
->bitmaps
[i
].file
)
635 xfree (dpyinfo
->bitmaps
[i
].file
);
637 dpyinfo
->bitmaps_last
= 0;
640 /* Connect the frame-parameter names for W32 frames
641 to the ways of passing the parameter values to the window system.
643 The name of a parameter, as a Lisp symbol,
644 has an `x-frame-parameter' property which is an integer in Lisp
645 but can be interpreted as an `enum x_frame_parm' in C. */
649 X_PARM_FOREGROUND_COLOR
,
650 X_PARM_BACKGROUND_COLOR
,
657 X_PARM_INTERNAL_BORDER_WIDTH
,
661 X_PARM_VERT_SCROLL_BAR
,
663 X_PARM_MENU_BAR_LINES
667 struct x_frame_parm_table
670 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
673 BOOL my_show_window
P_ ((struct frame
*, HWND
, int));
674 void my_set_window_pos
P_ ((HWND
, HWND
, int, int, int, int, UINT
));
675 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
676 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
677 static void x_change_window_heights
P_ ((Lisp_Object
, int));
678 /* TODO: Native Input Method support; see x_create_im. */
679 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
680 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
681 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
682 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
683 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
684 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
685 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
686 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
687 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
688 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
689 static void x_set_fringe_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
690 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
691 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
693 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
694 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
695 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
696 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
698 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
699 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
700 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
701 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
702 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
703 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
704 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
705 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
708 static struct x_frame_parm_table x_frame_parms
[] =
710 {"auto-raise", x_set_autoraise
},
711 {"auto-lower", x_set_autolower
},
712 {"background-color", x_set_background_color
},
713 {"border-color", x_set_border_color
},
714 {"border-width", x_set_border_width
},
715 {"cursor-color", x_set_cursor_color
},
716 {"cursor-type", x_set_cursor_type
},
717 {"font", x_set_font
},
718 {"foreground-color", x_set_foreground_color
},
719 {"icon-name", x_set_icon_name
},
720 {"icon-type", x_set_icon_type
},
721 {"internal-border-width", x_set_internal_border_width
},
722 {"menu-bar-lines", x_set_menu_bar_lines
},
723 {"mouse-color", x_set_mouse_color
},
724 {"name", x_explicitly_set_name
},
725 {"scroll-bar-width", x_set_scroll_bar_width
},
726 {"title", x_set_title
},
727 {"unsplittable", x_set_unsplittable
},
728 {"vertical-scroll-bars", x_set_vertical_scroll_bars
},
729 {"visibility", x_set_visibility
},
730 {"tool-bar-lines", x_set_tool_bar_lines
},
731 {"screen-gamma", x_set_screen_gamma
},
732 {"line-spacing", x_set_line_spacing
},
733 {"left-fringe", x_set_fringe_width
},
734 {"right-fringe", x_set_fringe_width
}
737 /* Attach the `x-frame-parameter' properties to
738 the Lisp symbol names of parameters relevant to W32. */
741 init_x_parm_symbols ()
745 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
746 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
750 /* Change the parameters of frame F as specified by ALIST.
751 If a parameter is not specially recognized, do nothing;
752 otherwise call the `x_set_...' function for that parameter. */
755 x_set_frame_parameters (f
, alist
)
761 /* If both of these parameters are present, it's more efficient to
762 set them both at once. So we wait until we've looked at the
763 entire list before we set them. */
767 Lisp_Object left
, top
;
769 /* Same with these. */
770 Lisp_Object icon_left
, icon_top
;
772 /* Record in these vectors all the parms specified. */
776 int left_no_change
= 0, top_no_change
= 0;
777 int icon_left_no_change
= 0, icon_top_no_change
= 0;
779 struct gcpro gcpro1
, gcpro2
;
782 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
785 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
786 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
788 /* Extract parm names and values into those vectors. */
791 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
796 parms
[i
] = Fcar (elt
);
797 values
[i
] = Fcdr (elt
);
800 /* TAIL and ALIST are not used again below here. */
803 GCPRO2 (*parms
, *values
);
807 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
808 because their values appear in VALUES and strings are not valid. */
809 top
= left
= Qunbound
;
810 icon_left
= icon_top
= Qunbound
;
812 /* Provide default values for HEIGHT and WIDTH. */
813 if (FRAME_NEW_WIDTH (f
))
814 width
= FRAME_NEW_WIDTH (f
);
816 width
= FRAME_WIDTH (f
);
818 if (FRAME_NEW_HEIGHT (f
))
819 height
= FRAME_NEW_HEIGHT (f
);
821 height
= FRAME_HEIGHT (f
);
823 /* Process foreground_color and background_color before anything else.
824 They are independent of other properties, but other properties (e.g.,
825 cursor_color) are dependent upon them. */
826 /* Process default font as well, since fringe widths depends on it. */
827 for (p
= 0; p
< i
; p
++)
829 Lisp_Object prop
, val
;
833 if (EQ (prop
, Qforeground_color
)
834 || EQ (prop
, Qbackground_color
)
837 register Lisp_Object param_index
, old_value
;
839 old_value
= get_frame_param (f
, prop
);
841 if (NILP (Fequal (val
, old_value
)))
843 store_frame_param (f
, prop
, val
);
845 param_index
= Fget (prop
, Qx_frame_parameter
);
846 if (NATNUMP (param_index
)
847 && (XFASTINT (param_index
)
848 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
849 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
854 /* Now process them in reverse of specified order. */
855 for (i
--; i
>= 0; i
--)
857 Lisp_Object prop
, val
;
862 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
863 width
= XFASTINT (val
);
864 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
865 height
= XFASTINT (val
);
866 else if (EQ (prop
, Qtop
))
868 else if (EQ (prop
, Qleft
))
870 else if (EQ (prop
, Qicon_top
))
872 else if (EQ (prop
, Qicon_left
))
874 else if (EQ (prop
, Qforeground_color
)
875 || EQ (prop
, Qbackground_color
)
877 /* Processed above. */
881 register Lisp_Object param_index
, old_value
;
883 old_value
= get_frame_param (f
, prop
);
885 store_frame_param (f
, prop
, val
);
887 param_index
= Fget (prop
, Qx_frame_parameter
);
888 if (NATNUMP (param_index
)
889 && (XFASTINT (param_index
)
890 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
891 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
895 /* Don't die if just one of these was set. */
896 if (EQ (left
, Qunbound
))
899 if (f
->output_data
.w32
->left_pos
< 0)
900 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
902 XSETINT (left
, f
->output_data
.w32
->left_pos
);
904 if (EQ (top
, Qunbound
))
907 if (f
->output_data
.w32
->top_pos
< 0)
908 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
910 XSETINT (top
, f
->output_data
.w32
->top_pos
);
913 /* If one of the icon positions was not set, preserve or default it. */
914 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
916 icon_left_no_change
= 1;
917 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
918 if (NILP (icon_left
))
919 XSETINT (icon_left
, 0);
921 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
923 icon_top_no_change
= 1;
924 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
926 XSETINT (icon_top
, 0);
929 /* Don't set these parameters unless they've been explicitly
930 specified. The window might be mapped or resized while we're in
931 this function, and we don't want to override that unless the lisp
932 code has asked for it.
934 Don't set these parameters unless they actually differ from the
935 window's current parameters; the window may not actually exist
940 check_frame_size (f
, &height
, &width
);
942 XSETFRAME (frame
, f
);
944 if (width
!= FRAME_WIDTH (f
)
945 || height
!= FRAME_HEIGHT (f
)
946 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
947 Fset_frame_size (frame
, make_number (width
), make_number (height
));
949 if ((!NILP (left
) || !NILP (top
))
950 && ! (left_no_change
&& top_no_change
)
951 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
952 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
957 /* Record the signs. */
958 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
959 if (EQ (left
, Qminus
))
960 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
961 else if (INTEGERP (left
))
963 leftpos
= XINT (left
);
965 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
967 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
968 && CONSP (XCDR (left
))
969 && INTEGERP (XCAR (XCDR (left
))))
971 leftpos
= - XINT (XCAR (XCDR (left
)));
972 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
974 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
975 && CONSP (XCDR (left
))
976 && INTEGERP (XCAR (XCDR (left
))))
978 leftpos
= XINT (XCAR (XCDR (left
)));
981 if (EQ (top
, Qminus
))
982 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
983 else if (INTEGERP (top
))
987 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
989 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
990 && CONSP (XCDR (top
))
991 && INTEGERP (XCAR (XCDR (top
))))
993 toppos
= - XINT (XCAR (XCDR (top
)));
994 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
996 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
997 && CONSP (XCDR (top
))
998 && INTEGERP (XCAR (XCDR (top
))))
1000 toppos
= XINT (XCAR (XCDR (top
)));
1004 /* Store the numeric value of the position. */
1005 f
->output_data
.w32
->top_pos
= toppos
;
1006 f
->output_data
.w32
->left_pos
= leftpos
;
1008 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
1010 /* Actually set that position, and convert to absolute. */
1011 x_set_offset (f
, leftpos
, toppos
, -1);
1014 if ((!NILP (icon_left
) || !NILP (icon_top
))
1015 && ! (icon_left_no_change
&& icon_top_no_change
))
1016 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1022 /* Store the screen positions of frame F into XPTR and YPTR.
1023 These are the positions of the containing window manager window,
1024 not Emacs's own window. */
1027 x_real_positions (f
, xptr
, yptr
)
1036 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
1037 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
1043 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
1049 /* Insert a description of internally-recorded parameters of frame X
1050 into the parameter alist *ALISTPTR that is to be given to the user.
1051 Only parameters that are specific to W32
1052 and whose values are not correctly recorded in the frame's
1053 param_alist need to be considered here. */
1056 x_report_frame_params (f
, alistptr
)
1058 Lisp_Object
*alistptr
;
1063 /* Represent negative positions (off the top or left screen edge)
1064 in a way that Fmodify_frame_parameters will understand correctly. */
1065 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
1066 if (f
->output_data
.w32
->left_pos
>= 0)
1067 store_in_alist (alistptr
, Qleft
, tem
);
1069 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1071 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
1072 if (f
->output_data
.w32
->top_pos
>= 0)
1073 store_in_alist (alistptr
, Qtop
, tem
);
1075 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1077 store_in_alist (alistptr
, Qborder_width
,
1078 make_number (f
->output_data
.w32
->border_width
));
1079 store_in_alist (alistptr
, Qinternal_border_width
,
1080 make_number (f
->output_data
.w32
->internal_border_width
));
1081 store_in_alist (alistptr
, Qleft_fringe
,
1082 make_number (f
->output_data
.w32
->left_fringe_width
));
1083 store_in_alist (alistptr
, Qright_fringe
,
1084 make_number (f
->output_data
.w32
->right_fringe_width
));
1085 store_in_alist (alistptr
, Qscroll_bar_width
,
1086 make_number (FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
1087 ? FRAME_SCROLL_BAR_PIXEL_WIDTH(f
)
1089 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
1090 store_in_alist (alistptr
, Qwindow_id
,
1091 build_string (buf
));
1092 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1093 FRAME_SAMPLE_VISIBILITY (f
);
1094 store_in_alist (alistptr
, Qvisibility
,
1095 (FRAME_VISIBLE_P (f
) ? Qt
1096 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1097 store_in_alist (alistptr
, Qdisplay
,
1098 XCAR (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
));
1102 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
,
1103 Sw32_define_rgb_color
, 4, 4, 0,
1104 doc
: /* Convert RGB numbers to a windows color reference and associate with NAME.
1105 This adds or updates a named color to w32-color-map, making it
1106 available for use. The original entry's RGB ref is returned, or nil
1107 if the entry is new. */)
1108 (red
, green
, blue
, name
)
1109 Lisp_Object red
, green
, blue
, name
;
1112 Lisp_Object oldrgb
= Qnil
;
1116 CHECK_NUMBER (green
);
1117 CHECK_NUMBER (blue
);
1118 CHECK_STRING (name
);
1120 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
1124 /* replace existing entry in w32-color-map or add new entry. */
1125 entry
= Fassoc (name
, Vw32_color_map
);
1128 entry
= Fcons (name
, rgb
);
1129 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
1133 oldrgb
= Fcdr (entry
);
1134 Fsetcdr (entry
, rgb
);
1142 DEFUN ("w32-load-color-file", Fw32_load_color_file
,
1143 Sw32_load_color_file
, 1, 1, 0,
1144 doc
: /* Create an alist of color entries from an external file.
1145 Assign this value to w32-color-map to replace the existing color map.
1147 The file should define one named RGB color per line like so:
1149 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
1151 Lisp_Object filename
;
1154 Lisp_Object cmap
= Qnil
;
1155 Lisp_Object abspath
;
1157 CHECK_STRING (filename
);
1158 abspath
= Fexpand_file_name (filename
, Qnil
);
1160 fp
= fopen (XSTRING (filename
)->data
, "rt");
1164 int red
, green
, blue
;
1169 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
1170 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
1172 char *name
= buf
+ num
;
1173 num
= strlen (name
) - 1;
1174 if (name
[num
] == '\n')
1176 cmap
= Fcons (Fcons (build_string (name
),
1177 make_number (RGB (red
, green
, blue
))),
1189 /* The default colors for the w32 color map */
1190 typedef struct colormap_t
1196 colormap_t w32_color_map
[] =
1198 {"snow" , PALETTERGB (255,250,250)},
1199 {"ghost white" , PALETTERGB (248,248,255)},
1200 {"GhostWhite" , PALETTERGB (248,248,255)},
1201 {"white smoke" , PALETTERGB (245,245,245)},
1202 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1203 {"gainsboro" , PALETTERGB (220,220,220)},
1204 {"floral white" , PALETTERGB (255,250,240)},
1205 {"FloralWhite" , PALETTERGB (255,250,240)},
1206 {"old lace" , PALETTERGB (253,245,230)},
1207 {"OldLace" , PALETTERGB (253,245,230)},
1208 {"linen" , PALETTERGB (250,240,230)},
1209 {"antique white" , PALETTERGB (250,235,215)},
1210 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1211 {"papaya whip" , PALETTERGB (255,239,213)},
1212 {"PapayaWhip" , PALETTERGB (255,239,213)},
1213 {"blanched almond" , PALETTERGB (255,235,205)},
1214 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1215 {"bisque" , PALETTERGB (255,228,196)},
1216 {"peach puff" , PALETTERGB (255,218,185)},
1217 {"PeachPuff" , PALETTERGB (255,218,185)},
1218 {"navajo white" , PALETTERGB (255,222,173)},
1219 {"NavajoWhite" , PALETTERGB (255,222,173)},
1220 {"moccasin" , PALETTERGB (255,228,181)},
1221 {"cornsilk" , PALETTERGB (255,248,220)},
1222 {"ivory" , PALETTERGB (255,255,240)},
1223 {"lemon chiffon" , PALETTERGB (255,250,205)},
1224 {"LemonChiffon" , PALETTERGB (255,250,205)},
1225 {"seashell" , PALETTERGB (255,245,238)},
1226 {"honeydew" , PALETTERGB (240,255,240)},
1227 {"mint cream" , PALETTERGB (245,255,250)},
1228 {"MintCream" , PALETTERGB (245,255,250)},
1229 {"azure" , PALETTERGB (240,255,255)},
1230 {"alice blue" , PALETTERGB (240,248,255)},
1231 {"AliceBlue" , PALETTERGB (240,248,255)},
1232 {"lavender" , PALETTERGB (230,230,250)},
1233 {"lavender blush" , PALETTERGB (255,240,245)},
1234 {"LavenderBlush" , PALETTERGB (255,240,245)},
1235 {"misty rose" , PALETTERGB (255,228,225)},
1236 {"MistyRose" , PALETTERGB (255,228,225)},
1237 {"white" , PALETTERGB (255,255,255)},
1238 {"black" , PALETTERGB ( 0, 0, 0)},
1239 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1240 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1241 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1242 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1243 {"dim gray" , PALETTERGB (105,105,105)},
1244 {"DimGray" , PALETTERGB (105,105,105)},
1245 {"dim grey" , PALETTERGB (105,105,105)},
1246 {"DimGrey" , PALETTERGB (105,105,105)},
1247 {"slate gray" , PALETTERGB (112,128,144)},
1248 {"SlateGray" , PALETTERGB (112,128,144)},
1249 {"slate grey" , PALETTERGB (112,128,144)},
1250 {"SlateGrey" , PALETTERGB (112,128,144)},
1251 {"light slate gray" , PALETTERGB (119,136,153)},
1252 {"LightSlateGray" , PALETTERGB (119,136,153)},
1253 {"light slate grey" , PALETTERGB (119,136,153)},
1254 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1255 {"gray" , PALETTERGB (190,190,190)},
1256 {"grey" , PALETTERGB (190,190,190)},
1257 {"light grey" , PALETTERGB (211,211,211)},
1258 {"LightGrey" , PALETTERGB (211,211,211)},
1259 {"light gray" , PALETTERGB (211,211,211)},
1260 {"LightGray" , PALETTERGB (211,211,211)},
1261 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1262 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1263 {"navy" , PALETTERGB ( 0, 0,128)},
1264 {"navy blue" , PALETTERGB ( 0, 0,128)},
1265 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1266 {"cornflower blue" , PALETTERGB (100,149,237)},
1267 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1268 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1269 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1270 {"slate blue" , PALETTERGB (106, 90,205)},
1271 {"SlateBlue" , PALETTERGB (106, 90,205)},
1272 {"medium slate blue" , PALETTERGB (123,104,238)},
1273 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1274 {"light slate blue" , PALETTERGB (132,112,255)},
1275 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1276 {"medium blue" , PALETTERGB ( 0, 0,205)},
1277 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1278 {"royal blue" , PALETTERGB ( 65,105,225)},
1279 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1280 {"blue" , PALETTERGB ( 0, 0,255)},
1281 {"dodger blue" , PALETTERGB ( 30,144,255)},
1282 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1283 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1284 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1285 {"sky blue" , PALETTERGB (135,206,235)},
1286 {"SkyBlue" , PALETTERGB (135,206,235)},
1287 {"light sky blue" , PALETTERGB (135,206,250)},
1288 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1289 {"steel blue" , PALETTERGB ( 70,130,180)},
1290 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1291 {"light steel blue" , PALETTERGB (176,196,222)},
1292 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1293 {"light blue" , PALETTERGB (173,216,230)},
1294 {"LightBlue" , PALETTERGB (173,216,230)},
1295 {"powder blue" , PALETTERGB (176,224,230)},
1296 {"PowderBlue" , PALETTERGB (176,224,230)},
1297 {"pale turquoise" , PALETTERGB (175,238,238)},
1298 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1299 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1300 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1301 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1302 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1303 {"turquoise" , PALETTERGB ( 64,224,208)},
1304 {"cyan" , PALETTERGB ( 0,255,255)},
1305 {"light cyan" , PALETTERGB (224,255,255)},
1306 {"LightCyan" , PALETTERGB (224,255,255)},
1307 {"cadet blue" , PALETTERGB ( 95,158,160)},
1308 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1309 {"medium aquamarine" , PALETTERGB (102,205,170)},
1310 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1311 {"aquamarine" , PALETTERGB (127,255,212)},
1312 {"dark green" , PALETTERGB ( 0,100, 0)},
1313 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1314 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1315 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1316 {"dark sea green" , PALETTERGB (143,188,143)},
1317 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1318 {"sea green" , PALETTERGB ( 46,139, 87)},
1319 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1320 {"medium sea green" , PALETTERGB ( 60,179,113)},
1321 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1322 {"light sea green" , PALETTERGB ( 32,178,170)},
1323 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1324 {"pale green" , PALETTERGB (152,251,152)},
1325 {"PaleGreen" , PALETTERGB (152,251,152)},
1326 {"spring green" , PALETTERGB ( 0,255,127)},
1327 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1328 {"lawn green" , PALETTERGB (124,252, 0)},
1329 {"LawnGreen" , PALETTERGB (124,252, 0)},
1330 {"green" , PALETTERGB ( 0,255, 0)},
1331 {"chartreuse" , PALETTERGB (127,255, 0)},
1332 {"medium spring green" , PALETTERGB ( 0,250,154)},
1333 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1334 {"green yellow" , PALETTERGB (173,255, 47)},
1335 {"GreenYellow" , PALETTERGB (173,255, 47)},
1336 {"lime green" , PALETTERGB ( 50,205, 50)},
1337 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1338 {"yellow green" , PALETTERGB (154,205, 50)},
1339 {"YellowGreen" , PALETTERGB (154,205, 50)},
1340 {"forest green" , PALETTERGB ( 34,139, 34)},
1341 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1342 {"olive drab" , PALETTERGB (107,142, 35)},
1343 {"OliveDrab" , PALETTERGB (107,142, 35)},
1344 {"dark khaki" , PALETTERGB (189,183,107)},
1345 {"DarkKhaki" , PALETTERGB (189,183,107)},
1346 {"khaki" , PALETTERGB (240,230,140)},
1347 {"pale goldenrod" , PALETTERGB (238,232,170)},
1348 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1349 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1350 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1351 {"light yellow" , PALETTERGB (255,255,224)},
1352 {"LightYellow" , PALETTERGB (255,255,224)},
1353 {"yellow" , PALETTERGB (255,255, 0)},
1354 {"gold" , PALETTERGB (255,215, 0)},
1355 {"light goldenrod" , PALETTERGB (238,221,130)},
1356 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1357 {"goldenrod" , PALETTERGB (218,165, 32)},
1358 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1359 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1360 {"rosy brown" , PALETTERGB (188,143,143)},
1361 {"RosyBrown" , PALETTERGB (188,143,143)},
1362 {"indian red" , PALETTERGB (205, 92, 92)},
1363 {"IndianRed" , PALETTERGB (205, 92, 92)},
1364 {"saddle brown" , PALETTERGB (139, 69, 19)},
1365 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1366 {"sienna" , PALETTERGB (160, 82, 45)},
1367 {"peru" , PALETTERGB (205,133, 63)},
1368 {"burlywood" , PALETTERGB (222,184,135)},
1369 {"beige" , PALETTERGB (245,245,220)},
1370 {"wheat" , PALETTERGB (245,222,179)},
1371 {"sandy brown" , PALETTERGB (244,164, 96)},
1372 {"SandyBrown" , PALETTERGB (244,164, 96)},
1373 {"tan" , PALETTERGB (210,180,140)},
1374 {"chocolate" , PALETTERGB (210,105, 30)},
1375 {"firebrick" , PALETTERGB (178,34, 34)},
1376 {"brown" , PALETTERGB (165,42, 42)},
1377 {"dark salmon" , PALETTERGB (233,150,122)},
1378 {"DarkSalmon" , PALETTERGB (233,150,122)},
1379 {"salmon" , PALETTERGB (250,128,114)},
1380 {"light salmon" , PALETTERGB (255,160,122)},
1381 {"LightSalmon" , PALETTERGB (255,160,122)},
1382 {"orange" , PALETTERGB (255,165, 0)},
1383 {"dark orange" , PALETTERGB (255,140, 0)},
1384 {"DarkOrange" , PALETTERGB (255,140, 0)},
1385 {"coral" , PALETTERGB (255,127, 80)},
1386 {"light coral" , PALETTERGB (240,128,128)},
1387 {"LightCoral" , PALETTERGB (240,128,128)},
1388 {"tomato" , PALETTERGB (255, 99, 71)},
1389 {"orange red" , PALETTERGB (255, 69, 0)},
1390 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1391 {"red" , PALETTERGB (255, 0, 0)},
1392 {"hot pink" , PALETTERGB (255,105,180)},
1393 {"HotPink" , PALETTERGB (255,105,180)},
1394 {"deep pink" , PALETTERGB (255, 20,147)},
1395 {"DeepPink" , PALETTERGB (255, 20,147)},
1396 {"pink" , PALETTERGB (255,192,203)},
1397 {"light pink" , PALETTERGB (255,182,193)},
1398 {"LightPink" , PALETTERGB (255,182,193)},
1399 {"pale violet red" , PALETTERGB (219,112,147)},
1400 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1401 {"maroon" , PALETTERGB (176, 48, 96)},
1402 {"medium violet red" , PALETTERGB (199, 21,133)},
1403 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1404 {"violet red" , PALETTERGB (208, 32,144)},
1405 {"VioletRed" , PALETTERGB (208, 32,144)},
1406 {"magenta" , PALETTERGB (255, 0,255)},
1407 {"violet" , PALETTERGB (238,130,238)},
1408 {"plum" , PALETTERGB (221,160,221)},
1409 {"orchid" , PALETTERGB (218,112,214)},
1410 {"medium orchid" , PALETTERGB (186, 85,211)},
1411 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1412 {"dark orchid" , PALETTERGB (153, 50,204)},
1413 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1414 {"dark violet" , PALETTERGB (148, 0,211)},
1415 {"DarkViolet" , PALETTERGB (148, 0,211)},
1416 {"blue violet" , PALETTERGB (138, 43,226)},
1417 {"BlueViolet" , PALETTERGB (138, 43,226)},
1418 {"purple" , PALETTERGB (160, 32,240)},
1419 {"medium purple" , PALETTERGB (147,112,219)},
1420 {"MediumPurple" , PALETTERGB (147,112,219)},
1421 {"thistle" , PALETTERGB (216,191,216)},
1422 {"gray0" , PALETTERGB ( 0, 0, 0)},
1423 {"grey0" , PALETTERGB ( 0, 0, 0)},
1424 {"dark grey" , PALETTERGB (169,169,169)},
1425 {"DarkGrey" , PALETTERGB (169,169,169)},
1426 {"dark gray" , PALETTERGB (169,169,169)},
1427 {"DarkGray" , PALETTERGB (169,169,169)},
1428 {"dark blue" , PALETTERGB ( 0, 0,139)},
1429 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1430 {"dark cyan" , PALETTERGB ( 0,139,139)},
1431 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1432 {"dark magenta" , PALETTERGB (139, 0,139)},
1433 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1434 {"dark red" , PALETTERGB (139, 0, 0)},
1435 {"DarkRed" , PALETTERGB (139, 0, 0)},
1436 {"light green" , PALETTERGB (144,238,144)},
1437 {"LightGreen" , PALETTERGB (144,238,144)},
1440 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1441 0, 0, 0, doc
: /* Return the default color map. */)
1445 colormap_t
*pc
= w32_color_map
;
1452 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1454 cmap
= Fcons (Fcons (build_string (pc
->name
),
1455 make_number (pc
->colorref
)),
1464 w32_to_x_color (rgb
)
1473 color
= Frassq (rgb
, Vw32_color_map
);
1478 return (Fcar (color
));
1484 w32_color_map_lookup (colorname
)
1487 Lisp_Object tail
, ret
= Qnil
;
1491 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1493 register Lisp_Object elt
, tem
;
1496 if (!CONSP (elt
)) continue;
1500 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1502 ret
= XUINT (Fcdr (elt
));
1516 x_to_w32_color (colorname
)
1519 register Lisp_Object ret
= Qnil
;
1523 if (colorname
[0] == '#')
1525 /* Could be an old-style RGB Device specification. */
1528 color
= colorname
+ 1;
1530 size
= strlen(color
);
1531 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1539 for (i
= 0; i
< 3; i
++)
1543 unsigned long value
;
1545 /* The check for 'x' in the following conditional takes into
1546 account the fact that strtol allows a "0x" in front of
1547 our numbers, and we don't. */
1548 if (!isxdigit(color
[0]) || color
[1] == 'x')
1552 value
= strtoul(color
, &end
, 16);
1554 if (errno
== ERANGE
|| end
- color
!= size
)
1559 value
= value
* 0x10;
1570 colorval
|= (value
<< pos
);
1581 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1589 color
= colorname
+ 4;
1590 for (i
= 0; i
< 3; i
++)
1593 unsigned long value
;
1595 /* The check for 'x' in the following conditional takes into
1596 account the fact that strtol allows a "0x" in front of
1597 our numbers, and we don't. */
1598 if (!isxdigit(color
[0]) || color
[1] == 'x')
1600 value
= strtoul(color
, &end
, 16);
1601 if (errno
== ERANGE
)
1603 switch (end
- color
)
1606 value
= value
* 0x10 + value
;
1619 if (value
== ULONG_MAX
)
1621 colorval
|= (value
<< pos
);
1635 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1637 /* This is an RGB Intensity specification. */
1644 color
= colorname
+ 5;
1645 for (i
= 0; i
< 3; i
++)
1651 value
= strtod(color
, &end
);
1652 if (errno
== ERANGE
)
1654 if (value
< 0.0 || value
> 1.0)
1656 val
= (UINT
)(0x100 * value
);
1657 /* We used 0x100 instead of 0xFF to give an continuous
1658 range between 0.0 and 1.0 inclusive. The next statement
1659 fixes the 1.0 case. */
1662 colorval
|= (val
<< pos
);
1676 /* I am not going to attempt to handle any of the CIE color schemes
1677 or TekHVC, since I don't know the algorithms for conversion to
1680 /* If we fail to lookup the color name in w32_color_map, then check the
1681 colorname to see if it can be crudely approximated: If the X color
1682 ends in a number (e.g., "darkseagreen2"), strip the number and
1683 return the result of looking up the base color name. */
1684 ret
= w32_color_map_lookup (colorname
);
1687 int len
= strlen (colorname
);
1689 if (isdigit (colorname
[len
- 1]))
1691 char *ptr
, *approx
= alloca (len
+ 1);
1693 strcpy (approx
, colorname
);
1694 ptr
= &approx
[len
- 1];
1695 while (ptr
> approx
&& isdigit (*ptr
))
1698 ret
= w32_color_map_lookup (approx
);
1708 w32_regenerate_palette (FRAME_PTR f
)
1710 struct w32_palette_entry
* list
;
1711 LOGPALETTE
* log_palette
;
1712 HPALETTE new_palette
;
1715 /* don't bother trying to create palette if not supported */
1716 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1719 log_palette
= (LOGPALETTE
*)
1720 alloca (sizeof (LOGPALETTE
) +
1721 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1722 log_palette
->palVersion
= 0x300;
1723 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1725 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1727 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1728 i
++, list
= list
->next
)
1729 log_palette
->palPalEntry
[i
] = list
->entry
;
1731 new_palette
= CreatePalette (log_palette
);
1735 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1736 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1737 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1739 /* Realize display palette and garbage all frames. */
1740 release_frame_dc (f
, get_frame_dc (f
));
1745 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1746 #define SET_W32_COLOR(pe, color) \
1749 pe.peRed = GetRValue (color); \
1750 pe.peGreen = GetGValue (color); \
1751 pe.peBlue = GetBValue (color); \
1756 /* Keep these around in case we ever want to track color usage. */
1758 w32_map_color (FRAME_PTR f
, COLORREF color
)
1760 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1762 if (NILP (Vw32_enable_palette
))
1765 /* check if color is already mapped */
1768 if (W32_COLOR (list
->entry
) == color
)
1776 /* not already mapped, so add to list and recreate Windows palette */
1777 list
= (struct w32_palette_entry
*)
1778 xmalloc (sizeof (struct w32_palette_entry
));
1779 SET_W32_COLOR (list
->entry
, color
);
1781 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1782 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1783 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1785 /* set flag that palette must be regenerated */
1786 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1790 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1792 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1793 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1795 if (NILP (Vw32_enable_palette
))
1798 /* check if color is already mapped */
1801 if (W32_COLOR (list
->entry
) == color
)
1803 if (--list
->refcount
== 0)
1807 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1817 /* set flag that palette must be regenerated */
1818 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1823 /* Gamma-correct COLOR on frame F. */
1826 gamma_correct (f
, color
)
1832 *color
= PALETTERGB (
1833 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1834 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1835 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1840 /* Decide if color named COLOR is valid for the display associated with
1841 the selected frame; if so, return the rgb values in COLOR_DEF.
1842 If ALLOC is nonzero, allocate a new colormap cell. */
1845 w32_defined_color (f
, color
, color_def
, alloc
)
1851 register Lisp_Object tem
;
1852 COLORREF w32_color_ref
;
1854 tem
= x_to_w32_color (color
);
1860 /* Apply gamma correction. */
1861 w32_color_ref
= XUINT (tem
);
1862 gamma_correct (f
, &w32_color_ref
);
1863 XSETINT (tem
, w32_color_ref
);
1866 /* Map this color to the palette if it is enabled. */
1867 if (!NILP (Vw32_enable_palette
))
1869 struct w32_palette_entry
* entry
=
1870 one_w32_display_info
.color_list
;
1871 struct w32_palette_entry
** prev
=
1872 &one_w32_display_info
.color_list
;
1874 /* check if color is already mapped */
1877 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1879 prev
= &entry
->next
;
1880 entry
= entry
->next
;
1883 if (entry
== NULL
&& alloc
)
1885 /* not already mapped, so add to list */
1886 entry
= (struct w32_palette_entry
*)
1887 xmalloc (sizeof (struct w32_palette_entry
));
1888 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1891 one_w32_display_info
.num_colors
++;
1893 /* set flag that palette must be regenerated */
1894 one_w32_display_info
.regen_palette
= TRUE
;
1897 /* Ensure COLORREF value is snapped to nearest color in (default)
1898 palette by simulating the PALETTERGB macro. This works whether
1899 or not the display device has a palette. */
1900 w32_color_ref
= XUINT (tem
) | 0x2000000;
1902 color_def
->pixel
= w32_color_ref
;
1903 color_def
->red
= GetRValue (w32_color_ref
);
1904 color_def
->green
= GetGValue (w32_color_ref
);
1905 color_def
->blue
= GetBValue (w32_color_ref
);
1915 /* Given a string ARG naming a color, compute a pixel value from it
1916 suitable for screen F.
1917 If F is not a color screen, return DEF (default) regardless of what
1921 x_decode_color (f
, arg
, def
)
1930 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1931 return BLACK_PIX_DEFAULT (f
);
1932 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1933 return WHITE_PIX_DEFAULT (f
);
1935 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1938 /* w32_defined_color is responsible for coping with failures
1939 by looking for a near-miss. */
1940 if (w32_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1943 /* defined_color failed; return an ultimate default. */
1947 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1948 the previous value of that parameter, NEW_VALUE is the new value. */
1951 x_set_line_spacing (f
, new_value
, old_value
)
1953 Lisp_Object new_value
, old_value
;
1955 if (NILP (new_value
))
1956 f
->extra_line_spacing
= 0;
1957 else if (NATNUMP (new_value
))
1958 f
->extra_line_spacing
= XFASTINT (new_value
);
1960 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1961 Fcons (new_value
, Qnil
)));
1962 if (FRAME_VISIBLE_P (f
))
1967 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1968 the previous value of that parameter, NEW_VALUE is the new value. */
1971 x_set_screen_gamma (f
, new_value
, old_value
)
1973 Lisp_Object new_value
, old_value
;
1975 if (NILP (new_value
))
1977 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1978 /* The value 0.4545 is the normal viewing gamma. */
1979 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1981 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1982 Fcons (new_value
, Qnil
)));
1984 clear_face_cache (0);
1988 /* Functions called only from `x_set_frame_param'
1989 to set individual parameters.
1991 If FRAME_W32_WINDOW (f) is 0,
1992 the frame is being created and its window does not exist yet.
1993 In that case, just record the parameter's new value
1994 in the standard place; do not attempt to change the window. */
1997 x_set_foreground_color (f
, arg
, oldval
)
1999 Lisp_Object arg
, oldval
;
2001 struct w32_output
*x
= f
->output_data
.w32
;
2002 PIX_TYPE fg
, old_fg
;
2004 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2005 old_fg
= FRAME_FOREGROUND_PIXEL (f
);
2006 FRAME_FOREGROUND_PIXEL (f
) = fg
;
2008 if (FRAME_W32_WINDOW (f
) != 0)
2010 if (x
->cursor_pixel
== old_fg
)
2011 x
->cursor_pixel
= fg
;
2013 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
2014 if (FRAME_VISIBLE_P (f
))
2020 x_set_background_color (f
, arg
, oldval
)
2022 Lisp_Object arg
, oldval
;
2024 FRAME_BACKGROUND_PIXEL (f
)
2025 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
2027 if (FRAME_W32_WINDOW (f
) != 0)
2029 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
2030 FRAME_BACKGROUND_PIXEL (f
));
2032 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
2034 if (FRAME_VISIBLE_P (f
))
2040 x_set_mouse_color (f
, arg
, oldval
)
2042 Lisp_Object arg
, oldval
;
2044 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
2048 if (!EQ (Qnil
, arg
))
2049 f
->output_data
.w32
->mouse_pixel
2050 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2051 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
2053 /* Don't let pointers be invisible. */
2054 if (mask_color
== f
->output_data
.w32
->mouse_pixel
2055 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
2056 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
2058 #if 0 /* TODO : cursor changes */
2061 /* It's not okay to crash if the user selects a screwy cursor. */
2062 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
2064 if (!EQ (Qnil
, Vx_pointer_shape
))
2066 CHECK_NUMBER (Vx_pointer_shape
);
2067 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
2070 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2071 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
2073 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
2075 CHECK_NUMBER (Vx_nontext_pointer_shape
);
2076 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2077 XINT (Vx_nontext_pointer_shape
));
2080 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
2081 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2083 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
2085 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
2086 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2087 XINT (Vx_hourglass_pointer_shape
));
2090 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
2091 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
2093 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2094 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
2096 CHECK_NUMBER (Vx_mode_pointer_shape
);
2097 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2098 XINT (Vx_mode_pointer_shape
));
2101 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2102 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
2104 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
2106 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
2108 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2109 XINT (Vx_sensitive_text_pointer_shape
));
2112 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
2114 if (!NILP (Vx_window_horizontal_drag_shape
))
2116 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
2117 horizontal_drag_cursor
2118 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
2119 XINT (Vx_window_horizontal_drag_shape
));
2122 horizontal_drag_cursor
2123 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
2125 /* Check and report errors with the above calls. */
2126 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
2127 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
2130 XColor fore_color
, back_color
;
2132 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
2133 back_color
.pixel
= mask_color
;
2134 XQueryColor (FRAME_W32_DISPLAY (f
),
2135 DefaultColormap (FRAME_W32_DISPLAY (f
),
2136 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2138 XQueryColor (FRAME_W32_DISPLAY (f
),
2139 DefaultColormap (FRAME_W32_DISPLAY (f
),
2140 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2142 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
2143 &fore_color
, &back_color
);
2144 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
2145 &fore_color
, &back_color
);
2146 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
2147 &fore_color
, &back_color
);
2148 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
2149 &fore_color
, &back_color
);
2150 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
2151 &fore_color
, &back_color
);
2154 if (FRAME_W32_WINDOW (f
) != 0)
2155 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
2157 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
2158 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
2159 f
->output_data
.w32
->text_cursor
= cursor
;
2161 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
2162 && f
->output_data
.w32
->nontext_cursor
!= 0)
2163 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
2164 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
2166 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
2167 && f
->output_data
.w32
->hourglass_cursor
!= 0)
2168 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
2169 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
2171 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
2172 && f
->output_data
.w32
->modeline_cursor
!= 0)
2173 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
2174 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
2176 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
2177 && f
->output_data
.w32
->cross_cursor
!= 0)
2178 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
2179 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
2181 XFlush (FRAME_W32_DISPLAY (f
));
2184 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
2188 /* Defined in w32term.c. */
2189 void x_update_cursor (struct frame
*f
, int on_p
);
2192 x_set_cursor_color (f
, arg
, oldval
)
2194 Lisp_Object arg
, oldval
;
2196 unsigned long fore_pixel
, pixel
;
2198 if (!NILP (Vx_cursor_fore_pixel
))
2199 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
2200 WHITE_PIX_DEFAULT (f
));
2202 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2204 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2206 /* Make sure that the cursor color differs from the background color. */
2207 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
2209 pixel
= f
->output_data
.w32
->mouse_pixel
;
2210 if (pixel
== fore_pixel
)
2211 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2214 FRAME_FOREGROUND_PIXEL (f
) = fore_pixel
;
2215 f
->output_data
.w32
->cursor_pixel
= pixel
;
2217 if (FRAME_W32_WINDOW (f
) != 0)
2219 if (FRAME_VISIBLE_P (f
))
2221 x_update_cursor (f
, 0);
2222 x_update_cursor (f
, 1);
2226 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
2229 /* Set the border-color of frame F to pixel value PIX.
2230 Note that this does not fully take effect if done before
2233 x_set_border_pixel (f
, pix
)
2237 f
->output_data
.w32
->border_pixel
= pix
;
2239 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
2241 if (FRAME_VISIBLE_P (f
))
2246 /* Set the border-color of frame F to value described by ARG.
2247 ARG can be a string naming a color.
2248 The border-color is used for the border that is drawn by the server.
2249 Note that this does not fully take effect if done before
2250 F has a window; it must be redone when the window is created. */
2253 x_set_border_color (f
, arg
, oldval
)
2255 Lisp_Object arg
, oldval
;
2260 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2261 x_set_border_pixel (f
, pix
);
2262 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
2265 /* Value is the internal representation of the specified cursor type
2266 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
2267 of the bar cursor. */
2269 enum text_cursor_kinds
2270 x_specified_cursor_type (arg
, width
)
2274 enum text_cursor_kinds type
;
2281 else if (CONSP (arg
)
2282 && EQ (XCAR (arg
), Qbar
)
2283 && INTEGERP (XCDR (arg
))
2284 && XINT (XCDR (arg
)) >= 0)
2287 *width
= XINT (XCDR (arg
));
2289 else if (NILP (arg
))
2292 /* Treat anything unknown as "box cursor".
2293 It was bad to signal an error; people have trouble fixing
2294 .Xdefaults with Emacs, when it has something bad in it. */
2295 type
= FILLED_BOX_CURSOR
;
2301 x_set_cursor_type (f
, arg
, oldval
)
2303 Lisp_Object arg
, oldval
;
2307 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
2308 f
->output_data
.w32
->cursor_width
= width
;
2310 /* Make sure the cursor gets redrawn. This is overkill, but how
2311 often do people change cursor types? */
2312 update_mode_lines
++;
2316 x_set_icon_type (f
, arg
, oldval
)
2318 Lisp_Object arg
, oldval
;
2322 if (NILP (arg
) && NILP (oldval
))
2325 if (STRINGP (arg
) && STRINGP (oldval
)
2326 && EQ (Fstring_equal (oldval
, arg
), Qt
))
2329 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
2334 result
= x_bitmap_icon (f
, arg
);
2338 error ("No icon window available");
2344 /* Return non-nil if frame F wants a bitmap icon. */
2352 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
2360 x_set_icon_name (f
, arg
, oldval
)
2362 Lisp_Object arg
, oldval
;
2366 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2369 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2375 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2380 result
= x_text_icon (f
,
2381 (char *) XSTRING ((!NILP (f
->icon_name
)
2390 error ("No icon window available");
2393 /* If the window was unmapped (and its icon was mapped),
2394 the new icon is not mapped, so map the window in its stead. */
2395 if (FRAME_VISIBLE_P (f
))
2397 #ifdef USE_X_TOOLKIT
2398 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2400 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2403 XFlush (FRAME_W32_DISPLAY (f
));
2408 extern Lisp_Object
x_new_font ();
2409 extern Lisp_Object
x_new_fontset();
2412 x_set_font (f
, arg
, oldval
)
2414 Lisp_Object arg
, oldval
;
2417 Lisp_Object fontset_name
;
2419 int old_fontset
= FRAME_FONTSET(f
);
2423 fontset_name
= Fquery_fontset (arg
, Qnil
);
2426 result
= (STRINGP (fontset_name
)
2427 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
2428 : x_new_font (f
, XSTRING (arg
)->data
));
2431 if (EQ (result
, Qnil
))
2432 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
2433 else if (EQ (result
, Qt
))
2434 error ("The characters of the given font have varying widths");
2435 else if (STRINGP (result
))
2437 if (STRINGP (fontset_name
))
2439 /* Fontset names are built from ASCII font names, so the
2440 names may be equal despite there was a change. */
2441 if (old_fontset
== FRAME_FONTSET (f
))
2444 else if (!NILP (Fequal (result
, oldval
)))
2447 store_frame_param (f
, Qfont
, result
);
2448 recompute_basic_faces (f
);
2453 do_pending_window_change (0);
2455 /* Don't call `face-set-after-frame-default' when faces haven't been
2456 initialized yet. This is the case when called from
2457 Fx_create_frame. In that case, the X widget or window doesn't
2458 exist either, and we can end up in x_report_frame_params with a
2459 null widget which gives a segfault. */
2460 if (FRAME_FACE_CACHE (f
))
2462 XSETFRAME (frame
, f
);
2463 call1 (Qface_set_after_frame_default
, frame
);
2468 x_set_fringe_width (f
, new_value
, old_value
)
2470 Lisp_Object new_value
, old_value
;
2472 x_compute_fringe_widths (f
, 1);
2476 x_set_border_width (f
, arg
, oldval
)
2478 Lisp_Object arg
, oldval
;
2482 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2485 if (FRAME_W32_WINDOW (f
) != 0)
2486 error ("Cannot change the border width of a window");
2488 f
->output_data
.w32
->border_width
= XINT (arg
);
2492 x_set_internal_border_width (f
, arg
, oldval
)
2494 Lisp_Object arg
, oldval
;
2496 int old
= f
->output_data
.w32
->internal_border_width
;
2499 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2500 if (f
->output_data
.w32
->internal_border_width
< 0)
2501 f
->output_data
.w32
->internal_border_width
= 0;
2503 if (f
->output_data
.w32
->internal_border_width
== old
)
2506 if (FRAME_W32_WINDOW (f
) != 0)
2508 x_set_window_size (f
, 0, f
->width
, f
->height
);
2509 SET_FRAME_GARBAGED (f
);
2510 do_pending_window_change (0);
2513 SET_FRAME_GARBAGED (f
);
2517 x_set_visibility (f
, value
, oldval
)
2519 Lisp_Object value
, oldval
;
2522 XSETFRAME (frame
, f
);
2525 Fmake_frame_invisible (frame
, Qt
);
2526 else if (EQ (value
, Qicon
))
2527 Ficonify_frame (frame
);
2529 Fmake_frame_visible (frame
);
2533 /* Change window heights in windows rooted in WINDOW by N lines. */
2536 x_change_window_heights (window
, n
)
2540 struct window
*w
= XWINDOW (window
);
2542 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2543 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2545 if (INTEGERP (w
->orig_top
))
2546 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2547 if (INTEGERP (w
->orig_height
))
2548 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2550 /* Handle just the top child in a vertical split. */
2551 if (!NILP (w
->vchild
))
2552 x_change_window_heights (w
->vchild
, n
);
2554 /* Adjust all children in a horizontal split. */
2555 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2557 w
= XWINDOW (window
);
2558 x_change_window_heights (window
, n
);
2563 x_set_menu_bar_lines (f
, value
, oldval
)
2565 Lisp_Object value
, oldval
;
2568 int olines
= FRAME_MENU_BAR_LINES (f
);
2570 /* Right now, menu bars don't work properly in minibuf-only frames;
2571 most of the commands try to apply themselves to the minibuffer
2572 frame itself, and get an error because you can't switch buffers
2573 in or split the minibuffer window. */
2574 if (FRAME_MINIBUF_ONLY_P (f
))
2577 if (INTEGERP (value
))
2578 nlines
= XINT (value
);
2582 FRAME_MENU_BAR_LINES (f
) = 0;
2584 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2587 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2588 free_frame_menubar (f
);
2589 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2591 /* Adjust the frame size so that the client (text) dimensions
2592 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2594 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2595 do_pending_window_change (0);
2601 /* Set the number of lines used for the tool bar of frame F to VALUE.
2602 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2603 is the old number of tool bar lines. This function changes the
2604 height of all windows on frame F to match the new tool bar height.
2605 The frame's height doesn't change. */
2608 x_set_tool_bar_lines (f
, value
, oldval
)
2610 Lisp_Object value
, oldval
;
2612 int delta
, nlines
, root_height
;
2613 Lisp_Object root_window
;
2615 /* Treat tool bars like menu bars. */
2616 if (FRAME_MINIBUF_ONLY_P (f
))
2619 /* Use VALUE only if an integer >= 0. */
2620 if (INTEGERP (value
) && XINT (value
) >= 0)
2621 nlines
= XFASTINT (value
);
2625 /* Make sure we redisplay all windows in this frame. */
2626 ++windows_or_buffers_changed
;
2628 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2630 /* Don't resize the tool-bar to more than we have room for. */
2631 root_window
= FRAME_ROOT_WINDOW (f
);
2632 root_height
= XINT (XWINDOW (root_window
)->height
);
2633 if (root_height
- delta
< 1)
2635 delta
= root_height
- 1;
2636 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2639 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2640 x_change_window_heights (root_window
, delta
);
2643 /* We also have to make sure that the internal border at the top of
2644 the frame, below the menu bar or tool bar, is redrawn when the
2645 tool bar disappears. This is so because the internal border is
2646 below the tool bar if one is displayed, but is below the menu bar
2647 if there isn't a tool bar. The tool bar draws into the area
2648 below the menu bar. */
2649 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2653 clear_current_matrices (f
);
2654 updating_frame
= NULL
;
2657 /* If the tool bar gets smaller, the internal border below it
2658 has to be cleared. It was formerly part of the display
2659 of the larger tool bar, and updating windows won't clear it. */
2662 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2663 int width
= PIXEL_WIDTH (f
);
2664 int y
= nlines
* CANON_Y_UNIT (f
);
2668 HDC hdc
= get_frame_dc (f
);
2669 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
2670 release_frame_dc (f
, hdc
);
2674 if (WINDOWP (f
->tool_bar_window
))
2675 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
2680 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2683 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2684 name; if NAME is a string, set F's name to NAME and set
2685 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2687 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2688 suggesting a new name, which lisp code should override; if
2689 F->explicit_name is set, ignore the new name; otherwise, set it. */
2692 x_set_name (f
, name
, explicit)
2697 /* Make sure that requests from lisp code override requests from
2698 Emacs redisplay code. */
2701 /* If we're switching from explicit to implicit, we had better
2702 update the mode lines and thereby update the title. */
2703 if (f
->explicit_name
&& NILP (name
))
2704 update_mode_lines
= 1;
2706 f
->explicit_name
= ! NILP (name
);
2708 else if (f
->explicit_name
)
2711 /* If NAME is nil, set the name to the w32_id_name. */
2714 /* Check for no change needed in this very common case
2715 before we do any consing. */
2716 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2717 XSTRING (f
->name
)->data
))
2719 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2722 CHECK_STRING (name
);
2724 /* Don't change the name if it's already NAME. */
2725 if (! NILP (Fstring_equal (name
, f
->name
)))
2730 /* For setting the frame title, the title parameter should override
2731 the name parameter. */
2732 if (! NILP (f
->title
))
2735 if (FRAME_W32_WINDOW (f
))
2737 if (STRING_MULTIBYTE (name
))
2738 name
= ENCODE_SYSTEM (name
);
2741 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2746 /* This function should be called when the user's lisp code has
2747 specified a name for the frame; the name will override any set by the
2750 x_explicitly_set_name (f
, arg
, oldval
)
2752 Lisp_Object arg
, oldval
;
2754 x_set_name (f
, arg
, 1);
2757 /* This function should be called by Emacs redisplay code to set the
2758 name; names set this way will never override names set by the user's
2761 x_implicitly_set_name (f
, arg
, oldval
)
2763 Lisp_Object arg
, oldval
;
2765 x_set_name (f
, arg
, 0);
2768 /* Change the title of frame F to NAME.
2769 If NAME is nil, use the frame name as the title.
2771 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2772 name; if NAME is a string, set F's name to NAME and set
2773 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2775 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2776 suggesting a new name, which lisp code should override; if
2777 F->explicit_name is set, ignore the new name; otherwise, set it. */
2780 x_set_title (f
, name
, old_name
)
2782 Lisp_Object name
, old_name
;
2784 /* Don't change the title if it's already NAME. */
2785 if (EQ (name
, f
->title
))
2788 update_mode_lines
= 1;
2795 if (FRAME_W32_WINDOW (f
))
2797 if (STRING_MULTIBYTE (name
))
2798 name
= ENCODE_SYSTEM (name
);
2801 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2807 x_set_autoraise (f
, arg
, oldval
)
2809 Lisp_Object arg
, oldval
;
2811 f
->auto_raise
= !EQ (Qnil
, arg
);
2815 x_set_autolower (f
, arg
, oldval
)
2817 Lisp_Object arg
, oldval
;
2819 f
->auto_lower
= !EQ (Qnil
, arg
);
2823 x_set_unsplittable (f
, arg
, oldval
)
2825 Lisp_Object arg
, oldval
;
2827 f
->no_split
= !NILP (arg
);
2831 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2833 Lisp_Object arg
, oldval
;
2835 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2836 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2837 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2838 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2840 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2841 vertical_scroll_bar_none
:
2842 /* Put scroll bars on the right by default, as is conventional
2845 ? vertical_scroll_bar_left
2846 : vertical_scroll_bar_right
;
2848 /* We set this parameter before creating the window for the
2849 frame, so we can get the geometry right from the start.
2850 However, if the window hasn't been created yet, we shouldn't
2851 call x_set_window_size. */
2852 if (FRAME_W32_WINDOW (f
))
2853 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2854 do_pending_window_change (0);
2859 x_set_scroll_bar_width (f
, arg
, oldval
)
2861 Lisp_Object arg
, oldval
;
2863 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2867 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
2868 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) +
2870 if (FRAME_W32_WINDOW (f
))
2871 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2872 do_pending_window_change (0);
2874 else if (INTEGERP (arg
) && XINT (arg
) > 0
2875 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2877 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2878 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2880 if (FRAME_W32_WINDOW (f
))
2881 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2882 do_pending_window_change (0);
2884 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2885 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2886 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2889 /* Subroutines of creating an frame. */
2891 /* Make sure that Vx_resource_name is set to a reasonable value.
2892 Fix it up, or set it to `emacs' if it is too hopeless. */
2895 validate_x_resource_name ()
2898 /* Number of valid characters in the resource name. */
2900 /* Number of invalid characters in the resource name. */
2905 if (STRINGP (Vx_resource_name
))
2907 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2910 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2912 /* Only letters, digits, - and _ are valid in resource names.
2913 Count the valid characters and count the invalid ones. */
2914 for (i
= 0; i
< len
; i
++)
2917 if (! ((c
>= 'a' && c
<= 'z')
2918 || (c
>= 'A' && c
<= 'Z')
2919 || (c
>= '0' && c
<= '9')
2920 || c
== '-' || c
== '_'))
2927 /* Not a string => completely invalid. */
2928 bad_count
= 5, good_count
= 0;
2930 /* If name is valid already, return. */
2934 /* If name is entirely invalid, or nearly so, use `emacs'. */
2936 || (good_count
== 1 && bad_count
> 0))
2938 Vx_resource_name
= build_string ("emacs");
2942 /* Name is partly valid. Copy it and replace the invalid characters
2943 with underscores. */
2945 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2947 for (i
= 0; i
< len
; i
++)
2949 int c
= XSTRING (new)->data
[i
];
2950 if (! ((c
>= 'a' && c
<= 'z')
2951 || (c
>= 'A' && c
<= 'Z')
2952 || (c
>= '0' && c
<= '9')
2953 || c
== '-' || c
== '_'))
2954 XSTRING (new)->data
[i
] = '_';
2959 extern char *x_get_string_resource ();
2961 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2962 doc
: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2963 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2964 class, where INSTANCE is the name under which Emacs was invoked, or
2965 the name specified by the `-name' or `-rn' command-line arguments.
2967 The optional arguments COMPONENT and SUBCLASS add to the key and the
2968 class, respectively. You must specify both of them or neither.
2969 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2970 and the class is `Emacs.CLASS.SUBCLASS'. */)
2971 (attribute
, class, component
, subclass
)
2972 Lisp_Object attribute
, class, component
, subclass
;
2974 register char *value
;
2978 CHECK_STRING (attribute
);
2979 CHECK_STRING (class);
2981 if (!NILP (component
))
2982 CHECK_STRING (component
);
2983 if (!NILP (subclass
))
2984 CHECK_STRING (subclass
);
2985 if (NILP (component
) != NILP (subclass
))
2986 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2988 validate_x_resource_name ();
2990 /* Allocate space for the components, the dots which separate them,
2991 and the final '\0'. Make them big enough for the worst case. */
2992 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2993 + (STRINGP (component
)
2994 ? STRING_BYTES (XSTRING (component
)) : 0)
2995 + STRING_BYTES (XSTRING (attribute
))
2998 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2999 + STRING_BYTES (XSTRING (class))
3000 + (STRINGP (subclass
)
3001 ? STRING_BYTES (XSTRING (subclass
)) : 0)
3004 /* Start with emacs.FRAMENAME for the name (the specific one)
3005 and with `Emacs' for the class key (the general one). */
3006 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
3007 strcpy (class_key
, EMACS_CLASS
);
3009 strcat (class_key
, ".");
3010 strcat (class_key
, XSTRING (class)->data
);
3012 if (!NILP (component
))
3014 strcat (class_key
, ".");
3015 strcat (class_key
, XSTRING (subclass
)->data
);
3017 strcat (name_key
, ".");
3018 strcat (name_key
, XSTRING (component
)->data
);
3021 strcat (name_key
, ".");
3022 strcat (name_key
, XSTRING (attribute
)->data
);
3024 value
= x_get_string_resource (Qnil
,
3025 name_key
, class_key
);
3027 if (value
!= (char *) 0)
3028 return build_string (value
);
3033 /* Used when C code wants a resource value. */
3036 x_get_resource_string (attribute
, class)
3037 char *attribute
, *class;
3041 struct frame
*sf
= SELECTED_FRAME ();
3043 /* Allocate space for the components, the dots which separate them,
3044 and the final '\0'. */
3045 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
3046 + strlen (attribute
) + 2);
3047 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3048 + strlen (class) + 2);
3050 sprintf (name_key
, "%s.%s",
3051 XSTRING (Vinvocation_name
)->data
,
3053 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3055 return x_get_string_resource (sf
, name_key
, class_key
);
3058 /* Types we might convert a resource string into. */
3068 /* Return the value of parameter PARAM.
3070 First search ALIST, then Vdefault_frame_alist, then the X defaults
3071 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3073 Convert the resource to the type specified by desired_type.
3075 If no default is specified, return Qunbound. If you call
3076 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
3077 and don't let it get stored in any Lisp-visible variables! */
3080 w32_get_arg (alist
, param
, attribute
, class, type
)
3081 Lisp_Object alist
, param
;
3084 enum resource_types type
;
3086 register Lisp_Object tem
;
3088 tem
= Fassq (param
, alist
);
3090 tem
= Fassq (param
, Vdefault_frame_alist
);
3096 tem
= Fx_get_resource (build_string (attribute
),
3097 build_string (class),
3105 case RES_TYPE_NUMBER
:
3106 return make_number (atoi (XSTRING (tem
)->data
));
3108 case RES_TYPE_FLOAT
:
3109 return make_float (atof (XSTRING (tem
)->data
));
3111 case RES_TYPE_BOOLEAN
:
3112 tem
= Fdowncase (tem
);
3113 if (!strcmp (XSTRING (tem
)->data
, "on")
3114 || !strcmp (XSTRING (tem
)->data
, "true"))
3119 case RES_TYPE_STRING
:
3122 case RES_TYPE_SYMBOL
:
3123 /* As a special case, we map the values `true' and `on'
3124 to Qt, and `false' and `off' to Qnil. */
3127 lower
= Fdowncase (tem
);
3128 if (!strcmp (XSTRING (lower
)->data
, "on")
3129 || !strcmp (XSTRING (lower
)->data
, "true"))
3131 else if (!strcmp (XSTRING (lower
)->data
, "off")
3132 || !strcmp (XSTRING (lower
)->data
, "false"))
3135 return Fintern (tem
, Qnil
);
3148 /* Record in frame F the specified or default value according to ALIST
3149 of the parameter named PROP (a Lisp symbol).
3150 If no value is specified for PROP, look for an X default for XPROP
3151 on the frame named NAME.
3152 If that is not found either, use the value DEFLT. */
3155 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3162 enum resource_types type
;
3166 tem
= w32_get_arg (alist
, prop
, xprop
, xclass
, type
);
3167 if (EQ (tem
, Qunbound
))
3169 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3173 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3174 doc
: /* Parse an X-style geometry string STRING.
3175 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3176 The properties returned may include `top', `left', `height', and `width'.
3177 The value of `left' or `top' may be an integer,
3178 or a list (+ N) meaning N pixels relative to top/left corner,
3179 or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3184 unsigned int width
, height
;
3187 CHECK_STRING (string
);
3189 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3190 &x
, &y
, &width
, &height
);
3193 if (geometry
& XValue
)
3195 Lisp_Object element
;
3197 if (x
>= 0 && (geometry
& XNegative
))
3198 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3199 else if (x
< 0 && ! (geometry
& XNegative
))
3200 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3202 element
= Fcons (Qleft
, make_number (x
));
3203 result
= Fcons (element
, result
);
3206 if (geometry
& YValue
)
3208 Lisp_Object element
;
3210 if (y
>= 0 && (geometry
& YNegative
))
3211 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3212 else if (y
< 0 && ! (geometry
& YNegative
))
3213 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3215 element
= Fcons (Qtop
, make_number (y
));
3216 result
= Fcons (element
, result
);
3219 if (geometry
& WidthValue
)
3220 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3221 if (geometry
& HeightValue
)
3222 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3227 /* Calculate the desired size and position of this window,
3228 and return the flags saying which aspects were specified.
3230 This function does not make the coordinates positive. */
3232 #define DEFAULT_ROWS 40
3233 #define DEFAULT_COLS 80
3236 x_figure_window_size (f
, parms
)
3240 register Lisp_Object tem0
, tem1
, tem2
;
3241 long window_prompting
= 0;
3243 /* Default values if we fall through.
3244 Actually, if that happens we should get
3245 window manager prompting. */
3246 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3247 f
->height
= DEFAULT_ROWS
;
3248 /* Window managers expect that if program-specified
3249 positions are not (0,0), they're intentional, not defaults. */
3250 f
->output_data
.w32
->top_pos
= 0;
3251 f
->output_data
.w32
->left_pos
= 0;
3253 /* Ensure that old new_width and new_height will not override the
3255 FRAME_NEW_WIDTH (f
) = 0;
3256 FRAME_NEW_HEIGHT (f
) = 0;
3258 tem0
= w32_get_arg (parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3259 tem1
= w32_get_arg (parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3260 tem2
= w32_get_arg (parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3261 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3263 if (!EQ (tem0
, Qunbound
))
3265 CHECK_NUMBER (tem0
);
3266 f
->height
= XINT (tem0
);
3268 if (!EQ (tem1
, Qunbound
))
3270 CHECK_NUMBER (tem1
);
3271 SET_FRAME_WIDTH (f
, XINT (tem1
));
3273 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3274 window_prompting
|= USSize
;
3276 window_prompting
|= PSize
;
3279 f
->output_data
.w32
->vertical_scroll_bar_extra
3280 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3282 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
3283 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
3284 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
3285 x_compute_fringe_widths (f
, 0);
3286 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3287 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3289 tem0
= w32_get_arg (parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3290 tem1
= w32_get_arg (parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3291 tem2
= w32_get_arg (parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3292 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3294 if (EQ (tem0
, Qminus
))
3296 f
->output_data
.w32
->top_pos
= 0;
3297 window_prompting
|= YNegative
;
3299 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3300 && CONSP (XCDR (tem0
))
3301 && INTEGERP (XCAR (XCDR (tem0
))))
3303 f
->output_data
.w32
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3304 window_prompting
|= YNegative
;
3306 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3307 && CONSP (XCDR (tem0
))
3308 && INTEGERP (XCAR (XCDR (tem0
))))
3310 f
->output_data
.w32
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3312 else if (EQ (tem0
, Qunbound
))
3313 f
->output_data
.w32
->top_pos
= 0;
3316 CHECK_NUMBER (tem0
);
3317 f
->output_data
.w32
->top_pos
= XINT (tem0
);
3318 if (f
->output_data
.w32
->top_pos
< 0)
3319 window_prompting
|= YNegative
;
3322 if (EQ (tem1
, Qminus
))
3324 f
->output_data
.w32
->left_pos
= 0;
3325 window_prompting
|= XNegative
;
3327 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3328 && CONSP (XCDR (tem1
))
3329 && INTEGERP (XCAR (XCDR (tem1
))))
3331 f
->output_data
.w32
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3332 window_prompting
|= XNegative
;
3334 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3335 && CONSP (XCDR (tem1
))
3336 && INTEGERP (XCAR (XCDR (tem1
))))
3338 f
->output_data
.w32
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3340 else if (EQ (tem1
, Qunbound
))
3341 f
->output_data
.w32
->left_pos
= 0;
3344 CHECK_NUMBER (tem1
);
3345 f
->output_data
.w32
->left_pos
= XINT (tem1
);
3346 if (f
->output_data
.w32
->left_pos
< 0)
3347 window_prompting
|= XNegative
;
3350 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3351 window_prompting
|= USPosition
;
3353 window_prompting
|= PPosition
;
3356 return window_prompting
;
3361 extern LRESULT CALLBACK
w32_wnd_proc ();
3364 w32_init_class (hinst
)
3369 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
3370 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
3372 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
3373 wc
.hInstance
= hinst
;
3374 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
3375 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
3376 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
3377 wc
.lpszMenuName
= NULL
;
3378 wc
.lpszClassName
= EMACS_CLASS
;
3380 return (RegisterClass (&wc
));
3384 w32_createscrollbar (f
, bar
)
3386 struct scroll_bar
* bar
;
3388 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
3389 /* Position and size of scroll bar. */
3390 XINT(bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
3392 XINT(bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
3394 FRAME_W32_WINDOW (f
),
3401 w32_createwindow (f
)
3407 rect
.left
= rect
.top
= 0;
3408 rect
.right
= PIXEL_WIDTH (f
);
3409 rect
.bottom
= PIXEL_HEIGHT (f
);
3411 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
3412 FRAME_EXTERNAL_MENU_BAR (f
));
3414 /* Do first time app init */
3418 w32_init_class (hinst
);
3421 FRAME_W32_WINDOW (f
) = hwnd
3422 = CreateWindow (EMACS_CLASS
,
3424 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
3425 f
->output_data
.w32
->left_pos
,
3426 f
->output_data
.w32
->top_pos
,
3427 rect
.right
- rect
.left
,
3428 rect
.bottom
- rect
.top
,
3436 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
3437 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
3438 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
3439 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
3440 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
3442 /* Enable drag-n-drop. */
3443 DragAcceptFiles (hwnd
, TRUE
);
3445 /* Do this to discard the default setting specified by our parent. */
3446 ShowWindow (hwnd
, SW_HIDE
);
3451 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
3458 wmsg
->msg
.hwnd
= hwnd
;
3459 wmsg
->msg
.message
= msg
;
3460 wmsg
->msg
.wParam
= wParam
;
3461 wmsg
->msg
.lParam
= lParam
;
3462 wmsg
->msg
.time
= GetMessageTime ();
3467 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
3468 between left and right keys as advertised. We test for this
3469 support dynamically, and set a flag when the support is absent. If
3470 absent, we keep track of the left and right control and alt keys
3471 ourselves. This is particularly necessary on keyboards that rely
3472 upon the AltGr key, which is represented as having the left control
3473 and right alt keys pressed. For these keyboards, we need to know
3474 when the left alt key has been pressed in addition to the AltGr key
3475 so that we can properly support M-AltGr-key sequences (such as M-@
3476 on Swedish keyboards). */
3478 #define EMACS_LCONTROL 0
3479 #define EMACS_RCONTROL 1
3480 #define EMACS_LMENU 2
3481 #define EMACS_RMENU 3
3483 static int modifiers
[4];
3484 static int modifiers_recorded
;
3485 static int modifier_key_support_tested
;
3488 test_modifier_support (unsigned int wparam
)
3492 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3494 if (wparam
== VK_CONTROL
)
3504 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
3505 modifiers_recorded
= 1;
3507 modifiers_recorded
= 0;
3508 modifier_key_support_tested
= 1;
3512 record_keydown (unsigned int wparam
, unsigned int lparam
)
3516 if (!modifier_key_support_tested
)
3517 test_modifier_support (wparam
);
3519 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3522 if (wparam
== VK_CONTROL
)
3523 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3525 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3531 record_keyup (unsigned int wparam
, unsigned int lparam
)
3535 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3538 if (wparam
== VK_CONTROL
)
3539 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3541 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3546 /* Emacs can lose focus while a modifier key has been pressed. When
3547 it regains focus, be conservative and clear all modifiers since
3548 we cannot reconstruct the left and right modifier state. */
3554 if (GetFocus () == NULL
)
3555 /* Emacs doesn't have keyboard focus. Do nothing. */
3558 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3559 alt
= GetAsyncKeyState (VK_MENU
);
3561 if (!(ctrl
& 0x08000))
3562 /* Clear any recorded control modifier state. */
3563 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3565 if (!(alt
& 0x08000))
3566 /* Clear any recorded alt modifier state. */
3567 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3569 /* Update the state of all modifier keys, because modifiers used in
3570 hot-key combinations can get stuck on if Emacs loses focus as a
3571 result of a hot-key being pressed. */
3575 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3577 GetKeyboardState (keystate
);
3578 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
3579 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
3580 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
3581 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
3582 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
3583 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
3584 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
3585 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
3586 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
3587 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
3588 SetKeyboardState (keystate
);
3592 /* Synchronize modifier state with what is reported with the current
3593 keystroke. Even if we cannot distinguish between left and right
3594 modifier keys, we know that, if no modifiers are set, then neither
3595 the left or right modifier should be set. */
3599 if (!modifiers_recorded
)
3602 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3603 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3605 if (!(GetKeyState (VK_MENU
) & 0x8000))
3606 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3610 modifier_set (int vkey
)
3612 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
3613 return (GetKeyState (vkey
) & 0x1);
3614 if (!modifiers_recorded
)
3615 return (GetKeyState (vkey
) & 0x8000);
3620 return modifiers
[EMACS_LCONTROL
];
3622 return modifiers
[EMACS_RCONTROL
];
3624 return modifiers
[EMACS_LMENU
];
3626 return modifiers
[EMACS_RMENU
];
3628 return (GetKeyState (vkey
) & 0x8000);
3631 /* Convert between the modifier bits W32 uses and the modifier bits
3635 w32_key_to_modifier (int key
)
3637 Lisp_Object key_mapping
;
3642 key_mapping
= Vw32_lwindow_modifier
;
3645 key_mapping
= Vw32_rwindow_modifier
;
3648 key_mapping
= Vw32_apps_modifier
;
3651 key_mapping
= Vw32_scroll_lock_modifier
;
3657 /* NB. This code runs in the input thread, asychronously to the lisp
3658 thread, so we must be careful to ensure access to lisp data is
3659 thread-safe. The following code is safe because the modifier
3660 variable values are updated atomically from lisp and symbols are
3661 not relocated by GC. Also, we don't have to worry about seeing GC
3663 if (EQ (key_mapping
, Qhyper
))
3664 return hyper_modifier
;
3665 if (EQ (key_mapping
, Qsuper
))
3666 return super_modifier
;
3667 if (EQ (key_mapping
, Qmeta
))
3668 return meta_modifier
;
3669 if (EQ (key_mapping
, Qalt
))
3670 return alt_modifier
;
3671 if (EQ (key_mapping
, Qctrl
))
3672 return ctrl_modifier
;
3673 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
3674 return ctrl_modifier
;
3675 if (EQ (key_mapping
, Qshift
))
3676 return shift_modifier
;
3678 /* Don't generate any modifier if not explicitly requested. */
3683 w32_get_modifiers ()
3685 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
3686 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
3687 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
3688 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
3689 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
3690 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
3691 (modifier_set (VK_MENU
) ?
3692 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
3695 /* We map the VK_* modifiers into console modifier constants
3696 so that we can use the same routines to handle both console
3697 and window input. */
3700 construct_console_modifiers ()
3705 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3706 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3707 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
3708 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
3709 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3710 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3711 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3712 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3713 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
3714 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
3715 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
3721 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
3725 /* Convert to emacs modifiers. */
3726 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
3732 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
3734 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
3737 if (virt_key
== VK_RETURN
)
3738 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3740 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
3741 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
3743 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
3744 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
3746 if (virt_key
== VK_CLEAR
)
3747 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
3752 /* List of special key combinations which w32 would normally capture,
3753 but emacs should grab instead. Not directly visible to lisp, to
3754 simplify synchronization. Each item is an integer encoding a virtual
3755 key code and modifier combination to capture. */
3756 Lisp_Object w32_grabbed_keys
;
3758 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3759 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3760 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3761 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3763 /* Register hot-keys for reserved key combinations when Emacs has
3764 keyboard focus, since this is the only way Emacs can receive key
3765 combinations like Alt-Tab which are used by the system. */
3768 register_hot_keys (hwnd
)
3771 Lisp_Object keylist
;
3773 /* Use GC_CONSP, since we are called asynchronously. */
3774 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3776 Lisp_Object key
= XCAR (keylist
);
3778 /* Deleted entries get set to nil. */
3779 if (!INTEGERP (key
))
3782 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
3783 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
3788 unregister_hot_keys (hwnd
)
3791 Lisp_Object keylist
;
3793 /* Use GC_CONSP, since we are called asynchronously. */
3794 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3796 Lisp_Object key
= XCAR (keylist
);
3798 if (!INTEGERP (key
))
3801 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
3805 /* Main message dispatch loop. */
3808 w32_msg_pump (deferred_msg
* msg_buf
)
3814 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3816 while (GetMessage (&msg
, NULL
, 0, 0))
3818 if (msg
.hwnd
== NULL
)
3820 switch (msg
.message
)
3823 /* Produced by complete_deferred_msg; just ignore. */
3825 case WM_EMACS_CREATEWINDOW
:
3826 w32_createwindow ((struct frame
*) msg
.wParam
);
3827 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3830 case WM_EMACS_SETLOCALE
:
3831 SetThreadLocale (msg
.wParam
);
3832 /* Reply is not expected. */
3834 case WM_EMACS_SETKEYBOARDLAYOUT
:
3835 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
3836 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3840 case WM_EMACS_REGISTER_HOT_KEY
:
3841 focus_window
= GetFocus ();
3842 if (focus_window
!= NULL
)
3843 RegisterHotKey (focus_window
,
3844 HOTKEY_ID (msg
.wParam
),
3845 HOTKEY_MODIFIERS (msg
.wParam
),
3846 HOTKEY_VK_CODE (msg
.wParam
));
3847 /* Reply is not expected. */
3849 case WM_EMACS_UNREGISTER_HOT_KEY
:
3850 focus_window
= GetFocus ();
3851 if (focus_window
!= NULL
)
3852 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
3853 /* Mark item as erased. NB: this code must be
3854 thread-safe. The next line is okay because the cons
3855 cell is never made into garbage and is not relocated by
3857 XSETCAR ((Lisp_Object
) msg
.lParam
, Qnil
);
3858 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3861 case WM_EMACS_TOGGLE_LOCK_KEY
:
3863 int vk_code
= (int) msg
.wParam
;
3864 int cur_state
= (GetKeyState (vk_code
) & 1);
3865 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
3867 /* NB: This code must be thread-safe. It is safe to
3868 call NILP because symbols are not relocated by GC,
3869 and pointer here is not touched by GC (so the markbit
3870 can't be set). Numbers are safe because they are
3871 immediate values. */
3872 if (NILP (new_state
)
3873 || (NUMBERP (new_state
)
3874 && ((XUINT (new_state
)) & 1) != cur_state
))
3876 one_w32_display_info
.faked_key
= vk_code
;
3878 keybd_event ((BYTE
) vk_code
,
3879 (BYTE
) MapVirtualKey (vk_code
, 0),
3880 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3881 keybd_event ((BYTE
) vk_code
,
3882 (BYTE
) MapVirtualKey (vk_code
, 0),
3883 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3884 keybd_event ((BYTE
) vk_code
,
3885 (BYTE
) MapVirtualKey (vk_code
, 0),
3886 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3887 cur_state
= !cur_state
;
3889 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3895 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3900 DispatchMessage (&msg
);
3903 /* Exit nested loop when our deferred message has completed. */
3904 if (msg_buf
->completed
)
3909 deferred_msg
* deferred_msg_head
;
3911 static deferred_msg
*
3912 find_deferred_msg (HWND hwnd
, UINT msg
)
3914 deferred_msg
* item
;
3916 /* Don't actually need synchronization for read access, since
3917 modification of single pointer is always atomic. */
3918 /* enter_crit (); */
3920 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3921 if (item
->w32msg
.msg
.hwnd
== hwnd
3922 && item
->w32msg
.msg
.message
== msg
)
3925 /* leave_crit (); */
3931 send_deferred_msg (deferred_msg
* msg_buf
,
3937 /* Only input thread can send deferred messages. */
3938 if (GetCurrentThreadId () != dwWindowsThreadId
)
3941 /* It is an error to send a message that is already deferred. */
3942 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3945 /* Enforced synchronization is not needed because this is the only
3946 function that alters deferred_msg_head, and the following critical
3947 section is guaranteed to only be serially reentered (since only the
3948 input thread can call us). */
3950 /* enter_crit (); */
3952 msg_buf
->completed
= 0;
3953 msg_buf
->next
= deferred_msg_head
;
3954 deferred_msg_head
= msg_buf
;
3955 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
3957 /* leave_crit (); */
3959 /* Start a new nested message loop to process other messages until
3960 this one is completed. */
3961 w32_msg_pump (msg_buf
);
3963 deferred_msg_head
= msg_buf
->next
;
3965 return msg_buf
->result
;
3969 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
3971 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
3973 if (msg_buf
== NULL
)
3974 /* Message may have been cancelled, so don't abort(). */
3977 msg_buf
->result
= result
;
3978 msg_buf
->completed
= 1;
3980 /* Ensure input thread is woken so it notices the completion. */
3981 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3985 cancel_all_deferred_msgs ()
3987 deferred_msg
* item
;
3989 /* Don't actually need synchronization for read access, since
3990 modification of single pointer is always atomic. */
3991 /* enter_crit (); */
3993 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3996 item
->completed
= 1;
3999 /* leave_crit (); */
4001 /* Ensure input thread is woken so it notices the completion. */
4002 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
4010 deferred_msg dummy_buf
;
4012 /* Ensure our message queue is created */
4014 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
4016 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
4019 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
4020 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
4021 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
4023 /* This is the inital message loop which should only exit when the
4024 application quits. */
4025 w32_msg_pump (&dummy_buf
);
4031 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
4041 wmsg
.dwModifiers
= modifiers
;
4043 /* Detect quit_char and set quit-flag directly. Note that we
4044 still need to post a message to ensure the main thread will be
4045 woken up if blocked in sys_select(), but we do NOT want to post
4046 the quit_char message itself (because it will usually be as if
4047 the user had typed quit_char twice). Instead, we post a dummy
4048 message that has no particular effect. */
4051 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
4052 c
= make_ctrl_char (c
) & 0377;
4054 || (wmsg
.dwModifiers
== 0 &&
4055 XFASTINT (Vw32_quit_key
) && wParam
== XFASTINT (Vw32_quit_key
)))
4059 /* The choice of message is somewhat arbitrary, as long as
4060 the main thread handler just ignores it. */
4063 /* Interrupt any blocking system calls. */
4066 /* As a safety precaution, forcibly complete any deferred
4067 messages. This is a kludge, but I don't see any particularly
4068 clean way to handle the situation where a deferred message is
4069 "dropped" in the lisp thread, and will thus never be
4070 completed, eg. by the user trying to activate the menubar
4071 when the lisp thread is busy, and then typing C-g when the
4072 menubar doesn't open promptly (with the result that the
4073 menubar never responds at all because the deferred
4074 WM_INITMENU message is never completed). Another problem
4075 situation is when the lisp thread calls SendMessage (to send
4076 a window manager command) when a message has been deferred;
4077 the lisp thread gets blocked indefinitely waiting for the
4078 deferred message to be completed, which itself is waiting for
4079 the lisp thread to respond.
4081 Note that we don't want to block the input thread waiting for
4082 a reponse from the lisp thread (although that would at least
4083 solve the deadlock problem above), because we want to be able
4084 to receive C-g to interrupt the lisp thread. */
4085 cancel_all_deferred_msgs ();
4089 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4092 /* Main window procedure */
4095 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
4102 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
4104 int windows_translate
;
4107 /* Note that it is okay to call x_window_to_frame, even though we are
4108 not running in the main lisp thread, because frame deletion
4109 requires the lisp thread to synchronize with this thread. Thus, if
4110 a frame struct is returned, it can be used without concern that the
4111 lisp thread might make it disappear while we are using it.
4113 NB. Walking the frame list in this thread is safe (as long as
4114 writes of Lisp_Object slots are atomic, which they are on Windows).
4115 Although delete-frame can destructively modify the frame list while
4116 we are walking it, a garbage collection cannot occur until after
4117 delete-frame has synchronized with this thread.
4119 It is also safe to use functions that make GDI calls, such as
4120 w32_clear_rect, because these functions must obtain a DC handle
4121 from the frame struct using get_frame_dc which is thread-aware. */
4126 f
= x_window_to_frame (dpyinfo
, hwnd
);
4129 HDC hdc
= get_frame_dc (f
);
4130 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
4131 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
4132 release_frame_dc (f
, hdc
);
4134 #if defined (W32_DEBUG_DISPLAY)
4135 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4137 wmsg
.rect
.left
, wmsg
.rect
.top
,
4138 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4139 #endif /* W32_DEBUG_DISPLAY */
4142 case WM_PALETTECHANGED
:
4143 /* ignore our own changes */
4144 if ((HWND
)wParam
!= hwnd
)
4146 f
= x_window_to_frame (dpyinfo
, hwnd
);
4148 /* get_frame_dc will realize our palette and force all
4149 frames to be redrawn if needed. */
4150 release_frame_dc (f
, get_frame_dc (f
));
4155 PAINTSTRUCT paintStruct
;
4158 f
= x_window_to_frame (dpyinfo
, hwnd
);
4161 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
4165 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4166 fails. Apparently this can happen under some
4168 if (!w32_strict_painting
|| GetUpdateRect (hwnd
, &update_rect
, FALSE
))
4171 BeginPaint (hwnd
, &paintStruct
);
4173 if (w32_strict_painting
)
4174 /* The rectangles returned by GetUpdateRect and BeginPaint
4175 do not always match. GetUpdateRect seems to be the
4176 more reliable of the two. */
4177 wmsg
.rect
= update_rect
;
4179 wmsg
.rect
= paintStruct
.rcPaint
;
4181 #if defined (W32_DEBUG_DISPLAY)
4182 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4184 wmsg
.rect
.left
, wmsg
.rect
.top
,
4185 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4186 DebPrint ((" [update region is %d,%d-%d,%d]\n",
4187 update_rect
.left
, update_rect
.top
,
4188 update_rect
.right
, update_rect
.bottom
));
4190 EndPaint (hwnd
, &paintStruct
);
4193 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4198 /* If GetUpdateRect returns 0 (meaning there is no update
4199 region), assume the whole window needs to be repainted. */
4200 GetClientRect(hwnd
, &wmsg
.rect
);
4201 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4205 case WM_INPUTLANGCHANGE
:
4206 /* Inform lisp thread of keyboard layout changes. */
4207 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4209 /* Clear dead keys in the keyboard state; for simplicity only
4210 preserve modifier key states. */
4215 GetKeyboardState (keystate
);
4216 for (i
= 0; i
< 256; i
++)
4233 SetKeyboardState (keystate
);
4238 /* Synchronize hot keys with normal input. */
4239 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
4244 record_keyup (wParam
, lParam
);
4249 /* Ignore keystrokes we fake ourself; see below. */
4250 if (dpyinfo
->faked_key
== wParam
)
4252 dpyinfo
->faked_key
= 0;
4253 /* Make sure TranslateMessage sees them though (as long as
4254 they don't produce WM_CHAR messages). This ensures that
4255 indicator lights are toggled promptly on Windows 9x, for
4257 if (lispy_function_keys
[wParam
] != 0)
4259 windows_translate
= 1;
4265 /* Synchronize modifiers with current keystroke. */
4267 record_keydown (wParam
, lParam
);
4268 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
4270 windows_translate
= 0;
4275 if (NILP (Vw32_pass_lwindow_to_system
))
4277 /* Prevent system from acting on keyup (which opens the
4278 Start menu if no other key was pressed) by simulating a
4279 press of Space which we will ignore. */
4280 if (GetAsyncKeyState (wParam
) & 1)
4282 if (NUMBERP (Vw32_phantom_key_code
))
4283 key
= XUINT (Vw32_phantom_key_code
) & 255;
4286 dpyinfo
->faked_key
= key
;
4287 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4290 if (!NILP (Vw32_lwindow_modifier
))
4294 if (NILP (Vw32_pass_rwindow_to_system
))
4296 if (GetAsyncKeyState (wParam
) & 1)
4298 if (NUMBERP (Vw32_phantom_key_code
))
4299 key
= XUINT (Vw32_phantom_key_code
) & 255;
4302 dpyinfo
->faked_key
= key
;
4303 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4306 if (!NILP (Vw32_rwindow_modifier
))
4310 if (!NILP (Vw32_apps_modifier
))
4314 if (NILP (Vw32_pass_alt_to_system
))
4315 /* Prevent DefWindowProc from activating the menu bar if an
4316 Alt key is pressed and released by itself. */
4318 windows_translate
= 1;
4321 /* Decide whether to treat as modifier or function key. */
4322 if (NILP (Vw32_enable_caps_lock
))
4323 goto disable_lock_key
;
4324 windows_translate
= 1;
4327 /* Decide whether to treat as modifier or function key. */
4328 if (NILP (Vw32_enable_num_lock
))
4329 goto disable_lock_key
;
4330 windows_translate
= 1;
4333 /* Decide whether to treat as modifier or function key. */
4334 if (NILP (Vw32_scroll_lock_modifier
))
4335 goto disable_lock_key
;
4336 windows_translate
= 1;
4339 /* Ensure the appropriate lock key state (and indicator light)
4340 remains in the same state. We do this by faking another
4341 press of the relevant key. Apparently, this really is the
4342 only way to toggle the state of the indicator lights. */
4343 dpyinfo
->faked_key
= wParam
;
4344 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4345 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4346 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4347 KEYEVENTF_EXTENDEDKEY
| 0, 0);
4348 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4349 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4350 /* Ensure indicator lights are updated promptly on Windows 9x
4351 (TranslateMessage apparently does this), after forwarding
4353 post_character_message (hwnd
, msg
, wParam
, lParam
,
4354 w32_get_key_modifiers (wParam
, lParam
));
4355 windows_translate
= 1;
4359 case VK_PROCESSKEY
: /* Generated by IME. */
4360 windows_translate
= 1;
4363 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4364 which is confusing for purposes of key binding; convert
4365 VK_CANCEL events into VK_PAUSE events. */
4369 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4370 for purposes of key binding; convert these back into
4371 VK_NUMLOCK events, at least when we want to see NumLock key
4372 presses. (Note that there is never any possibility that
4373 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4374 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
4375 wParam
= VK_NUMLOCK
;
4378 /* If not defined as a function key, change it to a WM_CHAR message. */
4379 if (lispy_function_keys
[wParam
] == 0)
4381 DWORD modifiers
= construct_console_modifiers ();
4383 if (!NILP (Vw32_recognize_altgr
)
4384 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
4386 /* Always let TranslateMessage handle AltGr key chords;
4387 for some reason, ToAscii doesn't always process AltGr
4388 chords correctly. */
4389 windows_translate
= 1;
4391 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
4393 /* Handle key chords including any modifiers other
4394 than shift directly, in order to preserve as much
4395 modifier information as possible. */
4396 if ('A' <= wParam
&& wParam
<= 'Z')
4398 /* Don't translate modified alphabetic keystrokes,
4399 so the user doesn't need to constantly switch
4400 layout to type control or meta keystrokes when
4401 the normal layout translates alphabetic
4402 characters to non-ascii characters. */
4403 if (!modifier_set (VK_SHIFT
))
4404 wParam
+= ('a' - 'A');
4409 /* Try to handle other keystrokes by determining the
4410 base character (ie. translating the base key plus
4414 KEY_EVENT_RECORD key
;
4416 key
.bKeyDown
= TRUE
;
4417 key
.wRepeatCount
= 1;
4418 key
.wVirtualKeyCode
= wParam
;
4419 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
4420 key
.uChar
.AsciiChar
= 0;
4421 key
.dwControlKeyState
= modifiers
;
4423 add
= w32_kbd_patch_key (&key
);
4424 /* 0 means an unrecognised keycode, negative means
4425 dead key. Ignore both. */
4428 /* Forward asciified character sequence. */
4429 post_character_message
4430 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
4431 w32_get_key_modifiers (wParam
, lParam
));
4432 w32_kbd_patch_key (&key
);
4439 /* Let TranslateMessage handle everything else. */
4440 windows_translate
= 1;
4446 if (windows_translate
)
4448 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
4450 windows_msg
.time
= GetMessageTime ();
4451 TranslateMessage (&windows_msg
);
4459 post_character_message (hwnd
, msg
, wParam
, lParam
,
4460 w32_get_key_modifiers (wParam
, lParam
));
4463 /* Simulate middle mouse button events when left and right buttons
4464 are used together, but only if user has two button mouse. */
4465 case WM_LBUTTONDOWN
:
4466 case WM_RBUTTONDOWN
:
4467 if (XINT (Vw32_num_mouse_buttons
) > 2)
4468 goto handle_plain_button
;
4471 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
4472 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
4474 if (button_state
& this)
4477 if (button_state
== 0)
4480 button_state
|= this;
4482 if (button_state
& other
)
4484 if (mouse_button_timer
)
4486 KillTimer (hwnd
, mouse_button_timer
);
4487 mouse_button_timer
= 0;
4489 /* Generate middle mouse event instead. */
4490 msg
= WM_MBUTTONDOWN
;
4491 button_state
|= MMOUSE
;
4493 else if (button_state
& MMOUSE
)
4495 /* Ignore button event if we've already generated a
4496 middle mouse down event. This happens if the
4497 user releases and press one of the two buttons
4498 after we've faked a middle mouse event. */
4503 /* Flush out saved message. */
4504 post_msg (&saved_mouse_button_msg
);
4506 wmsg
.dwModifiers
= w32_get_modifiers ();
4507 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4509 /* Clear message buffer. */
4510 saved_mouse_button_msg
.msg
.hwnd
= 0;
4514 /* Hold onto message for now. */
4515 mouse_button_timer
=
4516 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
4517 XINT (Vw32_mouse_button_tolerance
), NULL
);
4518 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
4519 saved_mouse_button_msg
.msg
.message
= msg
;
4520 saved_mouse_button_msg
.msg
.wParam
= wParam
;
4521 saved_mouse_button_msg
.msg
.lParam
= lParam
;
4522 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
4523 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
4530 if (XINT (Vw32_num_mouse_buttons
) > 2)
4531 goto handle_plain_button
;
4534 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
4535 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
4537 if ((button_state
& this) == 0)
4540 button_state
&= ~this;
4542 if (button_state
& MMOUSE
)
4544 /* Only generate event when second button is released. */
4545 if ((button_state
& other
) == 0)
4548 button_state
&= ~MMOUSE
;
4550 if (button_state
) abort ();
4557 /* Flush out saved message if necessary. */
4558 if (saved_mouse_button_msg
.msg
.hwnd
)
4560 post_msg (&saved_mouse_button_msg
);
4563 wmsg
.dwModifiers
= w32_get_modifiers ();
4564 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4566 /* Always clear message buffer and cancel timer. */
4567 saved_mouse_button_msg
.msg
.hwnd
= 0;
4568 KillTimer (hwnd
, mouse_button_timer
);
4569 mouse_button_timer
= 0;
4571 if (button_state
== 0)
4576 case WM_XBUTTONDOWN
:
4578 if (w32_pass_extra_mouse_buttons_to_system
)
4580 /* else fall through and process them. */
4581 case WM_MBUTTONDOWN
:
4583 handle_plain_button
:
4588 if (parse_button (msg
, HIWORD (wParam
), &button
, &up
))
4590 if (up
) ReleaseCapture ();
4591 else SetCapture (hwnd
);
4592 button
= (button
== 0) ? LMOUSE
:
4593 ((button
== 1) ? MMOUSE
: RMOUSE
);
4595 button_state
&= ~button
;
4597 button_state
|= button
;
4601 wmsg
.dwModifiers
= w32_get_modifiers ();
4602 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4604 /* Need to return true for XBUTTON messages, false for others,
4605 to indicate that we processed the message. */
4606 return (msg
== WM_XBUTTONDOWN
|| msg
== WM_XBUTTONUP
);
4609 /* If the mouse has just moved into the frame, start tracking
4610 it, so we will be notified when it leaves the frame. Mouse
4611 tracking only works under W98 and NT4 and later. On earlier
4612 versions, there is no way of telling when the mouse leaves the
4613 frame, so we just have to put up with help-echo and mouse
4614 highlighting remaining while the frame is not active. */
4615 if (track_mouse_event_fn
&& !track_mouse_window
)
4617 TRACKMOUSEEVENT tme
;
4618 tme
.cbSize
= sizeof (tme
);
4619 tme
.dwFlags
= TME_LEAVE
;
4620 tme
.hwndTrack
= hwnd
;
4622 track_mouse_event_fn (&tme
);
4623 track_mouse_window
= hwnd
;
4626 if (XINT (Vw32_mouse_move_interval
) <= 0
4627 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
4629 wmsg
.dwModifiers
= w32_get_modifiers ();
4630 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4634 /* Hang onto mouse move and scroll messages for a bit, to avoid
4635 sending such events to Emacs faster than it can process them.
4636 If we get more events before the timer from the first message
4637 expires, we just replace the first message. */
4639 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
4641 SetTimer (hwnd
, MOUSE_MOVE_ID
,
4642 XINT (Vw32_mouse_move_interval
), NULL
);
4644 /* Hold onto message for now. */
4645 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
4646 saved_mouse_move_msg
.msg
.message
= msg
;
4647 saved_mouse_move_msg
.msg
.wParam
= wParam
;
4648 saved_mouse_move_msg
.msg
.lParam
= lParam
;
4649 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
4650 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
4655 wmsg
.dwModifiers
= w32_get_modifiers ();
4656 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4660 wmsg
.dwModifiers
= w32_get_modifiers ();
4661 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4665 /* Flush out saved messages if necessary. */
4666 if (wParam
== mouse_button_timer
)
4668 if (saved_mouse_button_msg
.msg
.hwnd
)
4670 post_msg (&saved_mouse_button_msg
);
4671 saved_mouse_button_msg
.msg
.hwnd
= 0;
4673 KillTimer (hwnd
, mouse_button_timer
);
4674 mouse_button_timer
= 0;
4676 else if (wParam
== mouse_move_timer
)
4678 if (saved_mouse_move_msg
.msg
.hwnd
)
4680 post_msg (&saved_mouse_move_msg
);
4681 saved_mouse_move_msg
.msg
.hwnd
= 0;
4683 KillTimer (hwnd
, mouse_move_timer
);
4684 mouse_move_timer
= 0;
4689 /* Windows doesn't send us focus messages when putting up and
4690 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4691 The only indication we get that something happened is receiving
4692 this message afterwards. So this is a good time to reset our
4693 keyboard modifiers' state. */
4700 /* We must ensure menu bar is fully constructed and up to date
4701 before allowing user interaction with it. To achieve this
4702 we send this message to the lisp thread and wait for a
4703 reply (whose value is not actually needed) to indicate that
4704 the menu bar is now ready for use, so we can now return.
4706 To remain responsive in the meantime, we enter a nested message
4707 loop that can process all other messages.
4709 However, we skip all this if the message results from calling
4710 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4711 thread a message because it is blocked on us at this point. We
4712 set menubar_active before calling TrackPopupMenu to indicate
4713 this (there is no possibility of confusion with real menubar
4716 f
= x_window_to_frame (dpyinfo
, hwnd
);
4718 && (f
->output_data
.w32
->menubar_active
4719 /* We can receive this message even in the absence of a
4720 menubar (ie. when the system menu is activated) - in this
4721 case we do NOT want to forward the message, otherwise it
4722 will cause the menubar to suddenly appear when the user
4723 had requested it to be turned off! */
4724 || f
->output_data
.w32
->menubar_widget
== NULL
))
4728 deferred_msg msg_buf
;
4730 /* Detect if message has already been deferred; in this case
4731 we cannot return any sensible value to ignore this. */
4732 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4735 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
4738 case WM_EXITMENULOOP
:
4739 f
= x_window_to_frame (dpyinfo
, hwnd
);
4741 /* Free memory used by owner-drawn and help-echo strings. */
4742 w32_free_menu_strings (hwnd
);
4744 /* Indicate that menubar can be modified again. */
4746 f
->output_data
.w32
->menubar_active
= 0;
4750 /* Direct handling of help_echo in menus. Should be safe now
4751 that we generate the help_echo by placing a help event in the
4754 HMENU menu
= (HMENU
) lParam
;
4755 UINT menu_item
= (UINT
) LOWORD (wParam
);
4756 UINT flags
= (UINT
) HIWORD (wParam
);
4758 w32_menu_display_help (hwnd
, menu
, menu_item
, flags
);
4762 case WM_MEASUREITEM
:
4763 f
= x_window_to_frame (dpyinfo
, hwnd
);
4766 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
4768 if (pMis
->CtlType
== ODT_MENU
)
4770 /* Work out dimensions for popup menu titles. */
4771 char * title
= (char *) pMis
->itemData
;
4772 HDC hdc
= GetDC (hwnd
);
4773 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4774 LOGFONT menu_logfont
;
4778 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4779 menu_logfont
.lfWeight
= FW_BOLD
;
4780 menu_font
= CreateFontIndirect (&menu_logfont
);
4781 old_font
= SelectObject (hdc
, menu_font
);
4783 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
4786 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
4787 pMis
->itemWidth
= size
.cx
;
4788 if (pMis
->itemHeight
< size
.cy
)
4789 pMis
->itemHeight
= size
.cy
;
4792 pMis
->itemWidth
= 0;
4794 SelectObject (hdc
, old_font
);
4795 DeleteObject (menu_font
);
4796 ReleaseDC (hwnd
, hdc
);
4803 f
= x_window_to_frame (dpyinfo
, hwnd
);
4806 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
4808 if (pDis
->CtlType
== ODT_MENU
)
4810 /* Draw popup menu title. */
4811 char * title
= (char *) pDis
->itemData
;
4814 HDC hdc
= pDis
->hDC
;
4815 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4816 LOGFONT menu_logfont
;
4819 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4820 menu_logfont
.lfWeight
= FW_BOLD
;
4821 menu_font
= CreateFontIndirect (&menu_logfont
);
4822 old_font
= SelectObject (hdc
, menu_font
);
4824 /* Always draw title as if not selected. */
4827 + GetSystemMetrics (SM_CXMENUCHECK
),
4829 ETO_OPAQUE
, &pDis
->rcItem
,
4830 title
, strlen (title
), NULL
);
4832 SelectObject (hdc
, old_font
);
4833 DeleteObject (menu_font
);
4841 /* Still not right - can't distinguish between clicks in the
4842 client area of the frame from clicks forwarded from the scroll
4843 bars - may have to hook WM_NCHITTEST to remember the mouse
4844 position and then check if it is in the client area ourselves. */
4845 case WM_MOUSEACTIVATE
:
4846 /* Discard the mouse click that activates a frame, allowing the
4847 user to click anywhere without changing point (or worse!).
4848 Don't eat mouse clicks on scrollbars though!! */
4849 if (LOWORD (lParam
) == HTCLIENT
)
4850 return MA_ACTIVATEANDEAT
;
4855 /* No longer tracking mouse. */
4856 track_mouse_window
= NULL
;
4858 case WM_ACTIVATEAPP
:
4860 case WM_WINDOWPOSCHANGED
:
4862 /* Inform lisp thread that a frame might have just been obscured
4863 or exposed, so should recheck visibility of all frames. */
4864 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4868 dpyinfo
->faked_key
= 0;
4870 register_hot_keys (hwnd
);
4873 unregister_hot_keys (hwnd
);
4876 /* Relinquish the system caret. */
4877 if (w32_system_caret_hwnd
)
4880 w32_system_caret_hwnd
= NULL
;
4886 wmsg
.dwModifiers
= w32_get_modifiers ();
4887 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4891 wmsg
.dwModifiers
= w32_get_modifiers ();
4892 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4895 case WM_WINDOWPOSCHANGING
:
4896 /* Don't restrict the sizing of tip frames. */
4897 if (hwnd
== tip_window
)
4901 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
4903 wp
.length
= sizeof (WINDOWPLACEMENT
);
4904 GetWindowPlacement (hwnd
, &wp
);
4906 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
4913 DWORD internal_border
;
4914 DWORD scrollbar_extra
;
4917 wp
.length
= sizeof(wp
);
4918 GetWindowRect (hwnd
, &wr
);
4922 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
4923 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
4924 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
4925 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
4929 memset (&rect
, 0, sizeof (rect
));
4930 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
4931 GetMenu (hwnd
) != NULL
);
4933 /* Force width and height of client area to be exact
4934 multiples of the character cell dimensions. */
4935 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
4936 - 2 * internal_border
- scrollbar_extra
)
4938 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
4939 - 2 * internal_border
)
4944 /* For right/bottom sizing we can just fix the sizes.
4945 However for top/left sizing we will need to fix the X
4946 and Y positions as well. */
4951 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
4952 && (lppos
->flags
& SWP_NOMOVE
) == 0)
4954 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
4961 lppos
->flags
|= SWP_NOMOVE
;
4972 case WM_GETMINMAXINFO
:
4973 /* Hack to correct bug that allows Emacs frames to be resized
4974 below the Minimum Tracking Size. */
4975 ((LPMINMAXINFO
) lParam
)->ptMinTrackSize
.y
++;
4976 /* Hack to allow resizing the Emacs frame above the screen size.
4977 Note that Windows 9x limits coordinates to 16-bits. */
4978 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
4979 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
4982 case WM_EMACS_CREATESCROLLBAR
:
4983 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
4984 (struct scroll_bar
*) lParam
);
4986 case WM_EMACS_SHOWWINDOW
:
4987 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
4989 case WM_EMACS_SETFOREGROUND
:
4991 HWND foreground_window
;
4992 DWORD foreground_thread
, retval
;
4994 /* On NT 5.0, and apparently Windows 98, it is necessary to
4995 attach to the thread that currently has focus in order to
4996 pull the focus away from it. */
4997 foreground_window
= GetForegroundWindow ();
4998 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
4999 if (!foreground_window
5000 || foreground_thread
== GetCurrentThreadId ()
5001 || !AttachThreadInput (GetCurrentThreadId (),
5002 foreground_thread
, TRUE
))
5003 foreground_thread
= 0;
5005 retval
= SetForegroundWindow ((HWND
) wParam
);
5007 /* Detach from the previous foreground thread. */
5008 if (foreground_thread
)
5009 AttachThreadInput (GetCurrentThreadId (),
5010 foreground_thread
, FALSE
);
5015 case WM_EMACS_SETWINDOWPOS
:
5017 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
5018 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
5019 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
5022 case WM_EMACS_DESTROYWINDOW
:
5023 DragAcceptFiles ((HWND
) wParam
, FALSE
);
5024 return DestroyWindow ((HWND
) wParam
);
5026 case WM_EMACS_DESTROY_CARET
:
5027 w32_system_caret_hwnd
= NULL
;
5028 return DestroyCaret ();
5030 case WM_EMACS_TRACK_CARET
:
5031 /* If there is currently no system caret, create one. */
5032 if (w32_system_caret_hwnd
== NULL
)
5034 w32_system_caret_hwnd
= hwnd
;
5035 CreateCaret (hwnd
, NULL
, w32_system_caret_width
,
5036 w32_system_caret_height
);
5038 return SetCaretPos (w32_system_caret_x
, w32_system_caret_y
);
5040 case WM_EMACS_TRACKPOPUPMENU
:
5045 pos
= (POINT
*)lParam
;
5046 flags
= TPM_CENTERALIGN
;
5047 if (button_state
& LMOUSE
)
5048 flags
|= TPM_LEFTBUTTON
;
5049 else if (button_state
& RMOUSE
)
5050 flags
|= TPM_RIGHTBUTTON
;
5052 /* Remember we did a SetCapture on the initial mouse down event,
5053 so for safety, we make sure the capture is cancelled now. */
5057 /* Use menubar_active to indicate that WM_INITMENU is from
5058 TrackPopupMenu below, and should be ignored. */
5059 f
= x_window_to_frame (dpyinfo
, hwnd
);
5061 f
->output_data
.w32
->menubar_active
= 1;
5063 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
5067 /* Eat any mouse messages during popupmenu */
5068 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
5070 /* Get the menu selection, if any */
5071 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
5073 retval
= LOWORD (amsg
.wParam
);
5089 /* Check for messages registered at runtime. */
5090 if (msg
== msh_mousewheel
)
5092 wmsg
.dwModifiers
= w32_get_modifiers ();
5093 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
5098 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
5102 /* The most common default return code for handled messages is 0. */
5107 my_create_window (f
)
5112 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
5114 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
5118 /* Create a tooltip window. Unlike my_create_window, we do not do this
5119 indirectly via the Window thread, as we do not need to process Window
5120 messages for the tooltip. Creating tooltips indirectly also creates
5121 deadlocks when tooltips are created for menu items. */
5123 my_create_tip_window (f
)
5128 rect
.left
= rect
.top
= 0;
5129 rect
.right
= PIXEL_WIDTH (f
);
5130 rect
.bottom
= PIXEL_HEIGHT (f
);
5132 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
5133 FRAME_EXTERNAL_MENU_BAR (f
));
5135 tip_window
= FRAME_W32_WINDOW (f
)
5136 = CreateWindow (EMACS_CLASS
,
5138 f
->output_data
.w32
->dwStyle
,
5139 f
->output_data
.w32
->left_pos
,
5140 f
->output_data
.w32
->top_pos
,
5141 rect
.right
- rect
.left
,
5142 rect
.bottom
- rect
.top
,
5143 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
5150 SetWindowLong (tip_window
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
5151 SetWindowLong (tip_window
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
5152 SetWindowLong (tip_window
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
5153 SetWindowLong (tip_window
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
5155 /* Tip frames have no scrollbars. */
5156 SetWindowLong (tip_window
, WND_SCROLLBAR_INDEX
, 0);
5158 /* Do this to discard the default setting specified by our parent. */
5159 ShowWindow (tip_window
, SW_HIDE
);
5164 /* Create and set up the w32 window for frame F. */
5167 w32_window (f
, window_prompting
, minibuffer_only
)
5169 long window_prompting
;
5170 int minibuffer_only
;
5174 /* Use the resource name as the top-level window name
5175 for looking up resources. Make a non-Lisp copy
5176 for the window manager, so GC relocation won't bother it.
5178 Elsewhere we specify the window name for the window manager. */
5181 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
5182 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
5183 strcpy (f
->namebuf
, str
);
5186 my_create_window (f
);
5188 validate_x_resource_name ();
5190 /* x_set_name normally ignores requests to set the name if the
5191 requested name is the same as the current name. This is the one
5192 place where that assumption isn't correct; f->name is set, but
5193 the server hasn't been told. */
5196 int explicit = f
->explicit_name
;
5198 f
->explicit_name
= 0;
5201 x_set_name (f
, name
, explicit);
5206 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
5207 initialize_frame_menubar (f
);
5209 if (FRAME_W32_WINDOW (f
) == 0)
5210 error ("Unable to create window");
5213 /* Handle the icon stuff for this window. Perhaps later we might
5214 want an x_set_icon_position which can be called interactively as
5222 Lisp_Object icon_x
, icon_y
;
5224 /* Set the position of the icon. Note that Windows 95 groups all
5225 icons in the tray. */
5226 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
5227 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
5228 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
5230 CHECK_NUMBER (icon_x
);
5231 CHECK_NUMBER (icon_y
);
5233 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
5234 error ("Both left and top icon corners of icon must be specified");
5238 if (! EQ (icon_x
, Qunbound
))
5239 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
5242 /* Start up iconic or window? */
5243 x_wm_set_window_state
5244 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
5248 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
5261 XGCValues gc_values
;
5265 /* Create the GC's of this frame.
5266 Note that many default values are used. */
5269 gc_values
.font
= f
->output_data
.w32
->font
;
5271 /* Cursor has cursor-color background, background-color foreground. */
5272 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
5273 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
5274 f
->output_data
.w32
->cursor_gc
5275 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
5276 (GCFont
| GCForeground
| GCBackground
),
5280 f
->output_data
.w32
->white_relief
.gc
= 0;
5281 f
->output_data
.w32
->black_relief
.gc
= 0;
5287 /* Handler for signals raised during x_create_frame and
5288 x_create_top_frame. FRAME is the frame which is partially
5292 unwind_create_frame (frame
)
5295 struct frame
*f
= XFRAME (frame
);
5297 /* If frame is ``official'', nothing to do. */
5298 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
5301 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5304 x_free_frame_resources (f
);
5306 /* Check that reference counts are indeed correct. */
5307 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
5308 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
5317 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
5319 doc
: /* Make a new window, which is called a \"frame\" in Emacs terms.
5320 Returns an Emacs frame object.
5321 ALIST is an alist of frame parameters.
5322 If the parameters specify that the frame should not have a minibuffer,
5323 and do not specify a specific minibuffer window to use,
5324 then `default-minibuffer-frame' must be a frame whose minibuffer can
5325 be shared by the new frame.
5327 This function is an internal primitive--use `make-frame' instead. */)
5332 Lisp_Object frame
, tem
;
5334 int minibuffer_only
= 0;
5335 long window_prompting
= 0;
5337 int count
= BINDING_STACK_SIZE ();
5338 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
5339 Lisp_Object display
;
5340 struct w32_display_info
*dpyinfo
= NULL
;
5346 /* Use this general default value to start with
5347 until we know if this frame has a specified name. */
5348 Vx_resource_name
= Vinvocation_name
;
5350 display
= w32_get_arg (parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
5351 if (EQ (display
, Qunbound
))
5353 dpyinfo
= check_x_display_info (display
);
5355 kb
= dpyinfo
->kboard
;
5357 kb
= &the_only_kboard
;
5360 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
5362 && ! EQ (name
, Qunbound
)
5364 error ("Invalid frame name--not a string or nil");
5367 Vx_resource_name
= name
;
5369 /* See if parent window is specified. */
5370 parent
= w32_get_arg (parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
5371 if (EQ (parent
, Qunbound
))
5373 if (! NILP (parent
))
5374 CHECK_NUMBER (parent
);
5376 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5377 /* No need to protect DISPLAY because that's not used after passing
5378 it to make_frame_without_minibuffer. */
5380 GCPRO4 (parms
, parent
, name
, frame
);
5381 tem
= w32_get_arg (parms
, Qminibuffer
, "minibuffer", "Minibuffer",
5383 if (EQ (tem
, Qnone
) || NILP (tem
))
5384 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
5385 else if (EQ (tem
, Qonly
))
5387 f
= make_minibuffer_frame ();
5388 minibuffer_only
= 1;
5390 else if (WINDOWP (tem
))
5391 f
= make_frame_without_minibuffer (tem
, kb
, display
);
5395 XSETFRAME (frame
, f
);
5397 /* Note that Windows does support scroll bars. */
5398 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
5399 /* By default, make scrollbars the system standard width. */
5400 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
5402 f
->output_method
= output_w32
;
5403 f
->output_data
.w32
=
5404 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
5405 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
5406 FRAME_FONTSET (f
) = -1;
5407 record_unwind_protect (unwind_create_frame
, frame
);
5410 = w32_get_arg (parms
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
5411 if (! STRINGP (f
->icon_name
))
5412 f
->icon_name
= Qnil
;
5414 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
5416 FRAME_KBOARD (f
) = kb
;
5419 /* Specify the parent under which to make this window. */
5423 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
5424 f
->output_data
.w32
->explicit_parent
= 1;
5428 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5429 f
->output_data
.w32
->explicit_parent
= 0;
5432 /* Set the name; the functions to which we pass f expect the name to
5434 if (EQ (name
, Qunbound
) || NILP (name
))
5436 f
->name
= build_string (dpyinfo
->w32_id_name
);
5437 f
->explicit_name
= 0;
5442 f
->explicit_name
= 1;
5443 /* use the frame's title when getting resources for this frame. */
5444 specbind (Qx_resource_name
, name
);
5447 /* Extract the window parameters from the supplied values
5448 that are needed to determine window geometry. */
5452 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
5455 /* First, try whatever font the caller has specified. */
5458 tem
= Fquery_fontset (font
, Qnil
);
5460 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
5462 font
= x_new_font (f
, XSTRING (font
)->data
);
5464 /* Try out a font which we hope has bold and italic variations. */
5465 if (!STRINGP (font
))
5466 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
5467 if (! STRINGP (font
))
5468 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
5469 /* If those didn't work, look for something which will at least work. */
5470 if (! STRINGP (font
))
5471 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
5473 if (! STRINGP (font
))
5474 font
= build_string ("Fixedsys");
5476 x_default_parameter (f
, parms
, Qfont
, font
,
5477 "font", "Font", RES_TYPE_STRING
);
5480 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
5481 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
5482 /* This defaults to 2 in order to match xterm. We recognize either
5483 internalBorderWidth or internalBorder (which is what xterm calls
5485 if (NILP (Fassq (Qinternal_border_width
, parms
)))
5489 value
= w32_get_arg (parms
, Qinternal_border_width
,
5490 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
5491 if (! EQ (value
, Qunbound
))
5492 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
5495 /* Default internalBorderWidth to 0 on Windows to match other programs. */
5496 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
5497 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
5498 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qright
,
5499 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
5501 /* Also do the stuff which must be set before the window exists. */
5502 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
5503 "foreground", "Foreground", RES_TYPE_STRING
);
5504 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
5505 "background", "Background", RES_TYPE_STRING
);
5506 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
5507 "pointerColor", "Foreground", RES_TYPE_STRING
);
5508 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
5509 "cursorColor", "Foreground", RES_TYPE_STRING
);
5510 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
5511 "borderColor", "BorderColor", RES_TYPE_STRING
);
5512 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
5513 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
5514 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
5515 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
5516 x_default_parameter (f
, parms
, Qleft_fringe
, Qnil
,
5517 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
5518 x_default_parameter (f
, parms
, Qright_fringe
, Qnil
,
5519 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
5522 /* Init faces before x_default_parameter is called for scroll-bar
5523 parameters because that function calls x_set_scroll_bar_width,
5524 which calls change_frame_size, which calls Fset_window_buffer,
5525 which runs hooks, which call Fvertical_motion. At the end, we
5526 end up in init_iterator with a null face cache, which should not
5528 init_frame_faces (f
);
5530 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
5531 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
5532 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
5533 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
5534 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
5535 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
5536 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
5537 "title", "Title", RES_TYPE_STRING
);
5539 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
5540 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5542 /* Add the tool-bar height to the initial frame height so that the
5543 user gets a text display area of the size he specified with -g or
5544 via .Xdefaults. Later changes of the tool-bar height don't
5545 change the frame size. This is done so that users can create
5546 tall Emacs frames without having to guess how tall the tool-bar
5548 if (FRAME_TOOL_BAR_LINES (f
))
5550 int margin
, relief
, bar_height
;
5552 relief
= (tool_bar_button_relief
>= 0
5553 ? tool_bar_button_relief
5554 : DEFAULT_TOOL_BAR_BUTTON_RELIEF
);
5556 if (INTEGERP (Vtool_bar_button_margin
)
5557 && XINT (Vtool_bar_button_margin
) > 0)
5558 margin
= XFASTINT (Vtool_bar_button_margin
);
5559 else if (CONSP (Vtool_bar_button_margin
)
5560 && INTEGERP (XCDR (Vtool_bar_button_margin
))
5561 && XINT (XCDR (Vtool_bar_button_margin
)) > 0)
5562 margin
= XFASTINT (XCDR (Vtool_bar_button_margin
));
5566 bar_height
= DEFAULT_TOOL_BAR_IMAGE_HEIGHT
+ 2 * margin
+ 2 * relief
;
5567 f
->height
+= (bar_height
+ CANON_Y_UNIT (f
) - 1) / CANON_Y_UNIT (f
);
5570 window_prompting
= x_figure_window_size (f
, parms
);
5572 if (window_prompting
& XNegative
)
5574 if (window_prompting
& YNegative
)
5575 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
5577 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
5581 if (window_prompting
& YNegative
)
5582 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
5584 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
5587 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
5589 tem
= w32_get_arg (parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
5590 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
5592 w32_window (f
, window_prompting
, minibuffer_only
);
5597 /* Now consider the frame official. */
5598 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
5599 Vframe_list
= Fcons (frame
, Vframe_list
);
5601 /* We need to do this after creating the window, so that the
5602 icon-creation functions can say whose icon they're describing. */
5603 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
5604 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
5606 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
5607 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5608 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
5609 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5610 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
5611 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
5612 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
5613 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
5615 /* Dimensions, especially f->height, must be done via change_frame_size.
5616 Change will not be effected unless different from the current
5622 SET_FRAME_WIDTH (f
, 0);
5623 change_frame_size (f
, height
, width
, 1, 0, 0);
5625 /* Tell the server what size and position, etc, we want, and how
5626 badly we want them. This should be done after we have the menu
5627 bar so that its size can be taken into account. */
5629 x_wm_set_size_hint (f
, window_prompting
, 0);
5632 /* Set up faces after all frame parameters are known. This call
5633 also merges in face attributes specified for new frames. If we
5634 don't do this, the `menu' face for instance won't have the right
5635 colors, and the menu bar won't appear in the specified colors for
5637 call1 (Qface_set_after_frame_default
, frame
);
5639 /* Make the window appear on the frame and enable display, unless
5640 the caller says not to. However, with explicit parent, Emacs
5641 cannot control visibility, so don't try. */
5642 if (! f
->output_data
.w32
->explicit_parent
)
5644 Lisp_Object visibility
;
5646 visibility
= w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
5647 if (EQ (visibility
, Qunbound
))
5650 if (EQ (visibility
, Qicon
))
5651 x_iconify_frame (f
);
5652 else if (! NILP (visibility
))
5653 x_make_frame_visible (f
);
5655 /* Must have been Qnil. */
5660 /* Make sure windows on this frame appear in calls to next-window
5661 and similar functions. */
5662 Vwindow_list
= Qnil
;
5664 return unbind_to (count
, frame
);
5667 /* FRAME is used only to get a handle on the X display. We don't pass the
5668 display info directly because we're called from frame.c, which doesn't
5669 know about that structure. */
5671 x_get_focus_frame (frame
)
5672 struct frame
*frame
;
5674 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
5676 if (! dpyinfo
->w32_focus_frame
)
5679 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
5683 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
5684 doc
: /* Give FRAME input focus, raising to foreground if necessary. */)
5688 x_focus_on_frame (check_x_frame (frame
));
5693 /* Return the charset portion of a font name. */
5694 char * xlfd_charset_of_font (char * fontname
)
5696 char *charset
, *encoding
;
5698 encoding
= strrchr(fontname
, '-');
5699 if (!encoding
|| encoding
== fontname
)
5702 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
5703 if (*charset
== '-')
5706 if (charset
== fontname
|| strcmp(charset
, "-*-*") == 0)
5712 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
5713 int size
, char* filename
);
5714 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
5715 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
5717 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
5719 static struct font_info
*
5720 w32_load_system_font (f
,fontname
,size
)
5725 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5726 Lisp_Object font_names
;
5728 /* Get a list of all the fonts that match this name. Once we
5729 have a list of matching fonts, we compare them against the fonts
5730 we already have loaded by comparing names. */
5731 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
5733 if (!NILP (font_names
))
5738 /* First check if any are already loaded, as that is cheaper
5739 than loading another one. */
5740 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5741 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
5742 if (dpyinfo
->font_table
[i
].name
5743 && (!strcmp (dpyinfo
->font_table
[i
].name
,
5744 XSTRING (XCAR (tail
))->data
)
5745 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
5746 XSTRING (XCAR (tail
))->data
)))
5747 return (dpyinfo
->font_table
+ i
);
5749 fontname
= (char *) XSTRING (XCAR (font_names
))->data
;
5751 else if (w32_strict_fontnames
)
5753 /* If EnumFontFamiliesEx was available, we got a full list of
5754 fonts back so stop now to avoid the possibility of loading a
5755 random font. If we had to fall back to EnumFontFamilies, the
5756 list is incomplete, so continue whether the font we want was
5758 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5759 FARPROC enum_font_families_ex
5760 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
5761 if (enum_font_families_ex
)
5765 /* Load the font and add it to the table. */
5767 char *full_name
, *encoding
, *charset
;
5769 struct font_info
*fontp
;
5775 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
5778 if (!*lf
.lfFaceName
)
5779 /* If no name was specified for the font, we get a random font
5780 from CreateFontIndirect - this is not particularly
5781 desirable, especially since CreateFontIndirect does not
5782 fill out the missing name in lf, so we never know what we
5786 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
5787 bzero (font
, sizeof (*font
));
5789 /* Set bdf to NULL to indicate that this is a Windows font. */
5794 font
->hfont
= CreateFontIndirect (&lf
);
5796 if (font
->hfont
== NULL
)
5805 codepage
= w32_codepage_for_font (fontname
);
5807 hdc
= GetDC (dpyinfo
->root_window
);
5808 oldobj
= SelectObject (hdc
, font
->hfont
);
5810 ok
= GetTextMetrics (hdc
, &font
->tm
);
5811 if (codepage
== CP_UNICODE
)
5812 font
->double_byte_p
= 1;
5815 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5816 don't report themselves as double byte fonts, when
5817 patently they are. So instead of trusting
5818 GetFontLanguageInfo, we check the properties of the
5819 codepage directly, since that is ultimately what we are
5820 working from anyway. */
5821 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5823 GetCPInfo (codepage
, &cpi
);
5824 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
5827 SelectObject (hdc
, oldobj
);
5828 ReleaseDC (dpyinfo
->root_window
, hdc
);
5829 /* Fill out details in lf according to the font that was
5831 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
5832 lf
.lfWidth
= font
->tm
.tmAveCharWidth
;
5833 lf
.lfWeight
= font
->tm
.tmWeight
;
5834 lf
.lfItalic
= font
->tm
.tmItalic
;
5835 lf
.lfCharSet
= font
->tm
.tmCharSet
;
5836 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
5837 ? VARIABLE_PITCH
: FIXED_PITCH
);
5838 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
5839 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
5841 w32_cache_char_metrics (font
);
5848 w32_unload_font (dpyinfo
, font
);
5852 /* Find a free slot in the font table. */
5853 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
5854 if (dpyinfo
->font_table
[i
].name
== NULL
)
5857 /* If no free slot found, maybe enlarge the font table. */
5858 if (i
== dpyinfo
->n_fonts
5859 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
5862 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
5863 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
5865 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
5868 fontp
= dpyinfo
->font_table
+ i
;
5869 if (i
== dpyinfo
->n_fonts
)
5872 /* Now fill in the slots of *FONTP. */
5875 fontp
->font_idx
= i
;
5876 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
5877 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
5879 charset
= xlfd_charset_of_font (fontname
);
5881 /* Cache the W32 codepage for a font. This makes w32_encode_char
5882 (called for every glyph during redisplay) much faster. */
5883 fontp
->codepage
= codepage
;
5885 /* Work out the font's full name. */
5886 full_name
= (char *)xmalloc (100);
5887 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
5888 fontp
->full_name
= full_name
;
5891 /* If all else fails - just use the name we used to load it. */
5893 fontp
->full_name
= fontp
->name
;
5896 fontp
->size
= FONT_WIDTH (font
);
5897 fontp
->height
= FONT_HEIGHT (font
);
5899 /* The slot `encoding' specifies how to map a character
5900 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
5901 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
5902 (0:0x20..0x7F, 1:0xA0..0xFF,
5903 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
5904 2:0xA020..0xFF7F). For the moment, we don't know which charset
5905 uses this font. So, we set information in fontp->encoding[1]
5906 which is never used by any charset. If mapping can't be
5907 decided, set FONT_ENCODING_NOT_DECIDED. */
5909 /* SJIS fonts need to be set to type 4, all others seem to work as
5910 type FONT_ENCODING_NOT_DECIDED. */
5911 encoding
= strrchr (fontp
->name
, '-');
5912 if (encoding
&& stricmp (encoding
+1, "sjis") == 0)
5913 fontp
->encoding
[1] = 4;
5915 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
5917 /* The following three values are set to 0 under W32, which is
5918 what they get set to if XGetFontProperty fails under X. */
5919 fontp
->baseline_offset
= 0;
5920 fontp
->relative_compose
= 0;
5921 fontp
->default_ascent
= 0;
5923 /* Set global flag fonts_changed_p to non-zero if the font loaded
5924 has a character with a smaller width than any other character
5925 before, or if the font loaded has a smalle>r height than any
5926 other font loaded before. If this happens, it will make a
5927 glyph matrix reallocation necessary. */
5928 fonts_changed_p
= x_compute_min_glyph_bounds (f
);
5934 /* Load font named FONTNAME of size SIZE for frame F, and return a
5935 pointer to the structure font_info while allocating it dynamically.
5936 If loading fails, return NULL. */
5938 w32_load_font (f
,fontname
,size
)
5943 Lisp_Object bdf_fonts
;
5944 struct font_info
*retval
= NULL
;
5946 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
5948 while (!retval
&& CONSP (bdf_fonts
))
5950 char *bdf_name
, *bdf_file
;
5951 Lisp_Object bdf_pair
;
5953 bdf_name
= XSTRING (XCAR (bdf_fonts
))->data
;
5954 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
5955 bdf_file
= XSTRING (XCDR (bdf_pair
))->data
;
5957 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
5959 bdf_fonts
= XCDR (bdf_fonts
);
5965 return w32_load_system_font(f
, fontname
, size
);
5970 w32_unload_font (dpyinfo
, font
)
5971 struct w32_display_info
*dpyinfo
;
5976 if (font
->per_char
) xfree (font
->per_char
);
5977 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
5979 if (font
->hfont
) DeleteObject(font
->hfont
);
5984 /* The font conversion stuff between x and w32 */
5986 /* X font string is as follows (from faces.el)
5990 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5991 * (weight\? "\\([^-]*\\)") ; 1
5992 * (slant "\\([ior]\\)") ; 2
5993 * (slant\? "\\([^-]?\\)") ; 2
5994 * (swidth "\\([^-]*\\)") ; 3
5995 * (adstyle "[^-]*") ; 4
5996 * (pixelsize "[0-9]+")
5997 * (pointsize "[0-9][0-9]+")
5998 * (resx "[0-9][0-9]+")
5999 * (resy "[0-9][0-9]+")
6000 * (spacing "[cmp?*]")
6001 * (avgwidth "[0-9]+")
6002 * (registry "[^-]+")
6003 * (encoding "[^-]+")
6008 x_to_w32_weight (lpw
)
6011 if (!lpw
) return (FW_DONTCARE
);
6013 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
6014 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
6015 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
6016 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
6017 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
6018 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
6019 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
6020 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
6021 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
6022 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
6029 w32_to_x_weight (fnweight
)
6032 if (fnweight
>= FW_HEAVY
) return "heavy";
6033 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
6034 if (fnweight
>= FW_BOLD
) return "bold";
6035 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
6036 if (fnweight
>= FW_MEDIUM
) return "medium";
6037 if (fnweight
>= FW_NORMAL
) return "normal";
6038 if (fnweight
>= FW_LIGHT
) return "light";
6039 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
6040 if (fnweight
>= FW_THIN
) return "thin";
6046 x_to_w32_charset (lpcs
)
6049 Lisp_Object this_entry
, w32_charset
;
6051 int len
= strlen (lpcs
);
6053 /* Support "*-#nnn" format for unknown charsets. */
6054 if (strncmp (lpcs
, "*-#", 3) == 0)
6055 return atoi (lpcs
+ 3);
6057 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
6058 charset
= alloca (len
+ 1);
6059 strcpy (charset
, lpcs
);
6060 lpcs
= strchr (charset
, '*');
6064 /* Look through w32-charset-info-alist for the character set.
6065 Format of each entry is
6066 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6068 this_entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6070 if (NILP(this_entry
))
6072 /* At startup, we want iso8859-1 fonts to come up properly. */
6073 if (stricmp(charset
, "iso8859-1") == 0)
6074 return ANSI_CHARSET
;
6076 return DEFAULT_CHARSET
;
6079 w32_charset
= Fcar (Fcdr (this_entry
));
6081 // Translate Lisp symbol to number.
6082 if (w32_charset
== Qw32_charset_ansi
)
6083 return ANSI_CHARSET
;
6084 if (w32_charset
== Qw32_charset_symbol
)
6085 return SYMBOL_CHARSET
;
6086 if (w32_charset
== Qw32_charset_shiftjis
)
6087 return SHIFTJIS_CHARSET
;
6088 if (w32_charset
== Qw32_charset_hangeul
)
6089 return HANGEUL_CHARSET
;
6090 if (w32_charset
== Qw32_charset_chinesebig5
)
6091 return CHINESEBIG5_CHARSET
;
6092 if (w32_charset
== Qw32_charset_gb2312
)
6093 return GB2312_CHARSET
;
6094 if (w32_charset
== Qw32_charset_oem
)
6096 #ifdef JOHAB_CHARSET
6097 if (w32_charset
== Qw32_charset_johab
)
6098 return JOHAB_CHARSET
;
6099 if (w32_charset
== Qw32_charset_easteurope
)
6100 return EASTEUROPE_CHARSET
;
6101 if (w32_charset
== Qw32_charset_turkish
)
6102 return TURKISH_CHARSET
;
6103 if (w32_charset
== Qw32_charset_baltic
)
6104 return BALTIC_CHARSET
;
6105 if (w32_charset
== Qw32_charset_russian
)
6106 return RUSSIAN_CHARSET
;
6107 if (w32_charset
== Qw32_charset_arabic
)
6108 return ARABIC_CHARSET
;
6109 if (w32_charset
== Qw32_charset_greek
)
6110 return GREEK_CHARSET
;
6111 if (w32_charset
== Qw32_charset_hebrew
)
6112 return HEBREW_CHARSET
;
6113 if (w32_charset
== Qw32_charset_vietnamese
)
6114 return VIETNAMESE_CHARSET
;
6115 if (w32_charset
== Qw32_charset_thai
)
6116 return THAI_CHARSET
;
6117 if (w32_charset
== Qw32_charset_mac
)
6119 #endif /* JOHAB_CHARSET */
6120 #ifdef UNICODE_CHARSET
6121 if (w32_charset
== Qw32_charset_unicode
)
6122 return UNICODE_CHARSET
;
6125 return DEFAULT_CHARSET
;
6130 w32_to_x_charset (fncharset
)
6133 static char buf
[32];
6134 Lisp_Object charset_type
;
6139 /* Handle startup case of w32-charset-info-alist not
6140 being set up yet. */
6141 if (NILP(Vw32_charset_info_alist
))
6143 charset_type
= Qw32_charset_ansi
;
6145 case DEFAULT_CHARSET
:
6146 charset_type
= Qw32_charset_default
;
6148 case SYMBOL_CHARSET
:
6149 charset_type
= Qw32_charset_symbol
;
6151 case SHIFTJIS_CHARSET
:
6152 charset_type
= Qw32_charset_shiftjis
;
6154 case HANGEUL_CHARSET
:
6155 charset_type
= Qw32_charset_hangeul
;
6157 case GB2312_CHARSET
:
6158 charset_type
= Qw32_charset_gb2312
;
6160 case CHINESEBIG5_CHARSET
:
6161 charset_type
= Qw32_charset_chinesebig5
;
6164 charset_type
= Qw32_charset_oem
;
6167 /* More recent versions of Windows (95 and NT4.0) define more
6169 #ifdef EASTEUROPE_CHARSET
6170 case EASTEUROPE_CHARSET
:
6171 charset_type
= Qw32_charset_easteurope
;
6173 case TURKISH_CHARSET
:
6174 charset_type
= Qw32_charset_turkish
;
6176 case BALTIC_CHARSET
:
6177 charset_type
= Qw32_charset_baltic
;
6179 case RUSSIAN_CHARSET
:
6180 charset_type
= Qw32_charset_russian
;
6182 case ARABIC_CHARSET
:
6183 charset_type
= Qw32_charset_arabic
;
6186 charset_type
= Qw32_charset_greek
;
6188 case HEBREW_CHARSET
:
6189 charset_type
= Qw32_charset_hebrew
;
6191 case VIETNAMESE_CHARSET
:
6192 charset_type
= Qw32_charset_vietnamese
;
6195 charset_type
= Qw32_charset_thai
;
6198 charset_type
= Qw32_charset_mac
;
6201 charset_type
= Qw32_charset_johab
;
6205 #ifdef UNICODE_CHARSET
6206 case UNICODE_CHARSET
:
6207 charset_type
= Qw32_charset_unicode
;
6211 /* Encode numerical value of unknown charset. */
6212 sprintf (buf
, "*-#%u", fncharset
);
6218 char * best_match
= NULL
;
6220 /* Look through w32-charset-info-alist for the character set.
6221 Prefer ISO codepages, and prefer lower numbers in the ISO
6222 range. Only return charsets for codepages which are installed.
6224 Format of each entry is
6225 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6227 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
6230 Lisp_Object w32_charset
;
6231 Lisp_Object codepage
;
6233 Lisp_Object this_entry
= XCAR (rest
);
6235 /* Skip invalid entries in alist. */
6236 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
6237 || !CONSP (XCDR (this_entry
))
6238 || !SYMBOLP (XCAR (XCDR (this_entry
))))
6241 x_charset
= XSTRING (XCAR (this_entry
))->data
;
6242 w32_charset
= XCAR (XCDR (this_entry
));
6243 codepage
= XCDR (XCDR (this_entry
));
6245 /* Look for Same charset and a valid codepage (or non-int
6246 which means ignore). */
6247 if (w32_charset
== charset_type
6248 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
6249 || IsValidCodePage (XINT (codepage
))))
6251 /* If we don't have a match already, then this is the
6254 best_match
= x_charset
;
6255 /* If this is an ISO codepage, and the best so far isn't,
6256 then this is better. */
6257 else if (stricmp (best_match
, "iso") != 0
6258 && stricmp (x_charset
, "iso") == 0)
6259 best_match
= x_charset
;
6260 /* If both are ISO8859 codepages, choose the one with the
6261 lowest number in the encoding field. */
6262 else if (stricmp (best_match
, "iso8859-") == 0
6263 && stricmp (x_charset
, "iso8859-") == 0)
6265 int best_enc
= atoi (best_match
+ 8);
6266 int this_enc
= atoi (x_charset
+ 8);
6267 if (this_enc
> 0 && this_enc
< best_enc
)
6268 best_match
= x_charset
;
6273 /* If no match, encode the numeric value. */
6276 sprintf (buf
, "*-#%u", fncharset
);
6280 strncpy(buf
, best_match
, 31);
6287 /* Get the Windows codepage corresponding to the specified font. The
6288 charset info in the font name is used to look up
6289 w32-charset-to-codepage-alist. */
6291 w32_codepage_for_font (char *fontname
)
6293 Lisp_Object codepage
, entry
;
6294 char *charset_str
, *charset
, *end
;
6296 if (NILP (Vw32_charset_info_alist
))
6299 /* Extract charset part of font string. */
6300 charset
= xlfd_charset_of_font (fontname
);
6305 charset_str
= (char *) alloca (strlen (charset
) + 1);
6306 strcpy (charset_str
, charset
);
6309 /* Remove leading "*-". */
6310 if (strncmp ("*-", charset_str
, 2) == 0)
6311 charset
= charset_str
+ 2;
6314 charset
= charset_str
;
6316 /* Stop match at wildcard (including preceding '-'). */
6317 if (end
= strchr (charset
, '*'))
6319 if (end
> charset
&& *(end
-1) == '-')
6324 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6328 codepage
= Fcdr (Fcdr (entry
));
6330 if (NILP (codepage
))
6332 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
6334 else if (INTEGERP (codepage
))
6335 return XINT (codepage
);
6342 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
6343 LOGFONT
* lplogfont
;
6346 char * specific_charset
;
6350 char height_pixels
[8];
6352 char width_pixels
[8];
6353 char *fontname_dash
;
6354 int display_resy
= one_w32_display_info
.resy
;
6355 int display_resx
= one_w32_display_info
.resx
;
6357 struct coding_system coding
;
6359 if (!lpxstr
) abort ();
6364 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
6365 fonttype
= "raster";
6366 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
6367 fonttype
= "outline";
6369 fonttype
= "unknown";
6371 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system
),
6373 coding
.src_multibyte
= 0;
6374 coding
.dst_multibyte
= 1;
6375 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6376 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
6378 fontname
= alloca(sizeof(*fontname
) * bufsz
);
6379 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
6380 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
6381 *(fontname
+ coding
.produced
) = '\0';
6383 /* Replace dashes with underscores so the dashes are not
6385 fontname_dash
= fontname
;
6386 while (fontname_dash
= strchr (fontname_dash
, '-'))
6387 *fontname_dash
= '_';
6389 if (lplogfont
->lfHeight
)
6391 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
6392 sprintf (height_dpi
, "%u",
6393 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
6397 strcpy (height_pixels
, "*");
6398 strcpy (height_dpi
, "*");
6400 if (lplogfont
->lfWidth
)
6401 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
6403 strcpy (width_pixels
, "*");
6405 _snprintf (lpxstr
, len
- 1,
6406 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6407 fonttype
, /* foundry */
6408 fontname
, /* family */
6409 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
6410 lplogfont
->lfItalic
?'i':'r', /* slant */
6412 /* add style name */
6413 height_pixels
, /* pixel size */
6414 height_dpi
, /* point size */
6415 display_resx
, /* resx */
6416 display_resy
, /* resy */
6417 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
6418 ? 'p' : 'c', /* spacing */
6419 width_pixels
, /* avg width */
6420 specific_charset
? specific_charset
6421 : w32_to_x_charset (lplogfont
->lfCharSet
)
6422 /* charset registry and encoding */
6425 lpxstr
[len
- 1] = 0; /* just to be sure */
6430 x_to_w32_font (lpxstr
, lplogfont
)
6432 LOGFONT
* lplogfont
;
6434 struct coding_system coding
;
6436 if (!lplogfont
) return (FALSE
);
6438 memset (lplogfont
, 0, sizeof (*lplogfont
));
6440 /* Set default value for each field. */
6442 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
6443 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
6444 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
6446 /* go for maximum quality */
6447 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
6448 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
6449 lplogfont
->lfQuality
= PROOF_QUALITY
;
6452 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
6453 lplogfont
->lfWeight
= FW_DONTCARE
;
6454 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
6459 /* Provide a simple escape mechanism for specifying Windows font names
6460 * directly -- if font spec does not beginning with '-', assume this
6462 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6468 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
6469 width
[10], resy
[10], remainder
[50];
6471 int dpi
= one_w32_display_info
.resy
;
6473 fields
= sscanf (lpxstr
,
6474 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
6475 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
6479 /* In the general case when wildcards cover more than one field,
6480 we don't know which field is which, so don't fill any in.
6481 However, we need to cope with this particular form, which is
6482 generated by font_list_1 (invoked by try_font_list):
6483 "-raster-6x10-*-gb2312*-*"
6484 and make sure to correctly parse the charset field. */
6487 fields
= sscanf (lpxstr
,
6488 "-%*[^-]-%49[^-]-*-%49s",
6491 else if (fields
< 9)
6497 if (fields
> 0 && name
[0] != '*')
6503 (Fcheck_coding_system (Vlocale_coding_system
), &coding
);
6504 coding
.src_multibyte
= 1;
6505 coding
.dst_multibyte
= 1;
6506 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
6507 buf
= (unsigned char *) alloca (bufsize
);
6508 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6509 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
6510 if (coding
.produced
>= LF_FACESIZE
)
6511 coding
.produced
= LF_FACESIZE
- 1;
6512 buf
[coding
.produced
] = 0;
6513 strcpy (lplogfont
->lfFaceName
, buf
);
6517 lplogfont
->lfFaceName
[0] = '\0';
6522 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6526 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
6530 if (fields
> 0 && pixels
[0] != '*')
6531 lplogfont
->lfHeight
= atoi (pixels
);
6535 if (fields
> 0 && resy
[0] != '*')
6538 if (tem
> 0) dpi
= tem
;
6541 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
6542 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
6545 lplogfont
->lfPitchAndFamily
=
6546 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
6550 if (fields
> 0 && width
[0] != '*')
6551 lplogfont
->lfWidth
= atoi (width
) / 10;
6555 /* Strip the trailing '-' if present. (it shouldn't be, as it
6556 fails the test against xlfd-tight-regexp in fontset.el). */
6558 int len
= strlen (remainder
);
6559 if (len
> 0 && remainder
[len
-1] == '-')
6560 remainder
[len
-1] = 0;
6562 encoding
= remainder
;
6564 if (strncmp (encoding
, "*-", 2) == 0)
6567 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
6572 char name
[100], height
[10], width
[10], weight
[20];
6574 fields
= sscanf (lpxstr
,
6575 "%99[^:]:%9[^:]:%9[^:]:%19s",
6576 name
, height
, width
, weight
);
6578 if (fields
== EOF
) return (FALSE
);
6582 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
6583 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
6587 lplogfont
->lfFaceName
[0] = 0;
6593 lplogfont
->lfHeight
= atoi (height
);
6598 lplogfont
->lfWidth
= atoi (width
);
6602 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6605 /* This makes TrueType fonts work better. */
6606 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
6611 /* Strip the pixel height and point height from the given xlfd, and
6612 return the pixel height. If no pixel height is specified, calculate
6613 one from the point height, or if that isn't defined either, return
6614 0 (which usually signifies a scalable font).
6617 xlfd_strip_height (char *fontname
)
6619 int pixel_height
, field_number
;
6620 char *read_from
, *write_to
;
6624 pixel_height
= field_number
= 0;
6627 /* Look for height fields. */
6628 for (read_from
= fontname
; *read_from
; read_from
++)
6630 if (*read_from
== '-')
6633 if (field_number
== 7) /* Pixel height. */
6636 write_to
= read_from
;
6638 /* Find end of field. */
6639 for (;*read_from
&& *read_from
!= '-'; read_from
++)
6642 /* Split the fontname at end of field. */
6648 pixel_height
= atoi (write_to
);
6649 /* Blank out field. */
6650 if (read_from
> write_to
)
6655 /* If the pixel height field is at the end (partial xlfd),
6658 return pixel_height
;
6660 /* If we got a pixel height, the point height can be
6661 ignored. Just blank it out and break now. */
6664 /* Find end of point size field. */
6665 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6671 /* Blank out the point size field. */
6672 if (read_from
> write_to
)
6678 return pixel_height
;
6682 /* If the point height is already blank, break now. */
6683 if (*read_from
== '-')
6689 else if (field_number
== 8)
6691 /* If we didn't get a pixel height, try to get the point
6692 height and convert that. */
6694 char *point_size_start
= read_from
++;
6696 /* Find end of field. */
6697 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6706 point_size
= atoi (point_size_start
);
6708 /* Convert to pixel height. */
6709 pixel_height
= point_size
6710 * one_w32_display_info
.height_in
/ 720;
6712 /* Blank out this field and break. */
6720 /* Shift the rest of the font spec into place. */
6721 if (write_to
&& read_from
> write_to
)
6723 for (; *read_from
; read_from
++, write_to
++)
6724 *write_to
= *read_from
;
6728 return pixel_height
;
6731 /* Assume parameter 1 is fully qualified, no wildcards. */
6733 w32_font_match (fontname
, pattern
)
6737 char *regex
= alloca (strlen (pattern
) * 2 + 3);
6738 char *font_name_copy
= alloca (strlen (fontname
) + 1);
6741 /* Copy fontname so we can modify it during comparison. */
6742 strcpy (font_name_copy
, fontname
);
6747 /* Turn pattern into a regexp and do a regexp match. */
6748 for (; *pattern
; pattern
++)
6750 if (*pattern
== '?')
6752 else if (*pattern
== '*')
6763 /* Strip out font heights and compare them seperately, since
6764 rounding error can cause mismatches. This also allows a
6765 comparison between a font that declares only a pixel height and a
6766 pattern that declares the point height.
6769 int font_height
, pattern_height
;
6771 font_height
= xlfd_strip_height (font_name_copy
);
6772 pattern_height
= xlfd_strip_height (regex
);
6774 /* Compare now, and don't bother doing expensive regexp matching
6775 if the heights differ. */
6776 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
6780 return (fast_c_string_match_ignore_case (build_string (regex
),
6781 font_name_copy
) >= 0);
6784 /* Callback functions, and a structure holding info they need, for
6785 listing system fonts on W32. We need one set of functions to do the
6786 job properly, but these don't work on NT 3.51 and earlier, so we
6787 have a second set which don't handle character sets properly to
6790 In both cases, there are two passes made. The first pass gets one
6791 font from each family, the second pass lists all the fonts from
6794 typedef struct enumfont_t
6799 XFontStruct
*size_ref
;
6800 Lisp_Object
*pattern
;
6805 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
6807 NEWTEXTMETRIC
* lptm
;
6811 /* Ignore struck out and underlined versions of fonts. */
6812 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
6815 /* Only return fonts with names starting with @ if they were
6816 explicitly specified, since Microsoft uses an initial @ to
6817 denote fonts for vertical writing, without providing a more
6818 convenient way of identifying them. */
6819 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
6820 && lpef
->logfont
.lfFaceName
[0] != '@')
6823 /* Check that the character set matches if it was specified */
6824 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
6825 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
6830 Lisp_Object width
= Qnil
;
6831 char *charset
= NULL
;
6833 /* Truetype fonts do not report their true metrics until loaded */
6834 if (FontType
!= RASTER_FONTTYPE
)
6836 if (!NILP (*(lpef
->pattern
)))
6838 /* Scalable fonts are as big as you want them to be. */
6839 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
6840 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
6841 width
= make_number (lpef
->logfont
.lfWidth
);
6845 lplf
->elfLogFont
.lfHeight
= 0;
6846 lplf
->elfLogFont
.lfWidth
= 0;
6850 /* Make sure the height used here is the same as everywhere
6851 else (ie character height, not cell height). */
6852 if (lplf
->elfLogFont
.lfHeight
> 0)
6854 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6855 if (FontType
== RASTER_FONTTYPE
)
6856 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
6858 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
6861 if (!NILP (*(lpef
->pattern
)))
6863 charset
= xlfd_charset_of_font (XSTRING(*(lpef
->pattern
))->data
);
6865 /* Ensure that charset is valid for this font. */
6867 && (x_to_w32_charset (charset
) != lplf
->elfLogFont
.lfCharSet
))
6871 /* TODO: List all relevant charsets if charset not specified. */
6872 if (!w32_to_x_font (&(lplf
->elfLogFont
), buf
, 100, charset
))
6875 if (NILP (*(lpef
->pattern
))
6876 || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
6878 *lpef
->tail
= Fcons (Fcons (build_string (buf
), width
), Qnil
);
6879 lpef
->tail
= &(XCDR (*lpef
->tail
));
6888 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
6890 NEWTEXTMETRIC
* lptm
;
6894 return EnumFontFamilies (lpef
->hdc
,
6895 lplf
->elfLogFont
.lfFaceName
,
6896 (FONTENUMPROC
) enum_font_cb2
,
6902 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
6903 ENUMLOGFONTEX
* lplf
;
6904 NEWTEXTMETRICEX
* lptm
;
6908 /* We are not interested in the extra info we get back from the 'Ex
6909 version - only the fact that we get character set variations
6910 enumerated seperately. */
6911 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
6916 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
6917 ENUMLOGFONTEX
* lplf
;
6918 NEWTEXTMETRICEX
* lptm
;
6922 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6923 FARPROC enum_font_families_ex
6924 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6925 /* We don't really expect EnumFontFamiliesEx to disappear once we
6926 get here, so don't bother handling it gracefully. */
6927 if (enum_font_families_ex
== NULL
)
6928 error ("gdi32.dll has disappeared!");
6929 return enum_font_families_ex (lpef
->hdc
,
6931 (FONTENUMPROC
) enum_fontex_cb2
,
6935 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6936 and xterm.c in Emacs 20.3) */
6938 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
6940 char *fontname
, *ptnstr
;
6941 Lisp_Object list
, tem
, newlist
= Qnil
;
6944 list
= Vw32_bdf_filename_alist
;
6945 ptnstr
= XSTRING (pattern
)->data
;
6947 for ( ; CONSP (list
); list
= XCDR (list
))
6951 fontname
= XSTRING (XCAR (tem
))->data
;
6952 else if (STRINGP (tem
))
6953 fontname
= XSTRING (tem
)->data
;
6957 if (w32_font_match (fontname
, ptnstr
))
6959 newlist
= Fcons (XCAR (tem
), newlist
);
6961 if (n_fonts
>= max_names
)
6969 static Lisp_Object
w32_list_synthesized_fonts (FRAME_PTR f
,
6970 Lisp_Object pattern
,
6971 int size
, int max_names
);
6973 /* Return a list of names of available fonts matching PATTERN on frame
6974 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6975 to be listed. Frame F NULL means we have not yet created any
6976 frame, which means we can't get proper size info, as we don't have
6977 a device context to use for GetTextMetrics.
6978 MAXNAMES sets a limit on how many fonts to match. */
6981 w32_list_fonts (f
, pattern
, size
, maxnames
)
6983 Lisp_Object pattern
;
6987 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
6988 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
6989 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
6992 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
6993 if (NILP (patterns
))
6994 patterns
= Fcons (pattern
, Qnil
);
6996 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
7001 tpat
= XCAR (patterns
);
7003 if (!STRINGP (tpat
))
7006 /* Avoid expensive EnumFontFamilies functions if we are not
7007 going to be able to output one of these anyway. */
7008 codepage
= w32_codepage_for_font (XSTRING (tpat
)->data
);
7009 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
7010 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
7011 && !IsValidCodePage(codepage
))
7014 /* See if we cached the result for this particular query.
7015 The cache is an alist of the form:
7016 ((PATTERN (FONTNAME . WIDTH) ...) ...)
7018 if (tem
= XCDR (dpyinfo
->name_list_element
),
7019 !NILP (list
= Fassoc (tpat
, tem
)))
7021 list
= Fcdr_safe (list
);
7022 /* We have a cached list. Don't have to get the list again. */
7027 /* At first, put PATTERN in the cache. */
7033 /* Use EnumFontFamiliesEx where it is available, as it knows
7034 about character sets. Fall back to EnumFontFamilies for
7035 older versions of NT that don't support the 'Ex function. */
7036 x_to_w32_font (XSTRING (tpat
)->data
, &ef
.logfont
);
7038 LOGFONT font_match_pattern
;
7039 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
7040 FARPROC enum_font_families_ex
7041 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
7043 /* We do our own pattern matching so we can handle wildcards. */
7044 font_match_pattern
.lfFaceName
[0] = 0;
7045 font_match_pattern
.lfPitchAndFamily
= 0;
7046 /* We can use the charset, because if it is a wildcard it will
7047 be DEFAULT_CHARSET anyway. */
7048 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
7050 ef
.hdc
= GetDC (dpyinfo
->root_window
);
7052 if (enum_font_families_ex
)
7053 enum_font_families_ex (ef
.hdc
,
7054 &font_match_pattern
,
7055 (FONTENUMPROC
) enum_fontex_cb1
,
7058 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
7061 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
7066 /* Make a list of the fonts we got back.
7067 Store that in the font cache for the display. */
7068 XSETCDR (dpyinfo
->name_list_element
,
7069 Fcons (Fcons (tpat
, list
),
7070 XCDR (dpyinfo
->name_list_element
)));
7073 if (NILP (list
)) continue; /* Try the remaining alternatives. */
7075 newlist
= second_best
= Qnil
;
7077 /* Make a list of the fonts that have the right width. */
7078 for (; CONSP (list
); list
= XCDR (list
))
7085 if (NILP (XCAR (tem
)))
7089 newlist
= Fcons (XCAR (tem
), newlist
);
7091 if (n_fonts
>= maxnames
)
7096 if (!INTEGERP (XCDR (tem
)))
7098 /* Since we don't yet know the size of the font, we must
7099 load it and try GetTextMetrics. */
7100 W32FontStruct thisinfo
;
7105 if (!x_to_w32_font (XSTRING (XCAR (tem
))->data
, &lf
))
7109 thisinfo
.bdf
= NULL
;
7110 thisinfo
.hfont
= CreateFontIndirect (&lf
);
7111 if (thisinfo
.hfont
== NULL
)
7114 hdc
= GetDC (dpyinfo
->root_window
);
7115 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
7116 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
7117 XSETCDR (tem
, make_number (FONT_WIDTH (&thisinfo
)));
7119 XSETCDR (tem
, make_number (0));
7120 SelectObject (hdc
, oldobj
);
7121 ReleaseDC (dpyinfo
->root_window
, hdc
);
7122 DeleteObject(thisinfo
.hfont
);
7125 found_size
= XINT (XCDR (tem
));
7126 if (found_size
== size
)
7128 newlist
= Fcons (XCAR (tem
), newlist
);
7130 if (n_fonts
>= maxnames
)
7133 /* keep track of the closest matching size in case
7134 no exact match is found. */
7135 else if (found_size
> 0)
7137 if (NILP (second_best
))
7140 else if (found_size
< size
)
7142 if (XINT (XCDR (second_best
)) > size
7143 || XINT (XCDR (second_best
)) < found_size
)
7148 if (XINT (XCDR (second_best
)) > size
7149 && XINT (XCDR (second_best
)) >
7156 if (!NILP (newlist
))
7158 else if (!NILP (second_best
))
7160 newlist
= Fcons (XCAR (second_best
), Qnil
);
7165 /* Include any bdf fonts. */
7166 if (n_fonts
< maxnames
)
7168 Lisp_Object combined
[2];
7169 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
7170 combined
[1] = newlist
;
7171 newlist
= Fnconc(2, combined
);
7174 /* If we can't find a font that matches, check if Windows would be
7175 able to synthesize it from a different style. */
7176 if (NILP (newlist
) && !NILP (Vw32_enable_synthesized_fonts
))
7177 newlist
= w32_list_synthesized_fonts (f
, pattern
, size
, maxnames
);
7183 w32_list_synthesized_fonts (f
, pattern
, size
, max_names
)
7185 Lisp_Object pattern
;
7190 char *full_pattn
, *new_pattn
, foundary
[50], family
[50], *pattn_part2
;
7191 char style
[20], slant
;
7192 Lisp_Object matches
, tem
, synthed_matches
= Qnil
;
7194 full_pattn
= XSTRING (pattern
)->data
;
7196 pattn_part2
= alloca (XSTRING (pattern
)->size
+ 1);
7197 /* Allow some space for wildcard expansion. */
7198 new_pattn
= alloca (XSTRING (pattern
)->size
+ 100);
7200 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
7201 foundary
, family
, style
, &slant
, pattn_part2
);
7202 if (fields
== EOF
|| fields
< 5)
7205 /* If the style and slant are wildcards already there is no point
7206 checking again (and we don't want to keep recursing). */
7207 if (*style
== '*' && slant
== '*')
7210 sprintf (new_pattn
, "-%s-%s-*-*-%s", foundary
, family
, pattn_part2
);
7212 matches
= w32_list_fonts (f
, build_string (new_pattn
), size
, max_names
);
7214 for ( ; CONSP (matches
); matches
= XCDR (matches
))
7216 tem
= XCAR (matches
);
7220 full_pattn
= XSTRING (tem
)->data
;
7221 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
7222 foundary
, family
, pattn_part2
);
7223 if (fields
== EOF
|| fields
< 3)
7226 sprintf (new_pattn
, "-%s-%s-%s-%c-%s", foundary
, family
, style
,
7227 slant
, pattn_part2
);
7229 synthed_matches
= Fcons (build_string (new_pattn
),
7233 return synthed_matches
;
7237 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7239 w32_get_font_info (f
, font_idx
)
7243 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
7248 w32_query_font (struct frame
*f
, char *fontname
)
7251 struct font_info
*pfi
;
7253 pfi
= FRAME_W32_FONT_TABLE (f
);
7255 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
7257 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
7263 /* Find a CCL program for a font specified by FONTP, and set the member
7264 `encoder' of the structure. */
7267 w32_find_ccl_program (fontp
)
7268 struct font_info
*fontp
;
7270 Lisp_Object list
, elt
;
7272 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
7276 && STRINGP (XCAR (elt
))
7277 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
7283 struct ccl_program
*ccl
7284 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
7286 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
7289 fontp
->font_encoder
= ccl
;
7294 /* Find BDF files in a specified directory. (use GCPRO when calling,
7295 as this calls lisp to get a directory listing). */
7297 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
7299 Lisp_Object filelist
, list
= Qnil
;
7302 if (!STRINGP(directory
))
7305 filelist
= Fdirectory_files (directory
, Qt
,
7306 build_string (".*\\.[bB][dD][fF]"), Qt
);
7308 for ( ; CONSP(filelist
); filelist
= XCDR (filelist
))
7310 Lisp_Object filename
= XCAR (filelist
);
7311 if (w32_BDF_to_x_font (XSTRING (filename
)->data
, fontname
, 100))
7312 store_in_alist (&list
, build_string (fontname
), filename
);
7317 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
7319 doc
: /* Return a list of BDF fonts in DIR.
7320 The list is suitable for appending to w32-bdf-filename-alist. Fonts
7321 which do not contain an xlfd description will not be included in the
7322 list. DIR may be a list of directories. */)
7324 Lisp_Object directory
;
7326 Lisp_Object list
= Qnil
;
7327 struct gcpro gcpro1
, gcpro2
;
7329 if (!CONSP (directory
))
7330 return w32_find_bdf_fonts_in_dir (directory
);
7332 for ( ; CONSP (directory
); directory
= XCDR (directory
))
7334 Lisp_Object pair
[2];
7337 GCPRO2 (directory
, list
);
7338 pair
[1] = w32_find_bdf_fonts_in_dir( XCAR (directory
) );
7339 list
= Fnconc( 2, pair
);
7346 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
7347 doc
: /* Internal function called by `color-defined-p', which see. */)
7349 Lisp_Object color
, frame
;
7352 FRAME_PTR f
= check_x_frame (frame
);
7354 CHECK_STRING (color
);
7356 if (w32_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
7362 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
7363 doc
: /* Internal function called by `color-values', which see. */)
7365 Lisp_Object color
, frame
;
7368 FRAME_PTR f
= check_x_frame (frame
);
7370 CHECK_STRING (color
);
7372 if (w32_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
7376 rgb
[0] = make_number ((GetRValue (foo
.pixel
) << 8)
7377 | GetRValue (foo
.pixel
));
7378 rgb
[1] = make_number ((GetGValue (foo
.pixel
) << 8)
7379 | GetGValue (foo
.pixel
));
7380 rgb
[2] = make_number ((GetBValue (foo
.pixel
) << 8)
7381 | GetBValue (foo
.pixel
));
7382 return Flist (3, rgb
);
7388 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
7389 doc
: /* Internal function called by `display-color-p', which see. */)
7391 Lisp_Object display
;
7393 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7395 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
7401 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
7402 Sx_display_grayscale_p
, 0, 1, 0,
7403 doc
: /* Return t if the X display supports shades of gray.
7404 Note that color displays do support shades of gray.
7405 The optional argument DISPLAY specifies which display to ask about.
7406 DISPLAY should be either a frame or a display name (a string).
7407 If omitted or nil, that stands for the selected frame's display. */)
7409 Lisp_Object display
;
7411 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7413 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
7419 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
7420 Sx_display_pixel_width
, 0, 1, 0,
7421 doc
: /* Returns the width in pixels of DISPLAY.
7422 The optional argument DISPLAY specifies which display to ask about.
7423 DISPLAY should be either a frame or a display name (a string).
7424 If omitted or nil, that stands for the selected frame's display. */)
7426 Lisp_Object display
;
7428 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7430 return make_number (dpyinfo
->width
);
7433 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
7434 Sx_display_pixel_height
, 0, 1, 0,
7435 doc
: /* Returns the height in pixels of DISPLAY.
7436 The optional argument DISPLAY specifies which display to ask about.
7437 DISPLAY should be either a frame or a display name (a string).
7438 If omitted or nil, that stands for the selected frame's display. */)
7440 Lisp_Object display
;
7442 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7444 return make_number (dpyinfo
->height
);
7447 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
7449 doc
: /* Returns the number of bitplanes of DISPLAY.
7450 The optional argument DISPLAY specifies which display to ask about.
7451 DISPLAY should be either a frame or a display name (a string).
7452 If omitted or nil, that stands for the selected frame's display. */)
7454 Lisp_Object display
;
7456 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7458 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7461 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
7463 doc
: /* Returns the number of color cells of DISPLAY.
7464 The optional argument DISPLAY specifies which display to ask about.
7465 DISPLAY should be either a frame or a display name (a string).
7466 If omitted or nil, that stands for the selected frame's display. */)
7468 Lisp_Object display
;
7470 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7474 hdc
= GetDC (dpyinfo
->root_window
);
7475 if (dpyinfo
->has_palette
)
7476 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
7478 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
7481 cap
= 1 << (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7483 ReleaseDC (dpyinfo
->root_window
, hdc
);
7485 return make_number (cap
);
7488 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
7489 Sx_server_max_request_size
,
7491 doc
: /* Returns the maximum request size of the server of DISPLAY.
7492 The optional argument DISPLAY specifies which display to ask about.
7493 DISPLAY should be either a frame or a display name (a string).
7494 If omitted or nil, that stands for the selected frame's display. */)
7496 Lisp_Object display
;
7498 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7500 return make_number (1);
7503 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
7504 doc
: /* Returns the vendor ID string of the W32 system (Microsoft).
7505 The optional argument DISPLAY specifies which display to ask about.
7506 DISPLAY should be either a frame or a display name (a string).
7507 If omitted or nil, that stands for the selected frame's display. */)
7509 Lisp_Object display
;
7511 return build_string ("Microsoft Corp.");
7514 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
7515 doc
: /* Returns the version numbers of the server of DISPLAY.
7516 The value is a list of three integers: the major and minor
7517 version numbers, and the vendor-specific release
7518 number. See also the function `x-server-vendor'.
7520 The optional argument DISPLAY specifies which display to ask about.
7521 DISPLAY should be either a frame or a display name (a string).
7522 If omitted or nil, that stands for the selected frame's display. */)
7524 Lisp_Object display
;
7526 return Fcons (make_number (w32_major_version
),
7527 Fcons (make_number (w32_minor_version
),
7528 Fcons (make_number (w32_build_number
), Qnil
)));
7531 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
7532 doc
: /* Returns the number of screens on the server of DISPLAY.
7533 The optional argument DISPLAY specifies which display to ask about.
7534 DISPLAY should be either a frame or a display name (a string).
7535 If omitted or nil, that stands for the selected frame's display. */)
7537 Lisp_Object display
;
7539 return make_number (1);
7542 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
7543 Sx_display_mm_height
, 0, 1, 0,
7544 doc
: /* Returns the height in millimeters of DISPLAY.
7545 The optional argument DISPLAY specifies which display to ask about.
7546 DISPLAY should be either a frame or a display name (a string).
7547 If omitted or nil, that stands for the selected frame's display. */)
7549 Lisp_Object display
;
7551 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7555 hdc
= GetDC (dpyinfo
->root_window
);
7557 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
7559 ReleaseDC (dpyinfo
->root_window
, hdc
);
7561 return make_number (cap
);
7564 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
7565 doc
: /* Returns the width in millimeters of DISPLAY.
7566 The optional argument DISPLAY specifies which display to ask about.
7567 DISPLAY should be either a frame or a display name (a string).
7568 If omitted or nil, that stands for the selected frame's display. */)
7570 Lisp_Object display
;
7572 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7577 hdc
= GetDC (dpyinfo
->root_window
);
7579 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
7581 ReleaseDC (dpyinfo
->root_window
, hdc
);
7583 return make_number (cap
);
7586 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
7587 Sx_display_backing_store
, 0, 1, 0,
7588 doc
: /* Returns an indication of whether DISPLAY does backing store.
7589 The value may be `always', `when-mapped', or `not-useful'.
7590 The optional argument DISPLAY specifies which display to ask about.
7591 DISPLAY should be either a frame or a display name (a string).
7592 If omitted or nil, that stands for the selected frame's display. */)
7594 Lisp_Object display
;
7596 return intern ("not-useful");
7599 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
7600 Sx_display_visual_class
, 0, 1, 0,
7601 doc
: /* Returns the visual class of DISPLAY.
7602 The value is one of the symbols `static-gray', `gray-scale',
7603 `static-color', `pseudo-color', `true-color', or `direct-color'.
7605 The optional argument DISPLAY specifies which display to ask about.
7606 DISPLAY should be either a frame or a display name (a string).
7607 If omitted or nil, that stands for the selected frame's display. */)
7609 Lisp_Object display
;
7611 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7612 Lisp_Object result
= Qnil
;
7614 if (dpyinfo
->has_palette
)
7615 result
= intern ("pseudo-color");
7616 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
7617 result
= intern ("static-grey");
7618 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
7619 result
= intern ("static-color");
7620 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
7621 result
= intern ("true-color");
7626 DEFUN ("x-display-save-under", Fx_display_save_under
,
7627 Sx_display_save_under
, 0, 1, 0,
7628 doc
: /* Returns t if DISPLAY supports the save-under feature.
7629 The optional argument DISPLAY specifies which display to ask about.
7630 DISPLAY should be either a frame or a display name (a string).
7631 If omitted or nil, that stands for the selected frame's display. */)
7633 Lisp_Object display
;
7640 register struct frame
*f
;
7642 return PIXEL_WIDTH (f
);
7647 register struct frame
*f
;
7649 return PIXEL_HEIGHT (f
);
7654 register struct frame
*f
;
7656 return FONT_WIDTH (f
->output_data
.w32
->font
);
7661 register struct frame
*f
;
7663 return f
->output_data
.w32
->line_height
;
7668 register struct frame
*f
;
7670 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
7673 /* Return the display structure for the display named NAME.
7674 Open a new connection if necessary. */
7676 struct w32_display_info
*
7677 x_display_info_for_name (name
)
7681 struct w32_display_info
*dpyinfo
;
7683 CHECK_STRING (name
);
7685 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
7687 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
7690 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
7695 /* Use this general default value to start with. */
7696 Vx_resource_name
= Vinvocation_name
;
7698 validate_x_resource_name ();
7700 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
7701 (char *) XSTRING (Vx_resource_name
)->data
);
7704 error ("Cannot connect to server %s", XSTRING (name
)->data
);
7707 XSETFASTINT (Vwindow_system_version
, 3);
7712 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
7713 1, 3, 0, doc
: /* Open a connection to a server.
7714 DISPLAY is the name of the display to connect to.
7715 Optional second arg XRM-STRING is a string of resources in xrdb format.
7716 If the optional third arg MUST-SUCCEED is non-nil,
7717 terminate Emacs if we can't open the connection. */)
7718 (display
, xrm_string
, must_succeed
)
7719 Lisp_Object display
, xrm_string
, must_succeed
;
7721 unsigned char *xrm_option
;
7722 struct w32_display_info
*dpyinfo
;
7724 /* If initialization has already been done, return now to avoid
7725 overwriting critical parts of one_w32_display_info. */
7729 CHECK_STRING (display
);
7730 if (! NILP (xrm_string
))
7731 CHECK_STRING (xrm_string
);
7733 if (! EQ (Vwindow_system
, intern ("w32")))
7734 error ("Not using Microsoft Windows");
7736 /* Allow color mapping to be defined externally; first look in user's
7737 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
7739 Lisp_Object color_file
;
7740 struct gcpro gcpro1
;
7742 color_file
= build_string("~/rgb.txt");
7744 GCPRO1 (color_file
);
7746 if (NILP (Ffile_readable_p (color_file
)))
7748 Fexpand_file_name (build_string ("rgb.txt"),
7749 Fsymbol_value (intern ("data-directory")));
7751 Vw32_color_map
= Fw32_load_color_file (color_file
);
7755 if (NILP (Vw32_color_map
))
7756 Vw32_color_map
= Fw32_default_color_map ();
7758 if (! NILP (xrm_string
))
7759 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
7761 xrm_option
= (unsigned char *) 0;
7763 /* Use this general default value to start with. */
7764 /* First remove .exe suffix from invocation-name - it looks ugly. */
7766 char basename
[ MAX_PATH
], *str
;
7768 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
7769 str
= strrchr (basename
, '.');
7771 Vinvocation_name
= build_string (basename
);
7773 Vx_resource_name
= Vinvocation_name
;
7775 validate_x_resource_name ();
7777 /* This is what opens the connection and sets x_current_display.
7778 This also initializes many symbols, such as those used for input. */
7779 dpyinfo
= w32_term_init (display
, xrm_option
,
7780 (char *) XSTRING (Vx_resource_name
)->data
);
7784 if (!NILP (must_succeed
))
7785 fatal ("Cannot connect to server %s.\n",
7786 XSTRING (display
)->data
);
7788 error ("Cannot connect to server %s", XSTRING (display
)->data
);
7793 XSETFASTINT (Vwindow_system_version
, 3);
7797 DEFUN ("x-close-connection", Fx_close_connection
,
7798 Sx_close_connection
, 1, 1, 0,
7799 doc
: /* Close the connection to DISPLAY's server.
7800 For DISPLAY, specify either a frame or a display name (a string).
7801 If DISPLAY is nil, that stands for the selected frame's display. */)
7803 Lisp_Object display
;
7805 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7808 if (dpyinfo
->reference_count
> 0)
7809 error ("Display still has frames on it");
7812 /* Free the fonts in the font table. */
7813 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
7814 if (dpyinfo
->font_table
[i
].name
)
7816 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
7817 xfree (dpyinfo
->font_table
[i
].full_name
);
7818 xfree (dpyinfo
->font_table
[i
].name
);
7819 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
7821 x_destroy_all_bitmaps (dpyinfo
);
7823 x_delete_display (dpyinfo
);
7829 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
7830 doc
: /* Return the list of display names that Emacs has connections to. */)
7833 Lisp_Object tail
, result
;
7836 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
7837 result
= Fcons (XCAR (XCAR (tail
)), result
);
7842 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
7843 doc
: /* This is a noop on W32 systems. */)
7845 Lisp_Object display
, on
;
7852 /***********************************************************************
7854 ***********************************************************************/
7856 /* Value is the number of elements of vector VECTOR. */
7858 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
7860 /* List of supported image types. Use define_image_type to add new
7861 types. Use lookup_image_type to find a type for a given symbol. */
7863 static struct image_type
*image_types
;
7865 /* The symbol `image' which is the car of the lists used to represent
7868 extern Lisp_Object Qimage
;
7870 /* The symbol `xbm' which is used as the type symbol for XBM images. */
7876 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
7877 extern Lisp_Object QCdata
;
7878 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
7879 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
7880 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
7882 /* Other symbols. */
7884 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
7886 /* Time in seconds after which images should be removed from the cache
7887 if not displayed. */
7889 Lisp_Object Vimage_cache_eviction_delay
;
7891 /* Function prototypes. */
7893 static void define_image_type
P_ ((struct image_type
*type
));
7894 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
7895 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
7896 static void x_laplace
P_ ((struct frame
*, struct image
*));
7897 static void x_emboss
P_ ((struct frame
*, struct image
*));
7898 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
7902 /* Define a new image type from TYPE. This adds a copy of TYPE to
7903 image_types and adds the symbol *TYPE->type to Vimage_types. */
7906 define_image_type (type
)
7907 struct image_type
*type
;
7909 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7910 The initialized data segment is read-only. */
7911 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
7912 bcopy (type
, p
, sizeof *p
);
7913 p
->next
= image_types
;
7915 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
7919 /* Look up image type SYMBOL, and return a pointer to its image_type
7920 structure. Value is null if SYMBOL is not a known image type. */
7922 static INLINE
struct image_type
*
7923 lookup_image_type (symbol
)
7926 struct image_type
*type
;
7928 for (type
= image_types
; type
; type
= type
->next
)
7929 if (EQ (symbol
, *type
->type
))
7936 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
7937 valid image specification is a list whose car is the symbol
7938 `image', and whose rest is a property list. The property list must
7939 contain a value for key `:type'. That value must be the name of a
7940 supported image type. The rest of the property list depends on the
7944 valid_image_p (object
)
7949 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
7953 for (tem
= XCDR (object
); CONSP (tem
); tem
= XCDR (tem
))
7954 if (EQ (XCAR (tem
), QCtype
))
7957 if (CONSP (tem
) && SYMBOLP (XCAR (tem
)))
7959 struct image_type
*type
;
7960 type
= lookup_image_type (XCAR (tem
));
7962 valid_p
= type
->valid_p (object
);
7973 /* Log error message with format string FORMAT and argument ARG.
7974 Signaling an error, e.g. when an image cannot be loaded, is not a
7975 good idea because this would interrupt redisplay, and the error
7976 message display would lead to another redisplay. This function
7977 therefore simply displays a message. */
7980 image_error (format
, arg1
, arg2
)
7982 Lisp_Object arg1
, arg2
;
7984 add_to_log (format
, arg1
, arg2
);
7989 /***********************************************************************
7990 Image specifications
7991 ***********************************************************************/
7993 enum image_value_type
7995 IMAGE_DONT_CHECK_VALUE_TYPE
,
7997 IMAGE_STRING_OR_NIL_VALUE
,
7999 IMAGE_POSITIVE_INTEGER_VALUE
,
8000 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
8001 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
8003 IMAGE_INTEGER_VALUE
,
8004 IMAGE_FUNCTION_VALUE
,
8009 /* Structure used when parsing image specifications. */
8011 struct image_keyword
8013 /* Name of keyword. */
8016 /* The type of value allowed. */
8017 enum image_value_type type
;
8019 /* Non-zero means key must be present. */
8022 /* Used to recognize duplicate keywords in a property list. */
8025 /* The value that was found. */
8030 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
8032 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
8035 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
8036 has the format (image KEYWORD VALUE ...). One of the keyword/
8037 value pairs must be `:type TYPE'. KEYWORDS is a vector of
8038 image_keywords structures of size NKEYWORDS describing other
8039 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
8042 parse_image_spec (spec
, keywords
, nkeywords
, type
)
8044 struct image_keyword
*keywords
;
8051 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
8054 plist
= XCDR (spec
);
8055 while (CONSP (plist
))
8057 Lisp_Object key
, value
;
8059 /* First element of a pair must be a symbol. */
8061 plist
= XCDR (plist
);
8065 /* There must follow a value. */
8068 value
= XCAR (plist
);
8069 plist
= XCDR (plist
);
8071 /* Find key in KEYWORDS. Error if not found. */
8072 for (i
= 0; i
< nkeywords
; ++i
)
8073 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
8079 /* Record that we recognized the keyword. If a keywords
8080 was found more than once, it's an error. */
8081 keywords
[i
].value
= value
;
8082 ++keywords
[i
].count
;
8084 if (keywords
[i
].count
> 1)
8087 /* Check type of value against allowed type. */
8088 switch (keywords
[i
].type
)
8090 case IMAGE_STRING_VALUE
:
8091 if (!STRINGP (value
))
8095 case IMAGE_STRING_OR_NIL_VALUE
:
8096 if (!STRINGP (value
) && !NILP (value
))
8100 case IMAGE_SYMBOL_VALUE
:
8101 if (!SYMBOLP (value
))
8105 case IMAGE_POSITIVE_INTEGER_VALUE
:
8106 if (!INTEGERP (value
) || XINT (value
) <= 0)
8110 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
8111 if (INTEGERP (value
) && XINT (value
) >= 0)
8114 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
8115 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
8119 case IMAGE_ASCENT_VALUE
:
8120 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
8122 else if (INTEGERP (value
)
8123 && XINT (value
) >= 0
8124 && XINT (value
) <= 100)
8128 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
8129 if (!INTEGERP (value
) || XINT (value
) < 0)
8133 case IMAGE_DONT_CHECK_VALUE_TYPE
:
8136 case IMAGE_FUNCTION_VALUE
:
8137 value
= indirect_function (value
);
8139 || COMPILEDP (value
)
8140 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
8144 case IMAGE_NUMBER_VALUE
:
8145 if (!INTEGERP (value
) && !FLOATP (value
))
8149 case IMAGE_INTEGER_VALUE
:
8150 if (!INTEGERP (value
))
8154 case IMAGE_BOOL_VALUE
:
8155 if (!NILP (value
) && !EQ (value
, Qt
))
8164 if (EQ (key
, QCtype
) && !EQ (type
, value
))
8168 /* Check that all mandatory fields are present. */
8169 for (i
= 0; i
< nkeywords
; ++i
)
8170 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
8173 return NILP (plist
);
8177 /* Return the value of KEY in image specification SPEC. Value is nil
8178 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8179 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8182 image_spec_value (spec
, key
, found
)
8183 Lisp_Object spec
, key
;
8188 xassert (valid_image_p (spec
));
8190 for (tail
= XCDR (spec
);
8191 CONSP (tail
) && CONSP (XCDR (tail
));
8192 tail
= XCDR (XCDR (tail
)))
8194 if (EQ (XCAR (tail
), key
))
8198 return XCAR (XCDR (tail
));
8210 /***********************************************************************
8211 Image type independent image structures
8212 ***********************************************************************/
8214 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
8215 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
8218 /* Allocate and return a new image structure for image specification
8219 SPEC. SPEC has a hash value of HASH. */
8221 static struct image
*
8222 make_image (spec
, hash
)
8226 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
8228 xassert (valid_image_p (spec
));
8229 bzero (img
, sizeof *img
);
8230 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
8231 xassert (img
->type
!= NULL
);
8233 img
->data
.lisp_val
= Qnil
;
8234 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
8240 /* Free image IMG which was used on frame F, including its resources. */
8249 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8251 /* Remove IMG from the hash table of its cache. */
8253 img
->prev
->next
= img
->next
;
8255 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
8258 img
->next
->prev
= img
->prev
;
8260 c
->images
[img
->id
] = NULL
;
8262 /* Free resources, then free IMG. */
8263 img
->type
->free (f
, img
);
8269 /* Prepare image IMG for display on frame F. Must be called before
8270 drawing an image. */
8273 prepare_image_for_display (f
, img
)
8279 /* We're about to display IMG, so set its timestamp to `now'. */
8281 img
->timestamp
= EMACS_SECS (t
);
8283 /* If IMG doesn't have a pixmap yet, load it now, using the image
8284 type dependent loader function. */
8285 if (img
->pixmap
== 0 && !img
->load_failed_p
)
8286 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8290 /* Value is the number of pixels for the ascent of image IMG when
8291 drawn in face FACE. */
8294 image_ascent (img
, face
)
8298 int height
= img
->height
+ img
->vmargin
;
8301 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
8304 ascent
= height
/ 2 - (FONT_DESCENT(face
->font
)
8305 - FONT_BASE(face
->font
)) / 2;
8307 ascent
= height
/ 2;
8310 ascent
= height
* img
->ascent
/ 100.0;
8317 /* Image background colors. */
8319 static unsigned long
8320 four_corners_best (ximg
, width
, height
)
8322 unsigned long width
, height
;
8324 #if 0 /* TODO: Image support. */
8325 unsigned long corners
[4], best
;
8328 /* Get the colors at the corners of ximg. */
8329 corners
[0] = XGetPixel (ximg
, 0, 0);
8330 corners
[1] = XGetPixel (ximg
, width
- 1, 0);
8331 corners
[2] = XGetPixel (ximg
, width
- 1, height
- 1);
8332 corners
[3] = XGetPixel (ximg
, 0, height
- 1);
8334 /* Choose the most frequently found color as background. */
8335 for (i
= best_count
= 0; i
< 4; ++i
)
8339 for (j
= n
= 0; j
< 4; ++j
)
8340 if (corners
[i
] == corners
[j
])
8344 best
= corners
[i
], best_count
= n
;
8353 /* Return the `background' field of IMG. If IMG doesn't have one yet,
8354 it is guessed heuristically. If non-zero, XIMG is an existing XImage
8355 object to use for the heuristic. */
8358 image_background (img
, f
, ximg
)
8363 if (! img
->background_valid
)
8364 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8366 #if 0 /* TODO: Image support. */
8367 int free_ximg
= !ximg
;
8370 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
8371 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8373 img
->background
= four_corners_best (ximg
, img
->width
, img
->height
);
8376 XDestroyImage (ximg
);
8378 img
->background_valid
= 1;
8382 return img
->background
;
8385 /* Return the `background_transparent' field of IMG. If IMG doesn't
8386 have one yet, it is guessed heuristically. If non-zero, MASK is an
8387 existing XImage object to use for the heuristic. */
8390 image_background_transparent (img
, f
, mask
)
8395 if (! img
->background_transparent_valid
)
8396 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8398 #if 0 /* TODO: Image support. */
8401 int free_mask
= !mask
;
8404 mask
= XGetImage (FRAME_X_DISPLAY (f
), img
->mask
,
8405 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8407 img
->background_transparent
8408 = !four_corners_best (mask
, img
->width
, img
->height
);
8411 XDestroyImage (mask
);
8415 img
->background_transparent
= 0;
8417 img
->background_transparent_valid
= 1;
8420 return img
->background_transparent
;
8424 /***********************************************************************
8425 Helper functions for X image types
8426 ***********************************************************************/
8428 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
8430 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8431 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
8433 Lisp_Object color_name
,
8434 unsigned long dflt
));
8437 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
8438 free the pixmap if any. MASK_P non-zero means clear the mask
8439 pixmap if any. COLORS_P non-zero means free colors allocated for
8440 the image, if any. */
8443 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
8446 int pixmap_p
, mask_p
, colors_p
;
8448 #if 0 /* TODO: W32 image support */
8449 if (pixmap_p
&& img
->pixmap
)
8451 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8453 img
->background_valid
= 0;
8456 if (mask_p
&& img
->mask
)
8458 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8460 img
->background_transparent_valid
= 0;
8463 if (colors_p
&& img
->ncolors
)
8465 x_free_colors (f
, img
->colors
, img
->ncolors
);
8466 xfree (img
->colors
);
8473 /* Free X resources of image IMG which is used on frame F. */
8476 x_clear_image (f
, img
)
8480 #if 0 /* TODO: W32 image support */
8485 XFreePixmap (NULL
, img
->pixmap
);
8492 int class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
8494 /* If display has an immutable color map, freeing colors is not
8495 necessary and some servers don't allow it. So don't do it. */
8496 if (class != StaticColor
8497 && class != StaticGray
8498 && class != TrueColor
)
8502 cmap
= DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f
)->screen
);
8503 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
, img
->colors
,
8508 xfree (img
->colors
);
8516 /* Allocate color COLOR_NAME for image IMG on frame F. If color
8517 cannot be allocated, use DFLT. Add a newly allocated color to
8518 IMG->colors, so that it can be freed again. Value is the pixel
8521 static unsigned long
8522 x_alloc_image_color (f
, img
, color_name
, dflt
)
8525 Lisp_Object color_name
;
8528 #if 0 /* TODO: allocing colors. */
8530 unsigned long result
;
8532 xassert (STRINGP (color_name
));
8534 if (w32_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
8536 /* This isn't called frequently so we get away with simply
8537 reallocating the color vector to the needed size, here. */
8540 (unsigned long *) xrealloc (img
->colors
,
8541 img
->ncolors
* sizeof *img
->colors
);
8542 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
8543 result
= color
.pixel
;
8554 /***********************************************************************
8556 ***********************************************************************/
8558 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
8559 static void postprocess_image
P_ ((struct frame
*, struct image
*));
8562 /* Return a new, initialized image cache that is allocated from the
8563 heap. Call free_image_cache to free an image cache. */
8565 struct image_cache
*
8568 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
8571 bzero (c
, sizeof *c
);
8573 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
8574 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
8575 c
->buckets
= (struct image
**) xmalloc (size
);
8576 bzero (c
->buckets
, size
);
8581 /* Free image cache of frame F. Be aware that X frames share images
8585 free_image_cache (f
)
8588 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8593 /* Cache should not be referenced by any frame when freed. */
8594 xassert (c
->refcount
== 0);
8596 for (i
= 0; i
< c
->used
; ++i
)
8597 free_image (f
, c
->images
[i
]);
8601 FRAME_X_IMAGE_CACHE (f
) = NULL
;
8606 /* Clear image cache of frame F. FORCE_P non-zero means free all
8607 images. FORCE_P zero means clear only images that haven't been
8608 displayed for some time. Should be called from time to time to
8609 reduce the number of loaded images. If image-eviction-seconds is
8610 non-nil, this frees images in the cache which weren't displayed for
8611 at least that many seconds. */
8614 clear_image_cache (f
, force_p
)
8618 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8620 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
8624 int i
, any_freed_p
= 0;
8627 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
8629 for (i
= 0; i
< c
->used
; ++i
)
8631 struct image
*img
= c
->images
[i
];
8634 || (img
->timestamp
> old
)))
8636 free_image (f
, img
);
8641 /* We may be clearing the image cache because, for example,
8642 Emacs was iconified for a longer period of time. In that
8643 case, current matrices may still contain references to
8644 images freed above. So, clear these matrices. */
8647 clear_current_matrices (f
);
8648 ++windows_or_buffers_changed
;
8654 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
8656 doc
: /* Clear the image cache of FRAME.
8657 FRAME nil or omitted means use the selected frame.
8658 FRAME t means clear the image caches of all frames. */)
8666 FOR_EACH_FRAME (tail
, frame
)
8667 if (FRAME_W32_P (XFRAME (frame
)))
8668 clear_image_cache (XFRAME (frame
), 1);
8671 clear_image_cache (check_x_frame (frame
), 1);
8677 /* Compute masks and transform image IMG on frame F, as specified
8678 by the image's specification, */
8681 postprocess_image (f
, img
)
8685 #if 0 /* TODO: image support. */
8686 /* Manipulation of the image's mask. */
8689 Lisp_Object conversion
, spec
;
8694 /* `:heuristic-mask t'
8696 means build a mask heuristically.
8697 `:heuristic-mask (R G B)'
8698 `:mask (heuristic (R G B))'
8699 means build a mask from color (R G B) in the
8702 means remove a mask, if any. */
8704 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
8706 x_build_heuristic_mask (f
, img
, mask
);
8711 mask
= image_spec_value (spec
, QCmask
, &found_p
);
8713 if (EQ (mask
, Qheuristic
))
8714 x_build_heuristic_mask (f
, img
, Qt
);
8715 else if (CONSP (mask
)
8716 && EQ (XCAR (mask
), Qheuristic
))
8718 if (CONSP (XCDR (mask
)))
8719 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
8721 x_build_heuristic_mask (f
, img
, XCDR (mask
));
8723 else if (NILP (mask
) && found_p
&& img
->mask
)
8725 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
8731 /* Should we apply an image transformation algorithm? */
8732 conversion
= image_spec_value (spec
, QCconversion
, NULL
);
8733 if (EQ (conversion
, Qdisabled
))
8734 x_disable_image (f
, img
);
8735 else if (EQ (conversion
, Qlaplace
))
8737 else if (EQ (conversion
, Qemboss
))
8739 else if (CONSP (conversion
)
8740 && EQ (XCAR (conversion
), Qedge_detection
))
8743 tem
= XCDR (conversion
);
8745 x_edge_detection (f
, img
,
8746 Fplist_get (tem
, QCmatrix
),
8747 Fplist_get (tem
, QCcolor_adjustment
));
8754 /* Return the id of image with Lisp specification SPEC on frame F.
8755 SPEC must be a valid Lisp image specification (see valid_image_p). */
8758 lookup_image (f
, spec
)
8762 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8766 struct gcpro gcpro1
;
8769 /* F must be a window-system frame, and SPEC must be a valid image
8771 xassert (FRAME_WINDOW_P (f
));
8772 xassert (valid_image_p (spec
));
8776 /* Look up SPEC in the hash table of the image cache. */
8777 hash
= sxhash (spec
, 0);
8778 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8780 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
8781 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
8784 /* If not found, create a new image and cache it. */
8787 extern Lisp_Object Qpostscript
;
8790 img
= make_image (spec
, hash
);
8791 cache_image (f
, img
);
8792 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8794 /* If we can't load the image, and we don't have a width and
8795 height, use some arbitrary width and height so that we can
8796 draw a rectangle for it. */
8797 if (img
->load_failed_p
)
8801 value
= image_spec_value (spec
, QCwidth
, NULL
);
8802 img
->width
= (INTEGERP (value
)
8803 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
8804 value
= image_spec_value (spec
, QCheight
, NULL
);
8805 img
->height
= (INTEGERP (value
)
8806 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
8810 /* Handle image type independent image attributes
8811 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF',
8812 `:background COLOR'. */
8813 Lisp_Object ascent
, margin
, relief
, bg
;
8815 ascent
= image_spec_value (spec
, QCascent
, NULL
);
8816 if (INTEGERP (ascent
))
8817 img
->ascent
= XFASTINT (ascent
);
8818 else if (EQ (ascent
, Qcenter
))
8819 img
->ascent
= CENTERED_IMAGE_ASCENT
;
8821 margin
= image_spec_value (spec
, QCmargin
, NULL
);
8822 if (INTEGERP (margin
) && XINT (margin
) >= 0)
8823 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
8824 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
8825 && INTEGERP (XCDR (margin
)))
8827 if (XINT (XCAR (margin
)) > 0)
8828 img
->hmargin
= XFASTINT (XCAR (margin
));
8829 if (XINT (XCDR (margin
)) > 0)
8830 img
->vmargin
= XFASTINT (XCDR (margin
));
8833 relief
= image_spec_value (spec
, QCrelief
, NULL
);
8834 if (INTEGERP (relief
))
8836 img
->relief
= XINT (relief
);
8837 img
->hmargin
+= abs (img
->relief
);
8838 img
->vmargin
+= abs (img
->relief
);
8841 if (! img
->background_valid
)
8843 bg
= image_spec_value (img
->spec
, QCbackground
, NULL
);
8847 = x_alloc_image_color (f
, img
, bg
,
8848 FRAME_BACKGROUND_PIXEL (f
));
8849 img
->background_valid
= 1;
8853 /* Do image transformations and compute masks, unless we
8854 don't have the image yet. */
8855 if (!EQ (*img
->type
->type
, Qpostscript
))
8856 postprocess_image (f
, img
);
8860 xassert (!interrupt_input_blocked
);
8863 /* We're using IMG, so set its timestamp to `now'. */
8864 EMACS_GET_TIME (now
);
8865 img
->timestamp
= EMACS_SECS (now
);
8869 /* Value is the image id. */
8874 /* Cache image IMG in the image cache of frame F. */
8877 cache_image (f
, img
)
8881 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8884 /* Find a free slot in c->images. */
8885 for (i
= 0; i
< c
->used
; ++i
)
8886 if (c
->images
[i
] == NULL
)
8889 /* If no free slot found, maybe enlarge c->images. */
8890 if (i
== c
->used
&& c
->used
== c
->size
)
8893 c
->images
= (struct image
**) xrealloc (c
->images
,
8894 c
->size
* sizeof *c
->images
);
8897 /* Add IMG to c->images, and assign IMG an id. */
8903 /* Add IMG to the cache's hash table. */
8904 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8905 img
->next
= c
->buckets
[i
];
8907 img
->next
->prev
= img
;
8909 c
->buckets
[i
] = img
;
8913 /* Call FN on every image in the image cache of frame F. Used to mark
8914 Lisp Objects in the image cache. */
8917 forall_images_in_image_cache (f
, fn
)
8919 void (*fn
) P_ ((struct image
*img
));
8921 if (FRAME_LIVE_P (f
) && FRAME_W32_P (f
))
8923 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8927 for (i
= 0; i
< c
->used
; ++i
)
8936 /***********************************************************************
8938 ***********************************************************************/
8940 #if 0 /* TODO: W32 specific image code. */
8942 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
8943 XImage
**, Pixmap
*));
8944 static void x_destroy_x_image
P_ ((XImage
*));
8945 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
8948 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
8949 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
8950 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
8951 via xmalloc. Print error messages via image_error if an error
8952 occurs. Value is non-zero if successful. */
8955 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
8957 int width
, height
, depth
;
8961 #if 0 /* TODO: Image support for W32 */
8962 Display
*display
= FRAME_W32_DISPLAY (f
);
8963 Screen
*screen
= FRAME_X_SCREEN (f
);
8964 Window window
= FRAME_W32_WINDOW (f
);
8966 xassert (interrupt_input_blocked
);
8969 depth
= one_w32_display_info
.n_cbits
;
8970 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
8971 depth
, ZPixmap
, 0, NULL
, width
, height
,
8972 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
8975 image_error ("Unable to allocate X image", Qnil
, Qnil
);
8979 /* Allocate image raster. */
8980 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
8982 /* Allocate a pixmap of the same size. */
8983 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
8986 x_destroy_x_image (*ximg
);
8988 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
8996 /* Destroy XImage XIMG. Free XIMG->data. */
8999 x_destroy_x_image (ximg
)
9002 xassert (interrupt_input_blocked
);
9007 XDestroyImage (ximg
);
9012 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
9013 are width and height of both the image and pixmap. */
9016 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
9023 xassert (interrupt_input_blocked
);
9024 gc
= XCreateGC (NULL
, pixmap
, 0, NULL
);
9025 XPutImage (NULL
, pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
9032 /***********************************************************************
9034 ***********************************************************************/
9036 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
9037 static char *slurp_file
P_ ((char *, int *));
9040 /* Find image file FILE. Look in data-directory, then
9041 x-bitmap-file-path. Value is the full name of the file found, or
9042 nil if not found. */
9045 x_find_image_file (file
)
9048 Lisp_Object file_found
, search_path
;
9049 struct gcpro gcpro1
, gcpro2
;
9053 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
9054 GCPRO2 (file_found
, search_path
);
9056 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
9057 fd
= openp (search_path
, file
, Qnil
, &file_found
, 0);
9069 /* Read FILE into memory. Value is a pointer to a buffer allocated
9070 with xmalloc holding FILE's contents. Value is null if an error
9071 occurred. *SIZE is set to the size of the file. */
9074 slurp_file (file
, size
)
9082 if (stat (file
, &st
) == 0
9083 && (fp
= fopen (file
, "r")) != NULL
9084 && (buf
= (char *) xmalloc (st
.st_size
),
9085 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
9106 /***********************************************************************
9108 ***********************************************************************/
9110 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
9111 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
9113 static int xbm_image_p
P_ ((Lisp_Object object
));
9114 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
9118 /* Indices of image specification fields in xbm_format, below. */
9120 enum xbm_keyword_index
9138 /* Vector of image_keyword structures describing the format
9139 of valid XBM image specifications. */
9141 static struct image_keyword xbm_format
[XBM_LAST
] =
9143 {":type", IMAGE_SYMBOL_VALUE
, 1},
9144 {":file", IMAGE_STRING_VALUE
, 0},
9145 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9146 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9147 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9148 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
9149 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0},
9150 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9151 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9152 {":relief", IMAGE_INTEGER_VALUE
, 0},
9153 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9154 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9157 /* Structure describing the image type XBM. */
9159 static struct image_type xbm_type
=
9168 /* Tokens returned from xbm_scan. */
9177 /* Return non-zero if OBJECT is a valid XBM-type image specification.
9178 A valid specification is a list starting with the symbol `image'
9179 The rest of the list is a property list which must contain an
9182 If the specification specifies a file to load, it must contain
9183 an entry `:file FILENAME' where FILENAME is a string.
9185 If the specification is for a bitmap loaded from memory it must
9186 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
9187 WIDTH and HEIGHT are integers > 0. DATA may be:
9189 1. a string large enough to hold the bitmap data, i.e. it must
9190 have a size >= (WIDTH + 7) / 8 * HEIGHT
9192 2. a bool-vector of size >= WIDTH * HEIGHT
9194 3. a vector of strings or bool-vectors, one for each line of the
9197 Both the file and data forms may contain the additional entries
9198 `:background COLOR' and `:foreground COLOR'. If not present,
9199 foreground and background of the frame on which the image is
9200 displayed, is used. */
9203 xbm_image_p (object
)
9206 struct image_keyword kw
[XBM_LAST
];
9208 bcopy (xbm_format
, kw
, sizeof kw
);
9209 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
9212 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
9214 if (kw
[XBM_FILE
].count
)
9216 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
9224 /* Entries for `:width', `:height' and `:data' must be present. */
9225 if (!kw
[XBM_WIDTH
].count
9226 || !kw
[XBM_HEIGHT
].count
9227 || !kw
[XBM_DATA
].count
)
9230 data
= kw
[XBM_DATA
].value
;
9231 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
9232 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
9234 /* Check type of data, and width and height against contents of
9240 /* Number of elements of the vector must be >= height. */
9241 if (XVECTOR (data
)->size
< height
)
9244 /* Each string or bool-vector in data must be large enough
9245 for one line of the image. */
9246 for (i
= 0; i
< height
; ++i
)
9248 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
9252 if (XSTRING (elt
)->size
9253 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
9256 else if (BOOL_VECTOR_P (elt
))
9258 if (XBOOL_VECTOR (elt
)->size
< width
)
9265 else if (STRINGP (data
))
9267 if (XSTRING (data
)->size
9268 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
9271 else if (BOOL_VECTOR_P (data
))
9273 if (XBOOL_VECTOR (data
)->size
< width
* height
)
9280 /* Baseline must be a value between 0 and 100 (a percentage). */
9281 if (kw
[XBM_ASCENT
].count
9282 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
9289 /* Scan a bitmap file. FP is the stream to read from. Value is
9290 either an enumerator from enum xbm_token, or a character for a
9291 single-character token, or 0 at end of file. If scanning an
9292 identifier, store the lexeme of the identifier in SVAL. If
9293 scanning a number, store its value in *IVAL. */
9296 xbm_scan (s
, end
, sval
, ival
)
9305 /* Skip white space. */
9306 while (*s
< end
&&(c
= *(*s
)++, isspace (c
)))
9311 else if (isdigit (c
))
9313 int value
= 0, digit
;
9315 if (c
== '0' && *s
< end
)
9318 if (c
== 'x' || c
== 'X')
9325 else if (c
>= 'a' && c
<= 'f')
9326 digit
= c
- 'a' + 10;
9327 else if (c
>= 'A' && c
<= 'F')
9328 digit
= c
- 'A' + 10;
9331 value
= 16 * value
+ digit
;
9334 else if (isdigit (c
))
9338 && (c
= *(*s
)++, isdigit (c
)))
9339 value
= 8 * value
+ c
- '0';
9346 && (c
= *(*s
)++, isdigit (c
)))
9347 value
= 10 * value
+ c
- '0';
9355 else if (isalpha (c
) || c
== '_')
9359 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
9366 else if (c
== '/' && **s
== '*')
9368 /* C-style comment. */
9370 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
9383 /* Replacement for XReadBitmapFileData which isn't available under old
9384 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9385 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9386 the image. Return in *DATA the bitmap data allocated with xmalloc.
9387 Value is non-zero if successful. DATA null means just test if
9388 CONTENTS looks like an in-memory XBM file. */
9391 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
9392 char *contents
, *end
;
9393 int *width
, *height
;
9394 unsigned char **data
;
9397 char buffer
[BUFSIZ
];
9400 int bytes_per_line
, i
, nbytes
;
9406 LA1 = xbm_scan (contents, end, buffer, &value)
9408 #define expect(TOKEN) \
9409 if (LA1 != (TOKEN)) \
9414 #define expect_ident(IDENT) \
9415 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9420 *width
= *height
= -1;
9423 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
9425 /* Parse defines for width, height and hot-spots. */
9429 expect_ident ("define");
9430 expect (XBM_TK_IDENT
);
9432 if (LA1
== XBM_TK_NUMBER
);
9434 char *p
= strrchr (buffer
, '_');
9435 p
= p
? p
+ 1 : buffer
;
9436 if (strcmp (p
, "width") == 0)
9438 else if (strcmp (p
, "height") == 0)
9441 expect (XBM_TK_NUMBER
);
9444 if (*width
< 0 || *height
< 0)
9446 else if (data
== NULL
)
9449 /* Parse bits. Must start with `static'. */
9450 expect_ident ("static");
9451 if (LA1
== XBM_TK_IDENT
)
9453 if (strcmp (buffer
, "unsigned") == 0)
9456 expect_ident ("char");
9458 else if (strcmp (buffer
, "short") == 0)
9462 if (*width
% 16 && *width
% 16 < 9)
9465 else if (strcmp (buffer
, "char") == 0)
9473 expect (XBM_TK_IDENT
);
9479 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
9480 nbytes
= bytes_per_line
* *height
;
9481 p
= *data
= (char *) xmalloc (nbytes
);
9486 for (i
= 0; i
< nbytes
; i
+= 2)
9489 expect (XBM_TK_NUMBER
);
9492 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
9495 if (LA1
== ',' || LA1
== '}')
9503 for (i
= 0; i
< nbytes
; ++i
)
9506 expect (XBM_TK_NUMBER
);
9510 if (LA1
== ',' || LA1
== '}')
9535 /* Load XBM image IMG which will be displayed on frame F from buffer
9536 CONTENTS. END is the end of the buffer. Value is non-zero if
9540 xbm_load_image (f
, img
, contents
, end
)
9543 char *contents
, *end
;
9546 unsigned char *data
;
9549 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
9552 int depth
= one_w32_display_info
.n_cbits
;
9553 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
9554 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
9557 xassert (img
->width
> 0 && img
->height
> 0);
9559 /* Get foreground and background colors, maybe allocate colors. */
9560 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
9562 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
9563 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
9566 background
= x_alloc_image_color (f
, img
, value
, background
);
9567 img
->background
= background
;
9568 img
->background_valid
= 1;
9571 #if 0 /* TODO : Port image display to W32 */
9573 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f
),
9574 FRAME_W32_WINDOW (f
),
9576 img
->width
, img
->height
,
9577 foreground
, background
,
9582 if (img
->pixmap
== 0)
9584 x_clear_image (f
, img
);
9585 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
9591 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
9597 /* Value is non-zero if DATA looks like an in-memory XBM file. */
9604 return (STRINGP (data
)
9605 && xbm_read_bitmap_data (XSTRING (data
)->data
,
9606 (XSTRING (data
)->data
9607 + STRING_BYTES (XSTRING (data
))),
9612 /* Fill image IMG which is used on frame F with pixmap data. Value is
9613 non-zero if successful. */
9621 Lisp_Object file_name
;
9623 xassert (xbm_image_p (img
->spec
));
9625 /* If IMG->spec specifies a file name, create a non-file spec from it. */
9626 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
9627 if (STRINGP (file_name
))
9632 struct gcpro gcpro1
;
9634 file
= x_find_image_file (file_name
);
9636 if (!STRINGP (file
))
9638 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
9643 contents
= slurp_file (XSTRING (file
)->data
, &size
);
9644 if (contents
== NULL
)
9646 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
9651 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
9656 struct image_keyword fmt
[XBM_LAST
];
9659 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
9660 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
9663 int in_memory_file_p
= 0;
9665 /* See if data looks like an in-memory XBM file. */
9666 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9667 in_memory_file_p
= xbm_file_p (data
);
9669 /* Parse the list specification. */
9670 bcopy (xbm_format
, fmt
, sizeof fmt
);
9671 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
9674 /* Get specified width, and height. */
9675 if (!in_memory_file_p
)
9677 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
9678 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
9679 xassert (img
->width
> 0 && img
->height
> 0);
9681 /* Get foreground and background colors, maybe allocate colors. */
9682 if (fmt
[XBM_FOREGROUND
].count
9683 && STRINGP (fmt
[XBM_FOREGROUND
].value
))
9684 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
9686 if (fmt
[XBM_BACKGROUND
].count
9687 && STRINGP (fmt
[XBM_BACKGROUND
].value
))
9688 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
9691 if (in_memory_file_p
)
9692 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
9693 (XSTRING (data
)->data
9694 + STRING_BYTES (XSTRING (data
))));
9701 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
9703 p
= bits
= (char *) alloca (nbytes
* img
->height
);
9704 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
9706 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
9708 bcopy (XSTRING (line
)->data
, p
, nbytes
);
9710 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
9713 else if (STRINGP (data
))
9714 bits
= XSTRING (data
)->data
;
9716 bits
= XBOOL_VECTOR (data
)->data
;
9717 #ifdef TODO /* image support. */
9718 /* Create the pixmap. */
9719 depth
= one_w32_display_info
.n_cbits
;
9721 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
9724 img
->width
, img
->height
,
9725 foreground
, background
,
9732 image_error ("Unable to create pixmap for XBM image `%s'",
9734 x_clear_image (f
, img
);
9744 /***********************************************************************
9746 ***********************************************************************/
9750 static int xpm_image_p
P_ ((Lisp_Object object
));
9751 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
9752 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
9754 #include "X11/xpm.h"
9756 /* The symbol `xpm' identifying XPM-format images. */
9760 /* Indices of image specification fields in xpm_format, below. */
9762 enum xpm_keyword_index
9778 /* Vector of image_keyword structures describing the format
9779 of valid XPM image specifications. */
9781 static struct image_keyword xpm_format
[XPM_LAST
] =
9783 {":type", IMAGE_SYMBOL_VALUE
, 1},
9784 {":file", IMAGE_STRING_VALUE
, 0},
9785 {":data", IMAGE_STRING_VALUE
, 0},
9786 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9787 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
9788 {":relief", IMAGE_INTEGER_VALUE
, 0},
9789 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9790 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9791 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9792 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9793 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
9796 /* Structure describing the image type XBM. */
9798 static struct image_type xpm_type
=
9808 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
9809 for XPM images. Such a list must consist of conses whose car and
9813 xpm_valid_color_symbols_p (color_symbols
)
9814 Lisp_Object color_symbols
;
9816 while (CONSP (color_symbols
))
9818 Lisp_Object sym
= XCAR (color_symbols
);
9820 || !STRINGP (XCAR (sym
))
9821 || !STRINGP (XCDR (sym
)))
9823 color_symbols
= XCDR (color_symbols
);
9826 return NILP (color_symbols
);
9830 /* Value is non-zero if OBJECT is a valid XPM image specification. */
9833 xpm_image_p (object
)
9836 struct image_keyword fmt
[XPM_LAST
];
9837 bcopy (xpm_format
, fmt
, sizeof fmt
);
9838 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
9839 /* Either `:file' or `:data' must be present. */
9840 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
9841 /* Either no `:color-symbols' or it's a list of conses
9842 whose car and cdr are strings. */
9843 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
9844 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
9845 && (fmt
[XPM_ASCENT
].count
== 0
9846 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
9850 /* Load image IMG which will be displayed on frame F. Value is
9851 non-zero if successful. */
9859 XpmAttributes attrs
;
9860 Lisp_Object specified_file
, color_symbols
;
9862 /* Configure the XPM lib. Use the visual of frame F. Allocate
9863 close colors. Return colors allocated. */
9864 bzero (&attrs
, sizeof attrs
);
9865 attrs
.visual
= FRAME_X_VISUAL (f
);
9866 attrs
.colormap
= FRAME_X_COLORMAP (f
);
9867 attrs
.valuemask
|= XpmVisual
;
9868 attrs
.valuemask
|= XpmColormap
;
9869 attrs
.valuemask
|= XpmReturnAllocPixels
;
9870 #ifdef XpmAllocCloseColors
9871 attrs
.alloc_close_colors
= 1;
9872 attrs
.valuemask
|= XpmAllocCloseColors
;
9874 attrs
.closeness
= 600;
9875 attrs
.valuemask
|= XpmCloseness
;
9878 /* If image specification contains symbolic color definitions, add
9879 these to `attrs'. */
9880 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
9881 if (CONSP (color_symbols
))
9884 XpmColorSymbol
*xpm_syms
;
9887 attrs
.valuemask
|= XpmColorSymbols
;
9889 /* Count number of symbols. */
9890 attrs
.numsymbols
= 0;
9891 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
9894 /* Allocate an XpmColorSymbol array. */
9895 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
9896 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
9897 bzero (xpm_syms
, size
);
9898 attrs
.colorsymbols
= xpm_syms
;
9900 /* Fill the color symbol array. */
9901 for (tail
= color_symbols
, i
= 0;
9903 ++i
, tail
= XCDR (tail
))
9905 Lisp_Object name
= XCAR (XCAR (tail
));
9906 Lisp_Object color
= XCDR (XCAR (tail
));
9907 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
9908 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
9909 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
9910 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
9914 /* Create a pixmap for the image, either from a file, or from a
9915 string buffer containing data in the same format as an XPM file. */
9917 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9918 if (STRINGP (specified_file
))
9920 Lisp_Object file
= x_find_image_file (specified_file
);
9921 if (!STRINGP (file
))
9923 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9928 rc
= XpmReadFileToPixmap (NULL
, FRAME_W32_WINDOW (f
),
9929 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
9934 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
9935 rc
= XpmCreatePixmapFromBuffer (NULL
, FRAME_W32_WINDOW (f
),
9936 XSTRING (buffer
)->data
,
9937 &img
->pixmap
, &img
->mask
,
9942 if (rc
== XpmSuccess
)
9944 /* Remember allocated colors. */
9945 img
->ncolors
= attrs
.nalloc_pixels
;
9946 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
9947 * sizeof *img
->colors
);
9948 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
9949 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
9951 img
->width
= attrs
.width
;
9952 img
->height
= attrs
.height
;
9953 xassert (img
->width
> 0 && img
->height
> 0);
9955 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
9957 XpmFreeAttributes (&attrs
);
9965 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
9968 case XpmFileInvalid
:
9969 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
9973 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
9976 case XpmColorFailed
:
9977 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
9981 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
9986 return rc
== XpmSuccess
;
9989 #endif /* HAVE_XPM != 0 */
9992 #if 0 /* TODO : Color tables on W32. */
9993 /***********************************************************************
9995 ***********************************************************************/
9997 /* An entry in the color table mapping an RGB color to a pixel color. */
10002 unsigned long pixel
;
10004 /* Next in color table collision list. */
10005 struct ct_color
*next
;
10008 /* The bucket vector size to use. Must be prime. */
10010 #define CT_SIZE 101
10012 /* Value is a hash of the RGB color given by R, G, and B. */
10014 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
10016 /* The color hash table. */
10018 struct ct_color
**ct_table
;
10020 /* Number of entries in the color table. */
10022 int ct_colors_allocated
;
10024 /* Function prototypes. */
10026 static void init_color_table
P_ ((void));
10027 static void free_color_table
P_ ((void));
10028 static unsigned long *colors_in_color_table
P_ ((int *n
));
10029 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
10030 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
10033 /* Initialize the color table. */
10036 init_color_table ()
10038 int size
= CT_SIZE
* sizeof (*ct_table
);
10039 ct_table
= (struct ct_color
**) xmalloc (size
);
10040 bzero (ct_table
, size
);
10041 ct_colors_allocated
= 0;
10045 /* Free memory associated with the color table. */
10048 free_color_table ()
10051 struct ct_color
*p
, *next
;
10053 for (i
= 0; i
< CT_SIZE
; ++i
)
10054 for (p
= ct_table
[i
]; p
; p
= next
)
10065 /* Value is a pixel color for RGB color R, G, B on frame F. If an
10066 entry for that color already is in the color table, return the
10067 pixel color of that entry. Otherwise, allocate a new color for R,
10068 G, B, and make an entry in the color table. */
10070 static unsigned long
10071 lookup_rgb_color (f
, r
, g
, b
)
10075 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
10076 int i
= hash
% CT_SIZE
;
10077 struct ct_color
*p
;
10079 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10080 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
10089 color
= PALETTERGB (r
, g
, b
);
10091 ++ct_colors_allocated
;
10093 p
= (struct ct_color
*) xmalloc (sizeof *p
);
10098 p
->next
= ct_table
[i
];
10106 /* Look up pixel color PIXEL which is used on frame F in the color
10107 table. If not already present, allocate it. Value is PIXEL. */
10109 static unsigned long
10110 lookup_pixel_color (f
, pixel
)
10112 unsigned long pixel
;
10114 int i
= pixel
% CT_SIZE
;
10115 struct ct_color
*p
;
10117 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10118 if (p
->pixel
== pixel
)
10129 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
10130 color
.pixel
= pixel
;
10131 XQueryColor (NULL
, cmap
, &color
);
10132 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
10137 ++ct_colors_allocated
;
10139 p
= (struct ct_color
*) xmalloc (sizeof *p
);
10141 p
->g
= color
.green
;
10144 p
->next
= ct_table
[i
];
10148 return FRAME_FOREGROUND_PIXEL (f
);
10154 /* Value is a vector of all pixel colors contained in the color table,
10155 allocated via xmalloc. Set *N to the number of colors. */
10157 static unsigned long *
10158 colors_in_color_table (n
)
10162 struct ct_color
*p
;
10163 unsigned long *colors
;
10165 if (ct_colors_allocated
== 0)
10172 colors
= (unsigned long *) xmalloc (ct_colors_allocated
10174 *n
= ct_colors_allocated
;
10176 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
10177 for (p
= ct_table
[i
]; p
; p
= p
->next
)
10178 colors
[j
++] = p
->pixel
;
10187 /***********************************************************************
10189 ***********************************************************************/
10190 #if 0 /* TODO: image support. */
10191 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
10192 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
10193 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
10195 /* Non-zero means draw a cross on images having `:conversion
10198 int cross_disabled_images
;
10200 /* Edge detection matrices for different edge-detection
10203 static int emboss_matrix
[9] = {
10204 /* x - 1 x x + 1 */
10205 2, -1, 0, /* y - 1 */
10207 0, 1, -2 /* y + 1 */
10210 static int laplace_matrix
[9] = {
10211 /* x - 1 x x + 1 */
10212 1, 0, 0, /* y - 1 */
10214 0, 0, -1 /* y + 1 */
10217 /* Value is the intensity of the color whose red/green/blue values
10218 are R, G, and B. */
10220 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
10223 /* On frame F, return an array of XColor structures describing image
10224 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
10225 non-zero means also fill the red/green/blue members of the XColor
10226 structures. Value is a pointer to the array of XColors structures,
10227 allocated with xmalloc; it must be freed by the caller. */
10230 x_to_xcolors (f
, img
, rgb_p
)
10236 XColor
*colors
, *p
;
10239 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
10241 /* Get the X image IMG->pixmap. */
10242 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
10243 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
10245 /* Fill the `pixel' members of the XColor array. I wished there
10246 were an easy and portable way to circumvent XGetPixel. */
10248 for (y
= 0; y
< img
->height
; ++y
)
10252 for (x
= 0; x
< img
->width
; ++x
, ++p
)
10253 p
->pixel
= XGetPixel (ximg
, x
, y
);
10256 x_query_colors (f
, row
, img
->width
);
10259 XDestroyImage (ximg
);
10264 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
10265 RGB members are set. F is the frame on which this all happens.
10266 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
10269 x_from_xcolors (f
, img
, colors
)
10279 init_color_table ();
10281 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
10284 for (y
= 0; y
< img
->height
; ++y
)
10285 for (x
= 0; x
< img
->width
; ++x
, ++p
)
10287 unsigned long pixel
;
10288 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
10289 XPutPixel (oimg
, x
, y
, pixel
);
10293 x_clear_image_1 (f
, img
, 1, 0, 1);
10295 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
10296 x_destroy_x_image (oimg
);
10297 img
->pixmap
= pixmap
;
10298 img
->colors
= colors_in_color_table (&img
->ncolors
);
10299 free_color_table ();
10303 /* On frame F, perform edge-detection on image IMG.
10305 MATRIX is a nine-element array specifying the transformation
10306 matrix. See emboss_matrix for an example.
10308 COLOR_ADJUST is a color adjustment added to each pixel of the
10312 x_detect_edges (f
, img
, matrix
, color_adjust
)
10315 int matrix
[9], color_adjust
;
10317 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10321 for (i
= sum
= 0; i
< 9; ++i
)
10322 sum
+= abs (matrix
[i
]);
10324 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
10326 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
10328 for (y
= 0; y
< img
->height
; ++y
)
10330 p
= COLOR (new, 0, y
);
10331 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10332 p
= COLOR (new, img
->width
- 1, y
);
10333 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10336 for (x
= 1; x
< img
->width
- 1; ++x
)
10338 p
= COLOR (new, x
, 0);
10339 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10340 p
= COLOR (new, x
, img
->height
- 1);
10341 p
->red
= p
->green
= p
->blue
= 0xffff/2;
10344 for (y
= 1; y
< img
->height
- 1; ++y
)
10346 p
= COLOR (new, 1, y
);
10348 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
10350 int r
, g
, b
, y1
, x1
;
10353 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
10354 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
10357 XColor
*t
= COLOR (colors
, x1
, y1
);
10358 r
+= matrix
[i
] * t
->red
;
10359 g
+= matrix
[i
] * t
->green
;
10360 b
+= matrix
[i
] * t
->blue
;
10363 r
= (r
/ sum
+ color_adjust
) & 0xffff;
10364 g
= (g
/ sum
+ color_adjust
) & 0xffff;
10365 b
= (b
/ sum
+ color_adjust
) & 0xffff;
10366 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
10371 x_from_xcolors (f
, img
, new);
10377 /* Perform the pre-defined `emboss' edge-detection on image IMG
10385 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
10389 /* Transform image IMG which is used on frame F with a Laplace
10390 edge-detection algorithm. The result is an image that can be used
10391 to draw disabled buttons, for example. */
10398 x_detect_edges (f
, img
, laplace_matrix
, 45000);
10402 /* Perform edge-detection on image IMG on frame F, with specified
10403 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
10405 MATRIX must be either
10407 - a list of at least 9 numbers in row-major form
10408 - a vector of at least 9 numbers
10410 COLOR_ADJUST nil means use a default; otherwise it must be a
10414 x_edge_detection (f
, img
, matrix
, color_adjust
)
10417 Lisp_Object matrix
, color_adjust
;
10422 if (CONSP (matrix
))
10425 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
10426 ++i
, matrix
= XCDR (matrix
))
10427 trans
[i
] = XFLOATINT (XCAR (matrix
));
10429 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
10431 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
10432 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
10435 if (NILP (color_adjust
))
10436 color_adjust
= make_number (0xffff / 2);
10438 if (i
== 9 && NUMBERP (color_adjust
))
10439 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
10443 /* Transform image IMG on frame F so that it looks disabled. */
10446 x_disable_image (f
, img
)
10450 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
10452 if (dpyinfo
->n_planes
>= 2)
10454 /* Color (or grayscale). Convert to gray, and equalize. Just
10455 drawing such images with a stipple can look very odd, so
10456 we're using this method instead. */
10457 XColor
*colors
= x_to_xcolors (f
, img
, 1);
10459 const int h
= 15000;
10460 const int l
= 30000;
10462 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
10466 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
10467 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
10468 p
->red
= p
->green
= p
->blue
= i2
;
10471 x_from_xcolors (f
, img
, colors
);
10474 /* Draw a cross over the disabled image, if we must or if we
10476 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
10478 Display
*dpy
= FRAME_X_DISPLAY (f
);
10481 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
10482 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
10483 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
10484 img
->width
- 1, img
->height
- 1);
10485 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
10486 img
->width
- 1, 0);
10491 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
10492 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
10493 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
10494 img
->width
- 1, img
->height
- 1);
10495 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
10496 img
->width
- 1, 0);
10503 /* Build a mask for image IMG which is used on frame F. FILE is the
10504 name of an image file, for error messages. HOW determines how to
10505 determine the background color of IMG. If it is a list '(R G B)',
10506 with R, G, and B being integers >= 0, take that as the color of the
10507 background. Otherwise, determine the background color of IMG
10508 heuristically. Value is non-zero if successful. */
10511 x_build_heuristic_mask (f
, img
, how
)
10516 Display
*dpy
= FRAME_W32_DISPLAY (f
);
10517 XImage
*ximg
, *mask_img
;
10518 int x
, y
, rc
, use_img_background
;
10519 unsigned long bg
= 0;
10523 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
10525 img
->background_transparent_valid
= 0;
10528 /* Create an image and pixmap serving as mask. */
10529 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
10530 &mask_img
, &img
->mask
);
10534 /* Get the X image of IMG->pixmap. */
10535 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
10538 /* Determine the background color of ximg. If HOW is `(R G B)'
10539 take that as color. Otherwise, use the image's background color. */
10540 use_img_background
= 1;
10546 for (i
= 0; i
< 3 && CONSP (how
) && NATNUMP (XCAR (how
)); ++i
)
10548 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
10552 if (i
== 3 && NILP (how
))
10554 char color_name
[30];
10555 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
10556 bg
= x_alloc_image_color (f
, img
, build_string (color_name
), 0);
10557 use_img_background
= 0;
10561 if (use_img_background
)
10562 bg
= four_corners_best (ximg
, img
->width
, img
->height
);
10564 /* Set all bits in mask_img to 1 whose color in ximg is different
10565 from the background color bg. */
10566 for (y
= 0; y
< img
->height
; ++y
)
10567 for (x
= 0; x
< img
->width
; ++x
)
10568 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
10570 /* Fill in the background_transparent field while we have the mask handy. */
10571 image_background_transparent (img
, f
, mask_img
);
10573 /* Put mask_img into img->mask. */
10574 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
10575 x_destroy_x_image (mask_img
);
10576 XDestroyImage (ximg
);
10583 /***********************************************************************
10584 PBM (mono, gray, color)
10585 ***********************************************************************/
10588 static int pbm_image_p
P_ ((Lisp_Object object
));
10589 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
10590 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
10592 /* The symbol `pbm' identifying images of this type. */
10596 /* Indices of image specification fields in gs_format, below. */
10598 enum pbm_keyword_index
10607 PBM_HEURISTIC_MASK
,
10614 /* Vector of image_keyword structures describing the format
10615 of valid user-defined image specifications. */
10617 static struct image_keyword pbm_format
[PBM_LAST
] =
10619 {":type", IMAGE_SYMBOL_VALUE
, 1},
10620 {":file", IMAGE_STRING_VALUE
, 0},
10621 {":data", IMAGE_STRING_VALUE
, 0},
10622 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10623 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
10624 {":relief", IMAGE_INTEGER_VALUE
, 0},
10625 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10626 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10627 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10628 {":foreground", IMAGE_STRING_OR_NIL_VALUE
, 0},
10629 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
10632 /* Structure describing the image type `pbm'. */
10634 static struct image_type pbm_type
=
10644 /* Return non-zero if OBJECT is a valid PBM image specification. */
10647 pbm_image_p (object
)
10648 Lisp_Object object
;
10650 struct image_keyword fmt
[PBM_LAST
];
10652 bcopy (pbm_format
, fmt
, sizeof fmt
);
10654 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
10655 || (fmt
[PBM_ASCENT
].count
10656 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
10659 /* Must specify either :data or :file. */
10660 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
10664 /* Scan a decimal number from *S and return it. Advance *S while
10665 reading the number. END is the end of the string. Value is -1 at
10669 pbm_scan_number (s
, end
)
10670 unsigned char **s
, *end
;
10676 /* Skip white-space. */
10677 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
10682 /* Skip comment to end of line. */
10683 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
10686 else if (isdigit (c
))
10688 /* Read decimal number. */
10690 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
10691 val
= 10 * val
+ c
- '0';
10702 /* Read FILE into memory. Value is a pointer to a buffer allocated
10703 with xmalloc holding FILE's contents. Value is null if an error
10704 occured. *SIZE is set to the size of the file. */
10707 pbm_read_file (file
, size
)
10715 if (stat (XSTRING (file
)->data
, &st
) == 0
10716 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
10717 && (buf
= (char *) xmalloc (st
.st_size
),
10718 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
10720 *size
= st
.st_size
;
10738 /* Load PBM image IMG for use on frame F. */
10746 int width
, height
, max_color_idx
= 0;
10748 Lisp_Object file
, specified_file
;
10749 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
10750 struct gcpro gcpro1
;
10751 unsigned char *contents
= NULL
;
10752 unsigned char *end
, *p
;
10755 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10759 if (STRINGP (specified_file
))
10761 file
= x_find_image_file (specified_file
);
10762 if (!STRINGP (file
))
10764 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10769 contents
= slurp_file (XSTRING (file
)->data
, &size
);
10770 if (contents
== NULL
)
10772 image_error ("Error reading `%s'", file
, Qnil
);
10778 end
= contents
+ size
;
10783 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10784 p
= XSTRING (data
)->data
;
10785 end
= p
+ STRING_BYTES (XSTRING (data
));
10788 /* Check magic number. */
10789 if (end
- p
< 2 || *p
++ != 'P')
10791 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10801 raw_p
= 0, type
= PBM_MONO
;
10805 raw_p
= 0, type
= PBM_GRAY
;
10809 raw_p
= 0, type
= PBM_COLOR
;
10813 raw_p
= 1, type
= PBM_MONO
;
10817 raw_p
= 1, type
= PBM_GRAY
;
10821 raw_p
= 1, type
= PBM_COLOR
;
10825 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10829 /* Read width, height, maximum color-component. Characters
10830 starting with `#' up to the end of a line are ignored. */
10831 width
= pbm_scan_number (&p
, end
);
10832 height
= pbm_scan_number (&p
, end
);
10834 if (type
!= PBM_MONO
)
10836 max_color_idx
= pbm_scan_number (&p
, end
);
10837 if (raw_p
&& max_color_idx
> 255)
10838 max_color_idx
= 255;
10843 || (type
!= PBM_MONO
&& max_color_idx
< 0))
10846 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
10847 &ximg
, &img
->pixmap
))
10850 /* Initialize the color hash table. */
10851 init_color_table ();
10853 if (type
== PBM_MONO
)
10856 struct image_keyword fmt
[PBM_LAST
];
10857 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
10858 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
10860 /* Parse the image specification. */
10861 bcopy (pbm_format
, fmt
, sizeof fmt
);
10862 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
10864 /* Get foreground and background colors, maybe allocate colors. */
10865 if (fmt
[PBM_FOREGROUND
].count
10866 && STRINGP (fmt
[PBM_FOREGROUND
].value
))
10867 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
10868 if (fmt
[PBM_BACKGROUND
].count
10869 && STRINGP (fmt
[PBM_BACKGROUND
].value
))
10871 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
10872 img
->background
= bg
;
10873 img
->background_valid
= 1;
10876 for (y
= 0; y
< height
; ++y
)
10877 for (x
= 0; x
< width
; ++x
)
10887 g
= pbm_scan_number (&p
, end
);
10889 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
10894 for (y
= 0; y
< height
; ++y
)
10895 for (x
= 0; x
< width
; ++x
)
10899 if (type
== PBM_GRAY
)
10900 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
10909 r
= pbm_scan_number (&p
, end
);
10910 g
= pbm_scan_number (&p
, end
);
10911 b
= pbm_scan_number (&p
, end
);
10914 if (r
< 0 || g
< 0 || b
< 0)
10916 xfree (ximg
->data
);
10918 XDestroyImage (ximg
);
10919 image_error ("Invalid pixel value in image `%s'",
10924 /* RGB values are now in the range 0..max_color_idx.
10925 Scale this to the range 0..0xffff supported by X. */
10926 r
= (double) r
* 65535 / max_color_idx
;
10927 g
= (double) g
* 65535 / max_color_idx
;
10928 b
= (double) b
* 65535 / max_color_idx
;
10929 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
10933 /* Store in IMG->colors the colors allocated for the image, and
10934 free the color table. */
10935 img
->colors
= colors_in_color_table (&img
->ncolors
);
10936 free_color_table ();
10938 /* Maybe fill in the background field while we have ximg handy. */
10939 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
10940 IMAGE_BACKGROUND (img
, f
, ximg
);
10942 /* Put the image into a pixmap. */
10943 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10944 x_destroy_x_image (ximg
);
10946 img
->width
= width
;
10947 img
->height
= height
;
10953 #endif /* HAVE_PBM */
10956 /***********************************************************************
10958 ***********************************************************************/
10964 /* Function prototypes. */
10966 static int png_image_p
P_ ((Lisp_Object object
));
10967 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
10969 /* The symbol `png' identifying images of this type. */
10973 /* Indices of image specification fields in png_format, below. */
10975 enum png_keyword_index
10984 PNG_HEURISTIC_MASK
,
10990 /* Vector of image_keyword structures describing the format
10991 of valid user-defined image specifications. */
10993 static struct image_keyword png_format
[PNG_LAST
] =
10995 {":type", IMAGE_SYMBOL_VALUE
, 1},
10996 {":data", IMAGE_STRING_VALUE
, 0},
10997 {":file", IMAGE_STRING_VALUE
, 0},
10998 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10999 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11000 {":relief", IMAGE_INTEGER_VALUE
, 0},
11001 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11002 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11003 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11004 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11007 /* Structure describing the image type `png'. */
11009 static struct image_type png_type
=
11019 /* Return non-zero if OBJECT is a valid PNG image specification. */
11022 png_image_p (object
)
11023 Lisp_Object object
;
11025 struct image_keyword fmt
[PNG_LAST
];
11026 bcopy (png_format
, fmt
, sizeof fmt
);
11028 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
11029 || (fmt
[PNG_ASCENT
].count
11030 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
11033 /* Must specify either the :data or :file keyword. */
11034 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
11038 /* Error and warning handlers installed when the PNG library
11042 my_png_error (png_ptr
, msg
)
11043 png_struct
*png_ptr
;
11046 xassert (png_ptr
!= NULL
);
11047 image_error ("PNG error: %s", build_string (msg
), Qnil
);
11048 longjmp (png_ptr
->jmpbuf
, 1);
11053 my_png_warning (png_ptr
, msg
)
11054 png_struct
*png_ptr
;
11057 xassert (png_ptr
!= NULL
);
11058 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
11061 /* Memory source for PNG decoding. */
11063 struct png_memory_storage
11065 unsigned char *bytes
; /* The data */
11066 size_t len
; /* How big is it? */
11067 int index
; /* Where are we? */
11071 /* Function set as reader function when reading PNG image from memory.
11072 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
11073 bytes from the input to DATA. */
11076 png_read_from_memory (png_ptr
, data
, length
)
11077 png_structp png_ptr
;
11081 struct png_memory_storage
*tbr
11082 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
11084 if (length
> tbr
->len
- tbr
->index
)
11085 png_error (png_ptr
, "Read error");
11087 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
11088 tbr
->index
= tbr
->index
+ length
;
11091 /* Load PNG image IMG for use on frame F. Value is non-zero if
11099 Lisp_Object file
, specified_file
;
11100 Lisp_Object specified_data
;
11102 XImage
*ximg
, *mask_img
= NULL
;
11103 struct gcpro gcpro1
;
11104 png_struct
*png_ptr
= NULL
;
11105 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
11106 FILE *volatile fp
= NULL
;
11108 png_byte
*volatile pixels
= NULL
;
11109 png_byte
**volatile rows
= NULL
;
11110 png_uint_32 width
, height
;
11111 int bit_depth
, color_type
, interlace_type
;
11113 png_uint_32 row_bytes
;
11116 double screen_gamma
, image_gamma
;
11118 struct png_memory_storage tbr
; /* Data to be read */
11120 /* Find out what file to load. */
11121 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11122 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11126 if (NILP (specified_data
))
11128 file
= x_find_image_file (specified_file
);
11129 if (!STRINGP (file
))
11131 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11136 /* Open the image file. */
11137 fp
= fopen (XSTRING (file
)->data
, "rb");
11140 image_error ("Cannot open image file `%s'", file
, Qnil
);
11146 /* Check PNG signature. */
11147 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
11148 || !png_check_sig (sig
, sizeof sig
))
11150 image_error ("Not a PNG file:` %s'", file
, Qnil
);
11158 /* Read from memory. */
11159 tbr
.bytes
= XSTRING (specified_data
)->data
;
11160 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
11163 /* Check PNG signature. */
11164 if (tbr
.len
< sizeof sig
11165 || !png_check_sig (tbr
.bytes
, sizeof sig
))
11167 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
11172 /* Need to skip past the signature. */
11173 tbr
.bytes
+= sizeof (sig
);
11176 /* Initialize read and info structs for PNG lib. */
11177 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
11178 my_png_error
, my_png_warning
);
11181 if (fp
) fclose (fp
);
11186 info_ptr
= png_create_info_struct (png_ptr
);
11189 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
11190 if (fp
) fclose (fp
);
11195 end_info
= png_create_info_struct (png_ptr
);
11198 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
11199 if (fp
) fclose (fp
);
11204 /* Set error jump-back. We come back here when the PNG library
11205 detects an error. */
11206 if (setjmp (png_ptr
->jmpbuf
))
11210 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
11213 if (fp
) fclose (fp
);
11218 /* Read image info. */
11219 if (!NILP (specified_data
))
11220 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
11222 png_init_io (png_ptr
, fp
);
11224 png_set_sig_bytes (png_ptr
, sizeof sig
);
11225 png_read_info (png_ptr
, info_ptr
);
11226 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
11227 &interlace_type
, NULL
, NULL
);
11229 /* If image contains simply transparency data, we prefer to
11230 construct a clipping mask. */
11231 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
11236 /* This function is easier to write if we only have to handle
11237 one data format: RGB or RGBA with 8 bits per channel. Let's
11238 transform other formats into that format. */
11240 /* Strip more than 8 bits per channel. */
11241 if (bit_depth
== 16)
11242 png_set_strip_16 (png_ptr
);
11244 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
11246 png_set_expand (png_ptr
);
11248 /* Convert grayscale images to RGB. */
11249 if (color_type
== PNG_COLOR_TYPE_GRAY
11250 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
11251 png_set_gray_to_rgb (png_ptr
);
11253 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
11254 gamma_str
= getenv ("SCREEN_GAMMA");
11255 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
11257 /* Tell the PNG lib to handle gamma correction for us. */
11259 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
11260 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
11261 /* There is a special chunk in the image specifying the gamma. */
11262 png_set_sRGB (png_ptr
, info_ptr
, intent
);
11265 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
11266 /* Image contains gamma information. */
11267 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
11269 /* Use a default of 0.5 for the image gamma. */
11270 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
11272 /* Handle alpha channel by combining the image with a background
11273 color. Do this only if a real alpha channel is supplied. For
11274 simple transparency, we prefer a clipping mask. */
11275 if (!transparent_p
)
11277 png_color_16
*image_background
;
11278 Lisp_Object specified_bg
11279 = image_spec_value (img
->spec
, QCbackground
, NULL
);
11282 if (STRINGP (specified_bg
))
11283 /* The user specified `:background', use that. */
11286 if (w32_defined_color (f
, XSTRING (specified_bg
)->data
, &color
, 0))
11288 png_color_16 user_bg
;
11290 bzero (&user_bg
, sizeof user_bg
);
11291 user_bg
.red
= color
.red
;
11292 user_bg
.green
= color
.green
;
11293 user_bg
.blue
= color
.blue
;
11295 png_set_background (png_ptr
, &user_bg
,
11296 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
11299 else if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
11300 /* Image contains a background color with which to
11301 combine the image. */
11302 png_set_background (png_ptr
, image_background
,
11303 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
11306 /* Image does not contain a background color with which
11307 to combine the image data via an alpha channel. Use
11308 the frame's background instead. */
11311 png_color_16 frame_background
;
11313 cmap
= FRAME_X_COLORMAP (f
);
11314 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
11315 x_query_color (f
, &color
);
11317 bzero (&frame_background
, sizeof frame_background
);
11318 frame_background
.red
= color
.red
;
11319 frame_background
.green
= color
.green
;
11320 frame_background
.blue
= color
.blue
;
11322 png_set_background (png_ptr
, &frame_background
,
11323 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
11327 /* Update info structure. */
11328 png_read_update_info (png_ptr
, info_ptr
);
11330 /* Get number of channels. Valid values are 1 for grayscale images
11331 and images with a palette, 2 for grayscale images with transparency
11332 information (alpha channel), 3 for RGB images, and 4 for RGB
11333 images with alpha channel, i.e. RGBA. If conversions above were
11334 sufficient we should only have 3 or 4 channels here. */
11335 channels
= png_get_channels (png_ptr
, info_ptr
);
11336 xassert (channels
== 3 || channels
== 4);
11338 /* Number of bytes needed for one row of the image. */
11339 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
11341 /* Allocate memory for the image. */
11342 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
11343 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
11344 for (i
= 0; i
< height
; ++i
)
11345 rows
[i
] = pixels
+ i
* row_bytes
;
11347 /* Read the entire image. */
11348 png_read_image (png_ptr
, rows
);
11349 png_read_end (png_ptr
, info_ptr
);
11356 /* Create the X image and pixmap. */
11357 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
11361 /* Create an image and pixmap serving as mask if the PNG image
11362 contains an alpha channel. */
11365 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
11366 &mask_img
, &img
->mask
))
11368 x_destroy_x_image (ximg
);
11369 XFreePixmap (FRAME_W32_DISPLAY (f
), img
->pixmap
);
11374 /* Fill the X image and mask from PNG data. */
11375 init_color_table ();
11377 for (y
= 0; y
< height
; ++y
)
11379 png_byte
*p
= rows
[y
];
11381 for (x
= 0; x
< width
; ++x
)
11388 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
11390 /* An alpha channel, aka mask channel, associates variable
11391 transparency with an image. Where other image formats
11392 support binary transparency---fully transparent or fully
11393 opaque---PNG allows up to 254 levels of partial transparency.
11394 The PNG library implements partial transparency by combining
11395 the image with a specified background color.
11397 I'm not sure how to handle this here nicely: because the
11398 background on which the image is displayed may change, for
11399 real alpha channel support, it would be necessary to create
11400 a new image for each possible background.
11402 What I'm doing now is that a mask is created if we have
11403 boolean transparency information. Otherwise I'm using
11404 the frame's background color to combine the image with. */
11409 XPutPixel (mask_img
, x
, y
, *p
> 0);
11415 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11416 /* Set IMG's background color from the PNG image, unless the user
11420 if (png_get_bKGD (png_ptr
, info_ptr
, &bg
))
11422 img
->background
= lookup_rgb_color (f
, bg
->red
, bg
->green
, bg
->blue
);
11423 img
->background_valid
= 1;
11427 /* Remember colors allocated for this image. */
11428 img
->colors
= colors_in_color_table (&img
->ncolors
);
11429 free_color_table ();
11432 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
11436 img
->width
= width
;
11437 img
->height
= height
;
11439 /* Maybe fill in the background field while we have ximg handy. */
11440 IMAGE_BACKGROUND (img
, f
, ximg
);
11442 /* Put the image into the pixmap, then free the X image and its buffer. */
11443 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11444 x_destroy_x_image (ximg
);
11446 /* Same for the mask. */
11449 /* Fill in the background_transparent field while we have the mask
11451 image_background_transparent (img
, f
, mask_img
);
11453 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
11454 x_destroy_x_image (mask_img
);
11461 #endif /* HAVE_PNG != 0 */
11465 /***********************************************************************
11467 ***********************************************************************/
11471 /* Work around a warning about HAVE_STDLIB_H being redefined in
11473 #ifdef HAVE_STDLIB_H
11474 #define HAVE_STDLIB_H_1
11475 #undef HAVE_STDLIB_H
11476 #endif /* HAVE_STLIB_H */
11478 #include <jpeglib.h>
11479 #include <jerror.h>
11480 #include <setjmp.h>
11482 #ifdef HAVE_STLIB_H_1
11483 #define HAVE_STDLIB_H 1
11486 static int jpeg_image_p
P_ ((Lisp_Object object
));
11487 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
11489 /* The symbol `jpeg' identifying images of this type. */
11493 /* Indices of image specification fields in gs_format, below. */
11495 enum jpeg_keyword_index
11504 JPEG_HEURISTIC_MASK
,
11510 /* Vector of image_keyword structures describing the format
11511 of valid user-defined image specifications. */
11513 static struct image_keyword jpeg_format
[JPEG_LAST
] =
11515 {":type", IMAGE_SYMBOL_VALUE
, 1},
11516 {":data", IMAGE_STRING_VALUE
, 0},
11517 {":file", IMAGE_STRING_VALUE
, 0},
11518 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11519 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11520 {":relief", IMAGE_INTEGER_VALUE
, 0},
11521 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11522 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11523 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11524 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11527 /* Structure describing the image type `jpeg'. */
11529 static struct image_type jpeg_type
=
11539 /* Return non-zero if OBJECT is a valid JPEG image specification. */
11542 jpeg_image_p (object
)
11543 Lisp_Object object
;
11545 struct image_keyword fmt
[JPEG_LAST
];
11547 bcopy (jpeg_format
, fmt
, sizeof fmt
);
11549 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
11550 || (fmt
[JPEG_ASCENT
].count
11551 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
11554 /* Must specify either the :data or :file keyword. */
11555 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
11559 struct my_jpeg_error_mgr
11561 struct jpeg_error_mgr pub
;
11562 jmp_buf setjmp_buffer
;
11566 my_error_exit (cinfo
)
11567 j_common_ptr cinfo
;
11569 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
11570 longjmp (mgr
->setjmp_buffer
, 1);
11573 /* Init source method for JPEG data source manager. Called by
11574 jpeg_read_header() before any data is actually read. See
11575 libjpeg.doc from the JPEG lib distribution. */
11578 our_init_source (cinfo
)
11579 j_decompress_ptr cinfo
;
11584 /* Fill input buffer method for JPEG data source manager. Called
11585 whenever more data is needed. We read the whole image in one step,
11586 so this only adds a fake end of input marker at the end. */
11589 our_fill_input_buffer (cinfo
)
11590 j_decompress_ptr cinfo
;
11592 /* Insert a fake EOI marker. */
11593 struct jpeg_source_mgr
*src
= cinfo
->src
;
11594 static JOCTET buffer
[2];
11596 buffer
[0] = (JOCTET
) 0xFF;
11597 buffer
[1] = (JOCTET
) JPEG_EOI
;
11599 src
->next_input_byte
= buffer
;
11600 src
->bytes_in_buffer
= 2;
11605 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
11606 is the JPEG data source manager. */
11609 our_skip_input_data (cinfo
, num_bytes
)
11610 j_decompress_ptr cinfo
;
11613 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11617 if (num_bytes
> src
->bytes_in_buffer
)
11618 ERREXIT (cinfo
, JERR_INPUT_EOF
);
11620 src
->bytes_in_buffer
-= num_bytes
;
11621 src
->next_input_byte
+= num_bytes
;
11626 /* Method to terminate data source. Called by
11627 jpeg_finish_decompress() after all data has been processed. */
11630 our_term_source (cinfo
)
11631 j_decompress_ptr cinfo
;
11636 /* Set up the JPEG lib for reading an image from DATA which contains
11637 LEN bytes. CINFO is the decompression info structure created for
11638 reading the image. */
11641 jpeg_memory_src (cinfo
, data
, len
)
11642 j_decompress_ptr cinfo
;
11646 struct jpeg_source_mgr
*src
;
11648 if (cinfo
->src
== NULL
)
11650 /* First time for this JPEG object? */
11651 cinfo
->src
= (struct jpeg_source_mgr
*)
11652 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
11653 sizeof (struct jpeg_source_mgr
));
11654 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11655 src
->next_input_byte
= data
;
11658 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
11659 src
->init_source
= our_init_source
;
11660 src
->fill_input_buffer
= our_fill_input_buffer
;
11661 src
->skip_input_data
= our_skip_input_data
;
11662 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
11663 src
->term_source
= our_term_source
;
11664 src
->bytes_in_buffer
= len
;
11665 src
->next_input_byte
= data
;
11669 /* Load image IMG for use on frame F. Patterned after example.c
11670 from the JPEG lib. */
11677 struct jpeg_decompress_struct cinfo
;
11678 struct my_jpeg_error_mgr mgr
;
11679 Lisp_Object file
, specified_file
;
11680 Lisp_Object specified_data
;
11681 FILE * volatile fp
= NULL
;
11683 int row_stride
, x
, y
;
11684 XImage
*ximg
= NULL
;
11686 unsigned long *colors
;
11688 struct gcpro gcpro1
;
11690 /* Open the JPEG file. */
11691 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11692 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11696 if (NILP (specified_data
))
11698 file
= x_find_image_file (specified_file
);
11699 if (!STRINGP (file
))
11701 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11706 fp
= fopen (XSTRING (file
)->data
, "r");
11709 image_error ("Cannot open `%s'", file
, Qnil
);
11715 /* Customize libjpeg's error handling to call my_error_exit when an
11716 error is detected. This function will perform a longjmp. */
11717 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
11718 mgr
.pub
.error_exit
= my_error_exit
;
11720 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
11724 /* Called from my_error_exit. Display a JPEG error. */
11725 char buffer
[JMSG_LENGTH_MAX
];
11726 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
11727 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
11728 build_string (buffer
));
11731 /* Close the input file and destroy the JPEG object. */
11734 jpeg_destroy_decompress (&cinfo
);
11736 /* If we already have an XImage, free that. */
11737 x_destroy_x_image (ximg
);
11739 /* Free pixmap and colors. */
11740 x_clear_image (f
, img
);
11746 /* Create the JPEG decompression object. Let it read from fp.
11747 Read the JPEG image header. */
11748 jpeg_create_decompress (&cinfo
);
11750 if (NILP (specified_data
))
11751 jpeg_stdio_src (&cinfo
, fp
);
11753 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
11754 STRING_BYTES (XSTRING (specified_data
)));
11756 jpeg_read_header (&cinfo
, TRUE
);
11758 /* Customize decompression so that color quantization will be used.
11759 Start decompression. */
11760 cinfo
.quantize_colors
= TRUE
;
11761 jpeg_start_decompress (&cinfo
);
11762 width
= img
->width
= cinfo
.output_width
;
11763 height
= img
->height
= cinfo
.output_height
;
11765 /* Create X image and pixmap. */
11766 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
11768 longjmp (mgr
.setjmp_buffer
, 2);
11770 /* Allocate colors. When color quantization is used,
11771 cinfo.actual_number_of_colors has been set with the number of
11772 colors generated, and cinfo.colormap is a two-dimensional array
11773 of color indices in the range 0..cinfo.actual_number_of_colors.
11774 No more than 255 colors will be generated. */
11778 if (cinfo
.out_color_components
> 2)
11779 ir
= 0, ig
= 1, ib
= 2;
11780 else if (cinfo
.out_color_components
> 1)
11781 ir
= 0, ig
= 1, ib
= 0;
11783 ir
= 0, ig
= 0, ib
= 0;
11785 /* Use the color table mechanism because it handles colors that
11786 cannot be allocated nicely. Such colors will be replaced with
11787 a default color, and we don't have to care about which colors
11788 can be freed safely, and which can't. */
11789 init_color_table ();
11790 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
11793 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
11795 /* Multiply RGB values with 255 because X expects RGB values
11796 in the range 0..0xffff. */
11797 int r
= cinfo
.colormap
[ir
][i
] << 8;
11798 int g
= cinfo
.colormap
[ig
][i
] << 8;
11799 int b
= cinfo
.colormap
[ib
][i
] << 8;
11800 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
11803 /* Remember those colors actually allocated. */
11804 img
->colors
= colors_in_color_table (&img
->ncolors
);
11805 free_color_table ();
11809 row_stride
= width
* cinfo
.output_components
;
11810 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
11812 for (y
= 0; y
< height
; ++y
)
11814 jpeg_read_scanlines (&cinfo
, buffer
, 1);
11815 for (x
= 0; x
< cinfo
.output_width
; ++x
)
11816 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
11820 jpeg_finish_decompress (&cinfo
);
11821 jpeg_destroy_decompress (&cinfo
);
11825 /* Maybe fill in the background field while we have ximg handy. */
11826 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
11827 IMAGE_BACKGROUND (img
, f
, ximg
);
11829 /* Put the image into the pixmap. */
11830 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11831 x_destroy_x_image (ximg
);
11837 #endif /* HAVE_JPEG */
11841 /***********************************************************************
11843 ***********************************************************************/
11847 #include <tiffio.h>
11849 static int tiff_image_p
P_ ((Lisp_Object object
));
11850 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
11852 /* The symbol `tiff' identifying images of this type. */
11856 /* Indices of image specification fields in tiff_format, below. */
11858 enum tiff_keyword_index
11867 TIFF_HEURISTIC_MASK
,
11873 /* Vector of image_keyword structures describing the format
11874 of valid user-defined image specifications. */
11876 static struct image_keyword tiff_format
[TIFF_LAST
] =
11878 {":type", IMAGE_SYMBOL_VALUE
, 1},
11879 {":data", IMAGE_STRING_VALUE
, 0},
11880 {":file", IMAGE_STRING_VALUE
, 0},
11881 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11882 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
11883 {":relief", IMAGE_INTEGER_VALUE
, 0},
11884 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11885 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11886 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11887 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
11890 /* Structure describing the image type `tiff'. */
11892 static struct image_type tiff_type
=
11902 /* Return non-zero if OBJECT is a valid TIFF image specification. */
11905 tiff_image_p (object
)
11906 Lisp_Object object
;
11908 struct image_keyword fmt
[TIFF_LAST
];
11909 bcopy (tiff_format
, fmt
, sizeof fmt
);
11911 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
11912 || (fmt
[TIFF_ASCENT
].count
11913 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
11916 /* Must specify either the :data or :file keyword. */
11917 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
11921 /* Reading from a memory buffer for TIFF images Based on the PNG
11922 memory source, but we have to provide a lot of extra functions.
11925 We really only need to implement read and seek, but I am not
11926 convinced that the TIFF library is smart enough not to destroy
11927 itself if we only hand it the function pointers we need to
11932 unsigned char *bytes
;
11936 tiff_memory_source
;
11939 tiff_read_from_memory (data
, buf
, size
)
11944 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11946 if (size
> src
->len
- src
->index
)
11947 return (size_t) -1;
11948 bcopy (src
->bytes
+ src
->index
, buf
, size
);
11949 src
->index
+= size
;
11954 tiff_write_from_memory (data
, buf
, size
)
11959 return (size_t) -1;
11963 tiff_seek_in_memory (data
, off
, whence
)
11968 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11973 case SEEK_SET
: /* Go from beginning of source. */
11977 case SEEK_END
: /* Go from end of source. */
11978 idx
= src
->len
+ off
;
11981 case SEEK_CUR
: /* Go from current position. */
11982 idx
= src
->index
+ off
;
11985 default: /* Invalid `whence'. */
11989 if (idx
> src
->len
|| idx
< 0)
11997 tiff_close_memory (data
)
12005 tiff_mmap_memory (data
, pbase
, psize
)
12010 /* It is already _IN_ memory. */
12015 tiff_unmap_memory (data
, base
, size
)
12020 /* We don't need to do this. */
12024 tiff_size_of_memory (data
)
12027 return ((tiff_memory_source
*) data
)->len
;
12032 tiff_error_handler (title
, format
, ap
)
12033 const char *title
, *format
;
12039 len
= sprintf (buf
, "TIFF error: %s ", title
);
12040 vsprintf (buf
+ len
, format
, ap
);
12041 add_to_log (buf
, Qnil
, Qnil
);
12046 tiff_warning_handler (title
, format
, ap
)
12047 const char *title
, *format
;
12053 len
= sprintf (buf
, "TIFF warning: %s ", title
);
12054 vsprintf (buf
+ len
, format
, ap
);
12055 add_to_log (buf
, Qnil
, Qnil
);
12059 /* Load TIFF image IMG for use on frame F. Value is non-zero if
12067 Lisp_Object file
, specified_file
;
12068 Lisp_Object specified_data
;
12070 int width
, height
, x
, y
;
12074 struct gcpro gcpro1
;
12075 tiff_memory_source memsrc
;
12077 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12078 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12082 TIFFSetErrorHandler (tiff_error_handler
);
12083 TIFFSetWarningHandler (tiff_warning_handler
);
12085 if (NILP (specified_data
))
12087 /* Read from a file */
12088 file
= x_find_image_file (specified_file
);
12089 if (!STRINGP (file
))
12091 image_error ("Cannot find image file `%s'", file
, Qnil
);
12096 /* Try to open the image file. */
12097 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
12100 image_error ("Cannot open `%s'", file
, Qnil
);
12107 /* Memory source! */
12108 memsrc
.bytes
= XSTRING (specified_data
)->data
;
12109 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
12112 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
12113 (TIFFReadWriteProc
) tiff_read_from_memory
,
12114 (TIFFReadWriteProc
) tiff_write_from_memory
,
12115 tiff_seek_in_memory
,
12117 tiff_size_of_memory
,
12119 tiff_unmap_memory
);
12123 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
12129 /* Get width and height of the image, and allocate a raster buffer
12130 of width x height 32-bit values. */
12131 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
12132 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
12133 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
12135 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
12139 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
12145 /* Create the X image and pixmap. */
12146 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12153 /* Initialize the color table. */
12154 init_color_table ();
12156 /* Process the pixel raster. Origin is in the lower-left corner. */
12157 for (y
= 0; y
< height
; ++y
)
12159 uint32
*row
= buf
+ y
* width
;
12161 for (x
= 0; x
< width
; ++x
)
12163 uint32 abgr
= row
[x
];
12164 int r
= TIFFGetR (abgr
) << 8;
12165 int g
= TIFFGetG (abgr
) << 8;
12166 int b
= TIFFGetB (abgr
) << 8;
12167 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
12171 /* Remember the colors allocated for the image. Free the color table. */
12172 img
->colors
= colors_in_color_table (&img
->ncolors
);
12173 free_color_table ();
12175 img
->width
= width
;
12176 img
->height
= height
;
12178 /* Maybe fill in the background field while we have ximg handy. */
12179 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12180 IMAGE_BACKGROUND (img
, f
, ximg
);
12182 /* Put the image into the pixmap, then free the X image and its buffer. */
12183 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12184 x_destroy_x_image (ximg
);
12191 #endif /* HAVE_TIFF != 0 */
12195 /***********************************************************************
12197 ***********************************************************************/
12201 #include <gif_lib.h>
12203 static int gif_image_p
P_ ((Lisp_Object object
));
12204 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
12206 /* The symbol `gif' identifying images of this type. */
12210 /* Indices of image specification fields in gif_format, below. */
12212 enum gif_keyword_index
12221 GIF_HEURISTIC_MASK
,
12228 /* Vector of image_keyword structures describing the format
12229 of valid user-defined image specifications. */
12231 static struct image_keyword gif_format
[GIF_LAST
] =
12233 {":type", IMAGE_SYMBOL_VALUE
, 1},
12234 {":data", IMAGE_STRING_VALUE
, 0},
12235 {":file", IMAGE_STRING_VALUE
, 0},
12236 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
12237 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12238 {":relief", IMAGE_INTEGER_VALUE
, 0},
12239 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12240 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12241 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12242 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
12243 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12246 /* Structure describing the image type `gif'. */
12248 static struct image_type gif_type
=
12257 /* Return non-zero if OBJECT is a valid GIF image specification. */
12260 gif_image_p (object
)
12261 Lisp_Object object
;
12263 struct image_keyword fmt
[GIF_LAST
];
12264 bcopy (gif_format
, fmt
, sizeof fmt
);
12266 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
12267 || (fmt
[GIF_ASCENT
].count
12268 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
12271 /* Must specify either the :data or :file keyword. */
12272 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
12275 /* Reading a GIF image from memory
12276 Based on the PNG memory stuff to a certain extent. */
12280 unsigned char *bytes
;
12286 /* Make the current memory source available to gif_read_from_memory.
12287 It's done this way because not all versions of libungif support
12288 a UserData field in the GifFileType structure. */
12289 static gif_memory_source
*current_gif_memory_src
;
12292 gif_read_from_memory (file
, buf
, len
)
12297 gif_memory_source
*src
= current_gif_memory_src
;
12299 if (len
> src
->len
- src
->index
)
12302 bcopy (src
->bytes
+ src
->index
, buf
, len
);
12308 /* Load GIF image IMG for use on frame F. Value is non-zero if
12316 Lisp_Object file
, specified_file
;
12317 Lisp_Object specified_data
;
12318 int rc
, width
, height
, x
, y
, i
;
12320 ColorMapObject
*gif_color_map
;
12321 unsigned long pixel_colors
[256];
12323 struct gcpro gcpro1
;
12325 int ino
, image_left
, image_top
, image_width
, image_height
;
12326 gif_memory_source memsrc
;
12327 unsigned char *raster
;
12329 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
12330 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
12334 if (NILP (specified_data
))
12336 file
= x_find_image_file (specified_file
);
12337 if (!STRINGP (file
))
12339 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
12344 /* Open the GIF file. */
12345 gif
= DGifOpenFileName (XSTRING (file
)->data
);
12348 image_error ("Cannot open `%s'", file
, Qnil
);
12355 /* Read from memory! */
12356 current_gif_memory_src
= &memsrc
;
12357 memsrc
.bytes
= XSTRING (specified_data
)->data
;
12358 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
12361 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
12364 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
12370 /* Read entire contents. */
12371 rc
= DGifSlurp (gif
);
12372 if (rc
== GIF_ERROR
)
12374 image_error ("Error reading `%s'", img
->spec
, Qnil
);
12375 DGifCloseFile (gif
);
12380 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
12381 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
12382 if (ino
>= gif
->ImageCount
)
12384 image_error ("Invalid image number `%s' in image `%s'",
12386 DGifCloseFile (gif
);
12391 width
= img
->width
= gif
->SWidth
;
12392 height
= img
->height
= gif
->SHeight
;
12394 /* Create the X image and pixmap. */
12395 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
12397 DGifCloseFile (gif
);
12402 /* Allocate colors. */
12403 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
12404 if (!gif_color_map
)
12405 gif_color_map
= gif
->SColorMap
;
12406 init_color_table ();
12407 bzero (pixel_colors
, sizeof pixel_colors
);
12409 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
12411 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
12412 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
12413 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
12414 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
12417 img
->colors
= colors_in_color_table (&img
->ncolors
);
12418 free_color_table ();
12420 /* Clear the part of the screen image that are not covered by
12421 the image from the GIF file. Full animated GIF support
12422 requires more than can be done here (see the gif89 spec,
12423 disposal methods). Let's simply assume that the part
12424 not covered by a sub-image is in the frame's background color. */
12425 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
12426 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
12427 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
12428 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
12430 for (y
= 0; y
< image_top
; ++y
)
12431 for (x
= 0; x
< width
; ++x
)
12432 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12434 for (y
= image_top
+ image_height
; y
< height
; ++y
)
12435 for (x
= 0; x
< width
; ++x
)
12436 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12438 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
12440 for (x
= 0; x
< image_left
; ++x
)
12441 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12442 for (x
= image_left
+ image_width
; x
< width
; ++x
)
12443 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
12446 /* Read the GIF image into the X image. We use a local variable
12447 `raster' here because RasterBits below is a char *, and invites
12448 problems with bytes >= 0x80. */
12449 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
12451 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
12453 static int interlace_start
[] = {0, 4, 2, 1};
12454 static int interlace_increment
[] = {8, 8, 4, 2};
12456 int row
= interlace_start
[0];
12460 for (y
= 0; y
< image_height
; y
++)
12462 if (row
>= image_height
)
12464 row
= interlace_start
[++pass
];
12465 while (row
>= image_height
)
12466 row
= interlace_start
[++pass
];
12469 for (x
= 0; x
< image_width
; x
++)
12471 int i
= raster
[(y
* image_width
) + x
];
12472 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
12476 row
+= interlace_increment
[pass
];
12481 for (y
= 0; y
< image_height
; ++y
)
12482 for (x
= 0; x
< image_width
; ++x
)
12484 int i
= raster
[y
* image_width
+ x
];
12485 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
12489 DGifCloseFile (gif
);
12491 /* Maybe fill in the background field while we have ximg handy. */
12492 if (NILP (image_spec_value (img
->spec
, QCbackground
, NULL
)))
12493 IMAGE_BACKGROUND (img
, f
, ximg
);
12495 /* Put the image into the pixmap, then free the X image and its buffer. */
12496 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
12497 x_destroy_x_image (ximg
);
12503 #endif /* HAVE_GIF != 0 */
12507 /***********************************************************************
12509 ***********************************************************************/
12511 Lisp_Object Qpostscript
;
12513 #ifdef HAVE_GHOSTSCRIPT
12514 static int gs_image_p
P_ ((Lisp_Object object
));
12515 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
12516 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
12518 /* The symbol `postscript' identifying images of this type. */
12520 /* Keyword symbols. */
12522 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
12524 /* Indices of image specification fields in gs_format, below. */
12526 enum gs_keyword_index
12544 /* Vector of image_keyword structures describing the format
12545 of valid user-defined image specifications. */
12547 static struct image_keyword gs_format
[GS_LAST
] =
12549 {":type", IMAGE_SYMBOL_VALUE
, 1},
12550 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12551 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
12552 {":file", IMAGE_STRING_VALUE
, 1},
12553 {":loader", IMAGE_FUNCTION_VALUE
, 0},
12554 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
12555 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
12556 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
12557 {":relief", IMAGE_INTEGER_VALUE
, 0},
12558 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12559 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12560 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
12561 {":background", IMAGE_STRING_OR_NIL_VALUE
, 0}
12564 /* Structure describing the image type `ghostscript'. */
12566 static struct image_type gs_type
=
12576 /* Free X resources of Ghostscript image IMG which is used on frame F. */
12579 gs_clear_image (f
, img
)
12583 /* IMG->data.ptr_val may contain a recorded colormap. */
12584 xfree (img
->data
.ptr_val
);
12585 x_clear_image (f
, img
);
12589 /* Return non-zero if OBJECT is a valid Ghostscript image
12593 gs_image_p (object
)
12594 Lisp_Object object
;
12596 struct image_keyword fmt
[GS_LAST
];
12600 bcopy (gs_format
, fmt
, sizeof fmt
);
12602 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
12603 || (fmt
[GS_ASCENT
].count
12604 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
12607 /* Bounding box must be a list or vector containing 4 integers. */
12608 tem
= fmt
[GS_BOUNDING_BOX
].value
;
12611 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
12612 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
12617 else if (VECTORP (tem
))
12619 if (XVECTOR (tem
)->size
!= 4)
12621 for (i
= 0; i
< 4; ++i
)
12622 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
12632 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
12641 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
12642 struct gcpro gcpro1
, gcpro2
;
12644 double in_width
, in_height
;
12645 Lisp_Object pixel_colors
= Qnil
;
12647 /* Compute pixel size of pixmap needed from the given size in the
12648 image specification. Sizes in the specification are in pt. 1 pt
12649 = 1/72 in, xdpi and ydpi are stored in the frame's X display
12651 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
12652 in_width
= XFASTINT (pt_width
) / 72.0;
12653 img
->width
= in_width
* FRAME_W32_DISPLAY_INFO (f
)->resx
;
12654 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
12655 in_height
= XFASTINT (pt_height
) / 72.0;
12656 img
->height
= in_height
* FRAME_W32_DISPLAY_INFO (f
)->resy
;
12658 /* Create the pixmap. */
12660 xassert (img
->pixmap
== 0);
12661 img
->pixmap
= XCreatePixmap (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12662 img
->width
, img
->height
,
12663 one_w32_display_info
.n_cbits
);
12668 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
12672 /* Call the loader to fill the pixmap. It returns a process object
12673 if successful. We do not record_unwind_protect here because
12674 other places in redisplay like calling window scroll functions
12675 don't either. Let the Lisp loader use `unwind-protect' instead. */
12676 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
12678 sprintf (buffer
, "%lu %lu",
12679 (unsigned long) FRAME_W32_WINDOW (f
),
12680 (unsigned long) img
->pixmap
);
12681 window_and_pixmap_id
= build_string (buffer
);
12683 sprintf (buffer
, "%lu %lu",
12684 FRAME_FOREGROUND_PIXEL (f
),
12685 FRAME_BACKGROUND_PIXEL (f
));
12686 pixel_colors
= build_string (buffer
);
12688 XSETFRAME (frame
, f
);
12689 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
12691 loader
= intern ("gs-load-image");
12693 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
12694 make_number (img
->width
),
12695 make_number (img
->height
),
12696 window_and_pixmap_id
,
12699 return PROCESSP (img
->data
.lisp_val
);
12703 /* Kill the Ghostscript process that was started to fill PIXMAP on
12704 frame F. Called from XTread_socket when receiving an event
12705 telling Emacs that Ghostscript has finished drawing. */
12708 x_kill_gs_process (pixmap
, f
)
12712 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
12716 /* Find the image containing PIXMAP. */
12717 for (i
= 0; i
< c
->used
; ++i
)
12718 if (c
->images
[i
]->pixmap
== pixmap
)
12721 /* Should someone in between have cleared the image cache, for
12722 instance, give up. */
12726 /* Kill the GS process. We should have found PIXMAP in the image
12727 cache and its image should contain a process object. */
12728 img
= c
->images
[i
];
12729 xassert (PROCESSP (img
->data
.lisp_val
));
12730 Fkill_process (img
->data
.lisp_val
, Qnil
);
12731 img
->data
.lisp_val
= Qnil
;
12733 /* On displays with a mutable colormap, figure out the colors
12734 allocated for the image by looking at the pixels of an XImage for
12736 class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
12737 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
12743 /* Try to get an XImage for img->pixmep. */
12744 ximg
= XGetImage (FRAME_W32_DISPLAY (f
), img
->pixmap
,
12745 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
12750 /* Initialize the color table. */
12751 init_color_table ();
12753 /* For each pixel of the image, look its color up in the
12754 color table. After having done so, the color table will
12755 contain an entry for each color used by the image. */
12756 for (y
= 0; y
< img
->height
; ++y
)
12757 for (x
= 0; x
< img
->width
; ++x
)
12759 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
12760 lookup_pixel_color (f
, pixel
);
12763 /* Record colors in the image. Free color table and XImage. */
12764 img
->colors
= colors_in_color_table (&img
->ncolors
);
12765 free_color_table ();
12766 XDestroyImage (ximg
);
12768 #if 0 /* This doesn't seem to be the case. If we free the colors
12769 here, we get a BadAccess later in x_clear_image when
12770 freeing the colors. */
12771 /* We have allocated colors once, but Ghostscript has also
12772 allocated colors on behalf of us. So, to get the
12773 reference counts right, free them once. */
12775 x_free_colors (FRAME_W32_DISPLAY (f
), cmap
,
12776 img
->colors
, img
->ncolors
, 0);
12780 image_error ("Cannot get X image of `%s'; colors will not be freed",
12786 /* Now that we have the pixmap, compute mask and transform the
12787 image if requested. */
12789 postprocess_image (f
, img
);
12793 #endif /* HAVE_GHOSTSCRIPT */
12796 /***********************************************************************
12798 ***********************************************************************/
12800 DEFUN ("x-change-window-property", Fx_change_window_property
,
12801 Sx_change_window_property
, 2, 3, 0,
12802 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
12803 PROP and VALUE must be strings. FRAME nil or omitted means use the
12804 selected frame. Value is VALUE. */)
12805 (prop
, value
, frame
)
12806 Lisp_Object frame
, prop
, value
;
12808 #if 0 /* TODO : port window properties to W32 */
12809 struct frame
*f
= check_x_frame (frame
);
12812 CHECK_STRING (prop
);
12813 CHECK_STRING (value
);
12816 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12817 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12818 prop_atom
, XA_STRING
, 8, PropModeReplace
,
12819 XSTRING (value
)->data
, XSTRING (value
)->size
);
12821 /* Make sure the property is set when we return. */
12822 XFlush (FRAME_W32_DISPLAY (f
));
12831 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
12832 Sx_delete_window_property
, 1, 2, 0,
12833 doc
: /* Remove window property PROP from X window of FRAME.
12834 FRAME nil or omitted means use the selected frame. Value is PROP. */)
12836 Lisp_Object prop
, frame
;
12838 #if 0 /* TODO : port window properties to W32 */
12840 struct frame
*f
= check_x_frame (frame
);
12843 CHECK_STRING (prop
);
12845 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12846 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
12848 /* Make sure the property is removed when we return. */
12849 XFlush (FRAME_W32_DISPLAY (f
));
12857 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
12859 doc
: /* Value is the value of window property PROP on FRAME.
12860 If FRAME is nil or omitted, use the selected frame. Value is nil
12861 if FRAME hasn't a property with name PROP or if PROP has no string
12864 Lisp_Object prop
, frame
;
12866 #if 0 /* TODO : port window properties to W32 */
12868 struct frame
*f
= check_x_frame (frame
);
12871 Lisp_Object prop_value
= Qnil
;
12872 char *tmp_data
= NULL
;
12875 unsigned long actual_size
, bytes_remaining
;
12877 CHECK_STRING (prop
);
12879 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
12880 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12881 prop_atom
, 0, 0, False
, XA_STRING
,
12882 &actual_type
, &actual_format
, &actual_size
,
12883 &bytes_remaining
, (unsigned char **) &tmp_data
);
12886 int size
= bytes_remaining
;
12891 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
12892 prop_atom
, 0, bytes_remaining
,
12894 &actual_type
, &actual_format
,
12895 &actual_size
, &bytes_remaining
,
12896 (unsigned char **) &tmp_data
);
12898 prop_value
= make_string (tmp_data
, size
);
12913 /***********************************************************************
12915 ***********************************************************************/
12917 /* If non-null, an asynchronous timer that, when it expires, displays
12918 an hourglass cursor on all frames. */
12920 static struct atimer
*hourglass_atimer
;
12922 /* Non-zero means an hourglass cursor is currently shown. */
12924 static int hourglass_shown_p
;
12926 /* Number of seconds to wait before displaying an hourglass cursor. */
12928 static Lisp_Object Vhourglass_delay
;
12930 /* Default number of seconds to wait before displaying an hourglass
12933 #define DEFAULT_HOURGLASS_DELAY 1
12935 /* Function prototypes. */
12937 static void show_hourglass
P_ ((struct atimer
*));
12938 static void hide_hourglass
P_ ((void));
12941 /* Cancel a currently active hourglass timer, and start a new one. */
12946 #if 0 /* TODO: cursor shape changes. */
12948 int secs
, usecs
= 0;
12950 cancel_hourglass ();
12952 if (INTEGERP (Vhourglass_delay
)
12953 && XINT (Vhourglass_delay
) > 0)
12954 secs
= XFASTINT (Vhourglass_delay
);
12955 else if (FLOATP (Vhourglass_delay
)
12956 && XFLOAT_DATA (Vhourglass_delay
) > 0)
12959 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
12960 secs
= XFASTINT (tem
);
12961 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
12964 secs
= DEFAULT_HOURGLASS_DELAY
;
12966 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
12967 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
12968 show_hourglass
, NULL
);
12973 /* Cancel the hourglass cursor timer if active, hide an hourglass
12974 cursor if shown. */
12977 cancel_hourglass ()
12979 if (hourglass_atimer
)
12981 cancel_atimer (hourglass_atimer
);
12982 hourglass_atimer
= NULL
;
12985 if (hourglass_shown_p
)
12990 /* Timer function of hourglass_atimer. TIMER is equal to
12993 Display an hourglass cursor on all frames by mapping the frames'
12994 hourglass_window. Set the hourglass_p flag in the frames'
12995 output_data.x structure to indicate that an hourglass cursor is
12996 shown on the frames. */
12999 show_hourglass (timer
)
13000 struct atimer
*timer
;
13002 #if 0 /* TODO: cursor shape changes. */
13003 /* The timer implementation will cancel this timer automatically
13004 after this function has run. Set hourglass_atimer to null
13005 so that we know the timer doesn't have to be canceled. */
13006 hourglass_atimer
= NULL
;
13008 if (!hourglass_shown_p
)
13010 Lisp_Object rest
, frame
;
13014 FOR_EACH_FRAME (rest
, frame
)
13015 if (FRAME_W32_P (XFRAME (frame
)))
13017 struct frame
*f
= XFRAME (frame
);
13019 f
->output_data
.w32
->hourglass_p
= 1;
13021 if (!f
->output_data
.w32
->hourglass_window
)
13023 unsigned long mask
= CWCursor
;
13024 XSetWindowAttributes attrs
;
13026 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
13028 f
->output_data
.w32
->hourglass_window
13029 = XCreateWindow (FRAME_X_DISPLAY (f
),
13030 FRAME_OUTER_WINDOW (f
),
13031 0, 0, 32000, 32000, 0, 0,
13037 XMapRaised (FRAME_X_DISPLAY (f
),
13038 f
->output_data
.w32
->hourglass_window
);
13039 XFlush (FRAME_X_DISPLAY (f
));
13042 hourglass_shown_p
= 1;
13049 /* Hide the hourglass cursor on all frames, if it is currently shown. */
13054 #if 0 /* TODO: cursor shape changes. */
13055 if (hourglass_shown_p
)
13057 Lisp_Object rest
, frame
;
13060 FOR_EACH_FRAME (rest
, frame
)
13062 struct frame
*f
= XFRAME (frame
);
13064 if (FRAME_W32_P (f
)
13065 /* Watch out for newly created frames. */
13066 && f
->output_data
.x
->hourglass_window
)
13068 XUnmapWindow (FRAME_X_DISPLAY (f
),
13069 f
->output_data
.x
->hourglass_window
);
13070 /* Sync here because XTread_socket looks at the
13071 hourglass_p flag that is reset to zero below. */
13072 XSync (FRAME_X_DISPLAY (f
), False
);
13073 f
->output_data
.x
->hourglass_p
= 0;
13077 hourglass_shown_p
= 0;
13085 /***********************************************************************
13087 ***********************************************************************/
13089 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
13090 Lisp_Object
, Lisp_Object
));
13091 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
13092 Lisp_Object
, int, int, int *, int *));
13094 /* The frame of a currently visible tooltip. */
13096 Lisp_Object tip_frame
;
13098 /* If non-nil, a timer started that hides the last tooltip when it
13101 Lisp_Object tip_timer
;
13104 /* If non-nil, a vector of 3 elements containing the last args
13105 with which x-show-tip was called. See there. */
13107 Lisp_Object last_show_tip_args
;
13109 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
13111 Lisp_Object Vx_max_tooltip_size
;
13115 unwind_create_tip_frame (frame
)
13118 Lisp_Object deleted
;
13120 deleted
= unwind_create_frame (frame
);
13121 if (EQ (deleted
, Qt
))
13131 /* Create a frame for a tooltip on the display described by DPYINFO.
13132 PARMS is a list of frame parameters. TEXT is the string to
13133 display in the tip frame. Value is the frame.
13135 Note that functions called here, esp. x_default_parameter can
13136 signal errors, for instance when a specified color name is
13137 undefined. We have to make sure that we're in a consistent state
13138 when this happens. */
13141 x_create_tip_frame (dpyinfo
, parms
, text
)
13142 struct w32_display_info
*dpyinfo
;
13143 Lisp_Object parms
, text
;
13146 Lisp_Object frame
, tem
;
13148 long window_prompting
= 0;
13150 int count
= BINDING_STACK_SIZE ();
13151 struct gcpro gcpro1
, gcpro2
, gcpro3
;
13153 int face_change_count_before
= face_change_count
;
13154 Lisp_Object buffer
;
13155 struct buffer
*old_buffer
;
13159 /* Use this general default value to start with until we know if
13160 this frame has a specified name. */
13161 Vx_resource_name
= Vinvocation_name
;
13163 #ifdef MULTI_KBOARD
13164 kb
= dpyinfo
->kboard
;
13166 kb
= &the_only_kboard
;
13169 /* Get the name of the frame to use for resource lookup. */
13170 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
13171 if (!STRINGP (name
)
13172 && !EQ (name
, Qunbound
)
13174 error ("Invalid frame name--not a string or nil");
13175 Vx_resource_name
= name
;
13178 GCPRO3 (parms
, name
, frame
);
13179 /* Make a frame without minibuffer nor mode-line. */
13180 f
= make_frame (0);
13181 f
->wants_modeline
= 0;
13182 XSETFRAME (frame
, f
);
13184 buffer
= Fget_buffer_create (build_string (" *tip*"));
13185 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
13186 old_buffer
= current_buffer
;
13187 set_buffer_internal_1 (XBUFFER (buffer
));
13188 current_buffer
->truncate_lines
= Qnil
;
13190 Finsert (1, &text
);
13191 set_buffer_internal_1 (old_buffer
);
13193 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
13194 record_unwind_protect (unwind_create_tip_frame
, frame
);
13196 /* By setting the output method, we're essentially saying that
13197 the frame is live, as per FRAME_LIVE_P. If we get a signal
13198 from this point on, x_destroy_window might screw up reference
13200 f
->output_method
= output_w32
;
13201 f
->output_data
.w32
=
13202 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
13203 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
13205 FRAME_FONTSET (f
) = -1;
13206 f
->icon_name
= Qnil
;
13208 #if 0 /* GLYPH_DEBUG TODO: image support. */
13209 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
13210 dpyinfo_refcount
= dpyinfo
->reference_count
;
13211 #endif /* GLYPH_DEBUG */
13212 #ifdef MULTI_KBOARD
13213 FRAME_KBOARD (f
) = kb
;
13215 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
13216 f
->output_data
.w32
->explicit_parent
= 0;
13218 /* Set the name; the functions to which we pass f expect the name to
13220 if (EQ (name
, Qunbound
) || NILP (name
))
13222 f
->name
= build_string (dpyinfo
->w32_id_name
);
13223 f
->explicit_name
= 0;
13228 f
->explicit_name
= 1;
13229 /* use the frame's title when getting resources for this frame. */
13230 specbind (Qx_resource_name
, name
);
13233 /* Extract the window parameters from the supplied values
13234 that are needed to determine window geometry. */
13238 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
13241 /* First, try whatever font the caller has specified. */
13242 if (STRINGP (font
))
13244 tem
= Fquery_fontset (font
, Qnil
);
13246 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
13248 font
= x_new_font (f
, XSTRING (font
)->data
);
13251 /* Try out a font which we hope has bold and italic variations. */
13252 if (!STRINGP (font
))
13253 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
13254 if (! STRINGP (font
))
13255 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
13256 /* If those didn't work, look for something which will at least work. */
13257 if (! STRINGP (font
))
13258 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
13260 if (! STRINGP (font
))
13261 font
= build_string ("Fixedsys");
13263 x_default_parameter (f
, parms
, Qfont
, font
,
13264 "font", "Font", RES_TYPE_STRING
);
13267 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
13268 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
13269 /* This defaults to 2 in order to match xterm. We recognize either
13270 internalBorderWidth or internalBorder (which is what xterm calls
13272 if (NILP (Fassq (Qinternal_border_width
, parms
)))
13276 value
= w32_get_arg (parms
, Qinternal_border_width
,
13277 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
13278 if (! EQ (value
, Qunbound
))
13279 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
13282 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
13283 "internalBorderWidth", "internalBorderWidth",
13286 /* Also do the stuff which must be set before the window exists. */
13287 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
13288 "foreground", "Foreground", RES_TYPE_STRING
);
13289 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
13290 "background", "Background", RES_TYPE_STRING
);
13291 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
13292 "pointerColor", "Foreground", RES_TYPE_STRING
);
13293 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
13294 "cursorColor", "Foreground", RES_TYPE_STRING
);
13295 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
13296 "borderColor", "BorderColor", RES_TYPE_STRING
);
13298 /* Init faces before x_default_parameter is called for scroll-bar
13299 parameters because that function calls x_set_scroll_bar_width,
13300 which calls change_frame_size, which calls Fset_window_buffer,
13301 which runs hooks, which call Fvertical_motion. At the end, we
13302 end up in init_iterator with a null face cache, which should not
13304 init_frame_faces (f
);
13306 f
->output_data
.w32
->dwStyle
= WS_BORDER
| WS_POPUP
| WS_DISABLED
;
13307 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
13309 window_prompting
= x_figure_window_size (f
, parms
);
13311 /* No fringes on tip frame. */
13312 f
->output_data
.w32
->fringes_extra
= 0;
13313 f
->output_data
.w32
->fringe_cols
= 0;
13314 f
->output_data
.w32
->left_fringe_width
= 0;
13315 f
->output_data
.w32
->right_fringe_width
= 0;
13317 if (window_prompting
& XNegative
)
13319 if (window_prompting
& YNegative
)
13320 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
13322 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
13326 if (window_prompting
& YNegative
)
13327 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
13329 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
13332 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
13335 my_create_tip_window (f
);
13340 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
13341 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
13342 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
13343 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
13344 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
13345 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
13347 /* Dimensions, especially f->height, must be done via change_frame_size.
13348 Change will not be effected unless different from the current
13351 height
= f
->height
;
13353 SET_FRAME_WIDTH (f
, 0);
13354 change_frame_size (f
, height
, width
, 1, 0, 0);
13356 /* Set up faces after all frame parameters are known. This call
13357 also merges in face attributes specified for new frames.
13359 Frame parameters may be changed if .Xdefaults contains
13360 specifications for the default font. For example, if there is an
13361 `Emacs.default.attributeBackground: pink', the `background-color'
13362 attribute of the frame get's set, which let's the internal border
13363 of the tooltip frame appear in pink. Prevent this. */
13365 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
13367 /* Set tip_frame here, so that */
13369 call1 (Qface_set_after_frame_default
, frame
);
13371 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
13372 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
13380 /* It is now ok to make the frame official even if we get an error
13381 below. And the frame needs to be on Vframe_list or making it
13382 visible won't work. */
13383 Vframe_list
= Fcons (frame
, Vframe_list
);
13385 /* Now that the frame is official, it counts as a reference to
13387 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
13389 /* Setting attributes of faces of the tooltip frame from resources
13390 and similar will increment face_change_count, which leads to the
13391 clearing of all current matrices. Since this isn't necessary
13392 here, avoid it by resetting face_change_count to the value it
13393 had before we created the tip frame. */
13394 face_change_count
= face_change_count_before
;
13396 /* Discard the unwind_protect. */
13397 return unbind_to (count
, frame
);
13401 /* Compute where to display tip frame F. PARMS is the list of frame
13402 parameters for F. DX and DY are specified offsets from the current
13403 location of the mouse. WIDTH and HEIGHT are the width and height
13404 of the tooltip. Return coordinates relative to the root window of
13405 the display in *ROOT_X, and *ROOT_Y. */
13408 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
13410 Lisp_Object parms
, dx
, dy
;
13412 int *root_x
, *root_y
;
13414 Lisp_Object left
, top
;
13416 /* User-specified position? */
13417 left
= Fcdr (Fassq (Qleft
, parms
));
13418 top
= Fcdr (Fassq (Qtop
, parms
));
13420 /* Move the tooltip window where the mouse pointer is. Resize and
13422 if (!INTEGERP (left
) || !INTEGERP (top
))
13427 GetCursorPos (&pt
);
13433 if (INTEGERP (top
))
13434 *root_y
= XINT (top
);
13435 else if (*root_y
+ XINT (dy
) - height
< 0)
13436 *root_y
-= XINT (dy
);
13440 *root_y
+= XINT (dy
);
13443 if (INTEGERP (left
))
13444 *root_x
= XINT (left
);
13445 else if (*root_x
+ XINT (dx
) + width
<= FRAME_W32_DISPLAY_INFO (f
)->width
)
13446 /* It fits to the right of the pointer. */
13447 *root_x
+= XINT (dx
);
13448 else if (width
+ XINT (dx
) <= *root_x
)
13449 /* It fits to the left of the pointer. */
13450 *root_x
-= width
+ XINT (dx
);
13452 /* Put it left justified on the screen -- it ought to fit that way. */
13457 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
13458 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
13459 A tooltip window is a small window displaying a string.
13461 FRAME nil or omitted means use the selected frame.
13463 PARMS is an optional list of frame parameters which can be
13464 used to change the tooltip's appearance.
13466 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
13467 means use the default timeout of 5 seconds.
13469 If the list of frame parameters PARAMS contains a `left' parameter,
13470 the tooltip is displayed at that x-position. Otherwise it is
13471 displayed at the mouse position, with offset DX added (default is 5 if
13472 DX isn't specified). Likewise for the y-position; if a `top' frame
13473 parameter is specified, it determines the y-position of the tooltip
13474 window, otherwise it is displayed at the mouse position, with offset
13475 DY added (default is -10).
13477 A tooltip's maximum size is specified by `x-max-tooltip-size'.
13478 Text larger than the specified size is clipped. */)
13479 (string
, frame
, parms
, timeout
, dx
, dy
)
13480 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
13484 int root_x
, root_y
;
13485 struct buffer
*old_buffer
;
13486 struct text_pos pos
;
13487 int i
, width
, height
;
13488 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
13489 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
13490 int count
= BINDING_STACK_SIZE ();
13492 specbind (Qinhibit_redisplay
, Qt
);
13494 GCPRO4 (string
, parms
, frame
, timeout
);
13496 CHECK_STRING (string
);
13497 f
= check_x_frame (frame
);
13498 if (NILP (timeout
))
13499 timeout
= make_number (5);
13501 CHECK_NATNUM (timeout
);
13504 dx
= make_number (5);
13509 dy
= make_number (-10);
13513 if (NILP (last_show_tip_args
))
13514 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
13516 if (!NILP (tip_frame
))
13518 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
13519 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
13520 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
13522 if (EQ (frame
, last_frame
)
13523 && !NILP (Fequal (last_string
, string
))
13524 && !NILP (Fequal (last_parms
, parms
)))
13526 struct frame
*f
= XFRAME (tip_frame
);
13528 /* Only DX and DY have changed. */
13529 if (!NILP (tip_timer
))
13531 Lisp_Object timer
= tip_timer
;
13533 call1 (Qcancel_timer
, timer
);
13537 compute_tip_xy (f
, parms
, dx
, dy
, PIXEL_WIDTH (f
),
13538 PIXEL_HEIGHT (f
), &root_x
, &root_y
);
13539 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
13540 root_x
, root_y
, 0, 0,
13541 SWP_NOSIZE
| SWP_NOACTIVATE
);
13547 /* Hide a previous tip, if any. */
13550 ASET (last_show_tip_args
, 0, string
);
13551 ASET (last_show_tip_args
, 1, frame
);
13552 ASET (last_show_tip_args
, 2, parms
);
13554 /* Add default values to frame parameters. */
13555 if (NILP (Fassq (Qname
, parms
)))
13556 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
13557 if (NILP (Fassq (Qinternal_border_width
, parms
)))
13558 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
13559 if (NILP (Fassq (Qborder_width
, parms
)))
13560 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
13561 if (NILP (Fassq (Qborder_color
, parms
)))
13562 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
13563 if (NILP (Fassq (Qbackground_color
, parms
)))
13564 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
13567 /* Block input until the tip has been fully drawn, to avoid crashes
13568 when drawing tips in menus. */
13571 /* Create a frame for the tooltip, and record it in the global
13572 variable tip_frame. */
13573 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
, string
);
13574 f
= XFRAME (frame
);
13576 /* Set up the frame's root window. */
13577 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
13578 w
->left
= w
->top
= make_number (0);
13580 if (CONSP (Vx_max_tooltip_size
)
13581 && INTEGERP (XCAR (Vx_max_tooltip_size
))
13582 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
13583 && INTEGERP (XCDR (Vx_max_tooltip_size
))
13584 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
13586 w
->width
= XCAR (Vx_max_tooltip_size
);
13587 w
->height
= XCDR (Vx_max_tooltip_size
);
13591 w
->width
= make_number (80);
13592 w
->height
= make_number (40);
13595 f
->window_width
= XINT (w
->width
);
13597 w
->pseudo_window_p
= 1;
13599 /* Display the tooltip text in a temporary buffer. */
13600 old_buffer
= current_buffer
;
13601 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
13602 current_buffer
->truncate_lines
= Qnil
;
13603 clear_glyph_matrix (w
->desired_matrix
);
13604 clear_glyph_matrix (w
->current_matrix
);
13605 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
13606 try_window (FRAME_ROOT_WINDOW (f
), pos
);
13608 /* Compute width and height of the tooltip. */
13609 width
= height
= 0;
13610 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
13612 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
13613 struct glyph
*last
;
13616 /* Stop at the first empty row at the end. */
13617 if (!row
->enabled_p
|| !row
->displays_text_p
)
13620 /* Let the row go over the full width of the frame. */
13621 row
->full_width_p
= 1;
13623 #ifdef TODO /* Investigate why some fonts need more width than is
13624 calculated for some tooltips. */
13625 /* There's a glyph at the end of rows that is use to place
13626 the cursor there. Don't include the width of this glyph. */
13627 if (row
->used
[TEXT_AREA
])
13629 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
13630 row_width
= row
->pixel_width
- last
->pixel_width
;
13634 row_width
= row
->pixel_width
;
13636 /* TODO: find why tips do not draw along baseline as instructed. */
13637 height
+= row
->height
;
13638 width
= max (width
, row_width
);
13641 /* Add the frame's internal border to the width and height the X
13642 window should have. */
13643 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13644 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
13646 /* Move the tooltip window where the mouse pointer is. Resize and
13648 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
13651 /* Adjust Window size to take border into account. */
13653 rect
.left
= rect
.top
= 0;
13654 rect
.right
= width
;
13655 rect
.bottom
= height
;
13656 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
13657 FRAME_EXTERNAL_MENU_BAR (f
));
13659 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
13660 root_x
, root_y
, rect
.right
- rect
.left
,
13661 rect
.bottom
- rect
.top
, SWP_NOACTIVATE
);
13663 /* Let redisplay know that we have made the frame visible already. */
13664 f
->async_visible
= 1;
13666 ShowWindow (FRAME_W32_WINDOW (f
), SW_SHOWNOACTIVATE
);
13669 /* Draw into the window. */
13670 w
->must_be_updated_p
= 1;
13671 update_single_window (w
, 1);
13675 /* Restore original current buffer. */
13676 set_buffer_internal_1 (old_buffer
);
13677 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
13680 /* Let the tip disappear after timeout seconds. */
13681 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
13682 intern ("x-hide-tip"));
13685 return unbind_to (count
, Qnil
);
13689 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
13690 doc
: /* Hide the current tooltip window, if there is any.
13691 Value is t if tooltip was open, nil otherwise. */)
13695 Lisp_Object deleted
, frame
, timer
;
13696 struct gcpro gcpro1
, gcpro2
;
13698 /* Return quickly if nothing to do. */
13699 if (NILP (tip_timer
) && NILP (tip_frame
))
13704 GCPRO2 (frame
, timer
);
13705 tip_frame
= tip_timer
= deleted
= Qnil
;
13707 count
= BINDING_STACK_SIZE ();
13708 specbind (Qinhibit_redisplay
, Qt
);
13709 specbind (Qinhibit_quit
, Qt
);
13712 call1 (Qcancel_timer
, timer
);
13714 if (FRAMEP (frame
))
13716 Fdelete_frame (frame
, Qnil
);
13721 return unbind_to (count
, deleted
);
13726 /***********************************************************************
13727 File selection dialog
13728 ***********************************************************************/
13730 extern Lisp_Object Qfile_name_history
;
13732 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
13733 doc
: /* Read file name, prompting with PROMPT in directory DIR.
13734 Use a file selection dialog.
13735 Select DEFAULT-FILENAME in the dialog's file selection box, if
13736 specified. Ensure that file exists if MUSTMATCH is non-nil. */)
13737 (prompt
, dir
, default_filename
, mustmatch
)
13738 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
13740 struct frame
*f
= SELECTED_FRAME ();
13741 Lisp_Object file
= Qnil
;
13742 int count
= specpdl_ptr
- specpdl
;
13743 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
13744 char filename
[MAX_PATH
+ 1];
13745 char init_dir
[MAX_PATH
+ 1];
13746 int use_dialog_p
= 1;
13748 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
13749 CHECK_STRING (prompt
);
13750 CHECK_STRING (dir
);
13752 /* Create the dialog with PROMPT as title, using DIR as initial
13753 directory and using "*" as pattern. */
13754 dir
= Fexpand_file_name (dir
, Qnil
);
13755 strncpy (init_dir
, XSTRING (dir
)->data
, MAX_PATH
);
13756 init_dir
[MAX_PATH
] = '\0';
13757 unixtodos_filename (init_dir
);
13759 if (STRINGP (default_filename
))
13761 char *file_name_only
;
13762 char *full_path_name
= XSTRING (default_filename
)->data
;
13764 unixtodos_filename (full_path_name
);
13766 file_name_only
= strrchr (full_path_name
, '\\');
13767 if (!file_name_only
)
13768 file_name_only
= full_path_name
;
13773 /* If default_file_name is a directory, don't use the open
13774 file dialog, as it does not support selecting
13776 if (!(*file_name_only
))
13780 strncpy (filename
, file_name_only
, MAX_PATH
);
13781 filename
[MAX_PATH
] = '\0';
13784 filename
[0] = '\0';
13788 OPENFILENAME file_details
;
13790 /* Prevent redisplay. */
13791 specbind (Qinhibit_redisplay
, Qt
);
13794 bzero (&file_details
, sizeof (file_details
));
13795 file_details
.lStructSize
= sizeof (file_details
);
13796 file_details
.hwndOwner
= FRAME_W32_WINDOW (f
);
13797 /* Undocumented Bug in Common File Dialog:
13798 If a filter is not specified, shell links are not resolved. */
13799 file_details
.lpstrFilter
= "ALL Files (*.*)\0*.*\0\0";
13800 file_details
.lpstrFile
= filename
;
13801 file_details
.nMaxFile
= sizeof (filename
);
13802 file_details
.lpstrInitialDir
= init_dir
;
13803 file_details
.lpstrTitle
= XSTRING (prompt
)->data
;
13804 file_details
.Flags
= OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
;
13806 if (!NILP (mustmatch
))
13807 file_details
.Flags
|= OFN_FILEMUSTEXIST
| OFN_PATHMUSTEXIST
;
13809 if (GetOpenFileName (&file_details
))
13811 dostounix_filename (filename
);
13812 file
= build_string (filename
);
13818 file
= unbind_to (count
, file
);
13820 /* Open File dialog will not allow folders to be selected, so resort
13821 to minibuffer completing reads for directories. */
13823 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
13824 dir
, mustmatch
, dir
, Qfile_name_history
,
13825 default_filename
, Qnil
);
13829 /* Make "Cancel" equivalent to C-g. */
13831 Fsignal (Qquit
, Qnil
);
13833 return unbind_to (count
, file
);
13838 /***********************************************************************
13839 w32 specialized functions
13840 ***********************************************************************/
13842 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
13843 doc
: /* Select a font using the W32 font dialog.
13844 Returns an X font string corresponding to the selection. */)
13848 FRAME_PTR f
= check_x_frame (frame
);
13856 bzero (&cf
, sizeof (cf
));
13857 bzero (&lf
, sizeof (lf
));
13859 cf
.lStructSize
= sizeof (cf
);
13860 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
13861 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
13862 cf
.lpLogFont
= &lf
;
13864 /* Initialize as much of the font details as we can from the current
13866 hdc
= GetDC (FRAME_W32_WINDOW (f
));
13867 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
13868 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
13869 if (GetTextMetrics (hdc
, &tm
))
13871 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
13872 lf
.lfWeight
= tm
.tmWeight
;
13873 lf
.lfItalic
= tm
.tmItalic
;
13874 lf
.lfUnderline
= tm
.tmUnderlined
;
13875 lf
.lfStrikeOut
= tm
.tmStruckOut
;
13876 lf
.lfCharSet
= tm
.tmCharSet
;
13877 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
13879 SelectObject (hdc
, oldobj
);
13880 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
13882 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
13885 return build_string (buf
);
13888 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
13889 Sw32_send_sys_command
, 1, 2, 0,
13890 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
13891 Some useful values for command are 0xf030 to maximise frame (0xf020
13892 to minimize), 0xf120 to restore frame to original size, and 0xf100
13893 to activate the menubar for keyboard access. 0xf140 activates the
13894 screen saver if defined.
13896 If optional parameter FRAME is not specified, use selected frame. */)
13898 Lisp_Object command
, frame
;
13900 FRAME_PTR f
= check_x_frame (frame
);
13902 CHECK_NUMBER (command
);
13904 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
13909 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
13910 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
13911 This is a wrapper around the ShellExecute system function, which
13912 invokes the application registered to handle OPERATION for DOCUMENT.
13913 OPERATION is typically \"open\", \"print\" or \"explore\" (but can be
13914 nil for the default action), and DOCUMENT is typically the name of a
13915 document file or URL, but can also be a program executable to run or
13916 a directory to open in the Windows Explorer.
13918 If DOCUMENT is a program executable, PARAMETERS can be a string
13919 containing command line parameters, but otherwise should be nil.
13921 SHOW-FLAG can be used to control whether the invoked application is hidden
13922 or minimized. If SHOW-FLAG is nil, the application is displayed normally,
13923 otherwise it is an integer representing a ShowWindow flag:
13927 3 - start maximized
13928 6 - start minimized */)
13929 (operation
, document
, parameters
, show_flag
)
13930 Lisp_Object operation
, document
, parameters
, show_flag
;
13932 Lisp_Object current_dir
;
13934 CHECK_STRING (document
);
13936 /* Encode filename and current directory. */
13937 current_dir
= ENCODE_FILE (current_buffer
->directory
);
13938 document
= ENCODE_FILE (document
);
13939 if ((int) ShellExecute (NULL
,
13940 (STRINGP (operation
) ?
13941 XSTRING (operation
)->data
: NULL
),
13942 XSTRING (document
)->data
,
13943 (STRINGP (parameters
) ?
13944 XSTRING (parameters
)->data
: NULL
),
13945 XSTRING (current_dir
)->data
,
13946 (INTEGERP (show_flag
) ?
13947 XINT (show_flag
) : SW_SHOWDEFAULT
))
13950 error ("ShellExecute failed: %s", w32_strerror (0));
13953 /* Lookup virtual keycode from string representing the name of a
13954 non-ascii keystroke into the corresponding virtual key, using
13955 lispy_function_keys. */
13957 lookup_vk_code (char *key
)
13961 for (i
= 0; i
< 256; i
++)
13962 if (lispy_function_keys
[i
] != 0
13963 && strcmp (lispy_function_keys
[i
], key
) == 0)
13969 /* Convert a one-element vector style key sequence to a hot key
13972 w32_parse_hot_key (key
)
13975 /* Copied from Fdefine_key and store_in_keymap. */
13976 register Lisp_Object c
;
13978 int lisp_modifiers
;
13980 struct gcpro gcpro1
;
13982 CHECK_VECTOR (key
);
13984 if (XFASTINT (Flength (key
)) != 1)
13989 c
= Faref (key
, make_number (0));
13991 if (CONSP (c
) && lucid_event_type_list_p (c
))
13992 c
= Fevent_convert_list (c
);
13996 if (! INTEGERP (c
) && ! SYMBOLP (c
))
13997 error ("Key definition is invalid");
13999 /* Work out the base key and the modifiers. */
14002 c
= parse_modifiers (c
);
14003 lisp_modifiers
= Fcar (Fcdr (c
));
14007 vk_code
= lookup_vk_code (XSYMBOL (c
)->name
->data
);
14009 else if (INTEGERP (c
))
14011 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
14012 /* Many ascii characters are their own virtual key code. */
14013 vk_code
= XINT (c
) & CHARACTERBITS
;
14016 if (vk_code
< 0 || vk_code
> 255)
14019 if ((lisp_modifiers
& meta_modifier
) != 0
14020 && !NILP (Vw32_alt_is_meta
))
14021 lisp_modifiers
|= alt_modifier
;
14023 /* Supply defs missing from mingw32. */
14025 #define MOD_ALT 0x0001
14026 #define MOD_CONTROL 0x0002
14027 #define MOD_SHIFT 0x0004
14028 #define MOD_WIN 0x0008
14031 /* Convert lisp modifiers to Windows hot-key form. */
14032 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
14033 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
14034 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
14035 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
14037 return HOTKEY (vk_code
, w32_modifiers
);
14040 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
14041 Sw32_register_hot_key
, 1, 1, 0,
14042 doc
: /* Register KEY as a hot-key combination.
14043 Certain key combinations like Alt-Tab are reserved for system use on
14044 Windows, and therefore are normally intercepted by the system. However,
14045 most of these key combinations can be received by registering them as
14046 hot-keys, overriding their special meaning.
14048 KEY must be a one element key definition in vector form that would be
14049 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
14050 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
14051 is always interpreted as the Windows modifier keys.
14053 The return value is the hotkey-id if registered, otherwise nil. */)
14057 key
= w32_parse_hot_key (key
);
14059 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
14061 /* Reuse an empty slot if possible. */
14062 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
14064 /* Safe to add new key to list, even if we have focus. */
14066 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
14068 XSETCAR (item
, key
);
14070 /* Notify input thread about new hot-key definition, so that it
14071 takes effect without needing to switch focus. */
14072 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
14079 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
14080 Sw32_unregister_hot_key
, 1, 1, 0,
14081 doc
: /* Unregister HOTKEY as a hot-key combination. */)
14087 if (!INTEGERP (key
))
14088 key
= w32_parse_hot_key (key
);
14090 item
= Fmemq (key
, w32_grabbed_keys
);
14094 /* Notify input thread about hot-key definition being removed, so
14095 that it takes effect without needing focus switch. */
14096 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
14097 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
14100 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
14107 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
14108 Sw32_registered_hot_keys
, 0, 0, 0,
14109 doc
: /* Return list of registered hot-key IDs. */)
14112 return Fcopy_sequence (w32_grabbed_keys
);
14115 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
14116 Sw32_reconstruct_hot_key
, 1, 1, 0,
14117 doc
: /* Convert hot-key ID to a lisp key combination. */)
14119 Lisp_Object hotkeyid
;
14121 int vk_code
, w32_modifiers
;
14124 CHECK_NUMBER (hotkeyid
);
14126 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
14127 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
14129 if (lispy_function_keys
[vk_code
])
14130 key
= intern (lispy_function_keys
[vk_code
]);
14132 key
= make_number (vk_code
);
14134 key
= Fcons (key
, Qnil
);
14135 if (w32_modifiers
& MOD_SHIFT
)
14136 key
= Fcons (Qshift
, key
);
14137 if (w32_modifiers
& MOD_CONTROL
)
14138 key
= Fcons (Qctrl
, key
);
14139 if (w32_modifiers
& MOD_ALT
)
14140 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
14141 if (w32_modifiers
& MOD_WIN
)
14142 key
= Fcons (Qhyper
, key
);
14147 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
14148 Sw32_toggle_lock_key
, 1, 2, 0,
14149 doc
: /* Toggle the state of the lock key KEY.
14150 KEY can be `capslock', `kp-numlock', or `scroll'.
14151 If the optional parameter NEW-STATE is a number, then the state of KEY
14152 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
14154 Lisp_Object key
, new_state
;
14158 if (EQ (key
, intern ("capslock")))
14159 vk_code
= VK_CAPITAL
;
14160 else if (EQ (key
, intern ("kp-numlock")))
14161 vk_code
= VK_NUMLOCK
;
14162 else if (EQ (key
, intern ("scroll")))
14163 vk_code
= VK_SCROLL
;
14167 if (!dwWindowsThreadId
)
14168 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
14170 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
14171 (WPARAM
) vk_code
, (LPARAM
) new_state
))
14174 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
14175 return make_number (msg
.wParam
);
14180 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
14181 doc
: /* Return storage information about the file system FILENAME is on.
14182 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
14183 storage of the file system, FREE is the free storage, and AVAIL is the
14184 storage available to a non-superuser. All 3 numbers are in bytes.
14185 If the underlying system call fails, value is nil. */)
14187 Lisp_Object filename
;
14189 Lisp_Object encoded
, value
;
14191 CHECK_STRING (filename
);
14192 filename
= Fexpand_file_name (filename
, Qnil
);
14193 encoded
= ENCODE_FILE (filename
);
14197 /* Determining the required information on Windows turns out, sadly,
14198 to be more involved than one would hope. The original Win32 api
14199 call for this will return bogus information on some systems, but we
14200 must dynamically probe for the replacement api, since that was
14201 added rather late on. */
14203 HMODULE hKernel
= GetModuleHandle ("kernel32");
14204 BOOL (*pfn_GetDiskFreeSpaceEx
)
14205 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
14206 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
14208 /* On Windows, we may need to specify the root directory of the
14209 volume holding FILENAME. */
14210 char rootname
[MAX_PATH
];
14211 char *name
= XSTRING (encoded
)->data
;
14213 /* find the root name of the volume if given */
14214 if (isalpha (name
[0]) && name
[1] == ':')
14216 rootname
[0] = name
[0];
14217 rootname
[1] = name
[1];
14218 rootname
[2] = '\\';
14221 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
14223 char *str
= rootname
;
14227 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
14237 if (pfn_GetDiskFreeSpaceEx
)
14239 LARGE_INTEGER availbytes
;
14240 LARGE_INTEGER freebytes
;
14241 LARGE_INTEGER totalbytes
;
14243 if (pfn_GetDiskFreeSpaceEx(rootname
,
14247 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
14248 make_float ((double) freebytes
.QuadPart
),
14249 make_float ((double) availbytes
.QuadPart
));
14253 DWORD sectors_per_cluster
;
14254 DWORD bytes_per_sector
;
14255 DWORD free_clusters
;
14256 DWORD total_clusters
;
14258 if (GetDiskFreeSpace(rootname
,
14259 §ors_per_cluster
,
14263 value
= list3 (make_float ((double) total_clusters
14264 * sectors_per_cluster
* bytes_per_sector
),
14265 make_float ((double) free_clusters
14266 * sectors_per_cluster
* bytes_per_sector
),
14267 make_float ((double) free_clusters
14268 * sectors_per_cluster
* bytes_per_sector
));
14275 /***********************************************************************
14277 ***********************************************************************/
14282 HMODULE user32_lib
= GetModuleHandle ("user32.dll");
14284 /* This is zero if not using MS-Windows. */
14287 /* TrackMouseEvent not available in all versions of Windows, so must load
14288 it dynamically. Do it once, here, instead of every time it is used. */
14289 track_mouse_event_fn
= GetProcAddress (user32_lib
, "TrackMouseEvent");
14290 track_mouse_window
= NULL
;
14292 /* The section below is built by the lisp expression at the top of the file,
14293 just above where these variables are declared. */
14294 /*&&& init symbols here &&&*/
14295 Qauto_raise
= intern ("auto-raise");
14296 staticpro (&Qauto_raise
);
14297 Qauto_lower
= intern ("auto-lower");
14298 staticpro (&Qauto_lower
);
14299 Qbar
= intern ("bar");
14301 Qborder_color
= intern ("border-color");
14302 staticpro (&Qborder_color
);
14303 Qborder_width
= intern ("border-width");
14304 staticpro (&Qborder_width
);
14305 Qbox
= intern ("box");
14307 Qcursor_color
= intern ("cursor-color");
14308 staticpro (&Qcursor_color
);
14309 Qcursor_type
= intern ("cursor-type");
14310 staticpro (&Qcursor_type
);
14311 Qgeometry
= intern ("geometry");
14312 staticpro (&Qgeometry
);
14313 Qicon_left
= intern ("icon-left");
14314 staticpro (&Qicon_left
);
14315 Qicon_top
= intern ("icon-top");
14316 staticpro (&Qicon_top
);
14317 Qicon_type
= intern ("icon-type");
14318 staticpro (&Qicon_type
);
14319 Qicon_name
= intern ("icon-name");
14320 staticpro (&Qicon_name
);
14321 Qinternal_border_width
= intern ("internal-border-width");
14322 staticpro (&Qinternal_border_width
);
14323 Qleft
= intern ("left");
14324 staticpro (&Qleft
);
14325 Qright
= intern ("right");
14326 staticpro (&Qright
);
14327 Qmouse_color
= intern ("mouse-color");
14328 staticpro (&Qmouse_color
);
14329 Qnone
= intern ("none");
14330 staticpro (&Qnone
);
14331 Qparent_id
= intern ("parent-id");
14332 staticpro (&Qparent_id
);
14333 Qscroll_bar_width
= intern ("scroll-bar-width");
14334 staticpro (&Qscroll_bar_width
);
14335 Qsuppress_icon
= intern ("suppress-icon");
14336 staticpro (&Qsuppress_icon
);
14337 Qundefined_color
= intern ("undefined-color");
14338 staticpro (&Qundefined_color
);
14339 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
14340 staticpro (&Qvertical_scroll_bars
);
14341 Qvisibility
= intern ("visibility");
14342 staticpro (&Qvisibility
);
14343 Qwindow_id
= intern ("window-id");
14344 staticpro (&Qwindow_id
);
14345 Qx_frame_parameter
= intern ("x-frame-parameter");
14346 staticpro (&Qx_frame_parameter
);
14347 Qx_resource_name
= intern ("x-resource-name");
14348 staticpro (&Qx_resource_name
);
14349 Quser_position
= intern ("user-position");
14350 staticpro (&Quser_position
);
14351 Quser_size
= intern ("user-size");
14352 staticpro (&Quser_size
);
14353 Qscreen_gamma
= intern ("screen-gamma");
14354 staticpro (&Qscreen_gamma
);
14355 Qline_spacing
= intern ("line-spacing");
14356 staticpro (&Qline_spacing
);
14357 Qcenter
= intern ("center");
14358 staticpro (&Qcenter
);
14359 Qcancel_timer
= intern ("cancel-timer");
14360 staticpro (&Qcancel_timer
);
14361 /* This is the end of symbol initialization. */
14363 Qhyper
= intern ("hyper");
14364 staticpro (&Qhyper
);
14365 Qsuper
= intern ("super");
14366 staticpro (&Qsuper
);
14367 Qmeta
= intern ("meta");
14368 staticpro (&Qmeta
);
14369 Qalt
= intern ("alt");
14371 Qctrl
= intern ("ctrl");
14372 staticpro (&Qctrl
);
14373 Qcontrol
= intern ("control");
14374 staticpro (&Qcontrol
);
14375 Qshift
= intern ("shift");
14376 staticpro (&Qshift
);
14378 /* Text property `display' should be nonsticky by default. */
14379 Vtext_property_default_nonsticky
14380 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
14383 Qlaplace
= intern ("laplace");
14384 staticpro (&Qlaplace
);
14385 Qemboss
= intern ("emboss");
14386 staticpro (&Qemboss
);
14387 Qedge_detection
= intern ("edge-detection");
14388 staticpro (&Qedge_detection
);
14389 Qheuristic
= intern ("heuristic");
14390 staticpro (&Qheuristic
);
14391 QCmatrix
= intern (":matrix");
14392 staticpro (&QCmatrix
);
14393 QCcolor_adjustment
= intern (":color-adjustment");
14394 staticpro (&QCcolor_adjustment
);
14395 QCmask
= intern (":mask");
14396 staticpro (&QCmask
);
14398 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
14399 staticpro (&Qface_set_after_frame_default
);
14401 Fput (Qundefined_color
, Qerror_conditions
,
14402 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
14403 Fput (Qundefined_color
, Qerror_message
,
14404 build_string ("Undefined color"));
14406 staticpro (&w32_grabbed_keys
);
14407 w32_grabbed_keys
= Qnil
;
14409 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
14410 doc
: /* An array of color name mappings for windows. */);
14411 Vw32_color_map
= Qnil
;
14413 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
14414 doc
: /* Non-nil if alt key presses are passed on to Windows.
14415 When non-nil, for example, alt pressed and released and then space will
14416 open the System menu. When nil, Emacs silently swallows alt key events. */);
14417 Vw32_pass_alt_to_system
= Qnil
;
14419 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
14420 doc
: /* Non-nil if the alt key is to be considered the same as the meta key.
14421 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta. */);
14422 Vw32_alt_is_meta
= Qt
;
14424 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
14425 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
14426 XSETINT (Vw32_quit_key
, 0);
14428 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14429 &Vw32_pass_lwindow_to_system
,
14430 doc
: /* Non-nil if the left \"Windows\" key is passed on to Windows.
14431 When non-nil, the Start menu is opened by tapping the key. */);
14432 Vw32_pass_lwindow_to_system
= Qt
;
14434 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14435 &Vw32_pass_rwindow_to_system
,
14436 doc
: /* Non-nil if the right \"Windows\" key is passed on to Windows.
14437 When non-nil, the Start menu is opened by tapping the key. */);
14438 Vw32_pass_rwindow_to_system
= Qt
;
14440 DEFVAR_INT ("w32-phantom-key-code",
14441 &Vw32_phantom_key_code
,
14442 doc
: /* Virtual key code used to generate \"phantom\" key presses.
14443 Value is a number between 0 and 255.
14445 Phantom key presses are generated in order to stop the system from
14446 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
14447 `w32-pass-rwindow-to-system' is nil. */);
14448 /* Although 255 is technically not a valid key code, it works and
14449 means that this hack won't interfere with any real key code. */
14450 Vw32_phantom_key_code
= 255;
14452 DEFVAR_LISP ("w32-enable-num-lock",
14453 &Vw32_enable_num_lock
,
14454 doc
: /* Non-nil if Num Lock should act normally.
14455 Set to nil to see Num Lock as the key `kp-numlock'. */);
14456 Vw32_enable_num_lock
= Qt
;
14458 DEFVAR_LISP ("w32-enable-caps-lock",
14459 &Vw32_enable_caps_lock
,
14460 doc
: /* Non-nil if Caps Lock should act normally.
14461 Set to nil to see Caps Lock as the key `capslock'. */);
14462 Vw32_enable_caps_lock
= Qt
;
14464 DEFVAR_LISP ("w32-scroll-lock-modifier",
14465 &Vw32_scroll_lock_modifier
,
14466 doc
: /* Modifier to use for the Scroll Lock on state.
14467 The value can be hyper, super, meta, alt, control or shift for the
14468 respective modifier, or nil to see Scroll Lock as the key `scroll'.
14469 Any other value will cause the key to be ignored. */);
14470 Vw32_scroll_lock_modifier
= Qt
;
14472 DEFVAR_LISP ("w32-lwindow-modifier",
14473 &Vw32_lwindow_modifier
,
14474 doc
: /* Modifier to use for the left \"Windows\" key.
14475 The value can be hyper, super, meta, alt, control or shift for the
14476 respective modifier, or nil to appear as the key `lwindow'.
14477 Any other value will cause the key to be ignored. */);
14478 Vw32_lwindow_modifier
= Qnil
;
14480 DEFVAR_LISP ("w32-rwindow-modifier",
14481 &Vw32_rwindow_modifier
,
14482 doc
: /* Modifier to use for the right \"Windows\" key.
14483 The value can be hyper, super, meta, alt, control or shift for the
14484 respective modifier, or nil to appear as the key `rwindow'.
14485 Any other value will cause the key to be ignored. */);
14486 Vw32_rwindow_modifier
= Qnil
;
14488 DEFVAR_LISP ("w32-apps-modifier",
14489 &Vw32_apps_modifier
,
14490 doc
: /* Modifier to use for the \"Apps\" key.
14491 The value can be hyper, super, meta, alt, control or shift for the
14492 respective modifier, or nil to appear as the key `apps'.
14493 Any other value will cause the key to be ignored. */);
14494 Vw32_apps_modifier
= Qnil
;
14496 DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts
,
14497 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
14498 Vw32_enable_synthesized_fonts
= Qnil
;
14500 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
14501 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
14502 Vw32_enable_palette
= Qt
;
14504 DEFVAR_INT ("w32-mouse-button-tolerance",
14505 &Vw32_mouse_button_tolerance
,
14506 doc
: /* Analogue of double click interval for faking middle mouse events.
14507 The value is the minimum time in milliseconds that must elapse between
14508 left/right button down events before they are considered distinct events.
14509 If both mouse buttons are depressed within this interval, a middle mouse
14510 button down event is generated instead. */);
14511 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
14513 DEFVAR_INT ("w32-mouse-move-interval",
14514 &Vw32_mouse_move_interval
,
14515 doc
: /* Minimum interval between mouse move events.
14516 The value is the minimum time in milliseconds that must elapse between
14517 successive mouse move (or scroll bar drag) events before they are
14518 reported as lisp events. */);
14519 XSETINT (Vw32_mouse_move_interval
, 0);
14521 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
14522 &w32_pass_extra_mouse_buttons_to_system
,
14523 doc
: /* Non-nil if the fourth and fifth mouse buttons are passed to Windows.
14524 Recent versions of Windows support mice with up to five buttons.
14525 Since most applications don't support these extra buttons, most mouse
14526 drivers will allow you to map them to functions at the system level.
14527 If this variable is non-nil, Emacs will pass them on, allowing the
14528 system to handle them. */);
14529 w32_pass_extra_mouse_buttons_to_system
= 0;
14531 init_x_parm_symbols ();
14533 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
14534 doc
: /* List of directories to search for bitmap files for w32. */);
14535 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
14537 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
14538 doc
: /* The shape of the pointer when over text.
14539 Changing the value does not affect existing frames
14540 unless you set the mouse color. */);
14541 Vx_pointer_shape
= Qnil
;
14543 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
14544 doc
: /* The name Emacs uses to look up resources; for internal use only.
14545 `x-get-resource' uses this as the first component of the instance name
14546 when requesting resource values.
14547 Emacs initially sets `x-resource-name' to the name under which Emacs
14548 was invoked, or to the value specified with the `-name' or `-rn'
14549 switches, if present. */);
14550 Vx_resource_name
= Qnil
;
14552 Vx_nontext_pointer_shape
= Qnil
;
14554 Vx_mode_pointer_shape
= Qnil
;
14556 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
14557 doc
: /* The shape of the pointer when Emacs is busy.
14558 This variable takes effect when you create a new frame
14559 or when you set the mouse color. */);
14560 Vx_hourglass_pointer_shape
= Qnil
;
14562 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
14563 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
14564 display_hourglass_p
= 1;
14566 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
14567 doc
: /* *Seconds to wait before displaying an hourglass pointer.
14568 Value must be an integer or float. */);
14569 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
14571 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
14572 &Vx_sensitive_text_pointer_shape
,
14573 doc
: /* The shape of the pointer when over mouse-sensitive text.
14574 This variable takes effect when you create a new frame
14575 or when you set the mouse color. */);
14576 Vx_sensitive_text_pointer_shape
= Qnil
;
14578 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
14579 &Vx_window_horizontal_drag_shape
,
14580 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
14581 This variable takes effect when you create a new frame
14582 or when you set the mouse color. */);
14583 Vx_window_horizontal_drag_shape
= Qnil
;
14585 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
14586 doc
: /* A string indicating the foreground color of the cursor box. */);
14587 Vx_cursor_fore_pixel
= Qnil
;
14589 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
14590 doc
: /* Maximum size for tooltips.
14591 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
14592 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
14594 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
14595 doc
: /* Non-nil if no window manager is in use.
14596 Emacs doesn't try to figure this out; this is always nil
14597 unless you set it to something else. */);
14598 /* We don't have any way to find this out, so set it to nil
14599 and maybe the user would like to set it to t. */
14600 Vx_no_window_manager
= Qnil
;
14602 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
14603 &Vx_pixel_size_width_font_regexp
,
14604 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
14606 Since Emacs gets width of a font matching with this regexp from
14607 PIXEL_SIZE field of the name, font finding mechanism gets faster for
14608 such a font. This is especially effective for such large fonts as
14609 Chinese, Japanese, and Korean. */);
14610 Vx_pixel_size_width_font_regexp
= Qnil
;
14612 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
14613 doc
: /* Time after which cached images are removed from the cache.
14614 When an image has not been displayed this many seconds, remove it
14615 from the image cache. Value must be an integer or nil with nil
14616 meaning don't clear the cache. */);
14617 Vimage_cache_eviction_delay
= make_number (30 * 60);
14619 DEFVAR_LISP ("w32-bdf-filename-alist",
14620 &Vw32_bdf_filename_alist
,
14621 doc
: /* List of bdf fonts and their corresponding filenames. */);
14622 Vw32_bdf_filename_alist
= Qnil
;
14624 DEFVAR_BOOL ("w32-strict-fontnames",
14625 &w32_strict_fontnames
,
14626 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
14627 Default is nil, which allows old fontnames that are not XLFD compliant,
14628 and allows third-party CJK display to work by specifying false charset
14629 fields to trick Emacs into translating to Big5, SJIS etc.
14630 Setting this to t will prevent wrong fonts being selected when
14631 fontsets are automatically created. */);
14632 w32_strict_fontnames
= 0;
14634 DEFVAR_BOOL ("w32-strict-painting",
14635 &w32_strict_painting
,
14636 doc
: /* Non-nil means use strict rules for repainting frames.
14637 Set this to nil to get the old behaviour for repainting; this should
14638 only be necessary if the default setting causes problems. */);
14639 w32_strict_painting
= 1;
14641 DEFVAR_LISP ("w32-charset-info-alist",
14642 &Vw32_charset_info_alist
,
14643 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
14644 Each entry should be of the form:
14646 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
14648 where CHARSET_NAME is a string used in font names to identify the charset,
14649 WINDOWS_CHARSET is a symbol that can be one of:
14650 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
14651 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
14652 w32-charset-chinesebig5,
14653 #ifdef JOHAB_CHARSET
14654 w32-charset-johab, w32-charset-hebrew,
14655 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
14656 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
14657 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
14659 #ifdef UNICODE_CHARSET
14660 w32-charset-unicode,
14662 or w32-charset-oem.
14663 CODEPAGE should be an integer specifying the codepage that should be used
14664 to display the character set, t to do no translation and output as Unicode,
14665 or nil to do no translation and output as 8 bit (or multibyte on far-east
14666 versions of Windows) characters. */);
14667 Vw32_charset_info_alist
= Qnil
;
14669 staticpro (&Qw32_charset_ansi
);
14670 Qw32_charset_ansi
= intern ("w32-charset-ansi");
14671 staticpro (&Qw32_charset_symbol
);
14672 Qw32_charset_symbol
= intern ("w32-charset-symbol");
14673 staticpro (&Qw32_charset_shiftjis
);
14674 Qw32_charset_shiftjis
= intern ("w32-charset-shiftjis");
14675 staticpro (&Qw32_charset_hangeul
);
14676 Qw32_charset_hangeul
= intern ("w32-charset-hangeul");
14677 staticpro (&Qw32_charset_chinesebig5
);
14678 Qw32_charset_chinesebig5
= intern ("w32-charset-chinesebig5");
14679 staticpro (&Qw32_charset_gb2312
);
14680 Qw32_charset_gb2312
= intern ("w32-charset-gb2312");
14681 staticpro (&Qw32_charset_oem
);
14682 Qw32_charset_oem
= intern ("w32-charset-oem");
14684 #ifdef JOHAB_CHARSET
14686 static int w32_extra_charsets_defined
= 1;
14687 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
14688 doc
: /* Internal variable. */);
14690 staticpro (&Qw32_charset_johab
);
14691 Qw32_charset_johab
= intern ("w32-charset-johab");
14692 staticpro (&Qw32_charset_easteurope
);
14693 Qw32_charset_easteurope
= intern ("w32-charset-easteurope");
14694 staticpro (&Qw32_charset_turkish
);
14695 Qw32_charset_turkish
= intern ("w32-charset-turkish");
14696 staticpro (&Qw32_charset_baltic
);
14697 Qw32_charset_baltic
= intern ("w32-charset-baltic");
14698 staticpro (&Qw32_charset_russian
);
14699 Qw32_charset_russian
= intern ("w32-charset-russian");
14700 staticpro (&Qw32_charset_arabic
);
14701 Qw32_charset_arabic
= intern ("w32-charset-arabic");
14702 staticpro (&Qw32_charset_greek
);
14703 Qw32_charset_greek
= intern ("w32-charset-greek");
14704 staticpro (&Qw32_charset_hebrew
);
14705 Qw32_charset_hebrew
= intern ("w32-charset-hebrew");
14706 staticpro (&Qw32_charset_vietnamese
);
14707 Qw32_charset_vietnamese
= intern ("w32-charset-vietnamese");
14708 staticpro (&Qw32_charset_thai
);
14709 Qw32_charset_thai
= intern ("w32-charset-thai");
14710 staticpro (&Qw32_charset_mac
);
14711 Qw32_charset_mac
= intern ("w32-charset-mac");
14715 #ifdef UNICODE_CHARSET
14717 static int w32_unicode_charset_defined
= 1;
14718 DEFVAR_BOOL ("w32-unicode-charset-defined",
14719 &w32_unicode_charset_defined
,
14720 doc
: /* Internal variable. */);
14722 staticpro (&Qw32_charset_unicode
);
14723 Qw32_charset_unicode
= intern ("w32-charset-unicode");
14726 defsubr (&Sx_get_resource
);
14727 #if 0 /* TODO: Port to W32 */
14728 defsubr (&Sx_change_window_property
);
14729 defsubr (&Sx_delete_window_property
);
14730 defsubr (&Sx_window_property
);
14732 defsubr (&Sxw_display_color_p
);
14733 defsubr (&Sx_display_grayscale_p
);
14734 defsubr (&Sxw_color_defined_p
);
14735 defsubr (&Sxw_color_values
);
14736 defsubr (&Sx_server_max_request_size
);
14737 defsubr (&Sx_server_vendor
);
14738 defsubr (&Sx_server_version
);
14739 defsubr (&Sx_display_pixel_width
);
14740 defsubr (&Sx_display_pixel_height
);
14741 defsubr (&Sx_display_mm_width
);
14742 defsubr (&Sx_display_mm_height
);
14743 defsubr (&Sx_display_screens
);
14744 defsubr (&Sx_display_planes
);
14745 defsubr (&Sx_display_color_cells
);
14746 defsubr (&Sx_display_visual_class
);
14747 defsubr (&Sx_display_backing_store
);
14748 defsubr (&Sx_display_save_under
);
14749 defsubr (&Sx_parse_geometry
);
14750 defsubr (&Sx_create_frame
);
14751 defsubr (&Sx_open_connection
);
14752 defsubr (&Sx_close_connection
);
14753 defsubr (&Sx_display_list
);
14754 defsubr (&Sx_synchronize
);
14756 /* W32 specific functions */
14758 defsubr (&Sw32_focus_frame
);
14759 defsubr (&Sw32_select_font
);
14760 defsubr (&Sw32_define_rgb_color
);
14761 defsubr (&Sw32_default_color_map
);
14762 defsubr (&Sw32_load_color_file
);
14763 defsubr (&Sw32_send_sys_command
);
14764 defsubr (&Sw32_shell_execute
);
14765 defsubr (&Sw32_register_hot_key
);
14766 defsubr (&Sw32_unregister_hot_key
);
14767 defsubr (&Sw32_registered_hot_keys
);
14768 defsubr (&Sw32_reconstruct_hot_key
);
14769 defsubr (&Sw32_toggle_lock_key
);
14770 defsubr (&Sw32_find_bdf_fonts
);
14772 defsubr (&Sfile_system_info
);
14774 /* Setting callback functions for fontset handler. */
14775 get_font_info_func
= w32_get_font_info
;
14777 #if 0 /* This function pointer doesn't seem to be used anywhere.
14778 And the pointer assigned has the wrong type, anyway. */
14779 list_fonts_func
= w32_list_fonts
;
14782 load_font_func
= w32_load_font
;
14783 find_ccl_program_func
= w32_find_ccl_program
;
14784 query_font_func
= w32_query_font
;
14785 set_frame_fontset_func
= x_set_font
;
14786 check_window_system_func
= check_w32
;
14788 #if 0 /* TODO Image support for W32 */
14790 Qxbm
= intern ("xbm");
14792 QCtype
= intern (":type");
14793 staticpro (&QCtype
);
14794 QCconversion
= intern (":conversion");
14795 staticpro (&QCconversion
);
14796 QCheuristic_mask
= intern (":heuristic-mask");
14797 staticpro (&QCheuristic_mask
);
14798 QCcolor_symbols
= intern (":color-symbols");
14799 staticpro (&QCcolor_symbols
);
14800 QCascent
= intern (":ascent");
14801 staticpro (&QCascent
);
14802 QCmargin
= intern (":margin");
14803 staticpro (&QCmargin
);
14804 QCrelief
= intern (":relief");
14805 staticpro (&QCrelief
);
14806 Qpostscript
= intern ("postscript");
14807 staticpro (&Qpostscript
);
14808 QCloader
= intern (":loader");
14809 staticpro (&QCloader
);
14810 QCbounding_box
= intern (":bounding-box");
14811 staticpro (&QCbounding_box
);
14812 QCpt_width
= intern (":pt-width");
14813 staticpro (&QCpt_width
);
14814 QCpt_height
= intern (":pt-height");
14815 staticpro (&QCpt_height
);
14816 QCindex
= intern (":index");
14817 staticpro (&QCindex
);
14818 Qpbm
= intern ("pbm");
14822 Qxpm
= intern ("xpm");
14827 Qjpeg
= intern ("jpeg");
14828 staticpro (&Qjpeg
);
14832 Qtiff
= intern ("tiff");
14833 staticpro (&Qtiff
);
14837 Qgif
= intern ("gif");
14842 Qpng
= intern ("png");
14846 defsubr (&Sclear_image_cache
);
14849 defsubr (&Simagep
);
14850 defsubr (&Slookup_image
);
14854 hourglass_atimer
= NULL
;
14855 hourglass_shown_p
= 0;
14856 defsubr (&Sx_show_tip
);
14857 defsubr (&Sx_hide_tip
);
14859 staticpro (&tip_timer
);
14861 staticpro (&tip_frame
);
14863 last_show_tip_args
= Qnil
;
14864 staticpro (&last_show_tip_args
);
14866 defsubr (&Sx_file_dialog
);
14873 image_types
= NULL
;
14874 Vimage_types
= Qnil
;
14876 #if 0 /* TODO : Image support for W32 */
14877 define_image_type (&xbm_type
);
14878 define_image_type (&gs_type
);
14879 define_image_type (&pbm_type
);
14882 define_image_type (&xpm_type
);
14886 define_image_type (&jpeg_type
);
14890 define_image_type (&tiff_type
);
14894 define_image_type (&gif_type
);
14898 define_image_type (&png_type
);
14909 button
= MessageBox (NULL
,
14910 "A fatal error has occurred!\n\n"
14911 "Select Abort to exit, Retry to debug, Ignore to continue",
14912 "Emacs Abort Dialog",
14913 MB_ICONEXCLAMATION
| MB_TASKMODAL
14914 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
14929 /* For convenience when debugging. */
14933 return GetLastError ();