1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 92, 93, 94, 95, 1996, 1997, 1998, 1999
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"
39 #include "intervals.h"
41 #include "blockinput.h"
44 #include "termhooks.h"
49 #include "bitmaps/gray.xbm"
55 #define max(a, b) ((a) > (b) ? (a) : (b))
57 extern void free_frame_menubar ();
58 extern double atof ();
59 extern int w32_console_toggle_lock_key (int vk_code
, Lisp_Object new_state
);
62 /* A definition of XColor for non-X frames. */
63 #ifndef HAVE_X_WINDOWS
66 unsigned short red
, green
, blue
;
72 extern char *lispy_function_keys
[];
74 /* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
75 it, and including `bitmaps/gray' more than once is a problem when
76 config.h defines `static' as an empty replacement string. */
78 int gray_bitmap_width
= gray_width
;
79 int gray_bitmap_height
= gray_height
;
80 unsigned char *gray_bitmap_bits
= gray_bits
;
82 /* The colormap for converting color names to RGB values */
83 Lisp_Object Vw32_color_map
;
85 /* Non nil if alt key presses are passed on to Windows. */
86 Lisp_Object Vw32_pass_alt_to_system
;
88 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
90 Lisp_Object Vw32_alt_is_meta
;
92 /* If non-zero, the windows virtual key code for an alternative quit key. */
93 Lisp_Object Vw32_quit_key
;
95 /* Non nil if left window key events are passed on to Windows (this only
96 affects whether "tapping" the key opens the Start menu). */
97 Lisp_Object Vw32_pass_lwindow_to_system
;
99 /* Non nil if right window key events are passed on to Windows (this
100 only affects whether "tapping" the key opens the Start menu). */
101 Lisp_Object Vw32_pass_rwindow_to_system
;
103 /* Virtual key code used to generate "phantom" key presses in order
104 to stop system from acting on Windows key events. */
105 Lisp_Object Vw32_phantom_key_code
;
107 /* Modifier associated with the left "Windows" key, or nil to act as a
109 Lisp_Object Vw32_lwindow_modifier
;
111 /* Modifier associated with the right "Windows" key, or nil to act as a
113 Lisp_Object Vw32_rwindow_modifier
;
115 /* Modifier associated with the "Apps" key, or nil to act as a normal
117 Lisp_Object Vw32_apps_modifier
;
119 /* Value is nil if Num Lock acts as a function key. */
120 Lisp_Object Vw32_enable_num_lock
;
122 /* Value is nil if Caps Lock acts as a function key. */
123 Lisp_Object Vw32_enable_caps_lock
;
125 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
126 Lisp_Object Vw32_scroll_lock_modifier
;
128 /* Switch to control whether we inhibit requests for synthesized bold
129 and italic versions of fonts. */
130 Lisp_Object Vw32_enable_synthesized_fonts
;
132 /* Enable palette management. */
133 Lisp_Object Vw32_enable_palette
;
135 /* Control how close left/right button down events must be to
136 be converted to a middle button down event. */
137 Lisp_Object Vw32_mouse_button_tolerance
;
139 /* Minimum interval between mouse movement (and scroll bar drag)
140 events that are passed on to the event loop. */
141 Lisp_Object Vw32_mouse_move_interval
;
143 /* The name we're using in resource queries. */
144 Lisp_Object Vx_resource_name
;
146 /* Non nil if no window manager is in use. */
147 Lisp_Object Vx_no_window_manager
;
149 /* Non-zero means we're allowed to display a busy cursor. */
151 int display_busy_cursor_p
;
153 /* The background and shape of the mouse pointer, and shape when not
154 over text or in the modeline. */
156 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
157 Lisp_Object Vx_busy_pointer_shape
, Vx_window_horizontal_drag_shape
;
159 /* The shape when over mouse-sensitive text. */
161 Lisp_Object Vx_sensitive_text_pointer_shape
;
163 /* Color of chars displayed in cursor box. */
165 Lisp_Object Vx_cursor_fore_pixel
;
167 /* Nonzero if using Windows. */
169 static int w32_in_use
;
171 /* Search path for bitmap files. */
173 Lisp_Object Vx_bitmap_file_path
;
175 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
177 Lisp_Object Vx_pixel_size_width_font_regexp
;
179 /* Alist of bdf fonts and the files that define them. */
180 Lisp_Object Vw32_bdf_filename_alist
;
182 Lisp_Object Vw32_system_coding_system
;
184 /* A flag to control whether fonts are matched strictly or not. */
185 int w32_strict_fontnames
;
187 /* A flag to control whether we should only repaint if GetUpdateRect
188 indicates there is an update region. */
189 int w32_strict_painting
;
191 /* Associative list linking character set strings to Windows codepages. */
192 Lisp_Object Vw32_charset_info_alist
;
194 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
195 #ifndef VIETNAMESE_CHARSET
196 #define VIETNAMESE_CHARSET 163
200 /* Evaluate this expression to rebuild the section of syms_of_w32fns
201 that initializes and staticpros the symbols declared below. Note
202 that Emacs 18 has a bug that keeps C-x C-e from being able to
203 evaluate this expression.
206 ;; Accumulate a list of the symbols we want to initialize from the
207 ;; declarations at the top of the file.
208 (goto-char (point-min))
209 (search-forward "/\*&&& symbols declared here &&&*\/\n")
211 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
213 (cons (buffer-substring (match-beginning 1) (match-end 1))
216 (setq symbol-list (nreverse symbol-list))
217 ;; Delete the section of syms_of_... where we initialize the symbols.
218 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
219 (let ((start (point)))
220 (while (looking-at "^ Q")
222 (kill-region start (point)))
223 ;; Write a new symbol initialization section.
225 (insert (format " %s = intern (\"" (car symbol-list)))
226 (let ((start (point)))
227 (insert (substring (car symbol-list) 1))
228 (subst-char-in-region start (point) ?_ ?-))
229 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
230 (setq symbol-list (cdr symbol-list)))))
234 /*&&& symbols declared here &&&*/
235 Lisp_Object Qauto_raise
;
236 Lisp_Object Qauto_lower
;
238 Lisp_Object Qborder_color
;
239 Lisp_Object Qborder_width
;
241 Lisp_Object Qcursor_color
;
242 Lisp_Object Qcursor_type
;
243 Lisp_Object Qgeometry
;
244 Lisp_Object Qicon_left
;
245 Lisp_Object Qicon_top
;
246 Lisp_Object Qicon_type
;
247 Lisp_Object Qicon_name
;
248 Lisp_Object Qinternal_border_width
;
251 Lisp_Object Qmouse_color
;
253 Lisp_Object Qparent_id
;
254 Lisp_Object Qscroll_bar_width
;
255 Lisp_Object Qsuppress_icon
;
256 Lisp_Object Qundefined_color
;
257 Lisp_Object Qvertical_scroll_bars
;
258 Lisp_Object Qvisibility
;
259 Lisp_Object Qwindow_id
;
260 Lisp_Object Qx_frame_parameter
;
261 Lisp_Object Qx_resource_name
;
262 Lisp_Object Quser_position
;
263 Lisp_Object Quser_size
;
264 Lisp_Object Qscreen_gamma
;
265 Lisp_Object Qline_spacing
;
272 Lisp_Object Qcontrol
;
275 Lisp_Object Qw32_charset_ansi
;
276 Lisp_Object Qw32_charset_default
;
277 Lisp_Object Qw32_charset_symbol
;
278 Lisp_Object Qw32_charset_shiftjis
;
279 Lisp_Object Qw32_charset_hangeul
;
280 Lisp_Object Qw32_charset_gb2312
;
281 Lisp_Object Qw32_charset_chinesebig5
;
282 Lisp_Object Qw32_charset_oem
;
284 #ifndef JOHAB_CHARSET
285 #define JOHAB_CHARSET 130
288 Lisp_Object Qw32_charset_easteurope
;
289 Lisp_Object Qw32_charset_turkish
;
290 Lisp_Object Qw32_charset_baltic
;
291 Lisp_Object Qw32_charset_russian
;
292 Lisp_Object Qw32_charset_arabic
;
293 Lisp_Object Qw32_charset_greek
;
294 Lisp_Object Qw32_charset_hebrew
;
295 Lisp_Object Qw32_charset_vietnamese
;
296 Lisp_Object Qw32_charset_thai
;
297 Lisp_Object Qw32_charset_johab
;
298 Lisp_Object Qw32_charset_mac
;
301 #ifdef UNICODE_CHARSET
302 Lisp_Object Qw32_charset_unicode
;
305 extern Lisp_Object Qtop
;
306 extern Lisp_Object Qdisplay
;
307 extern Lisp_Object Qtool_bar_lines
;
309 /* State variables for emulating a three button mouse. */
314 static int button_state
= 0;
315 static W32Msg saved_mouse_button_msg
;
316 static unsigned mouse_button_timer
; /* non-zero when timer is active */
317 static W32Msg saved_mouse_move_msg
;
318 static unsigned mouse_move_timer
;
320 /* W95 mousewheel handler */
321 unsigned int msh_mousewheel
= 0;
323 #define MOUSE_BUTTON_ID 1
324 #define MOUSE_MOVE_ID 2
326 /* The below are defined in frame.c. */
328 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
329 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
330 extern Lisp_Object Qtool_bar_lines
;
332 extern Lisp_Object Vwindow_system_version
;
334 Lisp_Object Qface_set_after_frame_default
;
336 /* From w32term.c. */
337 extern Lisp_Object Vw32_num_mouse_buttons
;
338 extern Lisp_Object Vw32_recognize_altgr
;
341 /* Error if we are not connected to MS-Windows. */
346 error ("MS-Windows not in use or not initialized");
349 /* Nonzero if we can use mouse menus.
350 You should not call this unless HAVE_MENUS is defined. */
358 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
359 and checking validity for W32. */
362 check_x_frame (frame
)
368 frame
= selected_frame
;
369 CHECK_LIVE_FRAME (frame
, 0);
371 if (! FRAME_W32_P (f
))
372 error ("non-w32 frame used");
376 /* Let the user specify an display with a frame.
377 nil stands for the selected frame--or, if that is not a w32 frame,
378 the first display on the list. */
380 static struct w32_display_info
*
381 check_x_display_info (frame
)
386 struct frame
*sf
= XFRAME (selected_frame
);
388 if (FRAME_W32_P (sf
) && FRAME_LIVE_P (sf
))
389 return FRAME_W32_DISPLAY_INFO (sf
);
391 return &one_w32_display_info
;
393 else if (STRINGP (frame
))
394 return x_display_info_for_name (frame
);
399 CHECK_LIVE_FRAME (frame
, 0);
401 if (! FRAME_W32_P (f
))
402 error ("non-w32 frame used");
403 return FRAME_W32_DISPLAY_INFO (f
);
407 /* Return the Emacs frame-object corresponding to an w32 window.
408 It could be the frame's main window or an icon window. */
410 /* This function can be called during GC, so use GC_xxx type test macros. */
413 x_window_to_frame (dpyinfo
, wdesc
)
414 struct w32_display_info
*dpyinfo
;
417 Lisp_Object tail
, frame
;
420 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
423 if (!GC_FRAMEP (frame
))
426 if (!FRAME_W32_P (f
) || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
428 if (f
->output_data
.w32
->busy_window
== wdesc
)
431 /* TODO: Check tooltips when supported. */
432 if (FRAME_W32_WINDOW (f
) == wdesc
)
440 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
441 id, which is just an int that this section returns. Bitmaps are
442 reference counted so they can be shared among frames.
444 Bitmap indices are guaranteed to be > 0, so a negative number can
445 be used to indicate no bitmap.
447 If you use x_create_bitmap_from_data, then you must keep track of
448 the bitmaps yourself. That is, creating a bitmap from the same
449 data more than once will not be caught. */
452 /* Functions to access the contents of a bitmap, given an id. */
455 x_bitmap_height (f
, id
)
459 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
463 x_bitmap_width (f
, id
)
467 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
471 x_bitmap_pixmap (f
, id
)
475 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
479 /* Allocate a new bitmap record. Returns index of new record. */
482 x_allocate_bitmap_record (f
)
485 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
488 if (dpyinfo
->bitmaps
== NULL
)
490 dpyinfo
->bitmaps_size
= 10;
492 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
493 dpyinfo
->bitmaps_last
= 1;
497 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
498 return ++dpyinfo
->bitmaps_last
;
500 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
501 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
504 dpyinfo
->bitmaps_size
*= 2;
506 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
507 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
508 return ++dpyinfo
->bitmaps_last
;
511 /* Add one reference to the reference count of the bitmap with id ID. */
514 x_reference_bitmap (f
, id
)
518 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
521 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
524 x_create_bitmap_from_data (f
, bits
, width
, height
)
527 unsigned int width
, height
;
529 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
533 bitmap
= CreateBitmap (width
, height
,
534 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
535 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
541 id
= x_allocate_bitmap_record (f
);
542 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
543 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
544 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
545 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
546 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
547 dpyinfo
->bitmaps
[id
- 1].height
= height
;
548 dpyinfo
->bitmaps
[id
- 1].width
= width
;
553 /* Create bitmap from file FILE for frame F. */
556 x_create_bitmap_from_file (f
, file
)
561 #if 0 /* TODO : bitmap support */
562 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
563 unsigned int width
, height
;
565 int xhot
, yhot
, result
, id
;
571 /* Look for an existing bitmap with the same name. */
572 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
574 if (dpyinfo
->bitmaps
[id
].refcount
575 && dpyinfo
->bitmaps
[id
].file
576 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
578 ++dpyinfo
->bitmaps
[id
].refcount
;
583 /* Search bitmap-file-path for the file, if appropriate. */
584 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
589 filename
= (char *) XSTRING (found
)->data
;
591 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
597 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
598 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
599 if (result
!= BitmapSuccess
)
602 id
= x_allocate_bitmap_record (f
);
603 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
604 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
605 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
606 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
607 dpyinfo
->bitmaps
[id
- 1].height
= height
;
608 dpyinfo
->bitmaps
[id
- 1].width
= width
;
609 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
615 /* Remove reference to bitmap with id number ID. */
618 x_destroy_bitmap (f
, id
)
622 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
626 --dpyinfo
->bitmaps
[id
- 1].refcount
;
627 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
630 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
631 if (dpyinfo
->bitmaps
[id
- 1].file
)
633 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
634 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
641 /* Free all the bitmaps for the display specified by DPYINFO. */
644 x_destroy_all_bitmaps (dpyinfo
)
645 struct w32_display_info
*dpyinfo
;
648 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
649 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
651 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
652 if (dpyinfo
->bitmaps
[i
].file
)
653 xfree (dpyinfo
->bitmaps
[i
].file
);
655 dpyinfo
->bitmaps_last
= 0;
658 /* Connect the frame-parameter names for W32 frames
659 to the ways of passing the parameter values to the window system.
661 The name of a parameter, as a Lisp symbol,
662 has an `x-frame-parameter' property which is an integer in Lisp
663 but can be interpreted as an `enum x_frame_parm' in C. */
667 X_PARM_FOREGROUND_COLOR
,
668 X_PARM_BACKGROUND_COLOR
,
675 X_PARM_INTERNAL_BORDER_WIDTH
,
679 X_PARM_VERT_SCROLL_BAR
,
681 X_PARM_MENU_BAR_LINES
685 struct x_frame_parm_table
688 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
691 /* TODO: Native Input Method support; see x_create_im. */
692 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
693 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
694 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
695 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
696 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
697 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
698 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
699 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
700 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
701 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
702 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
703 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
705 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
706 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
707 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
708 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
710 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
711 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
712 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
713 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
714 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
715 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
716 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
718 static struct x_frame_parm_table x_frame_parms
[] =
720 "auto-raise", x_set_autoraise
,
721 "auto-lower", x_set_autolower
,
722 "background-color", x_set_background_color
,
723 "border-color", x_set_border_color
,
724 "border-width", x_set_border_width
,
725 "cursor-color", x_set_cursor_color
,
726 "cursor-type", x_set_cursor_type
,
728 "foreground-color", x_set_foreground_color
,
729 "icon-name", x_set_icon_name
,
730 "icon-type", x_set_icon_type
,
731 "internal-border-width", x_set_internal_border_width
,
732 "menu-bar-lines", x_set_menu_bar_lines
,
733 "mouse-color", x_set_mouse_color
,
734 "name", x_explicitly_set_name
,
735 "scroll-bar-width", x_set_scroll_bar_width
,
736 "title", x_set_title
,
737 "unsplittable", x_set_unsplittable
,
738 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
739 "visibility", x_set_visibility
,
740 "tool-bar-lines", x_set_tool_bar_lines
,
741 "screen-gamma", x_set_screen_gamma
,
742 "line-spacing", x_set_line_spacing
745 /* Attach the `x-frame-parameter' properties to
746 the Lisp symbol names of parameters relevant to W32. */
749 init_x_parm_symbols ()
753 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
754 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
758 /* Change the parameters of frame F as specified by ALIST.
759 If a parameter is not specially recognized, do nothing;
760 otherwise call the `x_set_...' function for that parameter. */
763 x_set_frame_parameters (f
, alist
)
769 /* If both of these parameters are present, it's more efficient to
770 set them both at once. So we wait until we've looked at the
771 entire list before we set them. */
775 Lisp_Object left
, top
;
777 /* Same with these. */
778 Lisp_Object icon_left
, icon_top
;
780 /* Record in these vectors all the parms specified. */
784 int left_no_change
= 0, top_no_change
= 0;
785 int icon_left_no_change
= 0, icon_top_no_change
= 0;
787 struct gcpro gcpro1
, gcpro2
;
790 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
793 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
794 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
796 /* Extract parm names and values into those vectors. */
799 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
804 parms
[i
] = Fcar (elt
);
805 values
[i
] = Fcdr (elt
);
808 /* TAIL and ALIST are not used again below here. */
811 GCPRO2 (*parms
, *values
);
815 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
816 because their values appear in VALUES and strings are not valid. */
817 top
= left
= Qunbound
;
818 icon_left
= icon_top
= Qunbound
;
820 /* Provide default values for HEIGHT and WIDTH. */
821 if (FRAME_NEW_WIDTH (f
))
822 width
= FRAME_NEW_WIDTH (f
);
824 width
= FRAME_WIDTH (f
);
826 if (FRAME_NEW_HEIGHT (f
))
827 height
= FRAME_NEW_HEIGHT (f
);
829 height
= FRAME_HEIGHT (f
);
831 /* Process foreground_color and background_color before anything else.
832 They are independent of other properties, but other properties (e.g.,
833 cursor_color) are dependent upon them. */
834 for (p
= 0; p
< i
; p
++)
836 Lisp_Object prop
, val
;
840 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
842 register Lisp_Object param_index
, old_value
;
844 param_index
= Fget (prop
, Qx_frame_parameter
);
845 old_value
= get_frame_param (f
, prop
);
846 store_frame_param (f
, prop
, val
);
847 if (NATNUMP (param_index
)
848 && (XFASTINT (param_index
)
849 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
850 (*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
) || EQ (prop
, Qbackground_color
))
875 /* Processed above. */
879 register Lisp_Object param_index
, old_value
;
881 param_index
= Fget (prop
, Qx_frame_parameter
);
882 old_value
= get_frame_param (f
, prop
);
883 store_frame_param (f
, prop
, val
);
884 if (NATNUMP (param_index
)
885 && (XFASTINT (param_index
)
886 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
887 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
891 /* Don't die if just one of these was set. */
892 if (EQ (left
, Qunbound
))
895 if (f
->output_data
.w32
->left_pos
< 0)
896 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
898 XSETINT (left
, f
->output_data
.w32
->left_pos
);
900 if (EQ (top
, Qunbound
))
903 if (f
->output_data
.w32
->top_pos
< 0)
904 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
906 XSETINT (top
, f
->output_data
.w32
->top_pos
);
909 /* If one of the icon positions was not set, preserve or default it. */
910 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
912 icon_left_no_change
= 1;
913 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
914 if (NILP (icon_left
))
915 XSETINT (icon_left
, 0);
917 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
919 icon_top_no_change
= 1;
920 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
922 XSETINT (icon_top
, 0);
925 /* Don't set these parameters unless they've been explicitly
926 specified. The window might be mapped or resized while we're in
927 this function, and we don't want to override that unless the lisp
928 code has asked for it.
930 Don't set these parameters unless they actually differ from the
931 window's current parameters; the window may not actually exist
936 check_frame_size (f
, &height
, &width
);
938 XSETFRAME (frame
, f
);
940 if (width
!= FRAME_WIDTH (f
)
941 || height
!= FRAME_HEIGHT (f
)
942 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
943 Fset_frame_size (frame
, make_number (width
), make_number (height
));
945 if ((!NILP (left
) || !NILP (top
))
946 && ! (left_no_change
&& top_no_change
)
947 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
948 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
953 /* Record the signs. */
954 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
955 if (EQ (left
, Qminus
))
956 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
957 else if (INTEGERP (left
))
959 leftpos
= XINT (left
);
961 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
963 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
964 && CONSP (XCDR (left
))
965 && INTEGERP (XCAR (XCDR (left
))))
967 leftpos
= - XINT (XCAR (XCDR (left
)));
968 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
970 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
971 && CONSP (XCDR (left
))
972 && INTEGERP (XCAR (XCDR (left
))))
974 leftpos
= XINT (XCAR (XCDR (left
)));
977 if (EQ (top
, Qminus
))
978 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
979 else if (INTEGERP (top
))
983 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
985 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
986 && CONSP (XCDR (top
))
987 && INTEGERP (XCAR (XCDR (top
))))
989 toppos
= - XINT (XCAR (XCDR (top
)));
990 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
992 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
993 && CONSP (XCDR (top
))
994 && INTEGERP (XCAR (XCDR (top
))))
996 toppos
= XINT (XCAR (XCDR (top
)));
1000 /* Store the numeric value of the position. */
1001 f
->output_data
.w32
->top_pos
= toppos
;
1002 f
->output_data
.w32
->left_pos
= leftpos
;
1004 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
1006 /* Actually set that position, and convert to absolute. */
1007 x_set_offset (f
, leftpos
, toppos
, -1);
1010 if ((!NILP (icon_left
) || !NILP (icon_top
))
1011 && ! (icon_left_no_change
&& icon_top_no_change
))
1012 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1018 /* Store the screen positions of frame F into XPTR and YPTR.
1019 These are the positions of the containing window manager window,
1020 not Emacs's own window. */
1023 x_real_positions (f
, xptr
, yptr
)
1032 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
1033 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
1039 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
1045 /* Insert a description of internally-recorded parameters of frame X
1046 into the parameter alist *ALISTPTR that is to be given to the user.
1047 Only parameters that are specific to W32
1048 and whose values are not correctly recorded in the frame's
1049 param_alist need to be considered here. */
1052 x_report_frame_params (f
, alistptr
)
1054 Lisp_Object
*alistptr
;
1059 /* Represent negative positions (off the top or left screen edge)
1060 in a way that Fmodify_frame_parameters will understand correctly. */
1061 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
1062 if (f
->output_data
.w32
->left_pos
>= 0)
1063 store_in_alist (alistptr
, Qleft
, tem
);
1065 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1067 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
1068 if (f
->output_data
.w32
->top_pos
>= 0)
1069 store_in_alist (alistptr
, Qtop
, tem
);
1071 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1073 store_in_alist (alistptr
, Qborder_width
,
1074 make_number (f
->output_data
.w32
->border_width
));
1075 store_in_alist (alistptr
, Qinternal_border_width
,
1076 make_number (f
->output_data
.w32
->internal_border_width
));
1077 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
1078 store_in_alist (alistptr
, Qwindow_id
,
1079 build_string (buf
));
1080 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1081 FRAME_SAMPLE_VISIBILITY (f
);
1082 store_in_alist (alistptr
, Qvisibility
,
1083 (FRAME_VISIBLE_P (f
) ? Qt
1084 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1085 store_in_alist (alistptr
, Qdisplay
,
1086 XCAR (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
));
1090 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
, Sw32_define_rgb_color
, 4, 4, 0,
1091 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
1092 This adds or updates a named color to w32-color-map, making it available for use.\n\
1093 The original entry's RGB ref is returned, or nil if the entry is new.")
1094 (red
, green
, blue
, name
)
1095 Lisp_Object red
, green
, blue
, name
;
1098 Lisp_Object oldrgb
= Qnil
;
1101 CHECK_NUMBER (red
, 0);
1102 CHECK_NUMBER (green
, 0);
1103 CHECK_NUMBER (blue
, 0);
1104 CHECK_STRING (name
, 0);
1106 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
1110 /* replace existing entry in w32-color-map or add new entry. */
1111 entry
= Fassoc (name
, Vw32_color_map
);
1114 entry
= Fcons (name
, rgb
);
1115 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
1119 oldrgb
= Fcdr (entry
);
1120 Fsetcdr (entry
, rgb
);
1128 DEFUN ("w32-load-color-file", Fw32_load_color_file
, Sw32_load_color_file
, 1, 1, 0,
1129 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
1130 Assign this value to w32-color-map to replace the existing color map.\n\
1132 The file should define one named RGB color per line like so:\
1134 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
1136 Lisp_Object filename
;
1139 Lisp_Object cmap
= Qnil
;
1140 Lisp_Object abspath
;
1142 CHECK_STRING (filename
, 0);
1143 abspath
= Fexpand_file_name (filename
, Qnil
);
1145 fp
= fopen (XSTRING (filename
)->data
, "rt");
1149 int red
, green
, blue
;
1154 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
1155 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
1157 char *name
= buf
+ num
;
1158 num
= strlen (name
) - 1;
1159 if (name
[num
] == '\n')
1161 cmap
= Fcons (Fcons (build_string (name
),
1162 make_number (RGB (red
, green
, blue
))),
1174 /* The default colors for the w32 color map */
1175 typedef struct colormap_t
1181 colormap_t w32_color_map
[] =
1183 {"snow" , PALETTERGB (255,250,250)},
1184 {"ghost white" , PALETTERGB (248,248,255)},
1185 {"GhostWhite" , PALETTERGB (248,248,255)},
1186 {"white smoke" , PALETTERGB (245,245,245)},
1187 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1188 {"gainsboro" , PALETTERGB (220,220,220)},
1189 {"floral white" , PALETTERGB (255,250,240)},
1190 {"FloralWhite" , PALETTERGB (255,250,240)},
1191 {"old lace" , PALETTERGB (253,245,230)},
1192 {"OldLace" , PALETTERGB (253,245,230)},
1193 {"linen" , PALETTERGB (250,240,230)},
1194 {"antique white" , PALETTERGB (250,235,215)},
1195 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1196 {"papaya whip" , PALETTERGB (255,239,213)},
1197 {"PapayaWhip" , PALETTERGB (255,239,213)},
1198 {"blanched almond" , PALETTERGB (255,235,205)},
1199 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1200 {"bisque" , PALETTERGB (255,228,196)},
1201 {"peach puff" , PALETTERGB (255,218,185)},
1202 {"PeachPuff" , PALETTERGB (255,218,185)},
1203 {"navajo white" , PALETTERGB (255,222,173)},
1204 {"NavajoWhite" , PALETTERGB (255,222,173)},
1205 {"moccasin" , PALETTERGB (255,228,181)},
1206 {"cornsilk" , PALETTERGB (255,248,220)},
1207 {"ivory" , PALETTERGB (255,255,240)},
1208 {"lemon chiffon" , PALETTERGB (255,250,205)},
1209 {"LemonChiffon" , PALETTERGB (255,250,205)},
1210 {"seashell" , PALETTERGB (255,245,238)},
1211 {"honeydew" , PALETTERGB (240,255,240)},
1212 {"mint cream" , PALETTERGB (245,255,250)},
1213 {"MintCream" , PALETTERGB (245,255,250)},
1214 {"azure" , PALETTERGB (240,255,255)},
1215 {"alice blue" , PALETTERGB (240,248,255)},
1216 {"AliceBlue" , PALETTERGB (240,248,255)},
1217 {"lavender" , PALETTERGB (230,230,250)},
1218 {"lavender blush" , PALETTERGB (255,240,245)},
1219 {"LavenderBlush" , PALETTERGB (255,240,245)},
1220 {"misty rose" , PALETTERGB (255,228,225)},
1221 {"MistyRose" , PALETTERGB (255,228,225)},
1222 {"white" , PALETTERGB (255,255,255)},
1223 {"black" , PALETTERGB ( 0, 0, 0)},
1224 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1225 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1226 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1227 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1228 {"dim gray" , PALETTERGB (105,105,105)},
1229 {"DimGray" , PALETTERGB (105,105,105)},
1230 {"dim grey" , PALETTERGB (105,105,105)},
1231 {"DimGrey" , PALETTERGB (105,105,105)},
1232 {"slate gray" , PALETTERGB (112,128,144)},
1233 {"SlateGray" , PALETTERGB (112,128,144)},
1234 {"slate grey" , PALETTERGB (112,128,144)},
1235 {"SlateGrey" , PALETTERGB (112,128,144)},
1236 {"light slate gray" , PALETTERGB (119,136,153)},
1237 {"LightSlateGray" , PALETTERGB (119,136,153)},
1238 {"light slate grey" , PALETTERGB (119,136,153)},
1239 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1240 {"gray" , PALETTERGB (190,190,190)},
1241 {"grey" , PALETTERGB (190,190,190)},
1242 {"light grey" , PALETTERGB (211,211,211)},
1243 {"LightGrey" , PALETTERGB (211,211,211)},
1244 {"light gray" , PALETTERGB (211,211,211)},
1245 {"LightGray" , PALETTERGB (211,211,211)},
1246 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1247 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1248 {"navy" , PALETTERGB ( 0, 0,128)},
1249 {"navy blue" , PALETTERGB ( 0, 0,128)},
1250 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1251 {"cornflower blue" , PALETTERGB (100,149,237)},
1252 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1253 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1254 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1255 {"slate blue" , PALETTERGB (106, 90,205)},
1256 {"SlateBlue" , PALETTERGB (106, 90,205)},
1257 {"medium slate blue" , PALETTERGB (123,104,238)},
1258 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1259 {"light slate blue" , PALETTERGB (132,112,255)},
1260 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1261 {"medium blue" , PALETTERGB ( 0, 0,205)},
1262 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1263 {"royal blue" , PALETTERGB ( 65,105,225)},
1264 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1265 {"blue" , PALETTERGB ( 0, 0,255)},
1266 {"dodger blue" , PALETTERGB ( 30,144,255)},
1267 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1268 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1269 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1270 {"sky blue" , PALETTERGB (135,206,235)},
1271 {"SkyBlue" , PALETTERGB (135,206,235)},
1272 {"light sky blue" , PALETTERGB (135,206,250)},
1273 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1274 {"steel blue" , PALETTERGB ( 70,130,180)},
1275 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1276 {"light steel blue" , PALETTERGB (176,196,222)},
1277 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1278 {"light blue" , PALETTERGB (173,216,230)},
1279 {"LightBlue" , PALETTERGB (173,216,230)},
1280 {"powder blue" , PALETTERGB (176,224,230)},
1281 {"PowderBlue" , PALETTERGB (176,224,230)},
1282 {"pale turquoise" , PALETTERGB (175,238,238)},
1283 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1284 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1285 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1286 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1287 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1288 {"turquoise" , PALETTERGB ( 64,224,208)},
1289 {"cyan" , PALETTERGB ( 0,255,255)},
1290 {"light cyan" , PALETTERGB (224,255,255)},
1291 {"LightCyan" , PALETTERGB (224,255,255)},
1292 {"cadet blue" , PALETTERGB ( 95,158,160)},
1293 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1294 {"medium aquamarine" , PALETTERGB (102,205,170)},
1295 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1296 {"aquamarine" , PALETTERGB (127,255,212)},
1297 {"dark green" , PALETTERGB ( 0,100, 0)},
1298 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1299 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1300 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1301 {"dark sea green" , PALETTERGB (143,188,143)},
1302 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1303 {"sea green" , PALETTERGB ( 46,139, 87)},
1304 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1305 {"medium sea green" , PALETTERGB ( 60,179,113)},
1306 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1307 {"light sea green" , PALETTERGB ( 32,178,170)},
1308 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1309 {"pale green" , PALETTERGB (152,251,152)},
1310 {"PaleGreen" , PALETTERGB (152,251,152)},
1311 {"spring green" , PALETTERGB ( 0,255,127)},
1312 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1313 {"lawn green" , PALETTERGB (124,252, 0)},
1314 {"LawnGreen" , PALETTERGB (124,252, 0)},
1315 {"green" , PALETTERGB ( 0,255, 0)},
1316 {"chartreuse" , PALETTERGB (127,255, 0)},
1317 {"medium spring green" , PALETTERGB ( 0,250,154)},
1318 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1319 {"green yellow" , PALETTERGB (173,255, 47)},
1320 {"GreenYellow" , PALETTERGB (173,255, 47)},
1321 {"lime green" , PALETTERGB ( 50,205, 50)},
1322 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1323 {"yellow green" , PALETTERGB (154,205, 50)},
1324 {"YellowGreen" , PALETTERGB (154,205, 50)},
1325 {"forest green" , PALETTERGB ( 34,139, 34)},
1326 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1327 {"olive drab" , PALETTERGB (107,142, 35)},
1328 {"OliveDrab" , PALETTERGB (107,142, 35)},
1329 {"dark khaki" , PALETTERGB (189,183,107)},
1330 {"DarkKhaki" , PALETTERGB (189,183,107)},
1331 {"khaki" , PALETTERGB (240,230,140)},
1332 {"pale goldenrod" , PALETTERGB (238,232,170)},
1333 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1334 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1335 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1336 {"light yellow" , PALETTERGB (255,255,224)},
1337 {"LightYellow" , PALETTERGB (255,255,224)},
1338 {"yellow" , PALETTERGB (255,255, 0)},
1339 {"gold" , PALETTERGB (255,215, 0)},
1340 {"light goldenrod" , PALETTERGB (238,221,130)},
1341 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1342 {"goldenrod" , PALETTERGB (218,165, 32)},
1343 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1344 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1345 {"rosy brown" , PALETTERGB (188,143,143)},
1346 {"RosyBrown" , PALETTERGB (188,143,143)},
1347 {"indian red" , PALETTERGB (205, 92, 92)},
1348 {"IndianRed" , PALETTERGB (205, 92, 92)},
1349 {"saddle brown" , PALETTERGB (139, 69, 19)},
1350 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1351 {"sienna" , PALETTERGB (160, 82, 45)},
1352 {"peru" , PALETTERGB (205,133, 63)},
1353 {"burlywood" , PALETTERGB (222,184,135)},
1354 {"beige" , PALETTERGB (245,245,220)},
1355 {"wheat" , PALETTERGB (245,222,179)},
1356 {"sandy brown" , PALETTERGB (244,164, 96)},
1357 {"SandyBrown" , PALETTERGB (244,164, 96)},
1358 {"tan" , PALETTERGB (210,180,140)},
1359 {"chocolate" , PALETTERGB (210,105, 30)},
1360 {"firebrick" , PALETTERGB (178,34, 34)},
1361 {"brown" , PALETTERGB (165,42, 42)},
1362 {"dark salmon" , PALETTERGB (233,150,122)},
1363 {"DarkSalmon" , PALETTERGB (233,150,122)},
1364 {"salmon" , PALETTERGB (250,128,114)},
1365 {"light salmon" , PALETTERGB (255,160,122)},
1366 {"LightSalmon" , PALETTERGB (255,160,122)},
1367 {"orange" , PALETTERGB (255,165, 0)},
1368 {"dark orange" , PALETTERGB (255,140, 0)},
1369 {"DarkOrange" , PALETTERGB (255,140, 0)},
1370 {"coral" , PALETTERGB (255,127, 80)},
1371 {"light coral" , PALETTERGB (240,128,128)},
1372 {"LightCoral" , PALETTERGB (240,128,128)},
1373 {"tomato" , PALETTERGB (255, 99, 71)},
1374 {"orange red" , PALETTERGB (255, 69, 0)},
1375 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1376 {"red" , PALETTERGB (255, 0, 0)},
1377 {"hot pink" , PALETTERGB (255,105,180)},
1378 {"HotPink" , PALETTERGB (255,105,180)},
1379 {"deep pink" , PALETTERGB (255, 20,147)},
1380 {"DeepPink" , PALETTERGB (255, 20,147)},
1381 {"pink" , PALETTERGB (255,192,203)},
1382 {"light pink" , PALETTERGB (255,182,193)},
1383 {"LightPink" , PALETTERGB (255,182,193)},
1384 {"pale violet red" , PALETTERGB (219,112,147)},
1385 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1386 {"maroon" , PALETTERGB (176, 48, 96)},
1387 {"medium violet red" , PALETTERGB (199, 21,133)},
1388 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1389 {"violet red" , PALETTERGB (208, 32,144)},
1390 {"VioletRed" , PALETTERGB (208, 32,144)},
1391 {"magenta" , PALETTERGB (255, 0,255)},
1392 {"violet" , PALETTERGB (238,130,238)},
1393 {"plum" , PALETTERGB (221,160,221)},
1394 {"orchid" , PALETTERGB (218,112,214)},
1395 {"medium orchid" , PALETTERGB (186, 85,211)},
1396 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1397 {"dark orchid" , PALETTERGB (153, 50,204)},
1398 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1399 {"dark violet" , PALETTERGB (148, 0,211)},
1400 {"DarkViolet" , PALETTERGB (148, 0,211)},
1401 {"blue violet" , PALETTERGB (138, 43,226)},
1402 {"BlueViolet" , PALETTERGB (138, 43,226)},
1403 {"purple" , PALETTERGB (160, 32,240)},
1404 {"medium purple" , PALETTERGB (147,112,219)},
1405 {"MediumPurple" , PALETTERGB (147,112,219)},
1406 {"thistle" , PALETTERGB (216,191,216)},
1407 {"gray0" , PALETTERGB ( 0, 0, 0)},
1408 {"grey0" , PALETTERGB ( 0, 0, 0)},
1409 {"dark grey" , PALETTERGB (169,169,169)},
1410 {"DarkGrey" , PALETTERGB (169,169,169)},
1411 {"dark gray" , PALETTERGB (169,169,169)},
1412 {"DarkGray" , PALETTERGB (169,169,169)},
1413 {"dark blue" , PALETTERGB ( 0, 0,139)},
1414 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1415 {"dark cyan" , PALETTERGB ( 0,139,139)},
1416 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1417 {"dark magenta" , PALETTERGB (139, 0,139)},
1418 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1419 {"dark red" , PALETTERGB (139, 0, 0)},
1420 {"DarkRed" , PALETTERGB (139, 0, 0)},
1421 {"light green" , PALETTERGB (144,238,144)},
1422 {"LightGreen" , PALETTERGB (144,238,144)},
1425 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1426 0, 0, 0, "Return the default color map.")
1430 colormap_t
*pc
= w32_color_map
;
1437 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1439 cmap
= Fcons (Fcons (build_string (pc
->name
),
1440 make_number (pc
->colorref
)),
1449 w32_to_x_color (rgb
)
1454 CHECK_NUMBER (rgb
, 0);
1458 color
= Frassq (rgb
, Vw32_color_map
);
1463 return (Fcar (color
));
1469 w32_color_map_lookup (colorname
)
1472 Lisp_Object tail
, ret
= Qnil
;
1476 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1478 register Lisp_Object elt
, tem
;
1481 if (!CONSP (elt
)) continue;
1485 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1487 ret
= XUINT (Fcdr (elt
));
1501 x_to_w32_color (colorname
)
1504 register Lisp_Object tail
, ret
= Qnil
;
1508 if (colorname
[0] == '#')
1510 /* Could be an old-style RGB Device specification. */
1513 color
= colorname
+ 1;
1515 size
= strlen(color
);
1516 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1524 for (i
= 0; i
< 3; i
++)
1528 unsigned long value
;
1530 /* The check for 'x' in the following conditional takes into
1531 account the fact that strtol allows a "0x" in front of
1532 our numbers, and we don't. */
1533 if (!isxdigit(color
[0]) || color
[1] == 'x')
1537 value
= strtoul(color
, &end
, 16);
1539 if (errno
== ERANGE
|| end
- color
!= size
)
1544 value
= value
* 0x10;
1555 colorval
|= (value
<< pos
);
1566 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1574 color
= colorname
+ 4;
1575 for (i
= 0; i
< 3; i
++)
1578 unsigned long value
;
1580 /* The check for 'x' in the following conditional takes into
1581 account the fact that strtol allows a "0x" in front of
1582 our numbers, and we don't. */
1583 if (!isxdigit(color
[0]) || color
[1] == 'x')
1585 value
= strtoul(color
, &end
, 16);
1586 if (errno
== ERANGE
)
1588 switch (end
- color
)
1591 value
= value
* 0x10 + value
;
1604 if (value
== ULONG_MAX
)
1606 colorval
|= (value
<< pos
);
1620 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1622 /* This is an RGB Intensity specification. */
1629 color
= colorname
+ 5;
1630 for (i
= 0; i
< 3; i
++)
1636 value
= strtod(color
, &end
);
1637 if (errno
== ERANGE
)
1639 if (value
< 0.0 || value
> 1.0)
1641 val
= (UINT
)(0x100 * value
);
1642 /* We used 0x100 instead of 0xFF to give an continuous
1643 range between 0.0 and 1.0 inclusive. The next statement
1644 fixes the 1.0 case. */
1647 colorval
|= (val
<< pos
);
1661 /* I am not going to attempt to handle any of the CIE color schemes
1662 or TekHVC, since I don't know the algorithms for conversion to
1665 /* If we fail to lookup the color name in w32_color_map, then check the
1666 colorname to see if it can be crudely approximated: If the X color
1667 ends in a number (e.g., "darkseagreen2"), strip the number and
1668 return the result of looking up the base color name. */
1669 ret
= w32_color_map_lookup (colorname
);
1672 int len
= strlen (colorname
);
1674 if (isdigit (colorname
[len
- 1]))
1676 char *ptr
, *approx
= alloca (len
);
1678 strcpy (approx
, colorname
);
1679 ptr
= &approx
[len
- 1];
1680 while (ptr
> approx
&& isdigit (*ptr
))
1683 ret
= w32_color_map_lookup (approx
);
1693 w32_regenerate_palette (FRAME_PTR f
)
1695 struct w32_palette_entry
* list
;
1696 LOGPALETTE
* log_palette
;
1697 HPALETTE new_palette
;
1700 /* don't bother trying to create palette if not supported */
1701 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1704 log_palette
= (LOGPALETTE
*)
1705 alloca (sizeof (LOGPALETTE
) +
1706 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1707 log_palette
->palVersion
= 0x300;
1708 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1710 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1712 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1713 i
++, list
= list
->next
)
1714 log_palette
->palPalEntry
[i
] = list
->entry
;
1716 new_palette
= CreatePalette (log_palette
);
1720 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1721 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1722 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1724 /* Realize display palette and garbage all frames. */
1725 release_frame_dc (f
, get_frame_dc (f
));
1730 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1731 #define SET_W32_COLOR(pe, color) \
1734 pe.peRed = GetRValue (color); \
1735 pe.peGreen = GetGValue (color); \
1736 pe.peBlue = GetBValue (color); \
1741 /* Keep these around in case we ever want to track color usage. */
1743 w32_map_color (FRAME_PTR f
, COLORREF color
)
1745 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1747 if (NILP (Vw32_enable_palette
))
1750 /* check if color is already mapped */
1753 if (W32_COLOR (list
->entry
) == color
)
1761 /* not already mapped, so add to list and recreate Windows palette */
1762 list
= (struct w32_palette_entry
*)
1763 xmalloc (sizeof (struct w32_palette_entry
));
1764 SET_W32_COLOR (list
->entry
, color
);
1766 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1767 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1768 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1770 /* set flag that palette must be regenerated */
1771 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1775 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1777 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1778 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1780 if (NILP (Vw32_enable_palette
))
1783 /* check if color is already mapped */
1786 if (W32_COLOR (list
->entry
) == color
)
1788 if (--list
->refcount
== 0)
1792 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1802 /* set flag that palette must be regenerated */
1803 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1808 /* Gamma-correct COLOR on frame F. */
1811 gamma_correct (f
, color
)
1817 *color
= PALETTERGB (
1818 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1819 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1820 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1825 /* Decide if color named COLOR is valid for the display associated with
1826 the selected frame; if so, return the rgb values in COLOR_DEF.
1827 If ALLOC is nonzero, allocate a new colormap cell. */
1830 w32_defined_color (f
, color
, color_def
, alloc
)
1836 register Lisp_Object tem
;
1837 COLORREF w32_color_ref
;
1839 tem
= x_to_w32_color (color
);
1845 /* Apply gamma correction. */
1846 w32_color_ref
= XUINT (tem
);
1847 gamma_correct (f
, &w32_color_ref
);
1848 XSETINT (tem
, w32_color_ref
);
1851 /* Map this color to the palette if it is enabled. */
1852 if (!NILP (Vw32_enable_palette
))
1854 struct w32_palette_entry
* entry
=
1855 one_w32_display_info
.color_list
;
1856 struct w32_palette_entry
** prev
=
1857 &one_w32_display_info
.color_list
;
1859 /* check if color is already mapped */
1862 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1864 prev
= &entry
->next
;
1865 entry
= entry
->next
;
1868 if (entry
== NULL
&& alloc
)
1870 /* not already mapped, so add to list */
1871 entry
= (struct w32_palette_entry
*)
1872 xmalloc (sizeof (struct w32_palette_entry
));
1873 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1876 one_w32_display_info
.num_colors
++;
1878 /* set flag that palette must be regenerated */
1879 one_w32_display_info
.regen_palette
= TRUE
;
1882 /* Ensure COLORREF value is snapped to nearest color in (default)
1883 palette by simulating the PALETTERGB macro. This works whether
1884 or not the display device has a palette. */
1885 w32_color_ref
= XUINT (tem
) | 0x2000000;
1887 color_def
->pixel
= w32_color_ref
;
1888 color_def
->red
= GetRValue (w32_color_ref
);
1889 color_def
->green
= GetGValue (w32_color_ref
);
1890 color_def
->blue
= GetBValue (w32_color_ref
);
1900 /* Given a string ARG naming a color, compute a pixel value from it
1901 suitable for screen F.
1902 If F is not a color screen, return DEF (default) regardless of what
1906 x_decode_color (f
, arg
, def
)
1913 CHECK_STRING (arg
, 0);
1915 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1916 return BLACK_PIX_DEFAULT (f
);
1917 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1918 return WHITE_PIX_DEFAULT (f
);
1920 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1923 /* w32_defined_color is responsible for coping with failures
1924 by looking for a near-miss. */
1925 if (w32_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1928 /* defined_color failed; return an ultimate default. */
1932 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1933 the previous value of that parameter, NEW_VALUE is the new value. */
1936 x_set_line_spacing (f
, new_value
, old_value
)
1938 Lisp_Object new_value
, old_value
;
1940 if (NILP (new_value
))
1941 f
->extra_line_spacing
= 0;
1942 else if (NATNUMP (new_value
))
1943 f
->extra_line_spacing
= XFASTINT (new_value
);
1945 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1946 Fcons (new_value
, Qnil
)));
1947 if (FRAME_VISIBLE_P (f
))
1952 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1953 the previous value of that parameter, NEW_VALUE is the new value. */
1956 x_set_screen_gamma (f
, new_value
, old_value
)
1958 Lisp_Object new_value
, old_value
;
1960 if (NILP (new_value
))
1962 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1963 /* The value 0.4545 is the normal viewing gamma. */
1964 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1966 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1967 Fcons (new_value
, Qnil
)));
1969 clear_face_cache (0);
1973 /* Functions called only from `x_set_frame_param'
1974 to set individual parameters.
1976 If FRAME_W32_WINDOW (f) is 0,
1977 the frame is being created and its window does not exist yet.
1978 In that case, just record the parameter's new value
1979 in the standard place; do not attempt to change the window. */
1982 x_set_foreground_color (f
, arg
, oldval
)
1984 Lisp_Object arg
, oldval
;
1986 FRAME_FOREGROUND_PIXEL (f
)
1987 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1989 if (FRAME_W32_WINDOW (f
) != 0)
1991 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1992 if (FRAME_VISIBLE_P (f
))
1998 x_set_background_color (f
, arg
, oldval
)
2000 Lisp_Object arg
, oldval
;
2002 FRAME_BACKGROUND_PIXEL (f
)
2003 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
2005 if (FRAME_W32_WINDOW (f
) != 0)
2007 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
2008 FRAME_BACKGROUND_PIXEL (f
));
2010 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
2012 if (FRAME_VISIBLE_P (f
))
2018 x_set_mouse_color (f
, arg
, oldval
)
2020 Lisp_Object arg
, oldval
;
2022 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
2026 if (!EQ (Qnil
, arg
))
2027 f
->output_data
.w32
->mouse_pixel
2028 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2029 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
2031 /* Don't let pointers be invisible. */
2032 if (mask_color
== f
->output_data
.w32
->mouse_pixel
2033 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
2034 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
2036 #if 0 /* TODO : cursor changes */
2039 /* It's not okay to crash if the user selects a screwy cursor. */
2040 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
2042 if (!EQ (Qnil
, Vx_pointer_shape
))
2044 CHECK_NUMBER (Vx_pointer_shape
, 0);
2045 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
2048 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2049 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
2051 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
2053 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
2054 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2055 XINT (Vx_nontext_pointer_shape
));
2058 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
2059 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2061 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
2063 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
2064 busy_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2065 XINT (Vx_busy_pointer_shape
));
2068 busy_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
2069 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
2071 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2072 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
2074 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
2075 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2076 XINT (Vx_mode_pointer_shape
));
2079 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2080 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
2082 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
2084 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
2086 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2087 XINT (Vx_sensitive_text_pointer_shape
));
2090 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
2092 if (!NILP (Vx_window_horizontal_drag_shape
))
2094 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
2095 horizontal_drag_cursor
2096 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
2097 XINT (Vx_window_horizontal_drag_shape
));
2100 horizontal_drag_cursor
2101 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
2103 /* Check and report errors with the above calls. */
2104 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
2105 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
2108 XColor fore_color
, back_color
;
2110 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
2111 back_color
.pixel
= mask_color
;
2112 XQueryColor (FRAME_W32_DISPLAY (f
),
2113 DefaultColormap (FRAME_W32_DISPLAY (f
),
2114 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2116 XQueryColor (FRAME_W32_DISPLAY (f
),
2117 DefaultColormap (FRAME_W32_DISPLAY (f
),
2118 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2120 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
2121 &fore_color
, &back_color
);
2122 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
2123 &fore_color
, &back_color
);
2124 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
2125 &fore_color
, &back_color
);
2126 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
2127 &fore_color
, &back_color
);
2128 XRecolorCursor (FRAME_W32_DISPLAY (f
), busy_cursor
,
2129 &fore_color
, &back_color
);
2132 if (FRAME_W32_WINDOW (f
) != 0)
2133 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
2135 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
2136 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
2137 f
->output_data
.w32
->text_cursor
= cursor
;
2139 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
2140 && f
->output_data
.w32
->nontext_cursor
!= 0)
2141 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
2142 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
2144 if (busy_cursor
!= f
->output_data
.w32
->busy_cursor
2145 && f
->output_data
.w32
->busy_cursor
!= 0)
2146 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->busy_cursor
);
2147 f
->output_data
.w32
->busy_cursor
= busy_cursor
;
2149 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
2150 && f
->output_data
.w32
->modeline_cursor
!= 0)
2151 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
2152 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
2154 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
2155 && f
->output_data
.w32
->cross_cursor
!= 0)
2156 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
2157 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
2159 XFlush (FRAME_W32_DISPLAY (f
));
2162 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
2166 /* Defined in w32term.c. */
2167 void x_update_cursor (struct frame
*f
, int on_p
);
2170 x_set_cursor_color (f
, arg
, oldval
)
2172 Lisp_Object arg
, oldval
;
2174 unsigned long fore_pixel
, pixel
;
2176 if (!NILP (Vx_cursor_fore_pixel
))
2177 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
2178 WHITE_PIX_DEFAULT (f
));
2180 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2182 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2184 /* Make sure that the cursor color differs from the background color. */
2185 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
2187 pixel
= f
->output_data
.w32
->mouse_pixel
;
2188 if (pixel
== fore_pixel
)
2189 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2192 FRAME_FOREGROUND_PIXEL (f
) = fore_pixel
;
2193 f
->output_data
.w32
->cursor_pixel
= pixel
;
2195 if (FRAME_W32_WINDOW (f
) != 0)
2197 if (FRAME_VISIBLE_P (f
))
2199 x_update_cursor (f
, 0);
2200 x_update_cursor (f
, 1);
2204 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
2207 /* Set the border-color of frame F to pixel value PIX.
2208 Note that this does not fully take effect if done before
2211 x_set_border_pixel (f
, pix
)
2215 f
->output_data
.w32
->border_pixel
= pix
;
2217 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
2219 if (FRAME_VISIBLE_P (f
))
2224 /* Set the border-color of frame F to value described by ARG.
2225 ARG can be a string naming a color.
2226 The border-color is used for the border that is drawn by the server.
2227 Note that this does not fully take effect if done before
2228 F has a window; it must be redone when the window is created. */
2231 x_set_border_color (f
, arg
, oldval
)
2233 Lisp_Object arg
, oldval
;
2237 CHECK_STRING (arg
, 0);
2238 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2239 x_set_border_pixel (f
, pix
);
2240 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
2243 /* Value is the internal representation of the specified cursor type
2244 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
2245 of the bar cursor. */
2247 enum text_cursor_kinds
2248 x_specified_cursor_type (arg
, width
)
2252 enum text_cursor_kinds type
;
2259 else if (CONSP (arg
)
2260 && EQ (XCAR (arg
), Qbar
)
2261 && INTEGERP (XCDR (arg
))
2262 && XINT (XCDR (arg
)) >= 0)
2265 *width
= XINT (XCDR (arg
));
2267 else if (NILP (arg
))
2270 /* Treat anything unknown as "box cursor".
2271 It was bad to signal an error; people have trouble fixing
2272 .Xdefaults with Emacs, when it has something bad in it. */
2273 type
= FILLED_BOX_CURSOR
;
2279 x_set_cursor_type (f
, arg
, oldval
)
2281 Lisp_Object arg
, oldval
;
2285 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
2286 f
->output_data
.w32
->cursor_width
= width
;
2288 /* Make sure the cursor gets redrawn. This is overkill, but how
2289 often do people change cursor types? */
2290 update_mode_lines
++;
2294 x_set_icon_type (f
, arg
, oldval
)
2296 Lisp_Object arg
, oldval
;
2300 if (NILP (arg
) && NILP (oldval
))
2303 if (STRINGP (arg
) && STRINGP (oldval
)
2304 && EQ (Fstring_equal (oldval
, arg
), Qt
))
2307 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
2312 result
= x_bitmap_icon (f
, arg
);
2316 error ("No icon window available");
2322 /* Return non-nil if frame F wants a bitmap icon. */
2330 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
2338 x_set_icon_name (f
, arg
, oldval
)
2340 Lisp_Object arg
, oldval
;
2346 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2349 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2355 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2360 result
= x_text_icon (f
,
2361 (char *) XSTRING ((!NILP (f
->icon_name
)
2370 error ("No icon window available");
2373 /* If the window was unmapped (and its icon was mapped),
2374 the new icon is not mapped, so map the window in its stead. */
2375 if (FRAME_VISIBLE_P (f
))
2377 #ifdef USE_X_TOOLKIT
2378 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2380 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2383 XFlush (FRAME_W32_DISPLAY (f
));
2388 extern Lisp_Object
x_new_font ();
2389 extern Lisp_Object
x_new_fontset();
2392 x_set_font (f
, arg
, oldval
)
2394 Lisp_Object arg
, oldval
;
2397 Lisp_Object fontset_name
;
2400 CHECK_STRING (arg
, 1);
2402 fontset_name
= Fquery_fontset (arg
, Qnil
);
2405 result
= (STRINGP (fontset_name
)
2406 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
2407 : x_new_font (f
, XSTRING (arg
)->data
));
2410 if (EQ (result
, Qnil
))
2411 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
2412 else if (EQ (result
, Qt
))
2413 error ("The characters of the given font have varying widths");
2414 else if (STRINGP (result
))
2416 store_frame_param (f
, Qfont
, result
);
2417 recompute_basic_faces (f
);
2422 do_pending_window_change (0);
2424 /* Don't call `face-set-after-frame-default' when faces haven't been
2425 initialized yet. This is the case when called from
2426 Fx_create_frame. In that case, the X widget or window doesn't
2427 exist either, and we can end up in x_report_frame_params with a
2428 null widget which gives a segfault. */
2429 if (FRAME_FACE_CACHE (f
))
2431 XSETFRAME (frame
, f
);
2432 call1 (Qface_set_after_frame_default
, frame
);
2437 x_set_border_width (f
, arg
, oldval
)
2439 Lisp_Object arg
, oldval
;
2441 CHECK_NUMBER (arg
, 0);
2443 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2446 if (FRAME_W32_WINDOW (f
) != 0)
2447 error ("Cannot change the border width of a window");
2449 f
->output_data
.w32
->border_width
= XINT (arg
);
2453 x_set_internal_border_width (f
, arg
, oldval
)
2455 Lisp_Object arg
, oldval
;
2457 int old
= f
->output_data
.w32
->internal_border_width
;
2459 CHECK_NUMBER (arg
, 0);
2460 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2461 if (f
->output_data
.w32
->internal_border_width
< 0)
2462 f
->output_data
.w32
->internal_border_width
= 0;
2464 if (f
->output_data
.w32
->internal_border_width
== old
)
2467 if (FRAME_W32_WINDOW (f
) != 0)
2469 x_set_window_size (f
, 0, f
->width
, f
->height
);
2470 SET_FRAME_GARBAGED (f
);
2471 do_pending_window_change (0);
2476 x_set_visibility (f
, value
, oldval
)
2478 Lisp_Object value
, oldval
;
2481 XSETFRAME (frame
, f
);
2484 Fmake_frame_invisible (frame
, Qt
);
2485 else if (EQ (value
, Qicon
))
2486 Ficonify_frame (frame
);
2488 Fmake_frame_visible (frame
);
2492 /* Change window heights in windows rooted in WINDOW by N lines. */
2495 x_change_window_heights (window
, n
)
2499 struct window
*w
= XWINDOW (window
);
2501 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2502 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2504 if (INTEGERP (w
->orig_top
))
2505 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2506 if (INTEGERP (w
->orig_height
))
2507 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2509 /* Handle just the top child in a vertical split. */
2510 if (!NILP (w
->vchild
))
2511 x_change_window_heights (w
->vchild
, n
);
2513 /* Adjust all children in a horizontal split. */
2514 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2516 w
= XWINDOW (window
);
2517 x_change_window_heights (window
, n
);
2522 x_set_menu_bar_lines (f
, value
, oldval
)
2524 Lisp_Object value
, oldval
;
2527 int olines
= FRAME_MENU_BAR_LINES (f
);
2529 /* Right now, menu bars don't work properly in minibuf-only frames;
2530 most of the commands try to apply themselves to the minibuffer
2531 frame itself, and get an error because you can't switch buffers
2532 in or split the minibuffer window. */
2533 if (FRAME_MINIBUF_ONLY_P (f
))
2536 if (INTEGERP (value
))
2537 nlines
= XINT (value
);
2541 FRAME_MENU_BAR_LINES (f
) = 0;
2543 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2546 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2547 free_frame_menubar (f
);
2548 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2550 /* Adjust the frame size so that the client (text) dimensions
2551 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2553 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2554 do_pending_window_change (0);
2560 /* Set the number of lines used for the tool bar of frame F to VALUE.
2561 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2562 is the old number of tool bar lines. This function changes the
2563 height of all windows on frame F to match the new tool bar height.
2564 The frame's height doesn't change. */
2567 x_set_tool_bar_lines (f
, value
, oldval
)
2569 Lisp_Object value
, oldval
;
2571 int delta
, nlines
, root_height
;
2572 Lisp_Object root_window
;
2574 /* Use VALUE only if an integer >= 0. */
2575 if (INTEGERP (value
) && XINT (value
) >= 0)
2576 nlines
= XFASTINT (value
);
2580 /* Make sure we redisplay all windows in this frame. */
2581 ++windows_or_buffers_changed
;
2583 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2585 /* Don't resize the tool-bar to more than we have room for. */
2586 root_window
= FRAME_ROOT_WINDOW (f
);
2587 root_height
= XINT (XWINDOW (root_window
)->height
);
2588 if (root_height
- delta
< 1)
2590 delta
= root_height
- 1;
2591 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2594 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2595 x_change_window_heights (root_window
, delta
);
2598 /* We also have to make sure that the internal border at the top of
2599 the frame, below the menu bar or tool bar, is redrawn when the
2600 tool bar disappears. This is so because the internal border is
2601 below the tool bar if one is displayed, but is below the menu bar
2602 if there isn't a tool bar. The tool bar draws into the area
2603 below the menu bar. */
2604 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2608 clear_current_matrices (f
);
2609 updating_frame
= NULL
;
2612 /* If the tool bar gets smaller, the internal border below it
2613 has to be cleared. It was formerly part of the display
2614 of the larger tool bar, and updating windows won't clear it. */
2617 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2618 int width
= PIXEL_WIDTH (f
);
2619 int y
= nlines
* CANON_Y_UNIT (f
);
2623 HDC hdc
= get_frame_dc (f
);
2624 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
2625 release_frame_dc (f
, hdc
);
2632 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2635 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2636 name; if NAME is a string, set F's name to NAME and set
2637 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2639 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2640 suggesting a new name, which lisp code should override; if
2641 F->explicit_name is set, ignore the new name; otherwise, set it. */
2644 x_set_name (f
, name
, explicit)
2649 /* Make sure that requests from lisp code override requests from
2650 Emacs redisplay code. */
2653 /* If we're switching from explicit to implicit, we had better
2654 update the mode lines and thereby update the title. */
2655 if (f
->explicit_name
&& NILP (name
))
2656 update_mode_lines
= 1;
2658 f
->explicit_name
= ! NILP (name
);
2660 else if (f
->explicit_name
)
2663 /* If NAME is nil, set the name to the w32_id_name. */
2666 /* Check for no change needed in this very common case
2667 before we do any consing. */
2668 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2669 XSTRING (f
->name
)->data
))
2671 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2674 CHECK_STRING (name
, 0);
2676 /* Don't change the name if it's already NAME. */
2677 if (! NILP (Fstring_equal (name
, f
->name
)))
2682 /* For setting the frame title, the title parameter should override
2683 the name parameter. */
2684 if (! NILP (f
->title
))
2687 if (FRAME_W32_WINDOW (f
))
2689 if (STRING_MULTIBYTE (name
))
2690 name
= ENCODE_SYSTEM (name
);
2693 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2698 /* This function should be called when the user's lisp code has
2699 specified a name for the frame; the name will override any set by the
2702 x_explicitly_set_name (f
, arg
, oldval
)
2704 Lisp_Object arg
, oldval
;
2706 x_set_name (f
, arg
, 1);
2709 /* This function should be called by Emacs redisplay code to set the
2710 name; names set this way will never override names set by the user's
2713 x_implicitly_set_name (f
, arg
, oldval
)
2715 Lisp_Object arg
, oldval
;
2717 x_set_name (f
, arg
, 0);
2720 /* Change the title of frame F to NAME.
2721 If NAME is nil, use the frame name as the title.
2723 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2724 name; if NAME is a string, set F's name to NAME and set
2725 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2727 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2728 suggesting a new name, which lisp code should override; if
2729 F->explicit_name is set, ignore the new name; otherwise, set it. */
2732 x_set_title (f
, name
, old_name
)
2734 Lisp_Object name
, old_name
;
2736 /* Don't change the title if it's already NAME. */
2737 if (EQ (name
, f
->title
))
2740 update_mode_lines
= 1;
2747 if (FRAME_W32_WINDOW (f
))
2749 if (STRING_MULTIBYTE (name
))
2750 name
= ENCODE_SYSTEM (name
);
2753 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2759 x_set_autoraise (f
, arg
, oldval
)
2761 Lisp_Object arg
, oldval
;
2763 f
->auto_raise
= !EQ (Qnil
, arg
);
2767 x_set_autolower (f
, arg
, oldval
)
2769 Lisp_Object arg
, oldval
;
2771 f
->auto_lower
= !EQ (Qnil
, arg
);
2775 x_set_unsplittable (f
, arg
, oldval
)
2777 Lisp_Object arg
, oldval
;
2779 f
->no_split
= !NILP (arg
);
2783 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2785 Lisp_Object arg
, oldval
;
2787 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2788 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2789 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2790 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2792 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2793 vertical_scroll_bar_none
:
2794 /* Put scroll bars on the right by default, as is conventional
2797 ? vertical_scroll_bar_left
2798 : vertical_scroll_bar_right
;
2800 /* We set this parameter before creating the window for the
2801 frame, so we can get the geometry right from the start.
2802 However, if the window hasn't been created yet, we shouldn't
2803 call x_set_window_size. */
2804 if (FRAME_W32_WINDOW (f
))
2805 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2806 do_pending_window_change (0);
2811 x_set_scroll_bar_width (f
, arg
, oldval
)
2813 Lisp_Object arg
, oldval
;
2815 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2819 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
2820 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) +
2822 if (FRAME_W32_WINDOW (f
))
2823 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2824 do_pending_window_change (0);
2826 else if (INTEGERP (arg
) && XINT (arg
) > 0
2827 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2829 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2830 FRAME_SCROLL_BAR_COLS (f
) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2832 if (FRAME_W32_WINDOW (f
))
2833 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2834 do_pending_window_change (0);
2836 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2837 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2838 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2841 /* Subroutines of creating an frame. */
2843 /* Make sure that Vx_resource_name is set to a reasonable value.
2844 Fix it up, or set it to `emacs' if it is too hopeless. */
2847 validate_x_resource_name ()
2850 /* Number of valid characters in the resource name. */
2852 /* Number of invalid characters in the resource name. */
2857 if (STRINGP (Vx_resource_name
))
2859 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2862 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2864 /* Only letters, digits, - and _ are valid in resource names.
2865 Count the valid characters and count the invalid ones. */
2866 for (i
= 0; i
< len
; i
++)
2869 if (! ((c
>= 'a' && c
<= 'z')
2870 || (c
>= 'A' && c
<= 'Z')
2871 || (c
>= '0' && c
<= '9')
2872 || c
== '-' || c
== '_'))
2879 /* Not a string => completely invalid. */
2880 bad_count
= 5, good_count
= 0;
2882 /* If name is valid already, return. */
2886 /* If name is entirely invalid, or nearly so, use `emacs'. */
2888 || (good_count
== 1 && bad_count
> 0))
2890 Vx_resource_name
= build_string ("emacs");
2894 /* Name is partly valid. Copy it and replace the invalid characters
2895 with underscores. */
2897 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2899 for (i
= 0; i
< len
; i
++)
2901 int c
= XSTRING (new)->data
[i
];
2902 if (! ((c
>= 'a' && c
<= 'z')
2903 || (c
>= 'A' && c
<= 'Z')
2904 || (c
>= '0' && c
<= '9')
2905 || c
== '-' || c
== '_'))
2906 XSTRING (new)->data
[i
] = '_';
2911 extern char *x_get_string_resource ();
2913 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2914 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2915 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2916 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2917 the name specified by the `-name' or `-rn' command-line arguments.\n\
2919 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2920 class, respectively. You must specify both of them or neither.\n\
2921 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2922 and the class is `Emacs.CLASS.SUBCLASS'.")
2923 (attribute
, class, component
, subclass
)
2924 Lisp_Object attribute
, class, component
, subclass
;
2926 register char *value
;
2930 CHECK_STRING (attribute
, 0);
2931 CHECK_STRING (class, 0);
2933 if (!NILP (component
))
2934 CHECK_STRING (component
, 1);
2935 if (!NILP (subclass
))
2936 CHECK_STRING (subclass
, 2);
2937 if (NILP (component
) != NILP (subclass
))
2938 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2940 validate_x_resource_name ();
2942 /* Allocate space for the components, the dots which separate them,
2943 and the final '\0'. Make them big enough for the worst case. */
2944 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2945 + (STRINGP (component
)
2946 ? STRING_BYTES (XSTRING (component
)) : 0)
2947 + STRING_BYTES (XSTRING (attribute
))
2950 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2951 + STRING_BYTES (XSTRING (class))
2952 + (STRINGP (subclass
)
2953 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2956 /* Start with emacs.FRAMENAME for the name (the specific one)
2957 and with `Emacs' for the class key (the general one). */
2958 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2959 strcpy (class_key
, EMACS_CLASS
);
2961 strcat (class_key
, ".");
2962 strcat (class_key
, XSTRING (class)->data
);
2964 if (!NILP (component
))
2966 strcat (class_key
, ".");
2967 strcat (class_key
, XSTRING (subclass
)->data
);
2969 strcat (name_key
, ".");
2970 strcat (name_key
, XSTRING (component
)->data
);
2973 strcat (name_key
, ".");
2974 strcat (name_key
, XSTRING (attribute
)->data
);
2976 value
= x_get_string_resource (Qnil
,
2977 name_key
, class_key
);
2979 if (value
!= (char *) 0)
2980 return build_string (value
);
2985 /* Used when C code wants a resource value. */
2988 x_get_resource_string (attribute
, class)
2989 char *attribute
, *class;
2993 struct frame
*sf
= SELECTED_FRAME ();
2995 /* Allocate space for the components, the dots which separate them,
2996 and the final '\0'. */
2997 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2998 + strlen (attribute
) + 2);
2999 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3000 + strlen (class) + 2);
3002 sprintf (name_key
, "%s.%s",
3003 XSTRING (Vinvocation_name
)->data
,
3005 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3007 return x_get_string_resource (sf
, name_key
, class_key
);
3010 /* Types we might convert a resource string into. */
3020 /* Return the value of parameter PARAM.
3022 First search ALIST, then Vdefault_frame_alist, then the X defaults
3023 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3025 Convert the resource to the type specified by desired_type.
3027 If no default is specified, return Qunbound. If you call
3028 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
3029 and don't let it get stored in any Lisp-visible variables! */
3032 w32_get_arg (alist
, param
, attribute
, class, type
)
3033 Lisp_Object alist
, param
;
3036 enum resource_types type
;
3038 register Lisp_Object tem
;
3040 tem
= Fassq (param
, alist
);
3042 tem
= Fassq (param
, Vdefault_frame_alist
);
3048 tem
= Fx_get_resource (build_string (attribute
),
3049 build_string (class),
3057 case RES_TYPE_NUMBER
:
3058 return make_number (atoi (XSTRING (tem
)->data
));
3060 case RES_TYPE_FLOAT
:
3061 return make_float (atof (XSTRING (tem
)->data
));
3063 case RES_TYPE_BOOLEAN
:
3064 tem
= Fdowncase (tem
);
3065 if (!strcmp (XSTRING (tem
)->data
, "on")
3066 || !strcmp (XSTRING (tem
)->data
, "true"))
3071 case RES_TYPE_STRING
:
3074 case RES_TYPE_SYMBOL
:
3075 /* As a special case, we map the values `true' and `on'
3076 to Qt, and `false' and `off' to Qnil. */
3079 lower
= Fdowncase (tem
);
3080 if (!strcmp (XSTRING (lower
)->data
, "on")
3081 || !strcmp (XSTRING (lower
)->data
, "true"))
3083 else if (!strcmp (XSTRING (lower
)->data
, "off")
3084 || !strcmp (XSTRING (lower
)->data
, "false"))
3087 return Fintern (tem
, Qnil
);
3100 /* Record in frame F the specified or default value according to ALIST
3101 of the parameter named PROP (a Lisp symbol).
3102 If no value is specified for PROP, look for an X default for XPROP
3103 on the frame named NAME.
3104 If that is not found either, use the value DEFLT. */
3107 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3114 enum resource_types type
;
3118 tem
= w32_get_arg (alist
, prop
, xprop
, xclass
, type
);
3119 if (EQ (tem
, Qunbound
))
3121 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3125 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3126 "Parse an X-style geometry string STRING.\n\
3127 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
3128 The properties returned may include `top', `left', `height', and `width'.\n\
3129 The value of `left' or `top' may be an integer,\n\
3130 or a list (+ N) meaning N pixels relative to top/left corner,\n\
3131 or a list (- N) meaning -N pixels relative to bottom/right corner.")
3136 unsigned int width
, height
;
3139 CHECK_STRING (string
, 0);
3141 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3142 &x
, &y
, &width
, &height
);
3145 if (geometry
& XValue
)
3147 Lisp_Object element
;
3149 if (x
>= 0 && (geometry
& XNegative
))
3150 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3151 else if (x
< 0 && ! (geometry
& XNegative
))
3152 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3154 element
= Fcons (Qleft
, make_number (x
));
3155 result
= Fcons (element
, result
);
3158 if (geometry
& YValue
)
3160 Lisp_Object element
;
3162 if (y
>= 0 && (geometry
& YNegative
))
3163 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3164 else if (y
< 0 && ! (geometry
& YNegative
))
3165 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3167 element
= Fcons (Qtop
, make_number (y
));
3168 result
= Fcons (element
, result
);
3171 if (geometry
& WidthValue
)
3172 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3173 if (geometry
& HeightValue
)
3174 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3179 /* Calculate the desired size and position of this window,
3180 and return the flags saying which aspects were specified.
3182 This function does not make the coordinates positive. */
3184 #define DEFAULT_ROWS 40
3185 #define DEFAULT_COLS 80
3188 x_figure_window_size (f
, parms
)
3192 register Lisp_Object tem0
, tem1
, tem2
;
3193 long window_prompting
= 0;
3195 /* Default values if we fall through.
3196 Actually, if that happens we should get
3197 window manager prompting. */
3198 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3199 f
->height
= DEFAULT_ROWS
;
3200 /* Window managers expect that if program-specified
3201 positions are not (0,0), they're intentional, not defaults. */
3202 f
->output_data
.w32
->top_pos
= 0;
3203 f
->output_data
.w32
->left_pos
= 0;
3205 tem0
= w32_get_arg (parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3206 tem1
= w32_get_arg (parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3207 tem2
= w32_get_arg (parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3208 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3210 if (!EQ (tem0
, Qunbound
))
3212 CHECK_NUMBER (tem0
, 0);
3213 f
->height
= XINT (tem0
);
3215 if (!EQ (tem1
, Qunbound
))
3217 CHECK_NUMBER (tem1
, 0);
3218 SET_FRAME_WIDTH (f
, XINT (tem1
));
3220 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3221 window_prompting
|= USSize
;
3223 window_prompting
|= PSize
;
3226 f
->output_data
.w32
->vertical_scroll_bar_extra
3227 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3229 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
3230 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
3231 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
3232 f
->output_data
.w32
->flags_areas_extra
3233 = FRAME_FLAGS_AREA_WIDTH (f
);
3234 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3235 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3237 tem0
= w32_get_arg (parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3238 tem1
= w32_get_arg (parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3239 tem2
= w32_get_arg (parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3240 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3242 if (EQ (tem0
, Qminus
))
3244 f
->output_data
.w32
->top_pos
= 0;
3245 window_prompting
|= YNegative
;
3247 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3248 && CONSP (XCDR (tem0
))
3249 && INTEGERP (XCAR (XCDR (tem0
))))
3251 f
->output_data
.w32
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3252 window_prompting
|= YNegative
;
3254 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3255 && CONSP (XCDR (tem0
))
3256 && INTEGERP (XCAR (XCDR (tem0
))))
3258 f
->output_data
.w32
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3260 else if (EQ (tem0
, Qunbound
))
3261 f
->output_data
.w32
->top_pos
= 0;
3264 CHECK_NUMBER (tem0
, 0);
3265 f
->output_data
.w32
->top_pos
= XINT (tem0
);
3266 if (f
->output_data
.w32
->top_pos
< 0)
3267 window_prompting
|= YNegative
;
3270 if (EQ (tem1
, Qminus
))
3272 f
->output_data
.w32
->left_pos
= 0;
3273 window_prompting
|= XNegative
;
3275 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3276 && CONSP (XCDR (tem1
))
3277 && INTEGERP (XCAR (XCDR (tem1
))))
3279 f
->output_data
.w32
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3280 window_prompting
|= XNegative
;
3282 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3283 && CONSP (XCDR (tem1
))
3284 && INTEGERP (XCAR (XCDR (tem1
))))
3286 f
->output_data
.w32
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3288 else if (EQ (tem1
, Qunbound
))
3289 f
->output_data
.w32
->left_pos
= 0;
3292 CHECK_NUMBER (tem1
, 0);
3293 f
->output_data
.w32
->left_pos
= XINT (tem1
);
3294 if (f
->output_data
.w32
->left_pos
< 0)
3295 window_prompting
|= XNegative
;
3298 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3299 window_prompting
|= USPosition
;
3301 window_prompting
|= PPosition
;
3304 return window_prompting
;
3309 extern LRESULT CALLBACK
w32_wnd_proc ();
3312 w32_init_class (hinst
)
3317 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
3318 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
3320 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
3321 wc
.hInstance
= hinst
;
3322 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
3323 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
3324 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
3325 wc
.lpszMenuName
= NULL
;
3326 wc
.lpszClassName
= EMACS_CLASS
;
3328 return (RegisterClass (&wc
));
3332 w32_createscrollbar (f
, bar
)
3334 struct scroll_bar
* bar
;
3336 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
3337 /* Position and size of scroll bar. */
3338 XINT(bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
3340 XINT(bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
3342 FRAME_W32_WINDOW (f
),
3349 w32_createwindow (f
)
3355 rect
.left
= rect
.top
= 0;
3356 rect
.right
= PIXEL_WIDTH (f
);
3357 rect
.bottom
= PIXEL_HEIGHT (f
);
3359 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
3360 FRAME_EXTERNAL_MENU_BAR (f
));
3362 /* Do first time app init */
3366 w32_init_class (hinst
);
3369 FRAME_W32_WINDOW (f
) = hwnd
3370 = CreateWindow (EMACS_CLASS
,
3372 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
3373 f
->output_data
.w32
->left_pos
,
3374 f
->output_data
.w32
->top_pos
,
3375 rect
.right
- rect
.left
,
3376 rect
.bottom
- rect
.top
,
3384 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
3385 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
3386 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
3387 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
3388 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
3390 /* Enable drag-n-drop. */
3391 DragAcceptFiles (hwnd
, TRUE
);
3393 /* Do this to discard the default setting specified by our parent. */
3394 ShowWindow (hwnd
, SW_HIDE
);
3399 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
3406 wmsg
->msg
.hwnd
= hwnd
;
3407 wmsg
->msg
.message
= msg
;
3408 wmsg
->msg
.wParam
= wParam
;
3409 wmsg
->msg
.lParam
= lParam
;
3410 wmsg
->msg
.time
= GetMessageTime ();
3415 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
3416 between left and right keys as advertised. We test for this
3417 support dynamically, and set a flag when the support is absent. If
3418 absent, we keep track of the left and right control and alt keys
3419 ourselves. This is particularly necessary on keyboards that rely
3420 upon the AltGr key, which is represented as having the left control
3421 and right alt keys pressed. For these keyboards, we need to know
3422 when the left alt key has been pressed in addition to the AltGr key
3423 so that we can properly support M-AltGr-key sequences (such as M-@
3424 on Swedish keyboards). */
3426 #define EMACS_LCONTROL 0
3427 #define EMACS_RCONTROL 1
3428 #define EMACS_LMENU 2
3429 #define EMACS_RMENU 3
3431 static int modifiers
[4];
3432 static int modifiers_recorded
;
3433 static int modifier_key_support_tested
;
3436 test_modifier_support (unsigned int wparam
)
3440 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3442 if (wparam
== VK_CONTROL
)
3452 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
3453 modifiers_recorded
= 1;
3455 modifiers_recorded
= 0;
3456 modifier_key_support_tested
= 1;
3460 record_keydown (unsigned int wparam
, unsigned int lparam
)
3464 if (!modifier_key_support_tested
)
3465 test_modifier_support (wparam
);
3467 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3470 if (wparam
== VK_CONTROL
)
3471 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3473 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3479 record_keyup (unsigned int wparam
, unsigned int lparam
)
3483 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3486 if (wparam
== VK_CONTROL
)
3487 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3489 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3494 /* Emacs can lose focus while a modifier key has been pressed. When
3495 it regains focus, be conservative and clear all modifiers since
3496 we cannot reconstruct the left and right modifier state. */
3502 if (GetFocus () == NULL
)
3503 /* Emacs doesn't have keyboard focus. Do nothing. */
3506 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3507 alt
= GetAsyncKeyState (VK_MENU
);
3509 if (!(ctrl
& 0x08000))
3510 /* Clear any recorded control modifier state. */
3511 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3513 if (!(alt
& 0x08000))
3514 /* Clear any recorded alt modifier state. */
3515 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3517 /* Update the state of all modifier keys, because modifiers used in
3518 hot-key combinations can get stuck on if Emacs loses focus as a
3519 result of a hot-key being pressed. */
3523 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3525 GetKeyboardState (keystate
);
3526 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
3527 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
3528 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
3529 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
3530 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
3531 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
3532 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
3533 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
3534 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
3535 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
3536 SetKeyboardState (keystate
);
3540 /* Synchronize modifier state with what is reported with the current
3541 keystroke. Even if we cannot distinguish between left and right
3542 modifier keys, we know that, if no modifiers are set, then neither
3543 the left or right modifier should be set. */
3547 if (!modifiers_recorded
)
3550 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3551 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3553 if (!(GetKeyState (VK_MENU
) & 0x8000))
3554 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3558 modifier_set (int vkey
)
3560 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
3561 return (GetKeyState (vkey
) & 0x1);
3562 if (!modifiers_recorded
)
3563 return (GetKeyState (vkey
) & 0x8000);
3568 return modifiers
[EMACS_LCONTROL
];
3570 return modifiers
[EMACS_RCONTROL
];
3572 return modifiers
[EMACS_LMENU
];
3574 return modifiers
[EMACS_RMENU
];
3576 return (GetKeyState (vkey
) & 0x8000);
3579 /* Convert between the modifier bits W32 uses and the modifier bits
3583 w32_key_to_modifier (int key
)
3585 Lisp_Object key_mapping
;
3590 key_mapping
= Vw32_lwindow_modifier
;
3593 key_mapping
= Vw32_rwindow_modifier
;
3596 key_mapping
= Vw32_apps_modifier
;
3599 key_mapping
= Vw32_scroll_lock_modifier
;
3605 /* NB. This code runs in the input thread, asychronously to the lisp
3606 thread, so we must be careful to ensure access to lisp data is
3607 thread-safe. The following code is safe because the modifier
3608 variable values are updated atomically from lisp and symbols are
3609 not relocated by GC. Also, we don't have to worry about seeing GC
3611 if (EQ (key_mapping
, Qhyper
))
3612 return hyper_modifier
;
3613 if (EQ (key_mapping
, Qsuper
))
3614 return super_modifier
;
3615 if (EQ (key_mapping
, Qmeta
))
3616 return meta_modifier
;
3617 if (EQ (key_mapping
, Qalt
))
3618 return alt_modifier
;
3619 if (EQ (key_mapping
, Qctrl
))
3620 return ctrl_modifier
;
3621 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
3622 return ctrl_modifier
;
3623 if (EQ (key_mapping
, Qshift
))
3624 return shift_modifier
;
3626 /* Don't generate any modifier if not explicitly requested. */
3631 w32_get_modifiers ()
3633 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
3634 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
3635 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
3636 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
3637 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
3638 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
3639 (modifier_set (VK_MENU
) ?
3640 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
3643 /* We map the VK_* modifiers into console modifier constants
3644 so that we can use the same routines to handle both console
3645 and window input. */
3648 construct_console_modifiers ()
3653 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3654 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3655 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
3656 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
3657 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3658 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3659 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3660 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3661 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
3662 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
3663 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
3669 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
3673 /* Convert to emacs modifiers. */
3674 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
3680 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
3682 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
3685 if (virt_key
== VK_RETURN
)
3686 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3688 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
3689 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
3691 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
3692 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
3694 if (virt_key
== VK_CLEAR
)
3695 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
3700 /* List of special key combinations which w32 would normally capture,
3701 but emacs should grab instead. Not directly visible to lisp, to
3702 simplify synchronization. Each item is an integer encoding a virtual
3703 key code and modifier combination to capture. */
3704 Lisp_Object w32_grabbed_keys
;
3706 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3707 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3708 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3709 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3711 /* Register hot-keys for reserved key combinations when Emacs has
3712 keyboard focus, since this is the only way Emacs can receive key
3713 combinations like Alt-Tab which are used by the system. */
3716 register_hot_keys (hwnd
)
3719 Lisp_Object keylist
;
3721 /* Use GC_CONSP, since we are called asynchronously. */
3722 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3724 Lisp_Object key
= XCAR (keylist
);
3726 /* Deleted entries get set to nil. */
3727 if (!INTEGERP (key
))
3730 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
3731 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
3736 unregister_hot_keys (hwnd
)
3739 Lisp_Object keylist
;
3741 /* Use GC_CONSP, since we are called asynchronously. */
3742 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3744 Lisp_Object key
= XCAR (keylist
);
3746 if (!INTEGERP (key
))
3749 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
3753 /* Main message dispatch loop. */
3756 w32_msg_pump (deferred_msg
* msg_buf
)
3762 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3764 while (GetMessage (&msg
, NULL
, 0, 0))
3766 if (msg
.hwnd
== NULL
)
3768 switch (msg
.message
)
3771 /* Produced by complete_deferred_msg; just ignore. */
3773 case WM_EMACS_CREATEWINDOW
:
3774 w32_createwindow ((struct frame
*) msg
.wParam
);
3775 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3778 case WM_EMACS_SETLOCALE
:
3779 SetThreadLocale (msg
.wParam
);
3780 /* Reply is not expected. */
3782 case WM_EMACS_SETKEYBOARDLAYOUT
:
3783 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
3784 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3788 case WM_EMACS_REGISTER_HOT_KEY
:
3789 focus_window
= GetFocus ();
3790 if (focus_window
!= NULL
)
3791 RegisterHotKey (focus_window
,
3792 HOTKEY_ID (msg
.wParam
),
3793 HOTKEY_MODIFIERS (msg
.wParam
),
3794 HOTKEY_VK_CODE (msg
.wParam
));
3795 /* Reply is not expected. */
3797 case WM_EMACS_UNREGISTER_HOT_KEY
:
3798 focus_window
= GetFocus ();
3799 if (focus_window
!= NULL
)
3800 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
3801 /* Mark item as erased. NB: this code must be
3802 thread-safe. The next line is okay because the cons
3803 cell is never made into garbage and is not relocated by
3805 XCAR ((Lisp_Object
) msg
.lParam
) = Qnil
;
3806 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3809 case WM_EMACS_TOGGLE_LOCK_KEY
:
3811 int vk_code
= (int) msg
.wParam
;
3812 int cur_state
= (GetKeyState (vk_code
) & 1);
3813 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
3815 /* NB: This code must be thread-safe. It is safe to
3816 call NILP because symbols are not relocated by GC,
3817 and pointer here is not touched by GC (so the markbit
3818 can't be set). Numbers are safe because they are
3819 immediate values. */
3820 if (NILP (new_state
)
3821 || (NUMBERP (new_state
)
3822 && (XUINT (new_state
)) & 1 != cur_state
))
3824 one_w32_display_info
.faked_key
= vk_code
;
3826 keybd_event ((BYTE
) vk_code
,
3827 (BYTE
) MapVirtualKey (vk_code
, 0),
3828 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3829 keybd_event ((BYTE
) vk_code
,
3830 (BYTE
) MapVirtualKey (vk_code
, 0),
3831 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3832 keybd_event ((BYTE
) vk_code
,
3833 (BYTE
) MapVirtualKey (vk_code
, 0),
3834 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3835 cur_state
= !cur_state
;
3837 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3843 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3848 DispatchMessage (&msg
);
3851 /* Exit nested loop when our deferred message has completed. */
3852 if (msg_buf
->completed
)
3857 deferred_msg
* deferred_msg_head
;
3859 static deferred_msg
*
3860 find_deferred_msg (HWND hwnd
, UINT msg
)
3862 deferred_msg
* item
;
3864 /* Don't actually need synchronization for read access, since
3865 modification of single pointer is always atomic. */
3866 /* enter_crit (); */
3868 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3869 if (item
->w32msg
.msg
.hwnd
== hwnd
3870 && item
->w32msg
.msg
.message
== msg
)
3873 /* leave_crit (); */
3879 send_deferred_msg (deferred_msg
* msg_buf
,
3885 /* Only input thread can send deferred messages. */
3886 if (GetCurrentThreadId () != dwWindowsThreadId
)
3889 /* It is an error to send a message that is already deferred. */
3890 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3893 /* Enforced synchronization is not needed because this is the only
3894 function that alters deferred_msg_head, and the following critical
3895 section is guaranteed to only be serially reentered (since only the
3896 input thread can call us). */
3898 /* enter_crit (); */
3900 msg_buf
->completed
= 0;
3901 msg_buf
->next
= deferred_msg_head
;
3902 deferred_msg_head
= msg_buf
;
3903 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
3905 /* leave_crit (); */
3907 /* Start a new nested message loop to process other messages until
3908 this one is completed. */
3909 w32_msg_pump (msg_buf
);
3911 deferred_msg_head
= msg_buf
->next
;
3913 return msg_buf
->result
;
3917 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
3919 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
3921 if (msg_buf
== NULL
)
3922 /* Message may have been cancelled, so don't abort(). */
3925 msg_buf
->result
= result
;
3926 msg_buf
->completed
= 1;
3928 /* Ensure input thread is woken so it notices the completion. */
3929 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3933 cancel_all_deferred_msgs ()
3935 deferred_msg
* item
;
3937 /* Don't actually need synchronization for read access, since
3938 modification of single pointer is always atomic. */
3939 /* enter_crit (); */
3941 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3944 item
->completed
= 1;
3947 /* leave_crit (); */
3949 /* Ensure input thread is woken so it notices the completion. */
3950 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3958 deferred_msg dummy_buf
;
3960 /* Ensure our message queue is created */
3962 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
3964 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3967 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
3968 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
3969 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
3971 /* This is the inital message loop which should only exit when the
3972 application quits. */
3973 w32_msg_pump (&dummy_buf
);
3979 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
3989 wmsg
.dwModifiers
= modifiers
;
3991 /* Detect quit_char and set quit-flag directly. Note that we
3992 still need to post a message to ensure the main thread will be
3993 woken up if blocked in sys_select(), but we do NOT want to post
3994 the quit_char message itself (because it will usually be as if
3995 the user had typed quit_char twice). Instead, we post a dummy
3996 message that has no particular effect. */
3999 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
4000 c
= make_ctrl_char (c
) & 0377;
4002 || (wmsg
.dwModifiers
== 0 &&
4003 XFASTINT (Vw32_quit_key
) && wParam
== XFASTINT (Vw32_quit_key
)))
4007 /* The choice of message is somewhat arbitrary, as long as
4008 the main thread handler just ignores it. */
4011 /* Interrupt any blocking system calls. */
4014 /* As a safety precaution, forcibly complete any deferred
4015 messages. This is a kludge, but I don't see any particularly
4016 clean way to handle the situation where a deferred message is
4017 "dropped" in the lisp thread, and will thus never be
4018 completed, eg. by the user trying to activate the menubar
4019 when the lisp thread is busy, and then typing C-g when the
4020 menubar doesn't open promptly (with the result that the
4021 menubar never responds at all because the deferred
4022 WM_INITMENU message is never completed). Another problem
4023 situation is when the lisp thread calls SendMessage (to send
4024 a window manager command) when a message has been deferred;
4025 the lisp thread gets blocked indefinitely waiting for the
4026 deferred message to be completed, which itself is waiting for
4027 the lisp thread to respond.
4029 Note that we don't want to block the input thread waiting for
4030 a reponse from the lisp thread (although that would at least
4031 solve the deadlock problem above), because we want to be able
4032 to receive C-g to interrupt the lisp thread. */
4033 cancel_all_deferred_msgs ();
4037 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4040 /* Main window procedure */
4043 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
4050 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
4052 int windows_translate
;
4055 /* Note that it is okay to call x_window_to_frame, even though we are
4056 not running in the main lisp thread, because frame deletion
4057 requires the lisp thread to synchronize with this thread. Thus, if
4058 a frame struct is returned, it can be used without concern that the
4059 lisp thread might make it disappear while we are using it.
4061 NB. Walking the frame list in this thread is safe (as long as
4062 writes of Lisp_Object slots are atomic, which they are on Windows).
4063 Although delete-frame can destructively modify the frame list while
4064 we are walking it, a garbage collection cannot occur until after
4065 delete-frame has synchronized with this thread.
4067 It is also safe to use functions that make GDI calls, such as
4068 w32_clear_rect, because these functions must obtain a DC handle
4069 from the frame struct using get_frame_dc which is thread-aware. */
4074 f
= x_window_to_frame (dpyinfo
, hwnd
);
4077 HDC hdc
= get_frame_dc (f
);
4078 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
4079 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
4080 release_frame_dc (f
, hdc
);
4082 #if defined (W32_DEBUG_DISPLAY)
4083 DebPrint (("WM_ERASEBKGND: erasing %d,%d-%d,%d\n",
4084 wmsg
.rect
.left
, wmsg
.rect
.top
, wmsg
.rect
.right
,
4086 #endif /* W32_DEBUG_DISPLAY */
4089 case WM_PALETTECHANGED
:
4090 /* ignore our own changes */
4091 if ((HWND
)wParam
!= hwnd
)
4093 f
= x_window_to_frame (dpyinfo
, hwnd
);
4095 /* get_frame_dc will realize our palette and force all
4096 frames to be redrawn if needed. */
4097 release_frame_dc (f
, get_frame_dc (f
));
4102 PAINTSTRUCT paintStruct
;
4105 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4106 fails. Apparently this can happen under some
4108 if (!w32_strict_painting
|| GetUpdateRect (hwnd
, &update_rect
, FALSE
))
4111 BeginPaint (hwnd
, &paintStruct
);
4113 if (w32_strict_painting
)
4114 /* The rectangles returned by GetUpdateRect and BeginPaint
4115 do not always match. GetUpdateRect seems to be the
4116 more reliable of the two. */
4117 wmsg
.rect
= update_rect
;
4119 wmsg
.rect
= paintStruct
.rcPaint
;
4121 #if defined (W32_DEBUG_DISPLAY)
4122 DebPrint (("WM_PAINT: painting %d,%d-%d,%d\n", wmsg
.rect
.left
,
4123 wmsg
.rect
.top
, wmsg
.rect
.right
, wmsg
.rect
.bottom
));
4124 DebPrint (("WM_PAINT: update region is %d,%d-%d,%d\n",
4125 update_rect
.left
, update_rect
.top
,
4126 update_rect
.right
, update_rect
.bottom
));
4128 EndPaint (hwnd
, &paintStruct
);
4131 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4136 /* If GetUpdateRect returns 0 (meaning there is no update
4137 region), assume the whole window needs to be repainted. */
4138 GetClientRect(hwnd
, &wmsg
.rect
);
4139 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4143 case WM_INPUTLANGCHANGE
:
4144 /* Inform lisp thread of keyboard layout changes. */
4145 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4147 /* Clear dead keys in the keyboard state; for simplicity only
4148 preserve modifier key states. */
4153 GetKeyboardState (keystate
);
4154 for (i
= 0; i
< 256; i
++)
4171 SetKeyboardState (keystate
);
4176 /* Synchronize hot keys with normal input. */
4177 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
4182 record_keyup (wParam
, lParam
);
4187 /* Ignore keystrokes we fake ourself; see below. */
4188 if (dpyinfo
->faked_key
== wParam
)
4190 dpyinfo
->faked_key
= 0;
4191 /* Make sure TranslateMessage sees them though (as long as
4192 they don't produce WM_CHAR messages). This ensures that
4193 indicator lights are toggled promptly on Windows 9x, for
4195 if (lispy_function_keys
[wParam
] != 0)
4197 windows_translate
= 1;
4203 /* Synchronize modifiers with current keystroke. */
4205 record_keydown (wParam
, lParam
);
4206 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
4208 windows_translate
= 0;
4213 if (NILP (Vw32_pass_lwindow_to_system
))
4215 /* Prevent system from acting on keyup (which opens the
4216 Start menu if no other key was pressed) by simulating a
4217 press of Space which we will ignore. */
4218 if (GetAsyncKeyState (wParam
) & 1)
4220 if (NUMBERP (Vw32_phantom_key_code
))
4221 key
= XUINT (Vw32_phantom_key_code
) & 255;
4224 dpyinfo
->faked_key
= key
;
4225 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4228 if (!NILP (Vw32_lwindow_modifier
))
4232 if (NILP (Vw32_pass_rwindow_to_system
))
4234 if (GetAsyncKeyState (wParam
) & 1)
4236 if (NUMBERP (Vw32_phantom_key_code
))
4237 key
= XUINT (Vw32_phantom_key_code
) & 255;
4240 dpyinfo
->faked_key
= key
;
4241 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
4244 if (!NILP (Vw32_rwindow_modifier
))
4248 if (!NILP (Vw32_apps_modifier
))
4252 if (NILP (Vw32_pass_alt_to_system
))
4253 /* Prevent DefWindowProc from activating the menu bar if an
4254 Alt key is pressed and released by itself. */
4256 windows_translate
= 1;
4259 /* Decide whether to treat as modifier or function key. */
4260 if (NILP (Vw32_enable_caps_lock
))
4261 goto disable_lock_key
;
4262 windows_translate
= 1;
4265 /* Decide whether to treat as modifier or function key. */
4266 if (NILP (Vw32_enable_num_lock
))
4267 goto disable_lock_key
;
4268 windows_translate
= 1;
4271 /* Decide whether to treat as modifier or function key. */
4272 if (NILP (Vw32_scroll_lock_modifier
))
4273 goto disable_lock_key
;
4274 windows_translate
= 1;
4277 /* Ensure the appropriate lock key state (and indicator light)
4278 remains in the same state. We do this by faking another
4279 press of the relevant key. Apparently, this really is the
4280 only way to toggle the state of the indicator lights. */
4281 dpyinfo
->faked_key
= wParam
;
4282 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4283 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4284 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4285 KEYEVENTF_EXTENDEDKEY
| 0, 0);
4286 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
4287 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
4288 /* Ensure indicator lights are updated promptly on Windows 9x
4289 (TranslateMessage apparently does this), after forwarding
4291 post_character_message (hwnd
, msg
, wParam
, lParam
,
4292 w32_get_key_modifiers (wParam
, lParam
));
4293 windows_translate
= 1;
4297 case VK_PROCESSKEY
: /* Generated by IME. */
4298 windows_translate
= 1;
4301 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4302 which is confusing for purposes of key binding; convert
4303 VK_CANCEL events into VK_PAUSE events. */
4307 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4308 for purposes of key binding; convert these back into
4309 VK_NUMLOCK events, at least when we want to see NumLock key
4310 presses. (Note that there is never any possibility that
4311 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4312 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
4313 wParam
= VK_NUMLOCK
;
4316 /* If not defined as a function key, change it to a WM_CHAR message. */
4317 if (lispy_function_keys
[wParam
] == 0)
4319 DWORD modifiers
= construct_console_modifiers ();
4321 if (!NILP (Vw32_recognize_altgr
)
4322 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
4324 /* Always let TranslateMessage handle AltGr key chords;
4325 for some reason, ToAscii doesn't always process AltGr
4326 chords correctly. */
4327 windows_translate
= 1;
4329 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
4331 /* Handle key chords including any modifiers other
4332 than shift directly, in order to preserve as much
4333 modifier information as possible. */
4334 if ('A' <= wParam
&& wParam
<= 'Z')
4336 /* Don't translate modified alphabetic keystrokes,
4337 so the user doesn't need to constantly switch
4338 layout to type control or meta keystrokes when
4339 the normal layout translates alphabetic
4340 characters to non-ascii characters. */
4341 if (!modifier_set (VK_SHIFT
))
4342 wParam
+= ('a' - 'A');
4347 /* Try to handle other keystrokes by determining the
4348 base character (ie. translating the base key plus
4352 KEY_EVENT_RECORD key
;
4354 key
.bKeyDown
= TRUE
;
4355 key
.wRepeatCount
= 1;
4356 key
.wVirtualKeyCode
= wParam
;
4357 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
4358 key
.uChar
.AsciiChar
= 0;
4359 key
.dwControlKeyState
= modifiers
;
4361 add
= w32_kbd_patch_key (&key
);
4362 /* 0 means an unrecognised keycode, negative means
4363 dead key. Ignore both. */
4366 /* Forward asciified character sequence. */
4367 post_character_message
4368 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
4369 w32_get_key_modifiers (wParam
, lParam
));
4370 w32_kbd_patch_key (&key
);
4377 /* Let TranslateMessage handle everything else. */
4378 windows_translate
= 1;
4384 if (windows_translate
)
4386 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
4388 windows_msg
.time
= GetMessageTime ();
4389 TranslateMessage (&windows_msg
);
4397 post_character_message (hwnd
, msg
, wParam
, lParam
,
4398 w32_get_key_modifiers (wParam
, lParam
));
4401 /* Simulate middle mouse button events when left and right buttons
4402 are used together, but only if user has two button mouse. */
4403 case WM_LBUTTONDOWN
:
4404 case WM_RBUTTONDOWN
:
4405 if (XINT (Vw32_num_mouse_buttons
) > 2)
4406 goto handle_plain_button
;
4409 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
4410 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
4412 if (button_state
& this)
4415 if (button_state
== 0)
4418 button_state
|= this;
4420 if (button_state
& other
)
4422 if (mouse_button_timer
)
4424 KillTimer (hwnd
, mouse_button_timer
);
4425 mouse_button_timer
= 0;
4427 /* Generate middle mouse event instead. */
4428 msg
= WM_MBUTTONDOWN
;
4429 button_state
|= MMOUSE
;
4431 else if (button_state
& MMOUSE
)
4433 /* Ignore button event if we've already generated a
4434 middle mouse down event. This happens if the
4435 user releases and press one of the two buttons
4436 after we've faked a middle mouse event. */
4441 /* Flush out saved message. */
4442 post_msg (&saved_mouse_button_msg
);
4444 wmsg
.dwModifiers
= w32_get_modifiers ();
4445 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4447 /* Clear message buffer. */
4448 saved_mouse_button_msg
.msg
.hwnd
= 0;
4452 /* Hold onto message for now. */
4453 mouse_button_timer
=
4454 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
4455 XINT (Vw32_mouse_button_tolerance
), NULL
);
4456 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
4457 saved_mouse_button_msg
.msg
.message
= msg
;
4458 saved_mouse_button_msg
.msg
.wParam
= wParam
;
4459 saved_mouse_button_msg
.msg
.lParam
= lParam
;
4460 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
4461 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
4468 if (XINT (Vw32_num_mouse_buttons
) > 2)
4469 goto handle_plain_button
;
4472 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
4473 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
4475 if ((button_state
& this) == 0)
4478 button_state
&= ~this;
4480 if (button_state
& MMOUSE
)
4482 /* Only generate event when second button is released. */
4483 if ((button_state
& other
) == 0)
4486 button_state
&= ~MMOUSE
;
4488 if (button_state
) abort ();
4495 /* Flush out saved message if necessary. */
4496 if (saved_mouse_button_msg
.msg
.hwnd
)
4498 post_msg (&saved_mouse_button_msg
);
4501 wmsg
.dwModifiers
= w32_get_modifiers ();
4502 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4504 /* Always clear message buffer and cancel timer. */
4505 saved_mouse_button_msg
.msg
.hwnd
= 0;
4506 KillTimer (hwnd
, mouse_button_timer
);
4507 mouse_button_timer
= 0;
4509 if (button_state
== 0)
4514 case WM_MBUTTONDOWN
:
4516 handle_plain_button
:
4521 if (parse_button (msg
, &button
, &up
))
4523 if (up
) ReleaseCapture ();
4524 else SetCapture (hwnd
);
4525 button
= (button
== 0) ? LMOUSE
:
4526 ((button
== 1) ? MMOUSE
: RMOUSE
);
4528 button_state
&= ~button
;
4530 button_state
|= button
;
4534 wmsg
.dwModifiers
= w32_get_modifiers ();
4535 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4540 if (XINT (Vw32_mouse_move_interval
) <= 0
4541 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
4543 wmsg
.dwModifiers
= w32_get_modifiers ();
4544 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4548 /* Hang onto mouse move and scroll messages for a bit, to avoid
4549 sending such events to Emacs faster than it can process them.
4550 If we get more events before the timer from the first message
4551 expires, we just replace the first message. */
4553 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
4555 SetTimer (hwnd
, MOUSE_MOVE_ID
,
4556 XINT (Vw32_mouse_move_interval
), NULL
);
4558 /* Hold onto message for now. */
4559 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
4560 saved_mouse_move_msg
.msg
.message
= msg
;
4561 saved_mouse_move_msg
.msg
.wParam
= wParam
;
4562 saved_mouse_move_msg
.msg
.lParam
= lParam
;
4563 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
4564 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
4569 wmsg
.dwModifiers
= w32_get_modifiers ();
4570 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4574 wmsg
.dwModifiers
= w32_get_modifiers ();
4575 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4579 /* Flush out saved messages if necessary. */
4580 if (wParam
== mouse_button_timer
)
4582 if (saved_mouse_button_msg
.msg
.hwnd
)
4584 post_msg (&saved_mouse_button_msg
);
4585 saved_mouse_button_msg
.msg
.hwnd
= 0;
4587 KillTimer (hwnd
, mouse_button_timer
);
4588 mouse_button_timer
= 0;
4590 else if (wParam
== mouse_move_timer
)
4592 if (saved_mouse_move_msg
.msg
.hwnd
)
4594 post_msg (&saved_mouse_move_msg
);
4595 saved_mouse_move_msg
.msg
.hwnd
= 0;
4597 KillTimer (hwnd
, mouse_move_timer
);
4598 mouse_move_timer
= 0;
4603 /* Windows doesn't send us focus messages when putting up and
4604 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4605 The only indication we get that something happened is receiving
4606 this message afterwards. So this is a good time to reset our
4607 keyboard modifiers' state. */
4614 /* We must ensure menu bar is fully constructed and up to date
4615 before allowing user interaction with it. To achieve this
4616 we send this message to the lisp thread and wait for a
4617 reply (whose value is not actually needed) to indicate that
4618 the menu bar is now ready for use, so we can now return.
4620 To remain responsive in the meantime, we enter a nested message
4621 loop that can process all other messages.
4623 However, we skip all this if the message results from calling
4624 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4625 thread a message because it is blocked on us at this point. We
4626 set menubar_active before calling TrackPopupMenu to indicate
4627 this (there is no possibility of confusion with real menubar
4630 f
= x_window_to_frame (dpyinfo
, hwnd
);
4632 && (f
->output_data
.w32
->menubar_active
4633 /* We can receive this message even in the absence of a
4634 menubar (ie. when the system menu is activated) - in this
4635 case we do NOT want to forward the message, otherwise it
4636 will cause the menubar to suddenly appear when the user
4637 had requested it to be turned off! */
4638 || f
->output_data
.w32
->menubar_widget
== NULL
))
4642 deferred_msg msg_buf
;
4644 /* Detect if message has already been deferred; in this case
4645 we cannot return any sensible value to ignore this. */
4646 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4649 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
4652 case WM_EXITMENULOOP
:
4653 f
= x_window_to_frame (dpyinfo
, hwnd
);
4655 /* Indicate that menubar can be modified again. */
4657 f
->output_data
.w32
->menubar_active
= 0;
4661 wmsg
.dwModifiers
= w32_get_modifiers ();
4662 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4665 case WM_MEASUREITEM
:
4666 f
= x_window_to_frame (dpyinfo
, hwnd
);
4669 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
4671 if (pMis
->CtlType
== ODT_MENU
)
4673 /* Work out dimensions for popup menu titles. */
4674 char * title
= (char *) pMis
->itemData
;
4675 HDC hdc
= GetDC (hwnd
);
4676 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4677 LOGFONT menu_logfont
;
4681 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4682 menu_logfont
.lfWeight
= FW_BOLD
;
4683 menu_font
= CreateFontIndirect (&menu_logfont
);
4684 old_font
= SelectObject (hdc
, menu_font
);
4686 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
4689 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
4690 pMis
->itemWidth
= size
.cx
;
4691 if (pMis
->itemHeight
< size
.cy
)
4692 pMis
->itemHeight
= size
.cy
;
4695 pMis
->itemWidth
= 0;
4697 SelectObject (hdc
, old_font
);
4698 DeleteObject (menu_font
);
4699 ReleaseDC (hwnd
, hdc
);
4706 f
= x_window_to_frame (dpyinfo
, hwnd
);
4709 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
4711 if (pDis
->CtlType
== ODT_MENU
)
4713 /* Draw popup menu title. */
4714 char * title
= (char *) pDis
->itemData
;
4717 HDC hdc
= pDis
->hDC
;
4718 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4719 LOGFONT menu_logfont
;
4722 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4723 menu_logfont
.lfWeight
= FW_BOLD
;
4724 menu_font
= CreateFontIndirect (&menu_logfont
);
4725 old_font
= SelectObject (hdc
, menu_font
);
4727 /* Always draw title as if not selected. */
4730 + GetSystemMetrics (SM_CXMENUCHECK
),
4732 ETO_OPAQUE
, &pDis
->rcItem
,
4733 title
, strlen (title
), NULL
);
4735 SelectObject (hdc
, old_font
);
4736 DeleteObject (menu_font
);
4744 /* Still not right - can't distinguish between clicks in the
4745 client area of the frame from clicks forwarded from the scroll
4746 bars - may have to hook WM_NCHITTEST to remember the mouse
4747 position and then check if it is in the client area ourselves. */
4748 case WM_MOUSEACTIVATE
:
4749 /* Discard the mouse click that activates a frame, allowing the
4750 user to click anywhere without changing point (or worse!).
4751 Don't eat mouse clicks on scrollbars though!! */
4752 if (LOWORD (lParam
) == HTCLIENT
)
4753 return MA_ACTIVATEANDEAT
;
4757 case WM_ACTIVATEAPP
:
4759 case WM_WINDOWPOSCHANGED
:
4761 /* Inform lisp thread that a frame might have just been obscured
4762 or exposed, so should recheck visibility of all frames. */
4763 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4767 dpyinfo
->faked_key
= 0;
4769 register_hot_keys (hwnd
);
4772 unregister_hot_keys (hwnd
);
4779 wmsg
.dwModifiers
= w32_get_modifiers ();
4780 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4784 wmsg
.dwModifiers
= w32_get_modifiers ();
4785 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4788 case WM_WINDOWPOSCHANGING
:
4791 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
4793 wp
.length
= sizeof (WINDOWPLACEMENT
);
4794 GetWindowPlacement (hwnd
, &wp
);
4796 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
4803 DWORD internal_border
;
4804 DWORD scrollbar_extra
;
4807 wp
.length
= sizeof(wp
);
4808 GetWindowRect (hwnd
, &wr
);
4812 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
4813 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
4814 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
4815 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
4819 memset (&rect
, 0, sizeof (rect
));
4820 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
4821 GetMenu (hwnd
) != NULL
);
4823 /* Force width and height of client area to be exact
4824 multiples of the character cell dimensions. */
4825 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
4826 - 2 * internal_border
- scrollbar_extra
)
4828 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
4829 - 2 * internal_border
)
4834 /* For right/bottom sizing we can just fix the sizes.
4835 However for top/left sizing we will need to fix the X
4836 and Y positions as well. */
4841 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
4842 && (lppos
->flags
& SWP_NOMOVE
) == 0)
4844 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
4851 lppos
->flags
|= SWP_NOMOVE
;
4862 case WM_GETMINMAXINFO
:
4863 /* Hack to correct bug that allows Emacs frames to be resized
4864 below the Minimum Tracking Size. */
4865 ((LPMINMAXINFO
) lParam
)->ptMinTrackSize
.y
++;
4868 case WM_EMACS_CREATESCROLLBAR
:
4869 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
4870 (struct scroll_bar
*) lParam
);
4872 case WM_EMACS_SHOWWINDOW
:
4873 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
4875 case WM_EMACS_SETFOREGROUND
:
4877 HWND foreground_window
;
4878 DWORD foreground_thread
, retval
;
4880 /* On NT 5.0, and apparently Windows 98, it is necessary to
4881 attach to the thread that currently has focus in order to
4882 pull the focus away from it. */
4883 foreground_window
= GetForegroundWindow ();
4884 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
4885 if (!foreground_window
4886 || foreground_thread
== GetCurrentThreadId ()
4887 || !AttachThreadInput (GetCurrentThreadId (),
4888 foreground_thread
, TRUE
))
4889 foreground_thread
= 0;
4891 retval
= SetForegroundWindow ((HWND
) wParam
);
4893 /* Detach from the previous foreground thread. */
4894 if (foreground_thread
)
4895 AttachThreadInput (GetCurrentThreadId (),
4896 foreground_thread
, FALSE
);
4901 case WM_EMACS_SETWINDOWPOS
:
4903 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
4904 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
4905 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
4908 case WM_EMACS_DESTROYWINDOW
:
4909 DragAcceptFiles ((HWND
) wParam
, FALSE
);
4910 return DestroyWindow ((HWND
) wParam
);
4912 case WM_EMACS_TRACKPOPUPMENU
:
4917 pos
= (POINT
*)lParam
;
4918 flags
= TPM_CENTERALIGN
;
4919 if (button_state
& LMOUSE
)
4920 flags
|= TPM_LEFTBUTTON
;
4921 else if (button_state
& RMOUSE
)
4922 flags
|= TPM_RIGHTBUTTON
;
4924 /* Remember we did a SetCapture on the initial mouse down event,
4925 so for safety, we make sure the capture is cancelled now. */
4929 /* Use menubar_active to indicate that WM_INITMENU is from
4930 TrackPopupMenu below, and should be ignored. */
4931 f
= x_window_to_frame (dpyinfo
, hwnd
);
4933 f
->output_data
.w32
->menubar_active
= 1;
4935 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
4939 /* Eat any mouse messages during popupmenu */
4940 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
4942 /* Get the menu selection, if any */
4943 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
4945 retval
= LOWORD (amsg
.wParam
);
4961 /* Check for messages registered at runtime. */
4962 if (msg
== msh_mousewheel
)
4964 wmsg
.dwModifiers
= w32_get_modifiers ();
4965 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4970 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
4974 /* The most common default return code for handled messages is 0. */
4979 my_create_window (f
)
4984 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
4986 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
4989 /* Create and set up the w32 window for frame F. */
4992 w32_window (f
, window_prompting
, minibuffer_only
)
4994 long window_prompting
;
4995 int minibuffer_only
;
4999 /* Use the resource name as the top-level window name
5000 for looking up resources. Make a non-Lisp copy
5001 for the window manager, so GC relocation won't bother it.
5003 Elsewhere we specify the window name for the window manager. */
5006 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
5007 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
5008 strcpy (f
->namebuf
, str
);
5011 my_create_window (f
);
5013 validate_x_resource_name ();
5015 /* x_set_name normally ignores requests to set the name if the
5016 requested name is the same as the current name. This is the one
5017 place where that assumption isn't correct; f->name is set, but
5018 the server hasn't been told. */
5021 int explicit = f
->explicit_name
;
5023 f
->explicit_name
= 0;
5026 x_set_name (f
, name
, explicit);
5031 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
5032 initialize_frame_menubar (f
);
5034 if (FRAME_W32_WINDOW (f
) == 0)
5035 error ("Unable to create window");
5038 /* Handle the icon stuff for this window. Perhaps later we might
5039 want an x_set_icon_position which can be called interactively as
5047 Lisp_Object icon_x
, icon_y
;
5049 /* Set the position of the icon. Note that Windows 95 groups all
5050 icons in the tray. */
5051 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
5052 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
5053 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
5055 CHECK_NUMBER (icon_x
, 0);
5056 CHECK_NUMBER (icon_y
, 0);
5058 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
5059 error ("Both left and top icon corners of icon must be specified");
5063 if (! EQ (icon_x
, Qunbound
))
5064 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
5067 /* Start up iconic or window? */
5068 x_wm_set_window_state
5069 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
5073 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
5086 XGCValues gc_values
;
5090 /* Create the GC's of this frame.
5091 Note that many default values are used. */
5094 gc_values
.font
= f
->output_data
.w32
->font
;
5096 /* Cursor has cursor-color background, background-color foreground. */
5097 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
5098 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
5099 f
->output_data
.w32
->cursor_gc
5100 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
5101 (GCFont
| GCForeground
| GCBackground
),
5105 f
->output_data
.w32
->white_relief
.gc
= 0;
5106 f
->output_data
.w32
->black_relief
.gc
= 0;
5112 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
5114 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
5115 Returns an Emacs frame object.\n\
5116 ALIST is an alist of frame parameters.\n\
5117 If the parameters specify that the frame should not have a minibuffer,\n\
5118 and do not specify a specific minibuffer window to use,\n\
5119 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
5120 be shared by the new frame.\n\
5122 This function is an internal primitive--use `make-frame' instead.")
5127 Lisp_Object frame
, tem
;
5129 int minibuffer_only
= 0;
5130 long window_prompting
= 0;
5132 int count
= specpdl_ptr
- specpdl
;
5133 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
5134 Lisp_Object display
;
5135 struct w32_display_info
*dpyinfo
= NULL
;
5141 /* Use this general default value to start with
5142 until we know if this frame has a specified name. */
5143 Vx_resource_name
= Vinvocation_name
;
5145 display
= w32_get_arg (parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
5146 if (EQ (display
, Qunbound
))
5148 dpyinfo
= check_x_display_info (display
);
5150 kb
= dpyinfo
->kboard
;
5152 kb
= &the_only_kboard
;
5155 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
5157 && ! EQ (name
, Qunbound
)
5159 error ("Invalid frame name--not a string or nil");
5162 Vx_resource_name
= name
;
5164 /* See if parent window is specified. */
5165 parent
= w32_get_arg (parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
5166 if (EQ (parent
, Qunbound
))
5168 if (! NILP (parent
))
5169 CHECK_NUMBER (parent
, 0);
5171 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5172 /* No need to protect DISPLAY because that's not used after passing
5173 it to make_frame_without_minibuffer. */
5175 GCPRO4 (parms
, parent
, name
, frame
);
5176 tem
= w32_get_arg (parms
, Qminibuffer
, "minibuffer", "Minibuffer",
5178 if (EQ (tem
, Qnone
) || NILP (tem
))
5179 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
5180 else if (EQ (tem
, Qonly
))
5182 f
= make_minibuffer_frame ();
5183 minibuffer_only
= 1;
5185 else if (WINDOWP (tem
))
5186 f
= make_frame_without_minibuffer (tem
, kb
, display
);
5190 XSETFRAME (frame
, f
);
5192 /* Note that Windows does support scroll bars. */
5193 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
5194 /* By default, make scrollbars the system standard width. */
5195 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
5197 f
->output_method
= output_w32
;
5198 f
->output_data
.w32
=
5199 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
5200 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
5202 FRAME_FONTSET (f
) = -1;
5205 = w32_get_arg (parms
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
5206 if (! STRINGP (f
->icon_name
))
5207 f
->icon_name
= Qnil
;
5209 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
5211 FRAME_KBOARD (f
) = kb
;
5214 /* Specify the parent under which to make this window. */
5218 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
5219 f
->output_data
.w32
->explicit_parent
= 1;
5223 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5224 f
->output_data
.w32
->explicit_parent
= 0;
5227 /* Set the name; the functions to which we pass f expect the name to
5229 if (EQ (name
, Qunbound
) || NILP (name
))
5231 f
->name
= build_string (dpyinfo
->w32_id_name
);
5232 f
->explicit_name
= 0;
5237 f
->explicit_name
= 1;
5238 /* use the frame's title when getting resources for this frame. */
5239 specbind (Qx_resource_name
, name
);
5242 /* Extract the window parameters from the supplied values
5243 that are needed to determine window geometry. */
5247 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
5250 /* First, try whatever font the caller has specified. */
5253 tem
= Fquery_fontset (font
, Qnil
);
5255 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
5257 font
= x_new_font (f
, XSTRING (font
)->data
);
5259 /* Try out a font which we hope has bold and italic variations. */
5260 if (!STRINGP (font
))
5261 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
5262 if (! STRINGP (font
))
5263 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
5264 /* If those didn't work, look for something which will at least work. */
5265 if (! STRINGP (font
))
5266 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
5268 if (! STRINGP (font
))
5269 font
= build_string ("Fixedsys");
5271 x_default_parameter (f
, parms
, Qfont
, font
,
5272 "font", "Font", RES_TYPE_STRING
);
5275 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
5276 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
5277 /* This defaults to 2 in order to match xterm. We recognize either
5278 internalBorderWidth or internalBorder (which is what xterm calls
5280 if (NILP (Fassq (Qinternal_border_width
, parms
)))
5284 value
= w32_get_arg (parms
, Qinternal_border_width
,
5285 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
5286 if (! EQ (value
, Qunbound
))
5287 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
5290 /* Default internalBorderWidth to 0 on Windows to match other programs. */
5291 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
5292 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
5293 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qright
,
5294 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
5296 /* Also do the stuff which must be set before the window exists. */
5297 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
5298 "foreground", "Foreground", RES_TYPE_STRING
);
5299 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
5300 "background", "Background", RES_TYPE_STRING
);
5301 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
5302 "pointerColor", "Foreground", RES_TYPE_STRING
);
5303 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
5304 "cursorColor", "Foreground", RES_TYPE_STRING
);
5305 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
5306 "borderColor", "BorderColor", RES_TYPE_STRING
);
5307 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
5308 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
5309 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
5310 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
5313 /* Init faces before x_default_parameter is called for scroll-bar
5314 parameters because that function calls x_set_scroll_bar_width,
5315 which calls change_frame_size, which calls Fset_window_buffer,
5316 which runs hooks, which call Fvertical_motion. At the end, we
5317 end up in init_iterator with a null face cache, which should not
5319 init_frame_faces (f
);
5321 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
5322 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
5323 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
5324 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
5325 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
5326 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
5327 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
5328 "title", "Title", RES_TYPE_STRING
);
5330 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
5331 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
5332 window_prompting
= x_figure_window_size (f
, parms
);
5334 if (window_prompting
& XNegative
)
5336 if (window_prompting
& YNegative
)
5337 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
5339 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
5343 if (window_prompting
& YNegative
)
5344 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
5346 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
5349 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
5351 tem
= w32_get_arg (parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
5352 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
5354 /* Create the window. Add the tool-bar height to the initial frame
5355 height so that the user gets a text display area of the size he
5356 specified with -g or via the registry. Later changes of the
5357 tool-bar height don't change the frame size. This is done so that
5358 users can create tall Emacs frames without having to guess how
5359 tall the tool-bar will get. */
5360 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
5361 w32_window (f
, window_prompting
, minibuffer_only
);
5366 /* Now consider the frame official. */
5367 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
5368 Vframe_list
= Fcons (frame
, Vframe_list
);
5370 /* We need to do this after creating the window, so that the
5371 icon-creation functions can say whose icon they're describing. */
5372 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
5373 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
5375 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
5376 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5377 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
5378 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
5379 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
5380 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
5381 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
5382 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
5384 /* Dimensions, especially f->height, must be done via change_frame_size.
5385 Change will not be effected unless different from the current
5390 SET_FRAME_WIDTH (f
, 0);
5391 change_frame_size (f
, height
, width
, 1, 0, 0);
5393 /* Tell the server what size and position, etc, we want, and how
5394 badly we want them. This should be done after we have the menu
5395 bar so that its size can be taken into account. */
5397 x_wm_set_size_hint (f
, window_prompting
, 0);
5400 /* Set up faces after all frame parameters are known. This call
5401 also merges in face attributes specified for new frames. If we
5402 don't do this, the `menu' face for instance won't have the right
5403 colors, and the menu bar won't appear in the specified colors for
5405 call1 (Qface_set_after_frame_default
, frame
);
5407 /* Make the window appear on the frame and enable display, unless
5408 the caller says not to. However, with explicit parent, Emacs
5409 cannot control visibility, so don't try. */
5410 if (! f
->output_data
.w32
->explicit_parent
)
5412 Lisp_Object visibility
;
5414 visibility
= w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
5415 if (EQ (visibility
, Qunbound
))
5418 if (EQ (visibility
, Qicon
))
5419 x_iconify_frame (f
);
5420 else if (! NILP (visibility
))
5421 x_make_frame_visible (f
);
5423 /* Must have been Qnil. */
5427 return unbind_to (count
, frame
);
5430 /* FRAME is used only to get a handle on the X display. We don't pass the
5431 display info directly because we're called from frame.c, which doesn't
5432 know about that structure. */
5434 x_get_focus_frame (frame
)
5435 struct frame
*frame
;
5437 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
5439 if (! dpyinfo
->w32_focus_frame
)
5442 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
5446 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
5447 "Give FRAME input focus, raising to foreground if necessary.")
5451 x_focus_on_frame (check_x_frame (frame
));
5456 /* Return the charset portion of a font name. */
5457 char * xlfd_charset_of_font (char * fontname
)
5459 char *charset
, *encoding
;
5461 encoding
= strrchr(fontname
, '-');
5462 if (!encoding
|| encoding
== fontname
)
5465 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
5466 if (*charset
== '-')
5469 if (charset
== fontname
|| strcmp(charset
, "-*-*") == 0)
5475 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
5476 int size
, char* filename
);
5477 BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
, char * charset
);
5480 w32_load_system_font (f
,fontname
,size
)
5485 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5486 Lisp_Object font_names
;
5488 /* Get a list of all the fonts that match this name. Once we
5489 have a list of matching fonts, we compare them against the fonts
5490 we already have loaded by comparing names. */
5491 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
5493 if (!NILP (font_names
))
5498 /* First check if any are already loaded, as that is cheaper
5499 than loading another one. */
5500 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5501 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
5502 if (dpyinfo
->font_table
[i
].name
5503 && (!strcmp (dpyinfo
->font_table
[i
].name
,
5504 XSTRING (XCAR (tail
))->data
)
5505 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
5506 XSTRING (XCAR (tail
))->data
)))
5507 return (dpyinfo
->font_table
+ i
);
5509 fontname
= (char *) XSTRING (XCAR (font_names
))->data
;
5511 else if (w32_strict_fontnames
)
5513 /* If EnumFontFamiliesEx was available, we got a full list of
5514 fonts back so stop now to avoid the possibility of loading a
5515 random font. If we had to fall back to EnumFontFamilies, the
5516 list is incomplete, so continue whether the font we want was
5518 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5519 FARPROC enum_font_families_ex
5520 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
5521 if (enum_font_families_ex
)
5525 /* Load the font and add it to the table. */
5527 char *full_name
, *encoding
, *charset
;
5529 struct font_info
*fontp
;
5534 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
5537 if (!*lf
.lfFaceName
)
5538 /* If no name was specified for the font, we get a random font
5539 from CreateFontIndirect - this is not particularly
5540 desirable, especially since CreateFontIndirect does not
5541 fill out the missing name in lf, so we never know what we
5545 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
5546 bzero (font
, sizeof (*font
));
5548 /* Set bdf to NULL to indicate that this is a Windows font. */
5553 font
->hfont
= CreateFontIndirect (&lf
);
5555 if (font
->hfont
== NULL
)
5563 int codepage
= w32_codepage_for_font (fontname
);
5565 hdc
= GetDC (dpyinfo
->root_window
);
5566 oldobj
= SelectObject (hdc
, font
->hfont
);
5568 ok
= GetTextMetrics (hdc
, &font
->tm
);
5569 if (codepage
== CP_UNICODE
)
5570 font
->double_byte_p
= 1;
5572 font
->double_byte_p
= GetFontLanguageInfo(hdc
) & GCP_DBCS
;
5574 SelectObject (hdc
, oldobj
);
5575 ReleaseDC (dpyinfo
->root_window
, hdc
);
5576 /* Fill out details in lf according to the font that was
5578 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
5579 lf
.lfWidth
= font
->tm
.tmAveCharWidth
;
5580 lf
.lfWeight
= font
->tm
.tmWeight
;
5581 lf
.lfItalic
= font
->tm
.tmItalic
;
5582 lf
.lfCharSet
= font
->tm
.tmCharSet
;
5583 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
5584 ? VARIABLE_PITCH
: FIXED_PITCH
);
5585 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
5586 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
5588 w32_cache_char_metrics (font
);
5595 w32_unload_font (dpyinfo
, font
);
5599 /* Find a free slot in the font table. */
5600 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
5601 if (dpyinfo
->font_table
[i
].name
== NULL
)
5604 /* If no free slot found, maybe enlarge the font table. */
5605 if (i
== dpyinfo
->n_fonts
5606 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
5609 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
5610 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
5612 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
5615 fontp
= dpyinfo
->font_table
+ i
;
5616 if (i
== dpyinfo
->n_fonts
)
5619 /* Now fill in the slots of *FONTP. */
5622 fontp
->font_idx
= i
;
5623 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
5624 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
5626 charset
= xlfd_charset_of_font (fontname
);
5628 /* Work out the font's full name. */
5629 full_name
= (char *)xmalloc (100);
5630 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
5631 fontp
->full_name
= full_name
;
5634 /* If all else fails - just use the name we used to load it. */
5636 fontp
->full_name
= fontp
->name
;
5639 fontp
->size
= FONT_WIDTH (font
);
5640 fontp
->height
= FONT_HEIGHT (font
);
5642 /* The slot `encoding' specifies how to map a character
5643 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
5644 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
5645 (0:0x20..0x7F, 1:0xA0..0xFF,
5646 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
5647 2:0xA020..0xFF7F). For the moment, we don't know which charset
5648 uses this font. So, we set information in fontp->encoding[1]
5649 which is never used by any charset. If mapping can't be
5650 decided, set FONT_ENCODING_NOT_DECIDED. */
5652 /* SJIS fonts need to be set to type 4, all others seem to work as
5653 type FONT_ENCODING_NOT_DECIDED. */
5654 encoding
= strrchr (fontp
->name
, '-');
5655 if (encoding
&& stricmp (encoding
+1, "sjis") == 0)
5656 fontp
->encoding
[1] = 4;
5658 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
5660 /* The following three values are set to 0 under W32, which is
5661 what they get set to if XGetFontProperty fails under X. */
5662 fontp
->baseline_offset
= 0;
5663 fontp
->relative_compose
= 0;
5664 fontp
->default_ascent
= 0;
5666 /* Set global flag fonts_changed_p to non-zero if the font loaded
5667 has a character with a smaller width than any other character
5668 before, or if the font loaded has a smalle>r height than any
5669 other font loaded before. If this happens, it will make a
5670 glyph matrix reallocation necessary. */
5671 fonts_changed_p
= x_compute_min_glyph_bounds (f
);
5677 /* Load font named FONTNAME of size SIZE for frame F, and return a
5678 pointer to the structure font_info while allocating it dynamically.
5679 If loading fails, return NULL. */
5681 w32_load_font (f
,fontname
,size
)
5686 Lisp_Object bdf_fonts
;
5687 struct font_info
*retval
= NULL
;
5689 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
));
5691 while (!retval
&& CONSP (bdf_fonts
))
5693 char *bdf_name
, *bdf_file
;
5694 Lisp_Object bdf_pair
;
5696 bdf_name
= XSTRING (XCAR (bdf_fonts
))->data
;
5697 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
5698 bdf_file
= XSTRING (XCDR (bdf_pair
))->data
;
5700 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
5702 bdf_fonts
= XCDR (bdf_fonts
);
5708 return w32_load_system_font(f
, fontname
, size
);
5713 w32_unload_font (dpyinfo
, font
)
5714 struct w32_display_info
*dpyinfo
;
5719 if (font
->per_char
) xfree (font
->per_char
);
5720 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
5722 if (font
->hfont
) DeleteObject(font
->hfont
);
5727 /* The font conversion stuff between x and w32 */
5729 /* X font string is as follows (from faces.el)
5733 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5734 * (weight\? "\\([^-]*\\)") ; 1
5735 * (slant "\\([ior]\\)") ; 2
5736 * (slant\? "\\([^-]?\\)") ; 2
5737 * (swidth "\\([^-]*\\)") ; 3
5738 * (adstyle "[^-]*") ; 4
5739 * (pixelsize "[0-9]+")
5740 * (pointsize "[0-9][0-9]+")
5741 * (resx "[0-9][0-9]+")
5742 * (resy "[0-9][0-9]+")
5743 * (spacing "[cmp?*]")
5744 * (avgwidth "[0-9]+")
5745 * (registry "[^-]+")
5746 * (encoding "[^-]+")
5751 x_to_w32_weight (lpw
)
5754 if (!lpw
) return (FW_DONTCARE
);
5756 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
5757 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
5758 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
5759 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
5760 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
5761 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
5762 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
5763 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
5764 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
5765 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
5772 w32_to_x_weight (fnweight
)
5775 if (fnweight
>= FW_HEAVY
) return "heavy";
5776 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
5777 if (fnweight
>= FW_BOLD
) return "bold";
5778 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
5779 if (fnweight
>= FW_MEDIUM
) return "medium";
5780 if (fnweight
>= FW_NORMAL
) return "normal";
5781 if (fnweight
>= FW_LIGHT
) return "light";
5782 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
5783 if (fnweight
>= FW_THIN
) return "thin";
5789 x_to_w32_charset (lpcs
)
5792 Lisp_Object this_entry
, w32_charset
;
5794 /* Look through w32-charset-info-alist for the character set.
5795 Format of each entry is
5796 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5798 this_entry
= Fassoc (build_string(lpcs
), Vw32_charset_info_alist
);
5800 if (NILP(this_entry
))
5802 /* At startup, we want iso8859-1 fonts to come up properly. */
5803 if (stricmp(lpcs
, "iso8859-1") == 0)
5804 return ANSI_CHARSET
;
5806 return DEFAULT_CHARSET
;
5809 w32_charset
= Fcar (Fcdr (this_entry
));
5811 // Translate Lisp symbol to number.
5812 if (w32_charset
== Qw32_charset_ansi
)
5813 return ANSI_CHARSET
;
5814 if (w32_charset
== Qw32_charset_symbol
)
5815 return SYMBOL_CHARSET
;
5816 if (w32_charset
== Qw32_charset_shiftjis
)
5817 return SHIFTJIS_CHARSET
;
5818 if (w32_charset
== Qw32_charset_hangeul
)
5819 return HANGEUL_CHARSET
;
5820 if (w32_charset
== Qw32_charset_chinesebig5
)
5821 return CHINESEBIG5_CHARSET
;
5822 if (w32_charset
== Qw32_charset_gb2312
)
5823 return GB2312_CHARSET
;
5824 if (w32_charset
== Qw32_charset_oem
)
5826 #ifdef JOHAB_CHARSET
5827 if (w32_charset
== Qw32_charset_johab
)
5828 return JOHAB_CHARSET
;
5829 if (w32_charset
== Qw32_charset_easteurope
)
5830 return EASTEUROPE_CHARSET
;
5831 if (w32_charset
== Qw32_charset_turkish
)
5832 return TURKISH_CHARSET
;
5833 if (w32_charset
== Qw32_charset_baltic
)
5834 return BALTIC_CHARSET
;
5835 if (w32_charset
== Qw32_charset_russian
)
5836 return RUSSIAN_CHARSET
;
5837 if (w32_charset
== Qw32_charset_arabic
)
5838 return ARABIC_CHARSET
;
5839 if (w32_charset
== Qw32_charset_greek
)
5840 return GREEK_CHARSET
;
5841 if (w32_charset
== Qw32_charset_hebrew
)
5842 return HEBREW_CHARSET
;
5843 if (w32_charset
== Qw32_charset_vietnamese
)
5844 return VIETNAMESE_CHARSET
;
5845 if (w32_charset
== Qw32_charset_thai
)
5846 return THAI_CHARSET
;
5847 if (w32_charset
== Qw32_charset_mac
)
5849 #endif /* JOHAB_CHARSET */
5850 #ifdef UNICODE_CHARSET
5851 if (w32_charset
== Qw32_charset_unicode
)
5852 return UNICODE_CHARSET
;
5855 return DEFAULT_CHARSET
;
5860 w32_to_x_charset (fncharset
)
5863 static char buf
[16];
5864 Lisp_Object charset_type
;
5869 /* Handle startup case of w32-charset-info-alist not
5870 being set up yet. */
5871 if (NILP(Vw32_charset_info_alist
))
5873 charset_type
= Qw32_charset_ansi
;
5875 case DEFAULT_CHARSET
:
5876 charset_type
= Qw32_charset_default
;
5878 case SYMBOL_CHARSET
:
5879 charset_type
= Qw32_charset_symbol
;
5881 case SHIFTJIS_CHARSET
:
5882 charset_type
= Qw32_charset_shiftjis
;
5884 case HANGEUL_CHARSET
:
5885 charset_type
= Qw32_charset_hangeul
;
5887 case GB2312_CHARSET
:
5888 charset_type
= Qw32_charset_gb2312
;
5890 case CHINESEBIG5_CHARSET
:
5891 charset_type
= Qw32_charset_chinesebig5
;
5894 charset_type
= Qw32_charset_oem
;
5897 /* More recent versions of Windows (95 and NT4.0) define more
5899 #ifdef EASTEUROPE_CHARSET
5900 case EASTEUROPE_CHARSET
:
5901 charset_type
= Qw32_charset_easteurope
;
5903 case TURKISH_CHARSET
:
5904 charset_type
= Qw32_charset_turkish
;
5906 case BALTIC_CHARSET
:
5907 charset_type
= Qw32_charset_baltic
;
5909 case RUSSIAN_CHARSET
:
5910 charset_type
= Qw32_charset_russian
;
5912 case ARABIC_CHARSET
:
5913 charset_type
= Qw32_charset_arabic
;
5916 charset_type
= Qw32_charset_greek
;
5918 case HEBREW_CHARSET
:
5919 charset_type
= Qw32_charset_hebrew
;
5921 case VIETNAMESE_CHARSET
:
5922 charset_type
= Qw32_charset_vietnamese
;
5925 charset_type
= Qw32_charset_thai
;
5928 charset_type
= Qw32_charset_mac
;
5931 charset_type
= Qw32_charset_johab
;
5935 #ifdef UNICODE_CHARSET
5936 case UNICODE_CHARSET
:
5937 charset_type
= Qw32_charset_unicode
;
5941 /* Encode numerical value of unknown charset. */
5942 sprintf (buf
, "*-#%u", fncharset
);
5948 char * best_match
= NULL
;
5950 /* Look through w32-charset-info-alist for the character set.
5951 Prefer ISO codepages, and prefer lower numbers in the ISO
5952 range. Only return charsets for codepages which are installed.
5954 Format of each entry is
5955 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5957 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5960 Lisp_Object w32_charset
;
5961 Lisp_Object codepage
;
5963 Lisp_Object this_entry
= XCAR (rest
);
5965 /* Skip invalid entries in alist. */
5966 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5967 || !CONSP (XCDR (this_entry
))
5968 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5971 x_charset
= XSTRING (XCAR (this_entry
))->data
;
5972 w32_charset
= XCAR (XCDR (this_entry
));
5973 codepage
= XCDR (XCDR (this_entry
));
5975 /* Look for Same charset and a valid codepage (or non-int
5976 which means ignore). */
5977 if (w32_charset
== charset_type
5978 && (!INTEGERP (codepage
) || codepage
== CP_DEFAULT
5979 || IsValidCodePage (XINT (codepage
))))
5981 /* If we don't have a match already, then this is the
5984 best_match
= x_charset
;
5985 /* If this is an ISO codepage, and the best so far isn't,
5986 then this is better. */
5987 else if (stricmp (best_match
, "iso") != 0
5988 && stricmp (x_charset
, "iso") == 0)
5989 best_match
= x_charset
;
5990 /* If both are ISO8859 codepages, choose the one with the
5991 lowest number in the encoding field. */
5992 else if (stricmp (best_match
, "iso8859-") == 0
5993 && stricmp (x_charset
, "iso8859-") == 0)
5995 int best_enc
= atoi (best_match
+ 8);
5996 int this_enc
= atoi (x_charset
+ 8);
5997 if (this_enc
> 0 && this_enc
< best_enc
)
5998 best_match
= x_charset
;
6003 /* If no match, encode the numeric value. */
6006 sprintf (buf
, "*-#%u", fncharset
);
6010 strncpy(buf
, best_match
, 15);
6017 /* Get the Windows codepage corresponding to the specified font. The
6018 charset info in the font name is used to look up
6019 w32-charset-to-codepage-alist. */
6021 w32_codepage_for_font (char *fontname
)
6023 Lisp_Object codepage
, entry
;
6024 char *charset_str
, *charset
, *end
;
6026 if (NILP (Vw32_charset_info_alist
))
6029 /* Extract charset part of font string. */
6030 charset
= xlfd_charset_of_font (fontname
);
6035 charset_str
= (char *) alloca (strlen (charset
));
6036 strcpy (charset_str
, charset
);
6038 /* Remove leading "*-". */
6039 if (strncmp ("*-", charset_str
, 2) == 0)
6040 charset
= charset_str
+ 2;
6042 charset
= charset_str
;
6044 /* Stop match at wildcard (including preceding '-'). */
6045 if (end
= strchr (charset
, '*'))
6047 if (end
> charset
&& *(end
-1) == '-')
6052 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
6056 codepage
= Fcdr (Fcdr (entry
));
6058 if (NILP (codepage
))
6060 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
6062 else if (INTEGERP (codepage
))
6063 return XINT (codepage
);
6070 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
6071 LOGFONT
* lplogfont
;
6074 char * specific_charset
;
6078 char height_pixels
[8];
6080 char width_pixels
[8];
6081 char *fontname_dash
;
6082 int display_resy
= one_w32_display_info
.resy
;
6083 int display_resx
= one_w32_display_info
.resx
;
6085 struct coding_system coding
;
6087 if (!lpxstr
) abort ();
6092 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
6093 fonttype
= "raster";
6094 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
6095 fonttype
= "outline";
6097 fonttype
= "unknown";
6099 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system
),
6101 coding
.src_multibyte
= 0;
6102 coding
.dst_multibyte
= 1;
6103 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6104 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
6106 fontname
= alloca(sizeof(*fontname
) * bufsz
);
6107 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
6108 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
6109 *(fontname
+ coding
.produced
) = '\0';
6111 /* Replace dashes with underscores so the dashes are not
6113 fontname_dash
= fontname
;
6114 while (fontname_dash
= strchr (fontname_dash
, '-'))
6115 *fontname_dash
= '_';
6117 if (lplogfont
->lfHeight
)
6119 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
6120 sprintf (height_dpi
, "%u",
6121 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
6125 strcpy (height_pixels
, "*");
6126 strcpy (height_dpi
, "*");
6128 if (lplogfont
->lfWidth
)
6129 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
6131 strcpy (width_pixels
, "*");
6133 _snprintf (lpxstr
, len
- 1,
6134 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6135 fonttype
, /* foundry */
6136 fontname
, /* family */
6137 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
6138 lplogfont
->lfItalic
?'i':'r', /* slant */
6140 /* add style name */
6141 height_pixels
, /* pixel size */
6142 height_dpi
, /* point size */
6143 display_resx
, /* resx */
6144 display_resy
, /* resy */
6145 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
6146 ? 'p' : 'c', /* spacing */
6147 width_pixels
, /* avg width */
6148 specific_charset
? specific_charset
6149 : w32_to_x_charset (lplogfont
->lfCharSet
)
6150 /* charset registry and encoding */
6153 lpxstr
[len
- 1] = 0; /* just to be sure */
6158 x_to_w32_font (lpxstr
, lplogfont
)
6160 LOGFONT
* lplogfont
;
6162 struct coding_system coding
;
6164 if (!lplogfont
) return (FALSE
);
6166 memset (lplogfont
, 0, sizeof (*lplogfont
));
6168 /* Set default value for each field. */
6170 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
6171 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
6172 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
6174 /* go for maximum quality */
6175 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
6176 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
6177 lplogfont
->lfQuality
= PROOF_QUALITY
;
6180 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
6181 lplogfont
->lfWeight
= FW_DONTCARE
;
6182 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
6187 /* Provide a simple escape mechanism for specifying Windows font names
6188 * directly -- if font spec does not beginning with '-', assume this
6190 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6196 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
6197 width
[10], resy
[10], remainder
[20];
6199 int dpi
= one_w32_display_info
.resy
;
6201 fields
= sscanf (lpxstr
,
6202 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%19s",
6203 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
6204 if (fields
== EOF
) return (FALSE
);
6206 /* If wildcards cover more than one field, we don't know which
6207 field is which, so don't fill any in. */
6212 if (fields
> 0 && name
[0] != '*')
6218 (Fcheck_coding_system (Vw32_system_coding_system
), &coding
);
6219 coding
.src_multibyte
= 1;
6220 coding
.dst_multibyte
= 1;
6221 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
6222 buf
= (unsigned char *) alloca (bufsize
);
6223 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
6224 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
6225 if (coding
.produced
>= LF_FACESIZE
)
6226 coding
.produced
= LF_FACESIZE
- 1;
6227 buf
[coding
.produced
] = 0;
6228 strcpy (lplogfont
->lfFaceName
, buf
);
6232 lplogfont
->lfFaceName
[0] = '\0';
6237 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6241 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
6245 if (fields
> 0 && pixels
[0] != '*')
6246 lplogfont
->lfHeight
= atoi (pixels
);
6250 if (fields
> 0 && resy
[0] != '*')
6253 if (tem
> 0) dpi
= tem
;
6256 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
6257 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
6260 lplogfont
->lfPitchAndFamily
=
6261 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
6265 if (fields
> 0 && width
[0] != '*')
6266 lplogfont
->lfWidth
= atoi (width
) / 10;
6270 /* Strip the trailing '-' if present. (it shouldn't be, as it
6271 fails the test against xlfd-tight-regexp in fontset.el). */
6273 int len
= strlen (remainder
);
6274 if (len
> 0 && remainder
[len
-1] == '-')
6275 remainder
[len
-1] = 0;
6277 encoding
= remainder
;
6278 if (strncmp (encoding
, "*-", 2) == 0)
6280 lplogfont
->lfCharSet
= x_to_w32_charset (fields
> 0 ? encoding
: "");
6285 char name
[100], height
[10], width
[10], weight
[20];
6287 fields
= sscanf (lpxstr
,
6288 "%99[^:]:%9[^:]:%9[^:]:%19s",
6289 name
, height
, width
, weight
);
6291 if (fields
== EOF
) return (FALSE
);
6295 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
6296 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
6300 lplogfont
->lfFaceName
[0] = 0;
6306 lplogfont
->lfHeight
= atoi (height
);
6311 lplogfont
->lfWidth
= atoi (width
);
6315 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
6318 /* This makes TrueType fonts work better. */
6319 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
6324 /* Strip the pixel height and point height from the given xlfd, and
6325 return the pixel height. If no pixel height is specified, calculate
6326 one from the point height, or if that isn't defined either, return
6327 0 (which usually signifies a scalable font).
6329 int xlfd_strip_height (char *fontname
)
6331 int pixel_height
, point_height
, dpi
, field_number
;
6332 char *read_from
, *write_to
;
6336 pixel_height
= field_number
= 0;
6339 /* Look for height fields. */
6340 for (read_from
= fontname
; *read_from
; read_from
++)
6342 if (*read_from
== '-')
6345 if (field_number
== 7) /* Pixel height. */
6348 write_to
= read_from
;
6350 /* Find end of field. */
6351 for (;*read_from
&& *read_from
!= '-'; read_from
++)
6354 /* Split the fontname at end of field. */
6360 pixel_height
= atoi (write_to
);
6361 /* Blank out field. */
6362 if (read_from
> write_to
)
6367 /* If the pixel height field is at the end (partial xlfd),
6370 return pixel_height
;
6372 /* If we got a pixel height, the point height can be
6373 ignored. Just blank it out and break now. */
6376 /* Find end of point size field. */
6377 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6383 /* Blank out the point size field. */
6384 if (read_from
> write_to
)
6390 return pixel_height
;
6394 /* If the point height is already blank, break now. */
6395 if (*read_from
== '-')
6401 else if (field_number
== 8)
6403 /* If we didn't get a pixel height, try to get the point
6404 height and convert that. */
6406 char *point_size_start
= read_from
++;
6408 /* Find end of field. */
6409 for (; *read_from
&& *read_from
!= '-'; read_from
++)
6418 point_size
= atoi (point_size_start
);
6420 /* Convert to pixel height. */
6421 pixel_height
= point_size
6422 * one_w32_display_info
.height_in
/ 720;
6424 /* Blank out this field and break. */
6432 /* Shift the rest of the font spec into place. */
6433 if (write_to
&& read_from
> write_to
)
6435 for (; *read_from
; read_from
++, write_to
++)
6436 *write_to
= *read_from
;
6440 return pixel_height
;
6443 /* Assume parameter 1 is fully qualified, no wildcards. */
6445 w32_font_match (fontname
, pattern
)
6449 char *regex
= alloca (strlen (pattern
) * 2);
6450 char *font_name_copy
= alloca (strlen (fontname
) + 1);
6453 /* Copy fontname so we can modify it during comparison. */
6454 strcpy (font_name_copy
, fontname
);
6459 /* Turn pattern into a regexp and do a regexp match. */
6460 for (; *pattern
; pattern
++)
6462 if (*pattern
== '?')
6464 else if (*pattern
== '*')
6475 /* Strip out font heights and compare them seperately, since
6476 rounding error can cause mismatches. This also allows a
6477 comparison between a font that declares only a pixel height and a
6478 pattern that declares the point height.
6481 int font_height
, pattern_height
;
6483 font_height
= xlfd_strip_height (font_name_copy
);
6484 pattern_height
= xlfd_strip_height (regex
);
6486 /* Compare now, and don't bother doing expensive regexp matching
6487 if the heights differ. */
6488 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
6492 return (fast_c_string_match_ignore_case (build_string (regex
),
6493 font_name_copy
) >= 0);
6496 /* Callback functions, and a structure holding info they need, for
6497 listing system fonts on W32. We need one set of functions to do the
6498 job properly, but these don't work on NT 3.51 and earlier, so we
6499 have a second set which don't handle character sets properly to
6502 In both cases, there are two passes made. The first pass gets one
6503 font from each family, the second pass lists all the fonts from
6506 typedef struct enumfont_t
6511 XFontStruct
*size_ref
;
6512 Lisp_Object
*pattern
;
6517 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
6519 NEWTEXTMETRIC
* lptm
;
6523 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
6526 /* Check that the character set matches if it was specified */
6527 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
6528 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
6533 Lisp_Object width
= Qnil
;
6534 char *charset
= NULL
;
6536 /* Truetype fonts do not report their true metrics until loaded */
6537 if (FontType
!= RASTER_FONTTYPE
)
6539 if (!NILP (*(lpef
->pattern
)))
6541 /* Scalable fonts are as big as you want them to be. */
6542 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
6543 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
6544 width
= make_number (lpef
->logfont
.lfWidth
);
6548 lplf
->elfLogFont
.lfHeight
= 0;
6549 lplf
->elfLogFont
.lfWidth
= 0;
6553 /* Make sure the height used here is the same as everywhere
6554 else (ie character height, not cell height). */
6555 if (lplf
->elfLogFont
.lfHeight
> 0)
6557 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6558 if (FontType
== RASTER_FONTTYPE
)
6559 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
6561 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
6564 if (!NILP (*(lpef
->pattern
)))
6566 charset
= xlfd_charset_of_font (XSTRING(*(lpef
->pattern
))->data
);
6568 /* Ensure that charset is valid for this font. */
6570 && (x_to_w32_charset (charset
) != lplf
->elfLogFont
.lfCharSet
))
6574 /* TODO: List all relevant charsets if charset not specified. */
6575 if (!w32_to_x_font (&(lplf
->elfLogFont
), buf
, 100, charset
))
6578 if (NILP (*(lpef
->pattern
))
6579 || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
6581 *lpef
->tail
= Fcons (Fcons (build_string (buf
), width
), Qnil
);
6582 lpef
->tail
= &(XCDR (*lpef
->tail
));
6591 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
6593 NEWTEXTMETRIC
* lptm
;
6597 return EnumFontFamilies (lpef
->hdc
,
6598 lplf
->elfLogFont
.lfFaceName
,
6599 (FONTENUMPROC
) enum_font_cb2
,
6605 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
6606 ENUMLOGFONTEX
* lplf
;
6607 NEWTEXTMETRICEX
* lptm
;
6611 /* We are not interested in the extra info we get back from the 'Ex
6612 version - only the fact that we get character set variations
6613 enumerated seperately. */
6614 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
6619 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
6620 ENUMLOGFONTEX
* lplf
;
6621 NEWTEXTMETRICEX
* lptm
;
6625 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6626 FARPROC enum_font_families_ex
6627 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6628 /* We don't really expect EnumFontFamiliesEx to disappear once we
6629 get here, so don't bother handling it gracefully. */
6630 if (enum_font_families_ex
== NULL
)
6631 error ("gdi32.dll has disappeared!");
6632 return enum_font_families_ex (lpef
->hdc
,
6634 (FONTENUMPROC
) enum_fontex_cb2
,
6638 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6639 and xterm.c in Emacs 20.3) */
6641 Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
6643 char *fontname
, *ptnstr
;
6644 Lisp_Object list
, tem
, newlist
= Qnil
;
6647 list
= Vw32_bdf_filename_alist
;
6648 ptnstr
= XSTRING (pattern
)->data
;
6650 for ( ; CONSP (list
); list
= XCDR (list
))
6654 fontname
= XSTRING (XCAR (tem
))->data
;
6655 else if (STRINGP (tem
))
6656 fontname
= XSTRING (tem
)->data
;
6660 if (w32_font_match (fontname
, ptnstr
))
6662 newlist
= Fcons (XCAR (tem
), newlist
);
6664 if (n_fonts
>= max_names
)
6672 Lisp_Object
w32_list_synthesized_fonts (FRAME_PTR f
, Lisp_Object pattern
,
6673 int size
, int max_names
);
6675 /* Return a list of names of available fonts matching PATTERN on frame
6676 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6677 to be listed. Frame F NULL means we have not yet created any
6678 frame, which means we can't get proper size info, as we don't have
6679 a device context to use for GetTextMetrics.
6680 MAXNAMES sets a limit on how many fonts to match. */
6683 w32_list_fonts (FRAME_PTR f
, Lisp_Object pattern
, int size
, int maxnames
)
6685 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
6686 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
6687 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
6690 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
6691 if (NILP (patterns
))
6692 patterns
= Fcons (pattern
, Qnil
);
6694 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
6699 tpat
= XCAR (patterns
);
6701 if (!STRINGP (tpat
))
6704 /* Avoid expensive EnumFontFamilies functions if we are not
6705 going to be able to output one of these anyway. */
6706 codepage
= w32_codepage_for_font (XSTRING (tpat
)->data
);
6707 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
6708 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
6709 && !IsValidCodePage(codepage
))
6712 /* See if we cached the result for this particular query.
6713 The cache is an alist of the form:
6714 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6716 if (tem
= XCDR (dpyinfo
->name_list_element
),
6717 !NILP (list
= Fassoc (tpat
, tem
)))
6719 list
= Fcdr_safe (list
);
6720 /* We have a cached list. Don't have to get the list again. */
6725 /* At first, put PATTERN in the cache. */
6731 /* Use EnumFontFamiliesEx where it is available, as it knows
6732 about character sets. Fall back to EnumFontFamilies for
6733 older versions of NT that don't support the 'Ex function. */
6734 x_to_w32_font (XSTRING (tpat
)->data
, &ef
.logfont
);
6736 LOGFONT font_match_pattern
;
6737 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6738 FARPROC enum_font_families_ex
6739 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6741 /* We do our own pattern matching so we can handle wildcards. */
6742 font_match_pattern
.lfFaceName
[0] = 0;
6743 font_match_pattern
.lfPitchAndFamily
= 0;
6744 /* We can use the charset, because if it is a wildcard it will
6745 be DEFAULT_CHARSET anyway. */
6746 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
6748 ef
.hdc
= GetDC (dpyinfo
->root_window
);
6750 if (enum_font_families_ex
)
6751 enum_font_families_ex (ef
.hdc
,
6752 &font_match_pattern
,
6753 (FONTENUMPROC
) enum_fontex_cb1
,
6756 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
6759 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
6764 /* Make a list of the fonts we got back.
6765 Store that in the font cache for the display. */
6766 XCDR (dpyinfo
->name_list_element
)
6767 = Fcons (Fcons (tpat
, list
),
6768 XCDR (dpyinfo
->name_list_element
));
6771 if (NILP (list
)) continue; /* Try the remaining alternatives. */
6773 newlist
= second_best
= Qnil
;
6775 /* Make a list of the fonts that have the right width. */
6776 for (; CONSP (list
); list
= XCDR (list
))
6783 if (NILP (XCAR (tem
)))
6787 newlist
= Fcons (XCAR (tem
), newlist
);
6789 if (n_fonts
>= maxnames
)
6794 if (!INTEGERP (XCDR (tem
)))
6796 /* Since we don't yet know the size of the font, we must
6797 load it and try GetTextMetrics. */
6798 W32FontStruct thisinfo
;
6803 if (!x_to_w32_font (XSTRING (XCAR (tem
))->data
, &lf
))
6807 thisinfo
.bdf
= NULL
;
6808 thisinfo
.hfont
= CreateFontIndirect (&lf
);
6809 if (thisinfo
.hfont
== NULL
)
6812 hdc
= GetDC (dpyinfo
->root_window
);
6813 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
6814 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
6815 XCDR (tem
) = make_number (FONT_WIDTH (&thisinfo
));
6817 XCDR (tem
) = make_number (0);
6818 SelectObject (hdc
, oldobj
);
6819 ReleaseDC (dpyinfo
->root_window
, hdc
);
6820 DeleteObject(thisinfo
.hfont
);
6823 found_size
= XINT (XCDR (tem
));
6824 if (found_size
== size
)
6826 newlist
= Fcons (XCAR (tem
), newlist
);
6828 if (n_fonts
>= maxnames
)
6831 /* keep track of the closest matching size in case
6832 no exact match is found. */
6833 else if (found_size
> 0)
6835 if (NILP (second_best
))
6838 else if (found_size
< size
)
6840 if (XINT (XCDR (second_best
)) > size
6841 || XINT (XCDR (second_best
)) < found_size
)
6846 if (XINT (XCDR (second_best
)) > size
6847 && XINT (XCDR (second_best
)) >
6854 if (!NILP (newlist
))
6856 else if (!NILP (second_best
))
6858 newlist
= Fcons (XCAR (second_best
), Qnil
);
6863 /* Include any bdf fonts. */
6864 if (n_fonts
< maxnames
)
6866 Lisp_Object combined
[2];
6867 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
6868 combined
[1] = newlist
;
6869 newlist
= Fnconc(2, combined
);
6872 /* If we can't find a font that matches, check if Windows would be
6873 able to synthesize it from a different style. */
6874 if (NILP (newlist
) && !NILP (Vw32_enable_synthesized_fonts
))
6875 newlist
= w32_list_synthesized_fonts (f
, pattern
, size
, maxnames
);
6881 w32_list_synthesized_fonts (f
, pattern
, size
, max_names
)
6883 Lisp_Object pattern
;
6888 char *full_pattn
, *new_pattn
, foundary
[50], family
[50], *pattn_part2
;
6889 char style
[20], slant
;
6890 Lisp_Object matches
, match
, tem
, synthed_matches
= Qnil
;
6892 full_pattn
= XSTRING (pattern
)->data
;
6894 pattn_part2
= alloca (XSTRING (pattern
)->size
);
6895 /* Allow some space for wildcard expansion. */
6896 new_pattn
= alloca (XSTRING (pattern
)->size
+ 100);
6898 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
6899 foundary
, family
, style
, &slant
, pattn_part2
);
6900 if (fields
== EOF
|| fields
< 5)
6903 /* If the style and slant are wildcards already there is no point
6904 checking again (and we don't want to keep recursing). */
6905 if (*style
== '*' && slant
== '*')
6908 sprintf (new_pattn
, "-%s-%s-*-*-%s", foundary
, family
, pattn_part2
);
6910 matches
= w32_list_fonts (f
, build_string (new_pattn
), size
, max_names
);
6912 for ( ; CONSP (matches
); matches
= XCDR (matches
))
6914 tem
= XCAR (matches
);
6918 full_pattn
= XSTRING (tem
)->data
;
6919 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
6920 foundary
, family
, pattn_part2
);
6921 if (fields
== EOF
|| fields
< 3)
6924 sprintf (new_pattn
, "-%s-%s-%s-%c-%s", foundary
, family
, style
,
6925 slant
, pattn_part2
);
6927 synthed_matches
= Fcons (build_string (new_pattn
),
6931 return synthed_matches
;
6935 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6937 w32_get_font_info (f
, font_idx
)
6941 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
6946 w32_query_font (struct frame
*f
, char *fontname
)
6949 struct font_info
*pfi
;
6951 pfi
= FRAME_W32_FONT_TABLE (f
);
6953 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
6955 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
6961 /* Find a CCL program for a font specified by FONTP, and set the member
6962 `encoder' of the structure. */
6965 w32_find_ccl_program (fontp
)
6966 struct font_info
*fontp
;
6968 Lisp_Object list
, elt
;
6970 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
6974 && STRINGP (XCAR (elt
))
6975 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
6981 struct ccl_program
*ccl
6982 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
6984 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
6987 fontp
->font_encoder
= ccl
;
6992 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
6994 "Return a list of BDF fonts in DIR, suitable for appending to\n\
6995 w32-bdf-filename-alist. Fonts which do not contain an xlfd description\n\
6996 will not be included in the list. DIR may be a list of directories.")
6998 Lisp_Object directory
;
7000 Lisp_Object list
= Qnil
;
7001 struct gcpro gcpro1
, gcpro2
;
7003 if (!CONSP (directory
))
7004 return w32_find_bdf_fonts_in_dir (directory
);
7006 for ( ; CONSP (directory
); directory
= XCDR (directory
))
7008 Lisp_Object pair
[2];
7011 GCPRO2 (directory
, list
);
7012 pair
[1] = w32_find_bdf_fonts_in_dir( XCAR (directory
) );
7013 list
= Fnconc( 2, pair
);
7019 /* Find BDF files in a specified directory. (use GCPRO when calling,
7020 as this calls lisp to get a directory listing). */
7021 Lisp_Object
w32_find_bdf_fonts_in_dir( Lisp_Object directory
)
7023 Lisp_Object filelist
, list
= Qnil
;
7026 if (!STRINGP(directory
))
7029 filelist
= Fdirectory_files (directory
, Qt
,
7030 build_string (".*\\.[bB][dD][fF]"), Qt
);
7032 for ( ; CONSP(filelist
); filelist
= XCDR (filelist
))
7034 Lisp_Object filename
= XCAR (filelist
);
7035 if (w32_BDF_to_x_font (XSTRING (filename
)->data
, fontname
, 100))
7036 store_in_alist (&list
, build_string (fontname
), filename
);
7042 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
7043 "Internal function called by `color-defined-p', which see.")
7045 Lisp_Object color
, frame
;
7048 FRAME_PTR f
= check_x_frame (frame
);
7050 CHECK_STRING (color
, 1);
7052 if (w32_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
7058 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
7059 "Internal function called by `color-values', which see.")
7061 Lisp_Object color
, frame
;
7064 FRAME_PTR f
= check_x_frame (frame
);
7066 CHECK_STRING (color
, 1);
7068 if (w32_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
7072 rgb
[0] = make_number ((GetRValue (foo
.pixel
) << 8)
7073 | GetRValue (foo
.pixel
));
7074 rgb
[1] = make_number ((GetGValue (foo
.pixel
) << 8)
7075 | GetGValue (foo
.pixel
));
7076 rgb
[2] = make_number ((GetBValue (foo
.pixel
) << 8)
7077 | GetBValue (foo
.pixel
));
7078 return Flist (3, rgb
);
7084 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
7085 "Internal function called by `display-color-p', which see.")
7087 Lisp_Object display
;
7089 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7091 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
7097 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
7099 "Return t if the X display supports shades of gray.\n\
7100 Note that color displays do support shades of gray.\n\
7101 The optional argument DISPLAY specifies which display to ask about.\n\
7102 DISPLAY should be either a frame or a display name (a string).\n\
7103 If omitted or nil, that stands for the selected frame's display.")
7105 Lisp_Object display
;
7107 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7109 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
7115 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
7117 "Returns the width in pixels of the X display DISPLAY.\n\
7118 The optional argument DISPLAY specifies which display to ask about.\n\
7119 DISPLAY should be either a frame or a display name (a string).\n\
7120 If omitted or nil, that stands for the selected frame's display.")
7122 Lisp_Object display
;
7124 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7126 return make_number (dpyinfo
->width
);
7129 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
7130 Sx_display_pixel_height
, 0, 1, 0,
7131 "Returns the height in pixels of the X display DISPLAY.\n\
7132 The optional argument DISPLAY specifies which display to ask about.\n\
7133 DISPLAY should be either a frame or a display name (a string).\n\
7134 If omitted or nil, that stands for the selected frame's display.")
7136 Lisp_Object display
;
7138 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7140 return make_number (dpyinfo
->height
);
7143 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
7145 "Returns the number of bitplanes of the display DISPLAY.\n\
7146 The optional argument DISPLAY specifies which display to ask about.\n\
7147 DISPLAY should be either a frame or a display name (a string).\n\
7148 If omitted or nil, that stands for the selected frame's display.")
7150 Lisp_Object display
;
7152 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7154 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
7157 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
7159 "Returns the number of color cells of the display DISPLAY.\n\
7160 The optional argument DISPLAY specifies which display to ask about.\n\
7161 DISPLAY should be either a frame or a display name (a string).\n\
7162 If omitted or nil, that stands for the selected frame's display.")
7164 Lisp_Object display
;
7166 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7170 hdc
= GetDC (dpyinfo
->root_window
);
7171 if (dpyinfo
->has_palette
)
7172 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
7174 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
7176 ReleaseDC (dpyinfo
->root_window
, hdc
);
7178 return make_number (cap
);
7181 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
7182 Sx_server_max_request_size
,
7184 "Returns the maximum request size of the server of display DISPLAY.\n\
7185 The optional argument DISPLAY specifies which display to ask about.\n\
7186 DISPLAY should be either a frame or a display name (a string).\n\
7187 If omitted or nil, that stands for the selected frame's display.")
7189 Lisp_Object display
;
7191 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7193 return make_number (1);
7196 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
7197 "Returns the vendor ID string of the W32 system (Microsoft).\n\
7198 The optional argument DISPLAY specifies which display to ask about.\n\
7199 DISPLAY should be either a frame or a display name (a string).\n\
7200 If omitted or nil, that stands for the selected frame's display.")
7202 Lisp_Object display
;
7204 return build_string ("Microsoft Corp.");
7207 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
7208 "Returns the version numbers of the server of display DISPLAY.\n\
7209 The value is a list of three integers: the major and minor\n\
7210 version numbers, and the vendor-specific release\n\
7211 number. See also the function `x-server-vendor'.\n\n\
7212 The optional argument DISPLAY specifies which display to ask about.\n\
7213 DISPLAY should be either a frame or a display name (a string).\n\
7214 If omitted or nil, that stands for the selected frame's display.")
7216 Lisp_Object display
;
7218 return Fcons (make_number (w32_major_version
),
7219 Fcons (make_number (w32_minor_version
),
7220 Fcons (make_number (w32_build_number
), Qnil
)));
7223 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
7224 "Returns the number of screens on the server of display DISPLAY.\n\
7225 The optional argument DISPLAY specifies which display to ask about.\n\
7226 DISPLAY should be either a frame or a display name (a string).\n\
7227 If omitted or nil, that stands for the selected frame's display.")
7229 Lisp_Object display
;
7231 return make_number (1);
7234 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
7235 "Returns the height in millimeters of the X display DISPLAY.\n\
7236 The optional argument DISPLAY specifies which display to ask about.\n\
7237 DISPLAY should be either a frame or a display name (a string).\n\
7238 If omitted or nil, that stands for the selected frame's display.")
7240 Lisp_Object display
;
7242 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7246 hdc
= GetDC (dpyinfo
->root_window
);
7248 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
7250 ReleaseDC (dpyinfo
->root_window
, hdc
);
7252 return make_number (cap
);
7255 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
7256 "Returns the width in millimeters of the X display DISPLAY.\n\
7257 The optional argument DISPLAY specifies which display to ask about.\n\
7258 DISPLAY should be either a frame or a display name (a string).\n\
7259 If omitted or nil, that stands for the selected frame's display.")
7261 Lisp_Object display
;
7263 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7268 hdc
= GetDC (dpyinfo
->root_window
);
7270 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
7272 ReleaseDC (dpyinfo
->root_window
, hdc
);
7274 return make_number (cap
);
7277 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
7278 Sx_display_backing_store
, 0, 1, 0,
7279 "Returns an indication of whether display DISPLAY does backing store.\n\
7280 The value may be `always', `when-mapped', or `not-useful'.\n\
7281 The optional argument DISPLAY specifies which display to ask about.\n\
7282 DISPLAY should be either a frame or a display name (a string).\n\
7283 If omitted or nil, that stands for the selected frame's display.")
7285 Lisp_Object display
;
7287 return intern ("not-useful");
7290 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
7291 Sx_display_visual_class
, 0, 1, 0,
7292 "Returns the visual class of the display DISPLAY.\n\
7293 The value is one of the symbols `static-gray', `gray-scale',\n\
7294 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
7295 The optional argument DISPLAY specifies which display to ask about.\n\
7296 DISPLAY should be either a frame or a display name (a string).\n\
7297 If omitted or nil, that stands for the selected frame's display.")
7299 Lisp_Object display
;
7301 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7304 switch (dpyinfo
->visual
->class)
7306 case StaticGray
: return (intern ("static-gray"));
7307 case GrayScale
: return (intern ("gray-scale"));
7308 case StaticColor
: return (intern ("static-color"));
7309 case PseudoColor
: return (intern ("pseudo-color"));
7310 case TrueColor
: return (intern ("true-color"));
7311 case DirectColor
: return (intern ("direct-color"));
7313 error ("Display has an unknown visual class");
7317 error ("Display has an unknown visual class");
7320 DEFUN ("x-display-save-under", Fx_display_save_under
,
7321 Sx_display_save_under
, 0, 1, 0,
7322 "Returns t if the display DISPLAY supports the save-under feature.\n\
7323 The optional argument DISPLAY specifies which display to ask about.\n\
7324 DISPLAY should be either a frame or a display name (a string).\n\
7325 If omitted or nil, that stands for the selected frame's display.")
7327 Lisp_Object display
;
7334 register struct frame
*f
;
7336 return PIXEL_WIDTH (f
);
7341 register struct frame
*f
;
7343 return PIXEL_HEIGHT (f
);
7348 register struct frame
*f
;
7350 return FONT_WIDTH (f
->output_data
.w32
->font
);
7355 register struct frame
*f
;
7357 return f
->output_data
.w32
->line_height
;
7362 register struct frame
*f
;
7364 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
7367 /* Return the display structure for the display named NAME.
7368 Open a new connection if necessary. */
7370 struct w32_display_info
*
7371 x_display_info_for_name (name
)
7375 struct w32_display_info
*dpyinfo
;
7377 CHECK_STRING (name
, 0);
7379 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
7381 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
7384 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
7389 /* Use this general default value to start with. */
7390 Vx_resource_name
= Vinvocation_name
;
7392 validate_x_resource_name ();
7394 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
7395 (char *) XSTRING (Vx_resource_name
)->data
);
7398 error ("Cannot connect to server %s", XSTRING (name
)->data
);
7401 XSETFASTINT (Vwindow_system_version
, 3);
7406 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
7407 1, 3, 0, "Open a connection to a server.\n\
7408 DISPLAY is the name of the display to connect to.\n\
7409 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
7410 If the optional third arg MUST-SUCCEED is non-nil,\n\
7411 terminate Emacs if we can't open the connection.")
7412 (display
, xrm_string
, must_succeed
)
7413 Lisp_Object display
, xrm_string
, must_succeed
;
7415 unsigned char *xrm_option
;
7416 struct w32_display_info
*dpyinfo
;
7418 CHECK_STRING (display
, 0);
7419 if (! NILP (xrm_string
))
7420 CHECK_STRING (xrm_string
, 1);
7422 if (! EQ (Vwindow_system
, intern ("w32")))
7423 error ("Not using Microsoft Windows");
7425 /* Allow color mapping to be defined externally; first look in user's
7426 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
7428 Lisp_Object color_file
;
7429 struct gcpro gcpro1
;
7431 color_file
= build_string("~/rgb.txt");
7433 GCPRO1 (color_file
);
7435 if (NILP (Ffile_readable_p (color_file
)))
7437 Fexpand_file_name (build_string ("rgb.txt"),
7438 Fsymbol_value (intern ("data-directory")));
7440 Vw32_color_map
= Fw32_load_color_file (color_file
);
7444 if (NILP (Vw32_color_map
))
7445 Vw32_color_map
= Fw32_default_color_map ();
7447 if (! NILP (xrm_string
))
7448 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
7450 xrm_option
= (unsigned char *) 0;
7452 /* Use this general default value to start with. */
7453 /* First remove .exe suffix from invocation-name - it looks ugly. */
7455 char basename
[ MAX_PATH
], *str
;
7457 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
7458 str
= strrchr (basename
, '.');
7460 Vinvocation_name
= build_string (basename
);
7462 Vx_resource_name
= Vinvocation_name
;
7464 validate_x_resource_name ();
7466 /* This is what opens the connection and sets x_current_display.
7467 This also initializes many symbols, such as those used for input. */
7468 dpyinfo
= w32_term_init (display
, xrm_option
,
7469 (char *) XSTRING (Vx_resource_name
)->data
);
7473 if (!NILP (must_succeed
))
7474 fatal ("Cannot connect to server %s.\n",
7475 XSTRING (display
)->data
);
7477 error ("Cannot connect to server %s", XSTRING (display
)->data
);
7482 XSETFASTINT (Vwindow_system_version
, 3);
7486 DEFUN ("x-close-connection", Fx_close_connection
,
7487 Sx_close_connection
, 1, 1, 0,
7488 "Close the connection to DISPLAY's server.\n\
7489 For DISPLAY, specify either a frame or a display name (a string).\n\
7490 If DISPLAY is nil, that stands for the selected frame's display.")
7492 Lisp_Object display
;
7494 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7497 if (dpyinfo
->reference_count
> 0)
7498 error ("Display still has frames on it");
7501 /* Free the fonts in the font table. */
7502 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
7503 if (dpyinfo
->font_table
[i
].name
)
7505 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
7506 xfree (dpyinfo
->font_table
[i
].full_name
);
7507 xfree (dpyinfo
->font_table
[i
].name
);
7508 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
7510 x_destroy_all_bitmaps (dpyinfo
);
7512 x_delete_display (dpyinfo
);
7518 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
7519 "Return the list of display names that Emacs has connections to.")
7522 Lisp_Object tail
, result
;
7525 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
7526 result
= Fcons (XCAR (XCAR (tail
)), result
);
7531 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
7532 "If ON is non-nil, report errors as soon as the erring request is made.\n\
7533 If ON is nil, allow buffering of requests.\n\
7534 This is a noop on W32 systems.\n\
7535 The optional second argument DISPLAY specifies which display to act on.\n\
7536 DISPLAY should be either a frame or a display name (a string).\n\
7537 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
7539 Lisp_Object display
, on
;
7546 /***********************************************************************
7548 ***********************************************************************/
7550 /* Value is the number of elements of vector VECTOR. */
7552 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
7554 /* List of supported image types. Use define_image_type to add new
7555 types. Use lookup_image_type to find a type for a given symbol. */
7557 static struct image_type
*image_types
;
7559 /* The symbol `image' which is the car of the lists used to represent
7562 extern Lisp_Object Qimage
;
7564 /* The symbol `xbm' which is used as the type symbol for XBM images. */
7570 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
7571 extern Lisp_Object QCdata
;
7572 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
7573 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
7574 Lisp_Object QCindex
;
7576 /* Other symbols. */
7578 Lisp_Object Qlaplace
;
7580 /* Time in seconds after which images should be removed from the cache
7581 if not displayed. */
7583 Lisp_Object Vimage_cache_eviction_delay
;
7585 /* Function prototypes. */
7587 static void define_image_type
P_ ((struct image_type
*type
));
7588 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
7589 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
7590 static void x_laplace
P_ ((struct frame
*, struct image
*));
7591 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
7595 /* Define a new image type from TYPE. This adds a copy of TYPE to
7596 image_types and adds the symbol *TYPE->type to Vimage_types. */
7599 define_image_type (type
)
7600 struct image_type
*type
;
7602 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7603 The initialized data segment is read-only. */
7604 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
7605 bcopy (type
, p
, sizeof *p
);
7606 p
->next
= image_types
;
7608 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
7612 /* Look up image type SYMBOL, and return a pointer to its image_type
7613 structure. Value is null if SYMBOL is not a known image type. */
7615 static INLINE
struct image_type
*
7616 lookup_image_type (symbol
)
7619 struct image_type
*type
;
7621 for (type
= image_types
; type
; type
= type
->next
)
7622 if (EQ (symbol
, *type
->type
))
7629 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
7630 valid image specification is a list whose car is the symbol
7631 `image', and whose rest is a property list. The property list must
7632 contain a value for key `:type'. That value must be the name of a
7633 supported image type. The rest of the property list depends on the
7637 valid_image_p (object
)
7642 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
7644 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
7645 struct image_type
*type
= lookup_image_type (symbol
);
7648 valid_p
= type
->valid_p (object
);
7655 /* Log error message with format string FORMAT and argument ARG.
7656 Signaling an error, e.g. when an image cannot be loaded, is not a
7657 good idea because this would interrupt redisplay, and the error
7658 message display would lead to another redisplay. This function
7659 therefore simply displays a message. */
7662 image_error (format
, arg1
, arg2
)
7664 Lisp_Object arg1
, arg2
;
7666 add_to_log (format
, arg1
, arg2
);
7671 /***********************************************************************
7672 Image specifications
7673 ***********************************************************************/
7675 enum image_value_type
7677 IMAGE_DONT_CHECK_VALUE_TYPE
,
7680 IMAGE_POSITIVE_INTEGER_VALUE
,
7681 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
7683 IMAGE_INTEGER_VALUE
,
7684 IMAGE_FUNCTION_VALUE
,
7689 /* Structure used when parsing image specifications. */
7691 struct image_keyword
7693 /* Name of keyword. */
7696 /* The type of value allowed. */
7697 enum image_value_type type
;
7699 /* Non-zero means key must be present. */
7702 /* Used to recognize duplicate keywords in a property list. */
7705 /* The value that was found. */
7710 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
7712 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
7715 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
7716 has the format (image KEYWORD VALUE ...). One of the keyword/
7717 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7718 image_keywords structures of size NKEYWORDS describing other
7719 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7722 parse_image_spec (spec
, keywords
, nkeywords
, type
)
7724 struct image_keyword
*keywords
;
7731 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
7734 plist
= XCDR (spec
);
7735 while (CONSP (plist
))
7737 Lisp_Object key
, value
;
7739 /* First element of a pair must be a symbol. */
7741 plist
= XCDR (plist
);
7745 /* There must follow a value. */
7748 value
= XCAR (plist
);
7749 plist
= XCDR (plist
);
7751 /* Find key in KEYWORDS. Error if not found. */
7752 for (i
= 0; i
< nkeywords
; ++i
)
7753 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
7759 /* Record that we recognized the keyword. If a keywords
7760 was found more than once, it's an error. */
7761 keywords
[i
].value
= value
;
7762 ++keywords
[i
].count
;
7764 if (keywords
[i
].count
> 1)
7767 /* Check type of value against allowed type. */
7768 switch (keywords
[i
].type
)
7770 case IMAGE_STRING_VALUE
:
7771 if (!STRINGP (value
))
7775 case IMAGE_SYMBOL_VALUE
:
7776 if (!SYMBOLP (value
))
7780 case IMAGE_POSITIVE_INTEGER_VALUE
:
7781 if (!INTEGERP (value
) || XINT (value
) <= 0)
7785 case IMAGE_ASCENT_VALUE
:
7786 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
7788 else if (INTEGERP (value
)
7789 && XINT (value
) >= 0
7790 && XINT (value
) <= 100)
7794 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
7795 if (!INTEGERP (value
) || XINT (value
) < 0)
7799 case IMAGE_DONT_CHECK_VALUE_TYPE
:
7802 case IMAGE_FUNCTION_VALUE
:
7803 value
= indirect_function (value
);
7805 || COMPILEDP (value
)
7806 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
7810 case IMAGE_NUMBER_VALUE
:
7811 if (!INTEGERP (value
) && !FLOATP (value
))
7815 case IMAGE_INTEGER_VALUE
:
7816 if (!INTEGERP (value
))
7820 case IMAGE_BOOL_VALUE
:
7821 if (!NILP (value
) && !EQ (value
, Qt
))
7830 if (EQ (key
, QCtype
) && !EQ (type
, value
))
7834 /* Check that all mandatory fields are present. */
7835 for (i
= 0; i
< nkeywords
; ++i
)
7836 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
7839 return NILP (plist
);
7843 /* Return the value of KEY in image specification SPEC. Value is nil
7844 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
7845 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
7848 image_spec_value (spec
, key
, found
)
7849 Lisp_Object spec
, key
;
7854 xassert (valid_image_p (spec
));
7856 for (tail
= XCDR (spec
);
7857 CONSP (tail
) && CONSP (XCDR (tail
));
7858 tail
= XCDR (XCDR (tail
)))
7860 if (EQ (XCAR (tail
), key
))
7864 return XCAR (XCDR (tail
));
7876 /***********************************************************************
7877 Image type independent image structures
7878 ***********************************************************************/
7880 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
7881 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
7884 /* Allocate and return a new image structure for image specification
7885 SPEC. SPEC has a hash value of HASH. */
7887 static struct image
*
7888 make_image (spec
, hash
)
7892 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
7894 xassert (valid_image_p (spec
));
7895 bzero (img
, sizeof *img
);
7896 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
7897 xassert (img
->type
!= NULL
);
7899 img
->data
.lisp_val
= Qnil
;
7900 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
7906 /* Free image IMG which was used on frame F, including its resources. */
7915 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
7917 /* Remove IMG from the hash table of its cache. */
7919 img
->prev
->next
= img
->next
;
7921 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
7924 img
->next
->prev
= img
->prev
;
7926 c
->images
[img
->id
] = NULL
;
7928 /* Free resources, then free IMG. */
7929 img
->type
->free (f
, img
);
7935 /* Prepare image IMG for display on frame F. Must be called before
7936 drawing an image. */
7939 prepare_image_for_display (f
, img
)
7945 /* We're about to display IMG, so set its timestamp to `now'. */
7947 img
->timestamp
= EMACS_SECS (t
);
7949 /* If IMG doesn't have a pixmap yet, load it now, using the image
7950 type dependent loader function. */
7951 if (img
->pixmap
== 0 && !img
->load_failed_p
)
7952 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
7956 /* Value is the number of pixels for the ascent of image IMG when
7957 drawn in face FACE. */
7960 image_ascent (img
, face
)
7964 int height
= img
->height
+ img
->margin
;
7967 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
7970 ascent
= height
/ 2 - (FONT_DESCENT(face
->font
)
7971 - FONT_BASE(face
->font
)) / 2;
7973 ascent
= height
/ 2;
7976 ascent
= height
* img
->ascent
/ 100.0;
7983 /***********************************************************************
7984 Helper functions for X image types
7985 ***********************************************************************/
7987 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
7988 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
7990 Lisp_Object color_name
,
7991 unsigned long dflt
));
7993 /* Free X resources of image IMG which is used on frame F. */
7996 x_clear_image (f
, img
)
8000 #if 0 /* TODO: W32 image support */
8005 XFreePixmap (NULL
, img
->pixmap
);
8012 int class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
8014 /* If display has an immutable color map, freeing colors is not
8015 necessary and some servers don't allow it. So don't do it. */
8016 if (class != StaticColor
8017 && class != StaticGray
8018 && class != TrueColor
)
8022 cmap
= DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f
)->screen
);
8023 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
, img
->colors
,
8028 xfree (img
->colors
);
8036 /* Allocate color COLOR_NAME for image IMG on frame F. If color
8037 cannot be allocated, use DFLT. Add a newly allocated color to
8038 IMG->colors, so that it can be freed again. Value is the pixel
8041 static unsigned long
8042 x_alloc_image_color (f
, img
, color_name
, dflt
)
8045 Lisp_Object color_name
;
8048 #if 0 /* TODO: allocing colors. */
8050 unsigned long result
;
8052 xassert (STRINGP (color_name
));
8054 if (w32_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
8056 /* This isn't called frequently so we get away with simply
8057 reallocating the color vector to the needed size, here. */
8060 (unsigned long *) xrealloc (img
->colors
,
8061 img
->ncolors
* sizeof *img
->colors
);
8062 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
8063 result
= color
.pixel
;
8074 /***********************************************************************
8076 ***********************************************************************/
8078 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
8081 /* Return a new, initialized image cache that is allocated from the
8082 heap. Call free_image_cache to free an image cache. */
8084 struct image_cache
*
8087 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
8090 bzero (c
, sizeof *c
);
8092 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
8093 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
8094 c
->buckets
= (struct image
**) xmalloc (size
);
8095 bzero (c
->buckets
, size
);
8100 /* Free image cache of frame F. Be aware that X frames share images
8104 free_image_cache (f
)
8107 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8112 /* Cache should not be referenced by any frame when freed. */
8113 xassert (c
->refcount
== 0);
8115 for (i
= 0; i
< c
->used
; ++i
)
8116 free_image (f
, c
->images
[i
]);
8120 FRAME_X_IMAGE_CACHE (f
) = NULL
;
8125 /* Clear image cache of frame F. FORCE_P non-zero means free all
8126 images. FORCE_P zero means clear only images that haven't been
8127 displayed for some time. Should be called from time to time to
8128 reduce the number of loaded images. If image-eviction-seconds is
8129 non-nil, this frees images in the cache which weren't displayed for
8130 at least that many seconds. */
8133 clear_image_cache (f
, force_p
)
8137 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8139 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
8143 int i
, any_freed_p
= 0;
8146 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
8148 for (i
= 0; i
< c
->used
; ++i
)
8150 struct image
*img
= c
->images
[i
];
8153 || (img
->timestamp
> old
)))
8155 free_image (f
, img
);
8160 /* We may be clearing the image cache because, for example,
8161 Emacs was iconified for a longer period of time. In that
8162 case, current matrices may still contain references to
8163 images freed above. So, clear these matrices. */
8166 clear_current_matrices (f
);
8167 ++windows_or_buffers_changed
;
8173 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
8175 "Clear the image cache of FRAME.\n\
8176 FRAME nil or omitted means use the selected frame.\n\
8177 FRAME t means clear the image caches of all frames.")
8185 FOR_EACH_FRAME (tail
, frame
)
8186 if (FRAME_W32_P (XFRAME (frame
)))
8187 clear_image_cache (XFRAME (frame
), 1);
8190 clear_image_cache (check_x_frame (frame
), 1);
8196 /* Return the id of image with Lisp specification SPEC on frame F.
8197 SPEC must be a valid Lisp image specification (see valid_image_p). */
8200 lookup_image (f
, spec
)
8204 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8208 struct gcpro gcpro1
;
8211 /* F must be a window-system frame, and SPEC must be a valid image
8213 xassert (FRAME_WINDOW_P (f
));
8214 xassert (valid_image_p (spec
));
8218 /* Look up SPEC in the hash table of the image cache. */
8219 hash
= sxhash (spec
, 0);
8220 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8222 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
8223 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
8226 /* If not found, create a new image and cache it. */
8229 img
= make_image (spec
, hash
);
8230 cache_image (f
, img
);
8231 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
8232 xassert (!interrupt_input_blocked
);
8234 /* If we can't load the image, and we don't have a width and
8235 height, use some arbitrary width and height so that we can
8236 draw a rectangle for it. */
8237 if (img
->load_failed_p
)
8241 value
= image_spec_value (spec
, QCwidth
, NULL
);
8242 img
->width
= (INTEGERP (value
)
8243 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
8244 value
= image_spec_value (spec
, QCheight
, NULL
);
8245 img
->height
= (INTEGERP (value
)
8246 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
8250 /* Handle image type independent image attributes
8251 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
8252 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
8255 ascent
= image_spec_value (spec
, QCascent
, NULL
);
8256 if (INTEGERP (ascent
))
8257 img
->ascent
= XFASTINT (ascent
);
8258 else if (EQ (ascent
, Qcenter
))
8259 img
->ascent
= CENTERED_IMAGE_ASCENT
;
8261 margin
= image_spec_value (spec
, QCmargin
, NULL
);
8262 if (INTEGERP (margin
) && XINT (margin
) >= 0)
8263 img
->margin
= XFASTINT (margin
);
8265 relief
= image_spec_value (spec
, QCrelief
, NULL
);
8266 if (INTEGERP (relief
))
8268 img
->relief
= XINT (relief
);
8269 img
->margin
+= abs (img
->relief
);
8272 /* Should we apply a Laplace edge-detection algorithm? */
8273 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
8274 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
8277 /* Should we built a mask heuristically? */
8278 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
8279 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
8280 x_build_heuristic_mask (f
, img
, heuristic_mask
);
8284 /* We're using IMG, so set its timestamp to `now'. */
8285 EMACS_GET_TIME (now
);
8286 img
->timestamp
= EMACS_SECS (now
);
8290 /* Value is the image id. */
8295 /* Cache image IMG in the image cache of frame F. */
8298 cache_image (f
, img
)
8302 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8305 /* Find a free slot in c->images. */
8306 for (i
= 0; i
< c
->used
; ++i
)
8307 if (c
->images
[i
] == NULL
)
8310 /* If no free slot found, maybe enlarge c->images. */
8311 if (i
== c
->used
&& c
->used
== c
->size
)
8314 c
->images
= (struct image
**) xrealloc (c
->images
,
8315 c
->size
* sizeof *c
->images
);
8318 /* Add IMG to c->images, and assign IMG an id. */
8324 /* Add IMG to the cache's hash table. */
8325 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
8326 img
->next
= c
->buckets
[i
];
8328 img
->next
->prev
= img
;
8330 c
->buckets
[i
] = img
;
8334 /* Call FN on every image in the image cache of frame F. Used to mark
8335 Lisp Objects in the image cache. */
8338 forall_images_in_image_cache (f
, fn
)
8340 void (*fn
) P_ ((struct image
*img
));
8342 if (FRAME_LIVE_P (f
) && FRAME_W32_P (f
))
8344 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8348 for (i
= 0; i
< c
->used
; ++i
)
8357 /***********************************************************************
8359 ***********************************************************************/
8361 #if 0 /* TODO: W32 specific image code. */
8363 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
8364 XImage
**, Pixmap
*));
8365 static void x_destroy_x_image
P_ ((XImage
*));
8366 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
8369 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
8370 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
8371 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
8372 via xmalloc. Print error messages via image_error if an error
8373 occurs. Value is non-zero if successful. */
8376 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
8378 int width
, height
, depth
;
8382 #if 0 /* TODO: Image support for W32 */
8383 Display
*display
= FRAME_W32_DISPLAY (f
);
8384 Screen
*screen
= FRAME_X_SCREEN (f
);
8385 Window window
= FRAME_W32_WINDOW (f
);
8387 xassert (interrupt_input_blocked
);
8390 depth
= DefaultDepthOfScreen (screen
);
8391 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
8392 depth
, ZPixmap
, 0, NULL
, width
, height
,
8393 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
8396 image_error ("Unable to allocate X image", Qnil
, Qnil
);
8400 /* Allocate image raster. */
8401 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
8403 /* Allocate a pixmap of the same size. */
8404 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
8407 x_destroy_x_image (*ximg
);
8409 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
8417 /* Destroy XImage XIMG. Free XIMG->data. */
8420 x_destroy_x_image (ximg
)
8423 xassert (interrupt_input_blocked
);
8428 XDestroyImage (ximg
);
8433 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
8434 are width and height of both the image and pixmap. */
8437 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
8444 xassert (interrupt_input_blocked
);
8445 gc
= XCreateGC (NULL
, pixmap
, 0, NULL
);
8446 XPutImage (NULL
, pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
8453 /***********************************************************************
8455 ***********************************************************************/
8457 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
8459 /* Find image file FILE. Look in data-directory, then
8460 x-bitmap-file-path. Value is the full name of the file found, or
8461 nil if not found. */
8464 x_find_image_file (file
)
8467 Lisp_Object file_found
, search_path
;
8468 struct gcpro gcpro1
, gcpro2
;
8472 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
8473 GCPRO2 (file_found
, search_path
);
8475 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
8476 fd
= openp (search_path
, file
, "", &file_found
, 0);
8489 /***********************************************************************
8491 ***********************************************************************/
8493 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
8494 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
8496 static int xbm_image_p
P_ ((Lisp_Object object
));
8497 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
8501 /* Indices of image specification fields in xbm_format, below. */
8503 enum xbm_keyword_index
8520 /* Vector of image_keyword structures describing the format
8521 of valid XBM image specifications. */
8523 static struct image_keyword xbm_format
[XBM_LAST
] =
8525 {":type", IMAGE_SYMBOL_VALUE
, 1},
8526 {":file", IMAGE_STRING_VALUE
, 0},
8527 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8528 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8529 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8530 {":foreground", IMAGE_STRING_VALUE
, 0},
8531 {":background", IMAGE_STRING_VALUE
, 0},
8532 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8533 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8534 {":relief", IMAGE_INTEGER_VALUE
, 0},
8535 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8536 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8539 /* Structure describing the image type XBM. */
8541 static struct image_type xbm_type
=
8550 /* Tokens returned from xbm_scan. */
8559 /* Return non-zero if OBJECT is a valid XBM-type image specification.
8560 A valid specification is a list starting with the symbol `image'
8561 The rest of the list is a property list which must contain an
8564 If the specification specifies a file to load, it must contain
8565 an entry `:file FILENAME' where FILENAME is a string.
8567 If the specification is for a bitmap loaded from memory it must
8568 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
8569 WIDTH and HEIGHT are integers > 0. DATA may be:
8571 1. a string large enough to hold the bitmap data, i.e. it must
8572 have a size >= (WIDTH + 7) / 8 * HEIGHT
8574 2. a bool-vector of size >= WIDTH * HEIGHT
8576 3. a vector of strings or bool-vectors, one for each line of the
8579 Both the file and data forms may contain the additional entries
8580 `:background COLOR' and `:foreground COLOR'. If not present,
8581 foreground and background of the frame on which the image is
8582 displayed, is used. */
8585 xbm_image_p (object
)
8588 struct image_keyword kw
[XBM_LAST
];
8590 bcopy (xbm_format
, kw
, sizeof kw
);
8591 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
8594 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
8596 if (kw
[XBM_FILE
].count
)
8598 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
8606 /* Entries for `:width', `:height' and `:data' must be present. */
8607 if (!kw
[XBM_WIDTH
].count
8608 || !kw
[XBM_HEIGHT
].count
8609 || !kw
[XBM_DATA
].count
)
8612 data
= kw
[XBM_DATA
].value
;
8613 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
8614 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
8616 /* Check type of data, and width and height against contents of
8622 /* Number of elements of the vector must be >= height. */
8623 if (XVECTOR (data
)->size
< height
)
8626 /* Each string or bool-vector in data must be large enough
8627 for one line of the image. */
8628 for (i
= 0; i
< height
; ++i
)
8630 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
8634 if (XSTRING (elt
)->size
8635 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
8638 else if (BOOL_VECTOR_P (elt
))
8640 if (XBOOL_VECTOR (elt
)->size
< width
)
8647 else if (STRINGP (data
))
8649 if (XSTRING (data
)->size
8650 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
8653 else if (BOOL_VECTOR_P (data
))
8655 if (XBOOL_VECTOR (data
)->size
< width
* height
)
8662 /* Baseline must be a value between 0 and 100 (a percentage). */
8663 if (kw
[XBM_ASCENT
].count
8664 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
8671 /* Scan a bitmap file. FP is the stream to read from. Value is
8672 either an enumerator from enum xbm_token, or a character for a
8673 single-character token, or 0 at end of file. If scanning an
8674 identifier, store the lexeme of the identifier in SVAL. If
8675 scanning a number, store its value in *IVAL. */
8678 xbm_scan (fp
, sval
, ival
)
8685 /* Skip white space. */
8686 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
8691 else if (isdigit (c
))
8693 int value
= 0, digit
;
8698 if (c
== 'x' || c
== 'X')
8700 while ((c
= fgetc (fp
)) != EOF
)
8704 else if (c
>= 'a' && c
<= 'f')
8705 digit
= c
- 'a' + 10;
8706 else if (c
>= 'A' && c
<= 'F')
8707 digit
= c
- 'A' + 10;
8710 value
= 16 * value
+ digit
;
8713 else if (isdigit (c
))
8716 while ((c
= fgetc (fp
)) != EOF
8718 value
= 8 * value
+ c
- '0';
8724 while ((c
= fgetc (fp
)) != EOF
8726 value
= 10 * value
+ c
- '0';
8734 else if (isalpha (c
) || c
== '_')
8737 while ((c
= fgetc (fp
)) != EOF
8738 && (isalnum (c
) || c
== '_'))
8750 /* Replacement for XReadBitmapFileData which isn't available under old
8751 X versions. FILE is the name of the bitmap file to read. Set
8752 *WIDTH and *HEIGHT to the width and height of the image. Return in
8753 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
8757 xbm_read_bitmap_file_data (file
, width
, height
, data
)
8759 int *width
, *height
;
8760 unsigned char **data
;
8763 char buffer
[BUFSIZ
];
8766 int bytes_per_line
, i
, nbytes
;
8772 LA1 = xbm_scan (fp, buffer, &value)
8774 #define expect(TOKEN) \
8775 if (LA1 != (TOKEN)) \
8780 #define expect_ident(IDENT) \
8781 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
8786 fp
= fopen (file
, "r");
8790 *width
= *height
= -1;
8792 LA1
= xbm_scan (fp
, buffer
, &value
);
8794 /* Parse defines for width, height and hot-spots. */
8798 expect_ident ("define");
8799 expect (XBM_TK_IDENT
);
8801 if (LA1
== XBM_TK_NUMBER
);
8803 char *p
= strrchr (buffer
, '_');
8804 p
= p
? p
+ 1 : buffer
;
8805 if (strcmp (p
, "width") == 0)
8807 else if (strcmp (p
, "height") == 0)
8810 expect (XBM_TK_NUMBER
);
8813 if (*width
< 0 || *height
< 0)
8816 /* Parse bits. Must start with `static'. */
8817 expect_ident ("static");
8818 if (LA1
== XBM_TK_IDENT
)
8820 if (strcmp (buffer
, "unsigned") == 0)
8823 expect_ident ("char");
8825 else if (strcmp (buffer
, "short") == 0)
8829 if (*width
% 16 && *width
% 16 < 9)
8832 else if (strcmp (buffer
, "char") == 0)
8840 expect (XBM_TK_IDENT
);
8846 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
8847 nbytes
= bytes_per_line
* *height
;
8848 p
= *data
= (char *) xmalloc (nbytes
);
8853 for (i
= 0; i
< nbytes
; i
+= 2)
8856 expect (XBM_TK_NUMBER
);
8859 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
8862 if (LA1
== ',' || LA1
== '}')
8870 for (i
= 0; i
< nbytes
; ++i
)
8873 expect (XBM_TK_NUMBER
);
8877 if (LA1
== ',' || LA1
== '}')
8903 /* Load XBM image IMG which will be displayed on frame F from file
8904 SPECIFIED_FILE. Value is non-zero if successful. */
8907 xbm_load_image_from_file (f
, img
, specified_file
)
8910 Lisp_Object specified_file
;
8913 unsigned char *data
;
8916 struct gcpro gcpro1
;
8918 xassert (STRINGP (specified_file
));
8922 file
= x_find_image_file (specified_file
);
8923 if (!STRINGP (file
))
8925 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8930 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
8931 &img
->height
, &data
);
8934 int depth
= one_w32_display_info
.n_cbits
;
8935 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
8936 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
8939 xassert (img
->width
> 0 && img
->height
> 0);
8941 /* Get foreground and background colors, maybe allocate colors. */
8942 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
8944 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
8946 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
8948 background
= x_alloc_image_color (f
, img
, value
, background
);
8950 #if 0 /* TODO : Port image display to W32 */
8953 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f
),
8954 FRAME_W32_WINDOW (f
),
8956 img
->width
, img
->height
,
8957 foreground
, background
,
8961 if (img
->pixmap
== 0)
8963 x_clear_image (f
, img
);
8964 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
8973 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
8980 /* Fill image IMG which is used on frame F with pixmap data. Value is
8981 non-zero if successful. */
8989 Lisp_Object file_name
;
8991 xassert (xbm_image_p (img
->spec
));
8993 /* If IMG->spec specifies a file name, create a non-file spec from it. */
8994 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
8995 if (STRINGP (file_name
))
8996 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
8999 struct image_keyword fmt
[XBM_LAST
];
9002 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
9003 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
9007 /* Parse the list specification. */
9008 bcopy (xbm_format
, fmt
, sizeof fmt
);
9009 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
9012 /* Get specified width, and height. */
9013 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
9014 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
9015 xassert (img
->width
> 0 && img
->height
> 0);
9019 if (fmt
[XBM_ASCENT
].count
)
9020 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
9022 /* Get foreground and background colors, maybe allocate colors. */
9023 if (fmt
[XBM_FOREGROUND
].count
)
9024 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
9026 if (fmt
[XBM_BACKGROUND
].count
)
9027 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
9030 /* Set bits to the bitmap image data. */
9031 data
= fmt
[XBM_DATA
].value
;
9036 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
9038 p
= bits
= (char *) alloca (nbytes
* img
->height
);
9039 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
9041 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
9043 bcopy (XSTRING (line
)->data
, p
, nbytes
);
9045 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
9048 else if (STRINGP (data
))
9049 bits
= XSTRING (data
)->data
;
9051 bits
= XBOOL_VECTOR (data
)->data
;
9053 #if 0 /* TODO : W32 XPM code */
9054 /* Create the pixmap. */
9055 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
9057 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f
),
9058 FRAME_W32_WINDOW (f
),
9060 img
->width
, img
->height
,
9061 foreground
, background
,
9069 image_error ("Unable to create pixmap for XBM image `%s'",
9071 x_clear_image (f
, img
);
9082 /***********************************************************************
9084 ***********************************************************************/
9088 static int xpm_image_p
P_ ((Lisp_Object object
));
9089 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
9090 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
9092 #include "X11/xpm.h"
9094 /* The symbol `xpm' identifying XPM-format images. */
9098 /* Indices of image specification fields in xpm_format, below. */
9100 enum xpm_keyword_index
9114 /* Vector of image_keyword structures describing the format
9115 of valid XPM image specifications. */
9117 static struct image_keyword xpm_format
[XPM_LAST
] =
9119 {":type", IMAGE_SYMBOL_VALUE
, 1},
9120 {":file", IMAGE_STRING_VALUE
, 0},
9121 {":data", IMAGE_STRING_VALUE
, 0},
9122 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9123 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9124 {":relief", IMAGE_INTEGER_VALUE
, 0},
9125 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9126 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9127 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9130 /* Structure describing the image type XBM. */
9132 static struct image_type xpm_type
=
9142 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
9143 for XPM images. Such a list must consist of conses whose car and
9147 xpm_valid_color_symbols_p (color_symbols
)
9148 Lisp_Object color_symbols
;
9150 while (CONSP (color_symbols
))
9152 Lisp_Object sym
= XCAR (color_symbols
);
9154 || !STRINGP (XCAR (sym
))
9155 || !STRINGP (XCDR (sym
)))
9157 color_symbols
= XCDR (color_symbols
);
9160 return NILP (color_symbols
);
9164 /* Value is non-zero if OBJECT is a valid XPM image specification. */
9167 xpm_image_p (object
)
9170 struct image_keyword fmt
[XPM_LAST
];
9171 bcopy (xpm_format
, fmt
, sizeof fmt
);
9172 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
9173 /* Either `:file' or `:data' must be present. */
9174 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
9175 /* Either no `:color-symbols' or it's a list of conses
9176 whose car and cdr are strings. */
9177 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
9178 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
9179 && (fmt
[XPM_ASCENT
].count
== 0
9180 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
9184 /* Load image IMG which will be displayed on frame F. Value is
9185 non-zero if successful. */
9193 XpmAttributes attrs
;
9194 Lisp_Object specified_file
, color_symbols
;
9196 /* Configure the XPM lib. Use the visual of frame F. Allocate
9197 close colors. Return colors allocated. */
9198 bzero (&attrs
, sizeof attrs
);
9199 attrs
.visual
= FRAME_X_VISUAL (f
);
9200 attrs
.colormap
= FRAME_X_COLORMAP (f
);
9201 attrs
.valuemask
|= XpmVisual
;
9202 attrs
.valuemask
|= XpmColormap
;
9203 attrs
.valuemask
|= XpmReturnAllocPixels
;
9204 #ifdef XpmAllocCloseColors
9205 attrs
.alloc_close_colors
= 1;
9206 attrs
.valuemask
|= XpmAllocCloseColors
;
9208 attrs
.closeness
= 600;
9209 attrs
.valuemask
|= XpmCloseness
;
9212 /* If image specification contains symbolic color definitions, add
9213 these to `attrs'. */
9214 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
9215 if (CONSP (color_symbols
))
9218 XpmColorSymbol
*xpm_syms
;
9221 attrs
.valuemask
|= XpmColorSymbols
;
9223 /* Count number of symbols. */
9224 attrs
.numsymbols
= 0;
9225 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
9228 /* Allocate an XpmColorSymbol array. */
9229 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
9230 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
9231 bzero (xpm_syms
, size
);
9232 attrs
.colorsymbols
= xpm_syms
;
9234 /* Fill the color symbol array. */
9235 for (tail
= color_symbols
, i
= 0;
9237 ++i
, tail
= XCDR (tail
))
9239 Lisp_Object name
= XCAR (XCAR (tail
));
9240 Lisp_Object color
= XCDR (XCAR (tail
));
9241 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
9242 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
9243 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
9244 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
9248 /* Create a pixmap for the image, either from a file, or from a
9249 string buffer containing data in the same format as an XPM file. */
9251 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9252 if (STRINGP (specified_file
))
9254 Lisp_Object file
= x_find_image_file (specified_file
);
9255 if (!STRINGP (file
))
9257 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9262 rc
= XpmReadFileToPixmap (NULL
, FRAME_W32_WINDOW (f
),
9263 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
9268 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
9269 rc
= XpmCreatePixmapFromBuffer (NULL
, FRAME_W32_WINDOW (f
),
9270 XSTRING (buffer
)->data
,
9271 &img
->pixmap
, &img
->mask
,
9276 if (rc
== XpmSuccess
)
9278 /* Remember allocated colors. */
9279 img
->ncolors
= attrs
.nalloc_pixels
;
9280 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
9281 * sizeof *img
->colors
);
9282 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
9283 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
9285 img
->width
= attrs
.width
;
9286 img
->height
= attrs
.height
;
9287 xassert (img
->width
> 0 && img
->height
> 0);
9289 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
9291 XpmFreeAttributes (&attrs
);
9299 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
9302 case XpmFileInvalid
:
9303 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
9307 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
9310 case XpmColorFailed
:
9311 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
9315 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
9320 return rc
== XpmSuccess
;
9323 #endif /* HAVE_XPM != 0 */
9326 #if 0 /* TODO : Color tables on W32. */
9327 /***********************************************************************
9329 ***********************************************************************/
9331 /* An entry in the color table mapping an RGB color to a pixel color. */
9336 unsigned long pixel
;
9338 /* Next in color table collision list. */
9339 struct ct_color
*next
;
9342 /* The bucket vector size to use. Must be prime. */
9346 /* Value is a hash of the RGB color given by R, G, and B. */
9348 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
9350 /* The color hash table. */
9352 struct ct_color
**ct_table
;
9354 /* Number of entries in the color table. */
9356 int ct_colors_allocated
;
9358 /* Function prototypes. */
9360 static void init_color_table
P_ ((void));
9361 static void free_color_table
P_ ((void));
9362 static unsigned long *colors_in_color_table
P_ ((int *n
));
9363 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
9364 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
9367 /* Initialize the color table. */
9372 int size
= CT_SIZE
* sizeof (*ct_table
);
9373 ct_table
= (struct ct_color
**) xmalloc (size
);
9374 bzero (ct_table
, size
);
9375 ct_colors_allocated
= 0;
9379 /* Free memory associated with the color table. */
9385 struct ct_color
*p
, *next
;
9387 for (i
= 0; i
< CT_SIZE
; ++i
)
9388 for (p
= ct_table
[i
]; p
; p
= next
)
9399 /* Value is a pixel color for RGB color R, G, B on frame F. If an
9400 entry for that color already is in the color table, return the
9401 pixel color of that entry. Otherwise, allocate a new color for R,
9402 G, B, and make an entry in the color table. */
9404 static unsigned long
9405 lookup_rgb_color (f
, r
, g
, b
)
9409 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
9410 int i
= hash
% CT_SIZE
;
9413 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9414 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
9423 color
= PALETTERGB (r
, g
, b
);
9425 ++ct_colors_allocated
;
9427 p
= (struct ct_color
*) xmalloc (sizeof *p
);
9432 p
->next
= ct_table
[i
];
9440 /* Look up pixel color PIXEL which is used on frame F in the color
9441 table. If not already present, allocate it. Value is PIXEL. */
9443 static unsigned long
9444 lookup_pixel_color (f
, pixel
)
9446 unsigned long pixel
;
9448 int i
= pixel
% CT_SIZE
;
9451 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9452 if (p
->pixel
== pixel
)
9463 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9464 color
.pixel
= pixel
;
9465 XQueryColor (NULL
, cmap
, &color
);
9466 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
9471 ++ct_colors_allocated
;
9473 p
= (struct ct_color
*) xmalloc (sizeof *p
);
9478 p
->next
= ct_table
[i
];
9482 return FRAME_FOREGROUND_PIXEL (f
);
9488 /* Value is a vector of all pixel colors contained in the color table,
9489 allocated via xmalloc. Set *N to the number of colors. */
9491 static unsigned long *
9492 colors_in_color_table (n
)
9497 unsigned long *colors
;
9499 if (ct_colors_allocated
== 0)
9506 colors
= (unsigned long *) xmalloc (ct_colors_allocated
9508 *n
= ct_colors_allocated
;
9510 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
9511 for (p
= ct_table
[i
]; p
; p
= p
->next
)
9512 colors
[j
++] = p
->pixel
;
9521 /***********************************************************************
9523 ***********************************************************************/
9525 #if 0 /* TODO : W32 versions of low level algorithms */
9526 static void x_laplace_write_row
P_ ((struct frame
*, long *,
9527 int, XImage
*, int));
9528 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
9529 XColor
*, int, XImage
*, int));
9532 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
9533 frame we operate on, CMAP is the color-map in effect, and WIDTH is
9534 the width of one row in the image. */
9537 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
9547 for (x
= 0; x
< width
; ++x
)
9548 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
9550 XQueryColors (NULL
, cmap
, colors
, width
);
9554 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
9555 containing the pixel colors to write. F is the frame we are
9559 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
9568 for (x
= 0; x
< width
; ++x
)
9569 XPutPixel (ximg
, x
, y
, pixels
[x
]);
9573 /* Transform image IMG which is used on frame F with a Laplace
9574 edge-detection algorithm. The result is an image that can be used
9575 to draw disabled buttons, for example. */
9582 #if 0 /* TODO : W32 version */
9583 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9584 XImage
*ximg
, *oimg
;
9590 int in_y
, out_y
, rc
;
9595 /* Get the X image IMG->pixmap. */
9596 ximg
= XGetImage (NULL
, img
->pixmap
,
9597 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9599 /* Allocate 3 input rows, and one output row of colors. */
9600 for (i
= 0; i
< 3; ++i
)
9601 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
9602 out
= (long *) alloca (img
->width
* sizeof (long));
9604 /* Create an X image for output. */
9605 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
9608 /* Fill first two rows. */
9609 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
9610 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
9613 /* Write first row, all zeros. */
9614 init_color_table ();
9615 pixel
= lookup_rgb_color (f
, 0, 0, 0);
9616 for (x
= 0; x
< img
->width
; ++x
)
9618 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
9621 for (y
= 2; y
< img
->height
; ++y
)
9624 int rowb
= (y
+ 2) % 3;
9626 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
9628 for (x
= 0; x
< img
->width
- 2; ++x
)
9630 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
9631 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
9632 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
9634 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
9638 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
9641 /* Write last line, all zeros. */
9642 for (x
= 0; x
< img
->width
; ++x
)
9644 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
9646 /* Free the input image, and free resources of IMG. */
9647 XDestroyImage (ximg
);
9648 x_clear_image (f
, img
);
9650 /* Put the output image into pixmap, and destroy it. */
9651 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
9652 x_destroy_x_image (oimg
);
9654 /* Remember new pixmap and colors in IMG. */
9655 img
->pixmap
= pixmap
;
9656 img
->colors
= colors_in_color_table (&img
->ncolors
);
9657 free_color_table ();
9664 /* Build a mask for image IMG which is used on frame F. FILE is the
9665 name of an image file, for error messages. HOW determines how to
9666 determine the background color of IMG. If it is a list '(R G B)',
9667 with R, G, and B being integers >= 0, take that as the color of the
9668 background. Otherwise, determine the background color of IMG
9669 heuristically. Value is non-zero if successful. */
9672 x_build_heuristic_mask (f
, img
, how
)
9677 #if 0 /* TODO : W32 version */
9678 Display
*dpy
= FRAME_W32_DISPLAY (f
);
9679 XImage
*ximg
, *mask_img
;
9680 int x
, y
, rc
, look_at_corners_p
;
9685 /* Create an image and pixmap serving as mask. */
9686 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
9687 &mask_img
, &img
->mask
);
9694 /* Get the X image of IMG->pixmap. */
9695 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
9698 /* Determine the background color of ximg. If HOW is `(R G B)'
9699 take that as color. Otherwise, try to determine the color
9701 look_at_corners_p
= 1;
9709 && NATNUMP (XCAR (how
)))
9711 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
9715 if (i
== 3 && NILP (how
))
9717 char color_name
[30];
9718 XColor exact
, color
;
9721 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
9723 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9724 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
9727 look_at_corners_p
= 0;
9732 if (look_at_corners_p
)
9734 unsigned long corners
[4];
9737 /* Get the colors at the corners of ximg. */
9738 corners
[0] = XGetPixel (ximg
, 0, 0);
9739 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
9740 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
9741 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
9743 /* Choose the most frequently found color as background. */
9744 for (i
= best_count
= 0; i
< 4; ++i
)
9748 for (j
= n
= 0; j
< 4; ++j
)
9749 if (corners
[i
] == corners
[j
])
9753 bg
= corners
[i
], best_count
= n
;
9757 /* Set all bits in mask_img to 1 whose color in ximg is different
9758 from the background color bg. */
9759 for (y
= 0; y
< img
->height
; ++y
)
9760 for (x
= 0; x
< img
->width
; ++x
)
9761 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
9763 /* Put mask_img into img->mask. */
9764 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
9765 x_destroy_x_image (mask_img
);
9766 XDestroyImage (ximg
);
9776 /***********************************************************************
9777 PBM (mono, gray, color)
9778 ***********************************************************************/
9781 static int pbm_image_p
P_ ((Lisp_Object object
));
9782 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
9783 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
9785 /* The symbol `pbm' identifying images of this type. */
9789 /* Indices of image specification fields in gs_format, below. */
9791 enum pbm_keyword_index
9804 /* Vector of image_keyword structures describing the format
9805 of valid user-defined image specifications. */
9807 static struct image_keyword pbm_format
[PBM_LAST
] =
9809 {":type", IMAGE_SYMBOL_VALUE
, 1},
9810 {":file", IMAGE_STRING_VALUE
, 0},
9811 {":data", IMAGE_STRING_VALUE
, 0},
9812 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9813 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9814 {":relief", IMAGE_INTEGER_VALUE
, 0},
9815 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9816 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9819 /* Structure describing the image type `pbm'. */
9821 static struct image_type pbm_type
=
9831 /* Return non-zero if OBJECT is a valid PBM image specification. */
9834 pbm_image_p (object
)
9837 struct image_keyword fmt
[PBM_LAST
];
9839 bcopy (pbm_format
, fmt
, sizeof fmt
);
9841 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
9842 || (fmt
[PBM_ASCENT
].count
9843 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
9846 /* Must specify either :data or :file. */
9847 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
9851 /* Scan a decimal number from *S and return it. Advance *S while
9852 reading the number. END is the end of the string. Value is -1 at
9856 pbm_scan_number (s
, end
)
9857 unsigned char **s
, *end
;
9863 /* Skip white-space. */
9864 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
9869 /* Skip comment to end of line. */
9870 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
9873 else if (isdigit (c
))
9875 /* Read decimal number. */
9877 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
9878 val
= 10 * val
+ c
- '0';
9889 /* Read FILE into memory. Value is a pointer to a buffer allocated
9890 with xmalloc holding FILE's contents. Value is null if an error
9891 occured. *SIZE is set to the size of the file. */
9894 pbm_read_file (file
, size
)
9902 if (stat (XSTRING (file
)->data
, &st
) == 0
9903 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
9904 && (buf
= (char *) xmalloc (st
.st_size
),
9905 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
9925 /* Load PBM image IMG for use on frame F. */
9933 int width
, height
, max_color_idx
= 0;
9935 Lisp_Object file
, specified_file
;
9936 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
9937 struct gcpro gcpro1
;
9938 unsigned char *contents
= NULL
;
9939 unsigned char *end
, *p
;
9942 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9946 if (STRINGP (specified_file
))
9948 file
= x_find_image_file (specified_file
);
9949 if (!STRINGP (file
))
9951 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9956 contents
= pbm_read_file (file
, &size
);
9957 if (contents
== NULL
)
9959 image_error ("Error reading `%s'", file
, Qnil
);
9965 end
= contents
+ size
;
9970 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9971 p
= XSTRING (data
)->data
;
9972 end
= p
+ STRING_BYTES (XSTRING (data
));
9975 /* Check magic number. */
9976 if (end
- p
< 2 || *p
++ != 'P')
9978 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
9988 raw_p
= 0, type
= PBM_MONO
;
9992 raw_p
= 0, type
= PBM_GRAY
;
9996 raw_p
= 0, type
= PBM_COLOR
;
10000 raw_p
= 1, type
= PBM_MONO
;
10004 raw_p
= 1, type
= PBM_GRAY
;
10008 raw_p
= 1, type
= PBM_COLOR
;
10012 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
10016 /* Read width, height, maximum color-component. Characters
10017 starting with `#' up to the end of a line are ignored. */
10018 width
= pbm_scan_number (&p
, end
);
10019 height
= pbm_scan_number (&p
, end
);
10021 if (type
!= PBM_MONO
)
10023 max_color_idx
= pbm_scan_number (&p
, end
);
10024 if (raw_p
&& max_color_idx
> 255)
10025 max_color_idx
= 255;
10030 || (type
!= PBM_MONO
&& max_color_idx
< 0))
10034 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
10035 &ximg
, &img
->pixmap
))
10041 /* Initialize the color hash table. */
10042 init_color_table ();
10044 if (type
== PBM_MONO
)
10048 for (y
= 0; y
< height
; ++y
)
10049 for (x
= 0; x
< width
; ++x
)
10059 g
= pbm_scan_number (&p
, end
);
10061 XPutPixel (ximg
, x
, y
, (g
10062 ? FRAME_FOREGROUND_PIXEL (f
)
10063 : FRAME_BACKGROUND_PIXEL (f
)));
10068 for (y
= 0; y
< height
; ++y
)
10069 for (x
= 0; x
< width
; ++x
)
10073 if (type
== PBM_GRAY
)
10074 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
10083 r
= pbm_scan_number (&p
, end
);
10084 g
= pbm_scan_number (&p
, end
);
10085 b
= pbm_scan_number (&p
, end
);
10088 if (r
< 0 || g
< 0 || b
< 0)
10090 xfree (ximg
->data
);
10092 XDestroyImage (ximg
);
10094 image_error ("Invalid pixel value in image `%s'",
10099 /* RGB values are now in the range 0..max_color_idx.
10100 Scale this to the range 0..0xffff supported by X. */
10101 r
= (double) r
* 65535 / max_color_idx
;
10102 g
= (double) g
* 65535 / max_color_idx
;
10103 b
= (double) b
* 65535 / max_color_idx
;
10104 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
10108 /* Store in IMG->colors the colors allocated for the image, and
10109 free the color table. */
10110 img
->colors
= colors_in_color_table (&img
->ncolors
);
10111 free_color_table ();
10113 /* Put the image into a pixmap. */
10114 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10115 x_destroy_x_image (ximg
);
10118 img
->width
= width
;
10119 img
->height
= height
;
10125 #endif /* HAVE_PBM */
10128 /***********************************************************************
10130 ***********************************************************************/
10136 /* Function prototypes. */
10138 static int png_image_p
P_ ((Lisp_Object object
));
10139 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
10141 /* The symbol `png' identifying images of this type. */
10145 /* Indices of image specification fields in png_format, below. */
10147 enum png_keyword_index
10156 PNG_HEURISTIC_MASK
,
10160 /* Vector of image_keyword structures describing the format
10161 of valid user-defined image specifications. */
10163 static struct image_keyword png_format
[PNG_LAST
] =
10165 {":type", IMAGE_SYMBOL_VALUE
, 1},
10166 {":data", IMAGE_STRING_VALUE
, 0},
10167 {":file", IMAGE_STRING_VALUE
, 0},
10168 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10169 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
10170 {":relief", IMAGE_INTEGER_VALUE
, 0},
10171 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10172 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
10175 /* Structure describing the image type `png'. */
10177 static struct image_type png_type
=
10187 /* Return non-zero if OBJECT is a valid PNG image specification. */
10190 png_image_p (object
)
10191 Lisp_Object object
;
10193 struct image_keyword fmt
[PNG_LAST
];
10194 bcopy (png_format
, fmt
, sizeof fmt
);
10196 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
10197 || (fmt
[PNG_ASCENT
].count
10198 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
10201 /* Must specify either the :data or :file keyword. */
10202 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
10206 /* Error and warning handlers installed when the PNG library
10210 my_png_error (png_ptr
, msg
)
10211 png_struct
*png_ptr
;
10214 xassert (png_ptr
!= NULL
);
10215 image_error ("PNG error: %s", build_string (msg
), Qnil
);
10216 longjmp (png_ptr
->jmpbuf
, 1);
10221 my_png_warning (png_ptr
, msg
)
10222 png_struct
*png_ptr
;
10225 xassert (png_ptr
!= NULL
);
10226 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
10229 /* Memory source for PNG decoding. */
10231 struct png_memory_storage
10233 unsigned char *bytes
; /* The data */
10234 size_t len
; /* How big is it? */
10235 int index
; /* Where are we? */
10239 /* Function set as reader function when reading PNG image from memory.
10240 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
10241 bytes from the input to DATA. */
10244 png_read_from_memory (png_ptr
, data
, length
)
10245 png_structp png_ptr
;
10249 struct png_memory_storage
*tbr
10250 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
10252 if (length
> tbr
->len
- tbr
->index
)
10253 png_error (png_ptr
, "Read error");
10255 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
10256 tbr
->index
= tbr
->index
+ length
;
10259 /* Load PNG image IMG for use on frame F. Value is non-zero if
10267 Lisp_Object file
, specified_file
;
10268 Lisp_Object specified_data
;
10270 XImage
*ximg
, *mask_img
= NULL
;
10271 struct gcpro gcpro1
;
10272 png_struct
*png_ptr
= NULL
;
10273 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
10276 png_byte
*pixels
= NULL
;
10277 png_byte
**rows
= NULL
;
10278 png_uint_32 width
, height
;
10279 int bit_depth
, color_type
, interlace_type
;
10281 png_uint_32 row_bytes
;
10284 double screen_gamma
, image_gamma
;
10286 struct png_memory_storage tbr
; /* Data to be read */
10288 /* Find out what file to load. */
10289 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10290 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10294 if (NILP (specified_data
))
10296 file
= x_find_image_file (specified_file
);
10297 if (!STRINGP (file
))
10299 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10304 /* Open the image file. */
10305 fp
= fopen (XSTRING (file
)->data
, "rb");
10308 image_error ("Cannot open image file `%s'", file
, Qnil
);
10314 /* Check PNG signature. */
10315 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
10316 || !png_check_sig (sig
, sizeof sig
))
10318 image_error ("Not a PNG file:` %s'", file
, Qnil
);
10326 /* Read from memory. */
10327 tbr
.bytes
= XSTRING (specified_data
)->data
;
10328 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
10331 /* Check PNG signature. */
10332 if (tbr
.len
< sizeof sig
10333 || !png_check_sig (tbr
.bytes
, sizeof sig
))
10335 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
10340 /* Need to skip past the signature. */
10341 tbr
.bytes
+= sizeof (sig
);
10344 /* Initialize read and info structs for PNG lib. */
10345 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
10346 my_png_error
, my_png_warning
);
10349 if (fp
) fclose (fp
);
10354 info_ptr
= png_create_info_struct (png_ptr
);
10357 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
10358 if (fp
) fclose (fp
);
10363 end_info
= png_create_info_struct (png_ptr
);
10366 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
10367 if (fp
) fclose (fp
);
10372 /* Set error jump-back. We come back here when the PNG library
10373 detects an error. */
10374 if (setjmp (png_ptr
->jmpbuf
))
10378 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
10381 if (fp
) fclose (fp
);
10386 /* Read image info. */
10387 if (!NILP (specified_data
))
10388 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
10390 png_init_io (png_ptr
, fp
);
10392 png_set_sig_bytes (png_ptr
, sizeof sig
);
10393 png_read_info (png_ptr
, info_ptr
);
10394 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
10395 &interlace_type
, NULL
, NULL
);
10397 /* If image contains simply transparency data, we prefer to
10398 construct a clipping mask. */
10399 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
10404 /* This function is easier to write if we only have to handle
10405 one data format: RGB or RGBA with 8 bits per channel. Let's
10406 transform other formats into that format. */
10408 /* Strip more than 8 bits per channel. */
10409 if (bit_depth
== 16)
10410 png_set_strip_16 (png_ptr
);
10412 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
10414 png_set_expand (png_ptr
);
10416 /* Convert grayscale images to RGB. */
10417 if (color_type
== PNG_COLOR_TYPE_GRAY
10418 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
10419 png_set_gray_to_rgb (png_ptr
);
10421 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
10422 gamma_str
= getenv ("SCREEN_GAMMA");
10423 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
10425 /* Tell the PNG lib to handle gamma correction for us. */
10427 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
10428 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
10429 /* There is a special chunk in the image specifying the gamma. */
10430 png_set_sRGB (png_ptr
, info_ptr
, intent
);
10433 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
10434 /* Image contains gamma information. */
10435 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
10437 /* Use a default of 0.5 for the image gamma. */
10438 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
10440 /* Handle alpha channel by combining the image with a background
10441 color. Do this only if a real alpha channel is supplied. For
10442 simple transparency, we prefer a clipping mask. */
10443 if (!transparent_p
)
10445 png_color_16
*image_background
;
10447 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
10448 /* Image contains a background color with which to
10449 combine the image. */
10450 png_set_background (png_ptr
, image_background
,
10451 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
10454 /* Image does not contain a background color with which
10455 to combine the image data via an alpha channel. Use
10456 the frame's background instead. */
10459 png_color_16 frame_background
;
10462 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
10463 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
10464 XQueryColor (FRAME_W32_DISPLAY (f
), cmap
, &color
);
10467 bzero (&frame_background
, sizeof frame_background
);
10468 frame_background
.red
= color
.red
;
10469 frame_background
.green
= color
.green
;
10470 frame_background
.blue
= color
.blue
;
10472 png_set_background (png_ptr
, &frame_background
,
10473 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
10477 /* Update info structure. */
10478 png_read_update_info (png_ptr
, info_ptr
);
10480 /* Get number of channels. Valid values are 1 for grayscale images
10481 and images with a palette, 2 for grayscale images with transparency
10482 information (alpha channel), 3 for RGB images, and 4 for RGB
10483 images with alpha channel, i.e. RGBA. If conversions above were
10484 sufficient we should only have 3 or 4 channels here. */
10485 channels
= png_get_channels (png_ptr
, info_ptr
);
10486 xassert (channels
== 3 || channels
== 4);
10488 /* Number of bytes needed for one row of the image. */
10489 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
10491 /* Allocate memory for the image. */
10492 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
10493 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
10494 for (i
= 0; i
< height
; ++i
)
10495 rows
[i
] = pixels
+ i
* row_bytes
;
10497 /* Read the entire image. */
10498 png_read_image (png_ptr
, rows
);
10499 png_read_end (png_ptr
, info_ptr
);
10508 /* Create the X image and pixmap. */
10509 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
10516 /* Create an image and pixmap serving as mask if the PNG image
10517 contains an alpha channel. */
10520 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
10521 &mask_img
, &img
->mask
))
10523 x_destroy_x_image (ximg
);
10524 XFreePixmap (FRAME_W32_DISPLAY (f
), img
->pixmap
);
10530 /* Fill the X image and mask from PNG data. */
10531 init_color_table ();
10533 for (y
= 0; y
< height
; ++y
)
10535 png_byte
*p
= rows
[y
];
10537 for (x
= 0; x
< width
; ++x
)
10544 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
10546 /* An alpha channel, aka mask channel, associates variable
10547 transparency with an image. Where other image formats
10548 support binary transparency---fully transparent or fully
10549 opaque---PNG allows up to 254 levels of partial transparency.
10550 The PNG library implements partial transparency by combining
10551 the image with a specified background color.
10553 I'm not sure how to handle this here nicely: because the
10554 background on which the image is displayed may change, for
10555 real alpha channel support, it would be necessary to create
10556 a new image for each possible background.
10558 What I'm doing now is that a mask is created if we have
10559 boolean transparency information. Otherwise I'm using
10560 the frame's background color to combine the image with. */
10565 XPutPixel (mask_img
, x
, y
, *p
> 0);
10571 /* Remember colors allocated for this image. */
10572 img
->colors
= colors_in_color_table (&img
->ncolors
);
10573 free_color_table ();
10576 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
10580 img
->width
= width
;
10581 img
->height
= height
;
10583 /* Put the image into the pixmap, then free the X image and its buffer. */
10584 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10585 x_destroy_x_image (ximg
);
10587 /* Same for the mask. */
10590 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
10591 x_destroy_x_image (mask_img
);
10599 #endif /* HAVE_PNG != 0 */
10603 /***********************************************************************
10605 ***********************************************************************/
10609 /* Work around a warning about HAVE_STDLIB_H being redefined in
10611 #ifdef HAVE_STDLIB_H
10612 #define HAVE_STDLIB_H_1
10613 #undef HAVE_STDLIB_H
10614 #endif /* HAVE_STLIB_H */
10616 #include <jpeglib.h>
10617 #include <jerror.h>
10618 #include <setjmp.h>
10620 #ifdef HAVE_STLIB_H_1
10621 #define HAVE_STDLIB_H 1
10624 static int jpeg_image_p
P_ ((Lisp_Object object
));
10625 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
10627 /* The symbol `jpeg' identifying images of this type. */
10631 /* Indices of image specification fields in gs_format, below. */
10633 enum jpeg_keyword_index
10642 JPEG_HEURISTIC_MASK
,
10646 /* Vector of image_keyword structures describing the format
10647 of valid user-defined image specifications. */
10649 static struct image_keyword jpeg_format
[JPEG_LAST
] =
10651 {":type", IMAGE_SYMBOL_VALUE
, 1},
10652 {":data", IMAGE_STRING_VALUE
, 0},
10653 {":file", IMAGE_STRING_VALUE
, 0},
10654 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
10655 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
10656 {":relief", IMAGE_INTEGER_VALUE
, 0},
10657 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
10658 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
10661 /* Structure describing the image type `jpeg'. */
10663 static struct image_type jpeg_type
=
10673 /* Return non-zero if OBJECT is a valid JPEG image specification. */
10676 jpeg_image_p (object
)
10677 Lisp_Object object
;
10679 struct image_keyword fmt
[JPEG_LAST
];
10681 bcopy (jpeg_format
, fmt
, sizeof fmt
);
10683 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
10684 || (fmt
[JPEG_ASCENT
].count
10685 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
10688 /* Must specify either the :data or :file keyword. */
10689 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
10693 struct my_jpeg_error_mgr
10695 struct jpeg_error_mgr pub
;
10696 jmp_buf setjmp_buffer
;
10700 my_error_exit (cinfo
)
10701 j_common_ptr cinfo
;
10703 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
10704 longjmp (mgr
->setjmp_buffer
, 1);
10707 /* Init source method for JPEG data source manager. Called by
10708 jpeg_read_header() before any data is actually read. See
10709 libjpeg.doc from the JPEG lib distribution. */
10712 our_init_source (cinfo
)
10713 j_decompress_ptr cinfo
;
10718 /* Fill input buffer method for JPEG data source manager. Called
10719 whenever more data is needed. We read the whole image in one step,
10720 so this only adds a fake end of input marker at the end. */
10723 our_fill_input_buffer (cinfo
)
10724 j_decompress_ptr cinfo
;
10726 /* Insert a fake EOI marker. */
10727 struct jpeg_source_mgr
*src
= cinfo
->src
;
10728 static JOCTET buffer
[2];
10730 buffer
[0] = (JOCTET
) 0xFF;
10731 buffer
[1] = (JOCTET
) JPEG_EOI
;
10733 src
->next_input_byte
= buffer
;
10734 src
->bytes_in_buffer
= 2;
10739 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
10740 is the JPEG data source manager. */
10743 our_skip_input_data (cinfo
, num_bytes
)
10744 j_decompress_ptr cinfo
;
10747 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
10751 if (num_bytes
> src
->bytes_in_buffer
)
10752 ERREXIT (cinfo
, JERR_INPUT_EOF
);
10754 src
->bytes_in_buffer
-= num_bytes
;
10755 src
->next_input_byte
+= num_bytes
;
10760 /* Method to terminate data source. Called by
10761 jpeg_finish_decompress() after all data has been processed. */
10764 our_term_source (cinfo
)
10765 j_decompress_ptr cinfo
;
10770 /* Set up the JPEG lib for reading an image from DATA which contains
10771 LEN bytes. CINFO is the decompression info structure created for
10772 reading the image. */
10775 jpeg_memory_src (cinfo
, data
, len
)
10776 j_decompress_ptr cinfo
;
10780 struct jpeg_source_mgr
*src
;
10782 if (cinfo
->src
== NULL
)
10784 /* First time for this JPEG object? */
10785 cinfo
->src
= (struct jpeg_source_mgr
*)
10786 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
10787 sizeof (struct jpeg_source_mgr
));
10788 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
10789 src
->next_input_byte
= data
;
10792 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
10793 src
->init_source
= our_init_source
;
10794 src
->fill_input_buffer
= our_fill_input_buffer
;
10795 src
->skip_input_data
= our_skip_input_data
;
10796 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
10797 src
->term_source
= our_term_source
;
10798 src
->bytes_in_buffer
= len
;
10799 src
->next_input_byte
= data
;
10803 /* Load image IMG for use on frame F. Patterned after example.c
10804 from the JPEG lib. */
10811 struct jpeg_decompress_struct cinfo
;
10812 struct my_jpeg_error_mgr mgr
;
10813 Lisp_Object file
, specified_file
;
10814 Lisp_Object specified_data
;
10817 int row_stride
, x
, y
;
10818 XImage
*ximg
= NULL
;
10820 unsigned long *colors
;
10822 struct gcpro gcpro1
;
10824 /* Open the JPEG file. */
10825 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
10826 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
10830 if (NILP (specified_data
))
10832 file
= x_find_image_file (specified_file
);
10833 if (!STRINGP (file
))
10835 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
10840 fp
= fopen (XSTRING (file
)->data
, "r");
10843 image_error ("Cannot open `%s'", file
, Qnil
);
10849 /* Customize libjpeg's error handling to call my_error_exit when an
10850 error is detected. This function will perform a longjmp. */
10851 mgr
.pub
.error_exit
= my_error_exit
;
10852 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
10854 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
10858 /* Called from my_error_exit. Display a JPEG error. */
10859 char buffer
[JMSG_LENGTH_MAX
];
10860 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
10861 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
10862 build_string (buffer
));
10865 /* Close the input file and destroy the JPEG object. */
10868 jpeg_destroy_decompress (&cinfo
);
10872 /* If we already have an XImage, free that. */
10873 x_destroy_x_image (ximg
);
10875 /* Free pixmap and colors. */
10876 x_clear_image (f
, img
);
10883 /* Create the JPEG decompression object. Let it read from fp.
10884 Read the JPEG image header. */
10885 jpeg_create_decompress (&cinfo
);
10887 if (NILP (specified_data
))
10888 jpeg_stdio_src (&cinfo
, fp
);
10890 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
10891 STRING_BYTES (XSTRING (specified_data
)));
10893 jpeg_read_header (&cinfo
, TRUE
);
10895 /* Customize decompression so that color quantization will be used.
10896 Start decompression. */
10897 cinfo
.quantize_colors
= TRUE
;
10898 jpeg_start_decompress (&cinfo
);
10899 width
= img
->width
= cinfo
.output_width
;
10900 height
= img
->height
= cinfo
.output_height
;
10904 /* Create X image and pixmap. */
10905 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
10909 longjmp (mgr
.setjmp_buffer
, 2);
10912 /* Allocate colors. When color quantization is used,
10913 cinfo.actual_number_of_colors has been set with the number of
10914 colors generated, and cinfo.colormap is a two-dimensional array
10915 of color indices in the range 0..cinfo.actual_number_of_colors.
10916 No more than 255 colors will be generated. */
10920 if (cinfo
.out_color_components
> 2)
10921 ir
= 0, ig
= 1, ib
= 2;
10922 else if (cinfo
.out_color_components
> 1)
10923 ir
= 0, ig
= 1, ib
= 0;
10925 ir
= 0, ig
= 0, ib
= 0;
10927 /* Use the color table mechanism because it handles colors that
10928 cannot be allocated nicely. Such colors will be replaced with
10929 a default color, and we don't have to care about which colors
10930 can be freed safely, and which can't. */
10931 init_color_table ();
10932 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
10935 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
10937 /* Multiply RGB values with 255 because X expects RGB values
10938 in the range 0..0xffff. */
10939 int r
= cinfo
.colormap
[ir
][i
] << 8;
10940 int g
= cinfo
.colormap
[ig
][i
] << 8;
10941 int b
= cinfo
.colormap
[ib
][i
] << 8;
10942 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
10945 /* Remember those colors actually allocated. */
10946 img
->colors
= colors_in_color_table (&img
->ncolors
);
10947 free_color_table ();
10951 row_stride
= width
* cinfo
.output_components
;
10952 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
10954 for (y
= 0; y
< height
; ++y
)
10956 jpeg_read_scanlines (&cinfo
, buffer
, 1);
10957 for (x
= 0; x
< cinfo
.output_width
; ++x
)
10958 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
10962 jpeg_finish_decompress (&cinfo
);
10963 jpeg_destroy_decompress (&cinfo
);
10967 /* Put the image into the pixmap. */
10968 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
10969 x_destroy_x_image (ximg
);
10975 #endif /* HAVE_JPEG */
10979 /***********************************************************************
10981 ***********************************************************************/
10985 #include <tiffio.h>
10987 static int tiff_image_p
P_ ((Lisp_Object object
));
10988 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
10990 /* The symbol `tiff' identifying images of this type. */
10994 /* Indices of image specification fields in tiff_format, below. */
10996 enum tiff_keyword_index
11005 TIFF_HEURISTIC_MASK
,
11009 /* Vector of image_keyword structures describing the format
11010 of valid user-defined image specifications. */
11012 static struct image_keyword tiff_format
[TIFF_LAST
] =
11014 {":type", IMAGE_SYMBOL_VALUE
, 1},
11015 {":data", IMAGE_STRING_VALUE
, 0},
11016 {":file", IMAGE_STRING_VALUE
, 0},
11017 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11018 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
11019 {":relief", IMAGE_INTEGER_VALUE
, 0},
11020 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11021 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
11024 /* Structure describing the image type `tiff'. */
11026 static struct image_type tiff_type
=
11036 /* Return non-zero if OBJECT is a valid TIFF image specification. */
11039 tiff_image_p (object
)
11040 Lisp_Object object
;
11042 struct image_keyword fmt
[TIFF_LAST
];
11043 bcopy (tiff_format
, fmt
, sizeof fmt
);
11045 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
11046 || (fmt
[TIFF_ASCENT
].count
11047 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
11050 /* Must specify either the :data or :file keyword. */
11051 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
11055 /* Reading from a memory buffer for TIFF images Based on the PNG
11056 memory source, but we have to provide a lot of extra functions.
11059 We really only need to implement read and seek, but I am not
11060 convinced that the TIFF library is smart enough not to destroy
11061 itself if we only hand it the function pointers we need to
11066 unsigned char *bytes
;
11070 tiff_memory_source
;
11073 tiff_read_from_memory (data
, buf
, size
)
11078 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11080 if (size
> src
->len
- src
->index
)
11081 return (size_t) -1;
11082 bcopy (src
->bytes
+ src
->index
, buf
, size
);
11083 src
->index
+= size
;
11088 tiff_write_from_memory (data
, buf
, size
)
11093 return (size_t) -1;
11097 tiff_seek_in_memory (data
, off
, whence
)
11102 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
11107 case SEEK_SET
: /* Go from beginning of source. */
11111 case SEEK_END
: /* Go from end of source. */
11112 idx
= src
->len
+ off
;
11115 case SEEK_CUR
: /* Go from current position. */
11116 idx
= src
->index
+ off
;
11119 default: /* Invalid `whence'. */
11123 if (idx
> src
->len
|| idx
< 0)
11131 tiff_close_memory (data
)
11139 tiff_mmap_memory (data
, pbase
, psize
)
11144 /* It is already _IN_ memory. */
11149 tiff_unmap_memory (data
, base
, size
)
11154 /* We don't need to do this. */
11158 tiff_size_of_memory (data
)
11161 return ((tiff_memory_source
*) data
)->len
;
11164 /* Load TIFF image IMG for use on frame F. Value is non-zero if
11172 Lisp_Object file
, specified_file
;
11173 Lisp_Object specified_data
;
11175 int width
, height
, x
, y
;
11179 struct gcpro gcpro1
;
11180 tiff_memory_source memsrc
;
11182 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11183 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11187 if (NILP (specified_data
))
11189 /* Read from a file */
11190 file
= x_find_image_file (specified_file
);
11191 if (!STRINGP (file
))
11193 image_error ("Cannot find image file `%s'", file
, Qnil
);
11198 /* Try to open the image file. */
11199 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
11202 image_error ("Cannot open `%s'", file
, Qnil
);
11209 /* Memory source! */
11210 memsrc
.bytes
= XSTRING (specified_data
)->data
;
11211 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
11214 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
11215 (TIFFReadWriteProc
) tiff_read_from_memory
,
11216 (TIFFReadWriteProc
) tiff_write_from_memory
,
11217 tiff_seek_in_memory
,
11219 tiff_size_of_memory
,
11221 tiff_unmap_memory
);
11225 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
11231 /* Get width and height of the image, and allocate a raster buffer
11232 of width x height 32-bit values. */
11233 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
11234 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
11235 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
11237 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
11241 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
11249 /* Create the X image and pixmap. */
11250 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11258 /* Initialize the color table. */
11259 init_color_table ();
11261 /* Process the pixel raster. Origin is in the lower-left corner. */
11262 for (y
= 0; y
< height
; ++y
)
11264 uint32
*row
= buf
+ y
* width
;
11266 for (x
= 0; x
< width
; ++x
)
11268 uint32 abgr
= row
[x
];
11269 int r
= TIFFGetR (abgr
) << 8;
11270 int g
= TIFFGetG (abgr
) << 8;
11271 int b
= TIFFGetB (abgr
) << 8;
11272 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
11276 /* Remember the colors allocated for the image. Free the color table. */
11277 img
->colors
= colors_in_color_table (&img
->ncolors
);
11278 free_color_table ();
11280 /* Put the image into the pixmap, then free the X image and its buffer. */
11281 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11282 x_destroy_x_image (ximg
);
11286 img
->width
= width
;
11287 img
->height
= height
;
11293 #endif /* HAVE_TIFF != 0 */
11297 /***********************************************************************
11299 ***********************************************************************/
11303 #include <gif_lib.h>
11305 static int gif_image_p
P_ ((Lisp_Object object
));
11306 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
11308 /* The symbol `gif' identifying images of this type. */
11312 /* Indices of image specification fields in gif_format, below. */
11314 enum gif_keyword_index
11323 GIF_HEURISTIC_MASK
,
11328 /* Vector of image_keyword structures describing the format
11329 of valid user-defined image specifications. */
11331 static struct image_keyword gif_format
[GIF_LAST
] =
11333 {":type", IMAGE_SYMBOL_VALUE
, 1},
11334 {":data", IMAGE_STRING_VALUE
, 0},
11335 {":file", IMAGE_STRING_VALUE
, 0},
11336 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11337 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
11338 {":relief", IMAGE_INTEGER_VALUE
, 0},
11339 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11340 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11341 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
11344 /* Structure describing the image type `gif'. */
11346 static struct image_type gif_type
=
11355 /* Return non-zero if OBJECT is a valid GIF image specification. */
11358 gif_image_p (object
)
11359 Lisp_Object object
;
11361 struct image_keyword fmt
[GIF_LAST
];
11362 bcopy (gif_format
, fmt
, sizeof fmt
);
11364 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
11365 || (fmt
[GIF_ASCENT
].count
11366 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
11369 /* Must specify either the :data or :file keyword. */
11370 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
11373 /* Reading a GIF image from memory
11374 Based on the PNG memory stuff to a certain extent. */
11378 unsigned char *bytes
;
11384 /* Make the current memory source available to gif_read_from_memory.
11385 It's done this way because not all versions of libungif support
11386 a UserData field in the GifFileType structure. */
11387 static gif_memory_source
*current_gif_memory_src
;
11390 gif_read_from_memory (file
, buf
, len
)
11395 gif_memory_source
*src
= current_gif_memory_src
;
11397 if (len
> src
->len
- src
->index
)
11400 bcopy (src
->bytes
+ src
->index
, buf
, len
);
11406 /* Load GIF image IMG for use on frame F. Value is non-zero if
11414 Lisp_Object file
, specified_file
;
11415 Lisp_Object specified_data
;
11416 int rc
, width
, height
, x
, y
, i
;
11418 ColorMapObject
*gif_color_map
;
11419 unsigned long pixel_colors
[256];
11421 struct gcpro gcpro1
;
11423 int ino
, image_left
, image_top
, image_width
, image_height
;
11424 gif_memory_source memsrc
;
11425 unsigned char *raster
;
11427 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
11428 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
11432 if (NILP (specified_data
))
11434 file
= x_find_image_file (specified_file
);
11435 if (!STRINGP (file
))
11437 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
11442 /* Open the GIF file. */
11443 gif
= DGifOpenFileName (XSTRING (file
)->data
);
11446 image_error ("Cannot open `%s'", file
, Qnil
);
11453 /* Read from memory! */
11454 current_gif_memory_src
= &memsrc
;
11455 memsrc
.bytes
= XSTRING (specified_data
)->data
;
11456 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
11459 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
11462 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
11468 /* Read entire contents. */
11469 rc
= DGifSlurp (gif
);
11470 if (rc
== GIF_ERROR
)
11472 image_error ("Error reading `%s'", img
->spec
, Qnil
);
11473 DGifCloseFile (gif
);
11478 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
11479 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
11480 if (ino
>= gif
->ImageCount
)
11482 image_error ("Invalid image number `%s' in image `%s'",
11484 DGifCloseFile (gif
);
11489 width
= img
->width
= gif
->SWidth
;
11490 height
= img
->height
= gif
->SHeight
;
11494 /* Create the X image and pixmap. */
11495 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
11498 DGifCloseFile (gif
);
11503 /* Allocate colors. */
11504 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
11505 if (!gif_color_map
)
11506 gif_color_map
= gif
->SColorMap
;
11507 init_color_table ();
11508 bzero (pixel_colors
, sizeof pixel_colors
);
11510 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
11512 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
11513 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
11514 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
11515 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
11518 img
->colors
= colors_in_color_table (&img
->ncolors
);
11519 free_color_table ();
11521 /* Clear the part of the screen image that are not covered by
11522 the image from the GIF file. Full animated GIF support
11523 requires more than can be done here (see the gif89 spec,
11524 disposal methods). Let's simply assume that the part
11525 not covered by a sub-image is in the frame's background color. */
11526 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
11527 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
11528 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
11529 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
11531 for (y
= 0; y
< image_top
; ++y
)
11532 for (x
= 0; x
< width
; ++x
)
11533 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
11535 for (y
= image_top
+ image_height
; y
< height
; ++y
)
11536 for (x
= 0; x
< width
; ++x
)
11537 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
11539 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
11541 for (x
= 0; x
< image_left
; ++x
)
11542 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
11543 for (x
= image_left
+ image_width
; x
< width
; ++x
)
11544 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
11547 /* Read the GIF image into the X image. We use a local variable
11548 `raster' here because RasterBits below is a char *, and invites
11549 problems with bytes >= 0x80. */
11550 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
11552 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
11554 static int interlace_start
[] = {0, 4, 2, 1};
11555 static int interlace_increment
[] = {8, 8, 4, 2};
11557 int row
= interlace_start
[0];
11561 for (y
= 0; y
< image_height
; y
++)
11563 if (row
>= image_height
)
11565 row
= interlace_start
[++pass
];
11566 while (row
>= image_height
)
11567 row
= interlace_start
[++pass
];
11570 for (x
= 0; x
< image_width
; x
++)
11572 int i
= raster
[(y
* image_width
) + x
];
11573 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
11577 row
+= interlace_increment
[pass
];
11582 for (y
= 0; y
< image_height
; ++y
)
11583 for (x
= 0; x
< image_width
; ++x
)
11585 int i
= raster
[y
* image_width
+ x
];
11586 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
11590 DGifCloseFile (gif
);
11592 /* Put the image into the pixmap, then free the X image and its buffer. */
11593 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
11594 x_destroy_x_image (ximg
);
11601 #endif /* HAVE_GIF != 0 */
11605 /***********************************************************************
11607 ***********************************************************************/
11609 #ifdef HAVE_GHOSTSCRIPT
11610 static int gs_image_p
P_ ((Lisp_Object object
));
11611 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
11612 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
11614 /* The symbol `postscript' identifying images of this type. */
11616 Lisp_Object Qpostscript
;
11618 /* Keyword symbols. */
11620 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
11622 /* Indices of image specification fields in gs_format, below. */
11624 enum gs_keyword_index
11640 /* Vector of image_keyword structures describing the format
11641 of valid user-defined image specifications. */
11643 static struct image_keyword gs_format
[GS_LAST
] =
11645 {":type", IMAGE_SYMBOL_VALUE
, 1},
11646 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
11647 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
11648 {":file", IMAGE_STRING_VALUE
, 1},
11649 {":loader", IMAGE_FUNCTION_VALUE
, 0},
11650 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
11651 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
11652 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
11653 {":relief", IMAGE_INTEGER_VALUE
, 0},
11654 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
11655 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
11658 /* Structure describing the image type `ghostscript'. */
11660 static struct image_type gs_type
=
11670 /* Free X resources of Ghostscript image IMG which is used on frame F. */
11673 gs_clear_image (f
, img
)
11677 /* IMG->data.ptr_val may contain a recorded colormap. */
11678 xfree (img
->data
.ptr_val
);
11679 x_clear_image (f
, img
);
11683 /* Return non-zero if OBJECT is a valid Ghostscript image
11687 gs_image_p (object
)
11688 Lisp_Object object
;
11690 struct image_keyword fmt
[GS_LAST
];
11694 bcopy (gs_format
, fmt
, sizeof fmt
);
11696 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
11697 || (fmt
[GS_ASCENT
].count
11698 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
11701 /* Bounding box must be a list or vector containing 4 integers. */
11702 tem
= fmt
[GS_BOUNDING_BOX
].value
;
11705 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
11706 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
11711 else if (VECTORP (tem
))
11713 if (XVECTOR (tem
)->size
!= 4)
11715 for (i
= 0; i
< 4; ++i
)
11716 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
11726 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
11735 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
11736 struct gcpro gcpro1
, gcpro2
;
11738 double in_width
, in_height
;
11739 Lisp_Object pixel_colors
= Qnil
;
11741 /* Compute pixel size of pixmap needed from the given size in the
11742 image specification. Sizes in the specification are in pt. 1 pt
11743 = 1/72 in, xdpi and ydpi are stored in the frame's X display
11745 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
11746 in_width
= XFASTINT (pt_width
) / 72.0;
11747 img
->width
= in_width
* FRAME_W32_DISPLAY_INFO (f
)->resx
;
11748 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
11749 in_height
= XFASTINT (pt_height
) / 72.0;
11750 img
->height
= in_height
* FRAME_W32_DISPLAY_INFO (f
)->resy
;
11752 /* Create the pixmap. */
11754 xassert (img
->pixmap
== 0);
11755 img
->pixmap
= XCreatePixmap (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
11756 img
->width
, img
->height
,
11757 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
11762 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
11766 /* Call the loader to fill the pixmap. It returns a process object
11767 if successful. We do not record_unwind_protect here because
11768 other places in redisplay like calling window scroll functions
11769 don't either. Let the Lisp loader use `unwind-protect' instead. */
11770 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
11772 sprintf (buffer
, "%lu %lu",
11773 (unsigned long) FRAME_W32_WINDOW (f
),
11774 (unsigned long) img
->pixmap
);
11775 window_and_pixmap_id
= build_string (buffer
);
11777 sprintf (buffer
, "%lu %lu",
11778 FRAME_FOREGROUND_PIXEL (f
),
11779 FRAME_BACKGROUND_PIXEL (f
));
11780 pixel_colors
= build_string (buffer
);
11782 XSETFRAME (frame
, f
);
11783 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
11785 loader
= intern ("gs-load-image");
11787 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
11788 make_number (img
->width
),
11789 make_number (img
->height
),
11790 window_and_pixmap_id
,
11793 return PROCESSP (img
->data
.lisp_val
);
11797 /* Kill the Ghostscript process that was started to fill PIXMAP on
11798 frame F. Called from XTread_socket when receiving an event
11799 telling Emacs that Ghostscript has finished drawing. */
11802 x_kill_gs_process (pixmap
, f
)
11806 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
11810 /* Find the image containing PIXMAP. */
11811 for (i
= 0; i
< c
->used
; ++i
)
11812 if (c
->images
[i
]->pixmap
== pixmap
)
11815 /* Kill the GS process. We should have found PIXMAP in the image
11816 cache and its image should contain a process object. */
11817 xassert (i
< c
->used
);
11818 img
= c
->images
[i
];
11819 xassert (PROCESSP (img
->data
.lisp_val
));
11820 Fkill_process (img
->data
.lisp_val
, Qnil
);
11821 img
->data
.lisp_val
= Qnil
;
11823 /* On displays with a mutable colormap, figure out the colors
11824 allocated for the image by looking at the pixels of an XImage for
11826 class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
11827 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
11833 /* Try to get an XImage for img->pixmep. */
11834 ximg
= XGetImage (FRAME_W32_DISPLAY (f
), img
->pixmap
,
11835 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
11840 /* Initialize the color table. */
11841 init_color_table ();
11843 /* For each pixel of the image, look its color up in the
11844 color table. After having done so, the color table will
11845 contain an entry for each color used by the image. */
11846 for (y
= 0; y
< img
->height
; ++y
)
11847 for (x
= 0; x
< img
->width
; ++x
)
11849 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
11850 lookup_pixel_color (f
, pixel
);
11853 /* Record colors in the image. Free color table and XImage. */
11854 img
->colors
= colors_in_color_table (&img
->ncolors
);
11855 free_color_table ();
11856 XDestroyImage (ximg
);
11858 #if 0 /* This doesn't seem to be the case. If we free the colors
11859 here, we get a BadAccess later in x_clear_image when
11860 freeing the colors. */
11861 /* We have allocated colors once, but Ghostscript has also
11862 allocated colors on behalf of us. So, to get the
11863 reference counts right, free them once. */
11866 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
11867 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
,
11868 img
->colors
, img
->ncolors
, 0);
11873 image_error ("Cannot get X image of `%s'; colors will not be freed",
11880 #endif /* HAVE_GHOSTSCRIPT */
11883 /***********************************************************************
11885 ***********************************************************************/
11887 DEFUN ("x-change-window-property", Fx_change_window_property
,
11888 Sx_change_window_property
, 2, 3, 0,
11889 "Change window property PROP to VALUE on the X window of FRAME.\n\
11890 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
11891 selected frame. Value is VALUE.")
11892 (prop
, value
, frame
)
11893 Lisp_Object frame
, prop
, value
;
11895 #if 0 /* TODO : port window properties to W32 */
11896 struct frame
*f
= check_x_frame (frame
);
11899 CHECK_STRING (prop
, 1);
11900 CHECK_STRING (value
, 2);
11903 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
11904 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
11905 prop_atom
, XA_STRING
, 8, PropModeReplace
,
11906 XSTRING (value
)->data
, XSTRING (value
)->size
);
11908 /* Make sure the property is set when we return. */
11909 XFlush (FRAME_W32_DISPLAY (f
));
11918 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
11919 Sx_delete_window_property
, 1, 2, 0,
11920 "Remove window property PROP from X window of FRAME.\n\
11921 FRAME nil or omitted means use the selected frame. Value is PROP.")
11923 Lisp_Object prop
, frame
;
11925 #if 0 /* TODO : port window properties to W32 */
11927 struct frame
*f
= check_x_frame (frame
);
11930 CHECK_STRING (prop
, 1);
11932 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
11933 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
11935 /* Make sure the property is removed when we return. */
11936 XFlush (FRAME_W32_DISPLAY (f
));
11944 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
11946 "Value is the value of window property PROP on FRAME.\n\
11947 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
11948 if FRAME hasn't a property with name PROP or if PROP has no string\n\
11951 Lisp_Object prop
, frame
;
11953 #if 0 /* TODO : port window properties to W32 */
11955 struct frame
*f
= check_x_frame (frame
);
11958 Lisp_Object prop_value
= Qnil
;
11959 char *tmp_data
= NULL
;
11962 unsigned long actual_size
, bytes_remaining
;
11964 CHECK_STRING (prop
, 1);
11966 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
11967 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
11968 prop_atom
, 0, 0, False
, XA_STRING
,
11969 &actual_type
, &actual_format
, &actual_size
,
11970 &bytes_remaining
, (unsigned char **) &tmp_data
);
11973 int size
= bytes_remaining
;
11978 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
11979 prop_atom
, 0, bytes_remaining
,
11981 &actual_type
, &actual_format
,
11982 &actual_size
, &bytes_remaining
,
11983 (unsigned char **) &tmp_data
);
11985 prop_value
= make_string (tmp_data
, size
);
12000 /***********************************************************************
12002 ***********************************************************************/
12004 /* If non-null, an asynchronous timer that, when it expires, displays
12005 a busy cursor on all frames. */
12007 static struct atimer
*busy_cursor_atimer
;
12009 /* Non-zero means a busy cursor is currently shown. */
12011 static int busy_cursor_shown_p
;
12013 /* Number of seconds to wait before displaying a busy cursor. */
12015 static Lisp_Object Vbusy_cursor_delay
;
12017 /* Default number of seconds to wait before displaying a busy
12020 #define DEFAULT_BUSY_CURSOR_DELAY 1
12022 /* Function prototypes. */
12024 static void show_busy_cursor
P_ ((struct atimer
*));
12025 static void hide_busy_cursor
P_ ((void));
12028 /* Cancel a currently active busy-cursor timer, and start a new one. */
12031 start_busy_cursor ()
12033 #if 0 /* TODO: cursor shape changes. */
12035 int secs
, usecs
= 0;
12037 cancel_busy_cursor ();
12039 if (INTEGERP (Vbusy_cursor_delay
)
12040 && XINT (Vbusy_cursor_delay
) > 0)
12041 secs
= XFASTINT (Vbusy_cursor_delay
);
12042 else if (FLOATP (Vbusy_cursor_delay
)
12043 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
12046 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
12047 secs
= XFASTINT (tem
);
12048 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
12051 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
12053 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
12054 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
12055 show_busy_cursor
, NULL
);
12060 /* Cancel the busy cursor timer if active, hide a busy cursor if
12064 cancel_busy_cursor ()
12066 if (busy_cursor_atimer
)
12068 cancel_atimer (busy_cursor_atimer
);
12069 busy_cursor_atimer
= NULL
;
12072 if (busy_cursor_shown_p
)
12073 hide_busy_cursor ();
12077 /* Timer function of busy_cursor_atimer. TIMER is equal to
12078 busy_cursor_atimer.
12080 Display a busy cursor on all frames by mapping the frames'
12081 busy_window. Set the busy_p flag in the frames' output_data.x
12082 structure to indicate that a busy cursor is shown on the
12086 show_busy_cursor (timer
)
12087 struct atimer
*timer
;
12089 #if 0 /* TODO: cursor shape changes. */
12090 /* The timer implementation will cancel this timer automatically
12091 after this function has run. Set busy_cursor_atimer to null
12092 so that we know the timer doesn't have to be canceled. */
12093 busy_cursor_atimer
= NULL
;
12095 if (!busy_cursor_shown_p
)
12097 Lisp_Object rest
, frame
;
12101 FOR_EACH_FRAME (rest
, frame
)
12102 if (FRAME_X_P (XFRAME (frame
)))
12104 struct frame
*f
= XFRAME (frame
);
12106 f
->output_data
.w32
->busy_p
= 1;
12108 if (!f
->output_data
.w32
->busy_window
)
12110 unsigned long mask
= CWCursor
;
12111 XSetWindowAttributes attrs
;
12113 attrs
.cursor
= f
->output_data
.w32
->busy_cursor
;
12115 f
->output_data
.w32
->busy_window
12116 = XCreateWindow (FRAME_X_DISPLAY (f
),
12117 FRAME_OUTER_WINDOW (f
),
12118 0, 0, 32000, 32000, 0, 0,
12124 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.w32
->busy_window
);
12125 XFlush (FRAME_X_DISPLAY (f
));
12128 busy_cursor_shown_p
= 1;
12135 /* Hide the busy cursor on all frames, if it is currently shown. */
12138 hide_busy_cursor ()
12140 #if 0 /* TODO: cursor shape changes. */
12141 if (busy_cursor_shown_p
)
12143 Lisp_Object rest
, frame
;
12146 FOR_EACH_FRAME (rest
, frame
)
12148 struct frame
*f
= XFRAME (frame
);
12151 /* Watch out for newly created frames. */
12152 && f
->output_data
.x
->busy_window
)
12154 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
12155 /* Sync here because XTread_socket looks at the busy_p flag
12156 that is reset to zero below. */
12157 XSync (FRAME_X_DISPLAY (f
), False
);
12158 f
->output_data
.x
->busy_p
= 0;
12162 busy_cursor_shown_p
= 0;
12170 /***********************************************************************
12172 ***********************************************************************/
12174 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
12177 /* The frame of a currently visible tooltip, or null. */
12179 struct frame
*tip_frame
;
12181 /* If non-nil, a timer started that hides the last tooltip when it
12184 Lisp_Object tip_timer
;
12187 /* Create a frame for a tooltip on the display described by DPYINFO.
12188 PARMS is a list of frame parameters. Value is the frame. */
12191 x_create_tip_frame (dpyinfo
, parms
)
12192 struct w32_display_info
*dpyinfo
;
12195 #if 0 /* TODO : w32 version */
12197 Lisp_Object frame
, tem
;
12199 long window_prompting
= 0;
12201 int count
= specpdl_ptr
- specpdl
;
12202 struct gcpro gcpro1
, gcpro2
, gcpro3
;
12207 /* Use this general default value to start with until we know if
12208 this frame has a specified name. */
12209 Vx_resource_name
= Vinvocation_name
;
12211 #ifdef MULTI_KBOARD
12212 kb
= dpyinfo
->kboard
;
12214 kb
= &the_only_kboard
;
12217 /* Get the name of the frame to use for resource lookup. */
12218 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
12219 if (!STRINGP (name
)
12220 && !EQ (name
, Qunbound
)
12222 error ("Invalid frame name--not a string or nil");
12223 Vx_resource_name
= name
;
12226 GCPRO3 (parms
, name
, frame
);
12227 tip_frame
= f
= make_frame (1);
12228 XSETFRAME (frame
, f
);
12229 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
12231 f
->output_method
= output_w32
;
12232 f
->output_data
.w32
=
12233 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
12234 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
12236 f
->output_data
.w32
->icon_bitmap
= -1;
12238 f
->output_data
.w32
->fontset
= -1;
12239 f
->icon_name
= Qnil
;
12241 #ifdef MULTI_KBOARD
12242 FRAME_KBOARD (f
) = kb
;
12244 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
12245 f
->output_data
.w32
->explicit_parent
= 0;
12247 /* Set the name; the functions to which we pass f expect the name to
12249 if (EQ (name
, Qunbound
) || NILP (name
))
12251 f
->name
= build_string (dpyinfo
->x_id_name
);
12252 f
->explicit_name
= 0;
12257 f
->explicit_name
= 1;
12258 /* use the frame's title when getting resources for this frame. */
12259 specbind (Qx_resource_name
, name
);
12262 /* Extract the window parameters from the supplied values
12263 that are needed to determine window geometry. */
12267 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
12270 /* First, try whatever font the caller has specified. */
12271 if (STRINGP (font
))
12273 tem
= Fquery_fontset (font
, Qnil
);
12275 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
12277 font
= x_new_font (f
, XSTRING (font
)->data
);
12280 /* Try out a font which we hope has bold and italic variations. */
12281 if (!STRINGP (font
))
12282 font
= x_new_font (f
, "-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
12283 if (!STRINGP (font
))
12284 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12285 if (! STRINGP (font
))
12286 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12287 if (! STRINGP (font
))
12288 /* This was formerly the first thing tried, but it finds too many fonts
12289 and takes too long. */
12290 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
12291 /* If those didn't work, look for something which will at least work. */
12292 if (! STRINGP (font
))
12293 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
12295 if (! STRINGP (font
))
12296 font
= build_string ("fixed");
12298 x_default_parameter (f
, parms
, Qfont
, font
,
12299 "font", "Font", RES_TYPE_STRING
);
12302 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
12303 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
12305 /* This defaults to 2 in order to match xterm. We recognize either
12306 internalBorderWidth or internalBorder (which is what xterm calls
12308 if (NILP (Fassq (Qinternal_border_width
, parms
)))
12312 value
= w32_get_arg (parms
, Qinternal_border_width
,
12313 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
12314 if (! EQ (value
, Qunbound
))
12315 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
12319 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
12320 "internalBorderWidth", "internalBorderWidth",
12323 /* Also do the stuff which must be set before the window exists. */
12324 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
12325 "foreground", "Foreground", RES_TYPE_STRING
);
12326 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
12327 "background", "Background", RES_TYPE_STRING
);
12328 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
12329 "pointerColor", "Foreground", RES_TYPE_STRING
);
12330 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
12331 "cursorColor", "Foreground", RES_TYPE_STRING
);
12332 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
12333 "borderColor", "BorderColor", RES_TYPE_STRING
);
12335 /* Init faces before x_default_parameter is called for scroll-bar
12336 parameters because that function calls x_set_scroll_bar_width,
12337 which calls change_frame_size, which calls Fset_window_buffer,
12338 which runs hooks, which call Fvertical_motion. At the end, we
12339 end up in init_iterator with a null face cache, which should not
12341 init_frame_faces (f
);
12343 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
12344 window_prompting
= x_figure_window_size (f
, parms
);
12346 if (window_prompting
& XNegative
)
12348 if (window_prompting
& YNegative
)
12349 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
12351 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
12355 if (window_prompting
& YNegative
)
12356 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
12358 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
12361 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
12363 XSetWindowAttributes attrs
;
12364 unsigned long mask
;
12367 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
12368 /* Window managers looks at the override-redirect flag to
12369 determine whether or net to give windows a decoration (Xlib
12371 attrs
.override_redirect
= True
;
12372 attrs
.save_under
= True
;
12373 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
12374 /* Arrange for getting MapNotify and UnmapNotify events. */
12375 attrs
.event_mask
= StructureNotifyMask
;
12377 = FRAME_W32_WINDOW (f
)
12378 = XCreateWindow (FRAME_W32_DISPLAY (f
),
12379 FRAME_W32_DISPLAY_INFO (f
)->root_window
,
12380 /* x, y, width, height */
12384 CopyFromParent
, InputOutput
, CopyFromParent
,
12391 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
12392 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
12393 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
12394 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
12395 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
12396 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
12398 /* Dimensions, especially f->height, must be done via change_frame_size.
12399 Change will not be effected unless different from the current
12402 height
= f
->height
;
12404 SET_FRAME_WIDTH (f
, 0);
12405 change_frame_size (f
, height
, width
, 1, 0, 0);
12411 /* It is now ok to make the frame official even if we get an error
12412 below. And the frame needs to be on Vframe_list or making it
12413 visible won't work. */
12414 Vframe_list
= Fcons (frame
, Vframe_list
);
12416 /* Now that the frame is official, it counts as a reference to
12418 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
12420 return unbind_to (count
, frame
);
12425 #ifdef TODO /* Tooltip support not complete. */
12426 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
12427 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
12428 A tooltip window is a small X window displaying a string.\n\
12430 FRAME nil or omitted means use the selected frame.\n\
12432 PARMS is an optional list of frame parameters which can be\n\
12433 used to change the tooltip's appearance.\n\
12435 Automatically hide the tooltip after TIMEOUT seconds.\n\
12436 TIMEOUT nil means use the default timeout of 5 seconds.\n\
12438 If the list of frame parameters PARAMS contains a `left' parameters,\n\
12439 the tooltip is displayed at that x-position. Otherwise it is\n\
12440 displayed at the mouse position, with offset DX added (default is 5 if\n\
12441 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
12442 parameter is specified, it determines the y-position of the tooltip\n\
12443 window, otherwise it is displayed at the mouse position, with offset\n\
12444 DY added (default is -5).")
12445 (string
, frame
, parms
, timeout
, dx
, dy
)
12446 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
12450 Window root
, child
;
12451 Lisp_Object buffer
, top
, left
;
12452 struct buffer
*old_buffer
;
12453 struct text_pos pos
;
12454 int i
, width
, height
;
12455 int root_x
, root_y
, win_x
, win_y
;
12457 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
12458 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
12459 int count
= specpdl_ptr
- specpdl
;
12461 specbind (Qinhibit_redisplay
, Qt
);
12463 GCPRO4 (string
, parms
, frame
, timeout
);
12465 CHECK_STRING (string
, 0);
12466 f
= check_x_frame (frame
);
12467 if (NILP (timeout
))
12468 timeout
= make_number (5);
12470 CHECK_NATNUM (timeout
, 2);
12473 dx
= make_number (5);
12475 CHECK_NUMBER (dx
, 5);
12478 dy
= make_number (-5);
12480 CHECK_NUMBER (dy
, 6);
12482 /* Hide a previous tip, if any. */
12485 /* Add default values to frame parameters. */
12486 if (NILP (Fassq (Qname
, parms
)))
12487 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
12488 if (NILP (Fassq (Qinternal_border_width
, parms
)))
12489 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
12490 if (NILP (Fassq (Qborder_width
, parms
)))
12491 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
12492 if (NILP (Fassq (Qborder_color
, parms
)))
12493 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
12494 if (NILP (Fassq (Qbackground_color
, parms
)))
12495 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
12498 /* Create a frame for the tooltip, and record it in the global
12499 variable tip_frame. */
12500 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
);
12501 tip_frame
= f
= XFRAME (frame
);
12503 /* Set up the frame's root window. Currently we use a size of 80
12504 columns x 40 lines. If someone wants to show a larger tip, he
12505 will loose. I don't think this is a realistic case. */
12506 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
12507 w
->left
= w
->top
= make_number (0);
12511 w
->pseudo_window_p
= 1;
12513 /* Display the tooltip text in a temporary buffer. */
12514 buffer
= Fget_buffer_create (build_string (" *tip*"));
12515 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
12516 old_buffer
= current_buffer
;
12517 set_buffer_internal_1 (XBUFFER (buffer
));
12519 Finsert (make_number (1), &string
);
12520 clear_glyph_matrix (w
->desired_matrix
);
12521 clear_glyph_matrix (w
->current_matrix
);
12522 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
12523 try_window (FRAME_ROOT_WINDOW (f
), pos
);
12525 /* Compute width and height of the tooltip. */
12526 width
= height
= 0;
12527 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
12529 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
12530 struct glyph
*last
;
12533 /* Stop at the first empty row at the end. */
12534 if (!row
->enabled_p
|| !row
->displays_text_p
)
12537 /* Let the row go over the full width of the frame. */
12538 row
->full_width_p
= 1;
12540 /* There's a glyph at the end of rows that is use to place
12541 the cursor there. Don't include the width of this glyph. */
12542 if (row
->used
[TEXT_AREA
])
12544 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
12545 row_width
= row
->pixel_width
- last
->pixel_width
;
12548 row_width
= row
->pixel_width
;
12550 height
+= row
->height
;
12551 width
= max (width
, row_width
);
12554 /* Add the frame's internal border to the width and height the X
12555 window should have. */
12556 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
12557 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
12559 /* User-specified position? */
12560 left
= Fcdr (Fassq (Qleft
, parms
));
12561 top
= Fcdr (Fassq (Qtop
, parms
));
12563 /* Move the tooltip window where the mouse pointer is. Resize and
12565 #if 0 /* TODO : W32 specifics */
12567 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
12568 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
12571 root_x
+= XINT (dx
);
12572 root_y
+= XINT (dy
);
12574 if (INTEGERP (left
))
12575 root_x
= XINT (left
);
12576 if (INTEGERP (top
))
12577 root_y
= XINT (top
);
12580 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
12581 root_x
, root_y
- height
, width
, height
);
12582 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
12586 /* Draw into the window. */
12587 w
->must_be_updated_p
= 1;
12588 update_single_window (w
, 1);
12590 /* Restore original current buffer. */
12591 set_buffer_internal_1 (old_buffer
);
12592 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
12594 /* Let the tip disappear after timeout seconds. */
12595 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
12596 intern ("x-hide-tip"));
12599 return unbind_to (count
, Qnil
);
12603 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
12604 "Hide the current tooltip window, if there is any.\n\
12605 Value is t is tooltip was open, nil otherwise.")
12608 int count
= specpdl_ptr
- specpdl
;
12611 specbind (Qinhibit_redisplay
, Qt
);
12613 if (!NILP (tip_timer
))
12615 call1 (intern ("cancel-timer"), tip_timer
);
12623 XSETFRAME (frame
, tip_frame
);
12624 Fdelete_frame (frame
, Qt
);
12629 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
12635 /***********************************************************************
12636 File selection dialog
12637 ***********************************************************************/
12639 extern Lisp_Object Qfile_name_history
;
12641 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
12642 "Read file name, prompting with PROMPT in directory DIR.\n\
12643 Use a file selection dialog.\n\
12644 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
12645 specified. Don't let the user enter a file name in the file\n\
12646 selection dialog's entry field, if MUSTMATCH is non-nil.")
12647 (prompt
, dir
, default_filename
, mustmatch
)
12648 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
12650 struct frame
*f
= SELECTED_FRAME ();
12651 Lisp_Object file
= Qnil
;
12652 int count
= specpdl_ptr
- specpdl
;
12653 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
12654 char filename
[MAX_PATH
+ 1];
12655 char init_dir
[MAX_PATH
+ 1];
12656 int use_dialog_p
= 1;
12658 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
12659 CHECK_STRING (prompt
, 0);
12660 CHECK_STRING (dir
, 1);
12662 /* Create the dialog with PROMPT as title, using DIR as initial
12663 directory and using "*" as pattern. */
12664 dir
= Fexpand_file_name (dir
, Qnil
);
12665 strncpy (init_dir
, XSTRING (dir
)->data
, MAX_PATH
);
12666 init_dir
[MAX_PATH
] = '\0';
12667 unixtodos_filename (init_dir
);
12669 if (STRINGP (default_filename
))
12671 char *file_name_only
;
12672 char *full_path_name
= XSTRING (default_filename
)->data
;
12674 unixtodos_filename (full_path_name
);
12676 file_name_only
= strrchr (full_path_name
, '\\');
12677 if (!file_name_only
)
12678 file_name_only
= full_path_name
;
12683 /* If default_file_name is a directory, don't use the open
12684 file dialog, as it does not support selecting
12686 if (!(*file_name_only
))
12690 strncpy (filename
, file_name_only
, MAX_PATH
);
12691 filename
[MAX_PATH
] = '\0';
12694 filename
[0] = '\0';
12698 OPENFILENAME file_details
;
12699 char *filename_file
;
12701 /* Prevent redisplay. */
12702 specbind (Qinhibit_redisplay
, Qt
);
12705 bzero (&file_details
, sizeof (file_details
));
12706 file_details
.lStructSize
= sizeof (file_details
);
12707 file_details
.hwndOwner
= FRAME_W32_WINDOW (f
);
12708 file_details
.lpstrFile
= filename
;
12709 file_details
.nMaxFile
= sizeof (filename
);
12710 file_details
.lpstrInitialDir
= init_dir
;
12711 file_details
.lpstrTitle
= XSTRING (prompt
)->data
;
12712 file_details
.Flags
= OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
;
12714 if (!NILP (mustmatch
))
12715 file_details
.Flags
|= OFN_FILEMUSTEXIST
| OFN_PATHMUSTEXIST
;
12717 if (GetOpenFileName (&file_details
))
12719 dostounix_filename (filename
);
12720 file
= build_string (filename
);
12726 file
= unbind_to (count
, file
);
12728 /* Open File dialog will not allow folders to be selected, so resort
12729 to minibuffer completing reads for directories. */
12731 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
12732 dir
, mustmatch
, dir
, Qfile_name_history
,
12733 default_filename
, Qnil
);
12737 /* Make "Cancel" equivalent to C-g. */
12739 Fsignal (Qquit
, Qnil
);
12741 return unbind_to (count
, file
);
12746 /***********************************************************************
12748 ***********************************************************************/
12752 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
12753 "Value is non-nil if SPEC is a valid image specification.")
12757 return valid_image_p (spec
) ? Qt
: Qnil
;
12761 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
12767 if (valid_image_p (spec
))
12768 id
= lookup_image (SELECTED_FRAME (), spec
);
12770 debug_print (spec
);
12771 return make_number (id
);
12774 #endif /* GLYPH_DEBUG != 0 */
12778 /***********************************************************************
12779 w32 specialized functions
12780 ***********************************************************************/
12782 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
12783 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
12787 FRAME_PTR f
= check_x_frame (frame
);
12795 bzero (&cf
, sizeof (cf
));
12796 bzero (&lf
, sizeof (lf
));
12798 cf
.lStructSize
= sizeof (cf
);
12799 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
12800 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
12801 cf
.lpLogFont
= &lf
;
12803 /* Initialize as much of the font details as we can from the current
12805 hdc
= GetDC (FRAME_W32_WINDOW (f
));
12806 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
12807 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
12808 if (GetTextMetrics (hdc
, &tm
))
12810 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
12811 lf
.lfWeight
= tm
.tmWeight
;
12812 lf
.lfItalic
= tm
.tmItalic
;
12813 lf
.lfUnderline
= tm
.tmUnderlined
;
12814 lf
.lfStrikeOut
= tm
.tmStruckOut
;
12815 lf
.lfCharSet
= tm
.tmCharSet
;
12816 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
12818 SelectObject (hdc
, oldobj
);
12819 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
12821 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
12824 return build_string (buf
);
12827 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
, Sw32_send_sys_command
, 1, 2, 0,
12828 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
12829 Some useful values for command are 0xf030 to maximise frame (0xf020\n\
12830 to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
12831 to activate the menubar for keyboard access. 0xf140 activates the\n\
12832 screen saver if defined.\n\
12834 If optional parameter FRAME is not specified, use selected frame.")
12836 Lisp_Object command
, frame
;
12839 FRAME_PTR f
= check_x_frame (frame
);
12841 CHECK_NUMBER (command
, 0);
12843 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
12848 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
12849 "Get Windows to perform OPERATION on DOCUMENT.\n\
12850 This is a wrapper around the ShellExecute system function, which\n\
12851 invokes the application registered to handle OPERATION for DOCUMENT.\n\
12852 OPERATION is typically \"open\", \"print\" or \"explore\" (but can be\n\
12853 nil for the default action), and DOCUMENT is typically the name of a\n\
12854 document file or URL, but can also be a program executable to run or\n\
12855 a directory to open in the Windows Explorer.\n\
12857 If DOCUMENT is a program executable, PARAMETERS can be a string\n\
12858 containing command line parameters, but otherwise should be nil.\n\
12860 SHOW-FLAG can be used to control whether the invoked application is hidden\n\
12861 or minimized. If SHOW-FLAG is nil, the application is displayed normally,\n\
12862 otherwise it is an integer representing a ShowWindow flag:\n\
12864 0 - start hidden\n\
12865 1 - start normally\n\
12866 3 - start maximized\n\
12867 6 - start minimized")
12868 (operation
, document
, parameters
, show_flag
)
12869 Lisp_Object operation
, document
, parameters
, show_flag
;
12871 Lisp_Object current_dir
;
12873 CHECK_STRING (document
, 0);
12875 /* Encode filename and current directory. */
12876 current_dir
= ENCODE_FILE (current_buffer
->directory
);
12877 document
= ENCODE_FILE (document
);
12878 if ((int) ShellExecute (NULL
,
12879 (STRINGP (operation
) ?
12880 XSTRING (operation
)->data
: NULL
),
12881 XSTRING (document
)->data
,
12882 (STRINGP (parameters
) ?
12883 XSTRING (parameters
)->data
: NULL
),
12884 XSTRING (current_dir
)->data
,
12885 (INTEGERP (show_flag
) ?
12886 XINT (show_flag
) : SW_SHOWDEFAULT
))
12889 error ("ShellExecute failed");
12892 /* Lookup virtual keycode from string representing the name of a
12893 non-ascii keystroke into the corresponding virtual key, using
12894 lispy_function_keys. */
12896 lookup_vk_code (char *key
)
12900 for (i
= 0; i
< 256; i
++)
12901 if (lispy_function_keys
[i
] != 0
12902 && strcmp (lispy_function_keys
[i
], key
) == 0)
12908 /* Convert a one-element vector style key sequence to a hot key
12911 w32_parse_hot_key (key
)
12914 /* Copied from Fdefine_key and store_in_keymap. */
12915 register Lisp_Object c
;
12917 int lisp_modifiers
;
12919 struct gcpro gcpro1
;
12921 CHECK_VECTOR (key
, 0);
12923 if (XFASTINT (Flength (key
)) != 1)
12928 c
= Faref (key
, make_number (0));
12930 if (CONSP (c
) && lucid_event_type_list_p (c
))
12931 c
= Fevent_convert_list (c
);
12935 if (! INTEGERP (c
) && ! SYMBOLP (c
))
12936 error ("Key definition is invalid");
12938 /* Work out the base key and the modifiers. */
12941 c
= parse_modifiers (c
);
12942 lisp_modifiers
= Fcar (Fcdr (c
));
12946 vk_code
= lookup_vk_code (XSYMBOL (c
)->name
->data
);
12948 else if (INTEGERP (c
))
12950 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
12951 /* Many ascii characters are their own virtual key code. */
12952 vk_code
= XINT (c
) & CHARACTERBITS
;
12955 if (vk_code
< 0 || vk_code
> 255)
12958 if ((lisp_modifiers
& meta_modifier
) != 0
12959 && !NILP (Vw32_alt_is_meta
))
12960 lisp_modifiers
|= alt_modifier
;
12962 /* Supply defs missing from mingw32. */
12964 #define MOD_ALT 0x0001
12965 #define MOD_CONTROL 0x0002
12966 #define MOD_SHIFT 0x0004
12967 #define MOD_WIN 0x0008
12970 /* Convert lisp modifiers to Windows hot-key form. */
12971 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
12972 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
12973 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
12974 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
12976 return HOTKEY (vk_code
, w32_modifiers
);
12979 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
, Sw32_register_hot_key
, 1, 1, 0,
12980 "Register KEY as a hot-key combination.\n\
12981 Certain key combinations like Alt-Tab are reserved for system use on\n\
12982 Windows, and therefore are normally intercepted by the system. However,\n\
12983 most of these key combinations can be received by registering them as\n\
12984 hot-keys, overriding their special meaning.\n\
12986 KEY must be a one element key definition in vector form that would be\n\
12987 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta\n\
12988 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper\n\
12989 is always interpreted as the Windows modifier keys.\n\
12991 The return value is the hotkey-id if registered, otherwise nil.")
12995 key
= w32_parse_hot_key (key
);
12997 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
12999 /* Reuse an empty slot if possible. */
13000 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
13002 /* Safe to add new key to list, even if we have focus. */
13004 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
13008 /* Notify input thread about new hot-key definition, so that it
13009 takes effect without needing to switch focus. */
13010 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
13017 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
, Sw32_unregister_hot_key
, 1, 1, 0,
13018 "Unregister HOTKEY as a hot-key combination.")
13024 if (!INTEGERP (key
))
13025 key
= w32_parse_hot_key (key
);
13027 item
= Fmemq (key
, w32_grabbed_keys
);
13031 /* Notify input thread about hot-key definition being removed, so
13032 that it takes effect without needing focus switch. */
13033 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
13034 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
13037 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
13044 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
, Sw32_registered_hot_keys
, 0, 0, 0,
13045 "Return list of registered hot-key IDs.")
13048 return Fcopy_sequence (w32_grabbed_keys
);
13051 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
, Sw32_reconstruct_hot_key
, 1, 1, 0,
13052 "Convert hot-key ID to a lisp key combination.")
13054 Lisp_Object hotkeyid
;
13056 int vk_code
, w32_modifiers
;
13059 CHECK_NUMBER (hotkeyid
, 0);
13061 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
13062 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
13064 if (lispy_function_keys
[vk_code
])
13065 key
= intern (lispy_function_keys
[vk_code
]);
13067 key
= make_number (vk_code
);
13069 key
= Fcons (key
, Qnil
);
13070 if (w32_modifiers
& MOD_SHIFT
)
13071 key
= Fcons (Qshift
, key
);
13072 if (w32_modifiers
& MOD_CONTROL
)
13073 key
= Fcons (Qctrl
, key
);
13074 if (w32_modifiers
& MOD_ALT
)
13075 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
13076 if (w32_modifiers
& MOD_WIN
)
13077 key
= Fcons (Qhyper
, key
);
13082 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
, Sw32_toggle_lock_key
, 1, 2, 0,
13083 "Toggle the state of the lock key KEY.\n\
13084 KEY can be `capslock', `kp-numlock', or `scroll'.\n\
13085 If the optional parameter NEW-STATE is a number, then the state of KEY\n\
13086 is set to off if the low bit of NEW-STATE is zero, otherwise on.")
13088 Lisp_Object key
, new_state
;
13093 if (EQ (key
, intern ("capslock")))
13094 vk_code
= VK_CAPITAL
;
13095 else if (EQ (key
, intern ("kp-numlock")))
13096 vk_code
= VK_NUMLOCK
;
13097 else if (EQ (key
, intern ("scroll")))
13098 vk_code
= VK_SCROLL
;
13102 if (!dwWindowsThreadId
)
13103 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
13105 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
13106 (WPARAM
) vk_code
, (LPARAM
) new_state
))
13109 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
13110 return make_number (msg
.wParam
);
13117 /* This is zero if not using MS-Windows. */
13120 /* The section below is built by the lisp expression at the top of the file,
13121 just above where these variables are declared. */
13122 /*&&& init symbols here &&&*/
13123 Qauto_raise
= intern ("auto-raise");
13124 staticpro (&Qauto_raise
);
13125 Qauto_lower
= intern ("auto-lower");
13126 staticpro (&Qauto_lower
);
13127 Qbar
= intern ("bar");
13129 Qborder_color
= intern ("border-color");
13130 staticpro (&Qborder_color
);
13131 Qborder_width
= intern ("border-width");
13132 staticpro (&Qborder_width
);
13133 Qbox
= intern ("box");
13135 Qcursor_color
= intern ("cursor-color");
13136 staticpro (&Qcursor_color
);
13137 Qcursor_type
= intern ("cursor-type");
13138 staticpro (&Qcursor_type
);
13139 Qgeometry
= intern ("geometry");
13140 staticpro (&Qgeometry
);
13141 Qicon_left
= intern ("icon-left");
13142 staticpro (&Qicon_left
);
13143 Qicon_top
= intern ("icon-top");
13144 staticpro (&Qicon_top
);
13145 Qicon_type
= intern ("icon-type");
13146 staticpro (&Qicon_type
);
13147 Qicon_name
= intern ("icon-name");
13148 staticpro (&Qicon_name
);
13149 Qinternal_border_width
= intern ("internal-border-width");
13150 staticpro (&Qinternal_border_width
);
13151 Qleft
= intern ("left");
13152 staticpro (&Qleft
);
13153 Qright
= intern ("right");
13154 staticpro (&Qright
);
13155 Qmouse_color
= intern ("mouse-color");
13156 staticpro (&Qmouse_color
);
13157 Qnone
= intern ("none");
13158 staticpro (&Qnone
);
13159 Qparent_id
= intern ("parent-id");
13160 staticpro (&Qparent_id
);
13161 Qscroll_bar_width
= intern ("scroll-bar-width");
13162 staticpro (&Qscroll_bar_width
);
13163 Qsuppress_icon
= intern ("suppress-icon");
13164 staticpro (&Qsuppress_icon
);
13165 Qundefined_color
= intern ("undefined-color");
13166 staticpro (&Qundefined_color
);
13167 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
13168 staticpro (&Qvertical_scroll_bars
);
13169 Qvisibility
= intern ("visibility");
13170 staticpro (&Qvisibility
);
13171 Qwindow_id
= intern ("window-id");
13172 staticpro (&Qwindow_id
);
13173 Qx_frame_parameter
= intern ("x-frame-parameter");
13174 staticpro (&Qx_frame_parameter
);
13175 Qx_resource_name
= intern ("x-resource-name");
13176 staticpro (&Qx_resource_name
);
13177 Quser_position
= intern ("user-position");
13178 staticpro (&Quser_position
);
13179 Quser_size
= intern ("user-size");
13180 staticpro (&Quser_size
);
13181 Qscreen_gamma
= intern ("screen-gamma");
13182 staticpro (&Qscreen_gamma
);
13183 Qline_spacing
= intern ("line-spacing");
13184 staticpro (&Qline_spacing
);
13185 Qcenter
= intern ("center");
13186 staticpro (&Qcenter
);
13187 /* This is the end of symbol initialization. */
13189 Qhyper
= intern ("hyper");
13190 staticpro (&Qhyper
);
13191 Qsuper
= intern ("super");
13192 staticpro (&Qsuper
);
13193 Qmeta
= intern ("meta");
13194 staticpro (&Qmeta
);
13195 Qalt
= intern ("alt");
13197 Qctrl
= intern ("ctrl");
13198 staticpro (&Qctrl
);
13199 Qcontrol
= intern ("control");
13200 staticpro (&Qcontrol
);
13201 Qshift
= intern ("shift");
13202 staticpro (&Qshift
);
13204 /* Text property `display' should be nonsticky by default. */
13205 Vtext_property_default_nonsticky
13206 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
13209 Qlaplace
= intern ("laplace");
13210 staticpro (&Qlaplace
);
13212 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
13213 staticpro (&Qface_set_after_frame_default
);
13215 Fput (Qundefined_color
, Qerror_conditions
,
13216 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
13217 Fput (Qundefined_color
, Qerror_message
,
13218 build_string ("Undefined color"));
13220 staticpro (&w32_grabbed_keys
);
13221 w32_grabbed_keys
= Qnil
;
13223 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
13224 "An array of color name mappings for windows.");
13225 Vw32_color_map
= Qnil
;
13227 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
13228 "Non-nil if alt key presses are passed on to Windows.\n\
13229 When non-nil, for example, alt pressed and released and then space will\n\
13230 open the System menu. When nil, Emacs silently swallows alt key events.");
13231 Vw32_pass_alt_to_system
= Qnil
;
13233 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
13234 "Non-nil if the alt key is to be considered the same as the meta key.\n\
13235 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
13236 Vw32_alt_is_meta
= Qt
;
13238 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
13239 "If non-zero, the virtual key code for an alternative quit key.");
13240 XSETINT (Vw32_quit_key
, 0);
13242 DEFVAR_LISP ("w32-pass-lwindow-to-system",
13243 &Vw32_pass_lwindow_to_system
,
13244 "Non-nil if the left \"Windows\" key is passed on to Windows.\n\
13245 When non-nil, the Start menu is opened by tapping the key.");
13246 Vw32_pass_lwindow_to_system
= Qt
;
13248 DEFVAR_LISP ("w32-pass-rwindow-to-system",
13249 &Vw32_pass_rwindow_to_system
,
13250 "Non-nil if the right \"Windows\" key is passed on to Windows.\n\
13251 When non-nil, the Start menu is opened by tapping the key.");
13252 Vw32_pass_rwindow_to_system
= Qt
;
13254 DEFVAR_INT ("w32-phantom-key-code",
13255 &Vw32_phantom_key_code
,
13256 "Virtual key code used to generate \"phantom\" key presses.\n\
13257 Value is a number between 0 and 255.\n\
13259 Phantom key presses are generated in order to stop the system from\n\
13260 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or\n\
13261 `w32-pass-rwindow-to-system' is nil.");
13262 /* Although 255 is technically not a valid key code, it works and
13263 means that this hack won't interfere with any real key code. */
13264 Vw32_phantom_key_code
= 255;
13266 DEFVAR_LISP ("w32-enable-num-lock",
13267 &Vw32_enable_num_lock
,
13268 "Non-nil if Num Lock should act normally.\n\
13269 Set to nil to see Num Lock as the key `kp-numlock'.");
13270 Vw32_enable_num_lock
= Qt
;
13272 DEFVAR_LISP ("w32-enable-caps-lock",
13273 &Vw32_enable_caps_lock
,
13274 "Non-nil if Caps Lock should act normally.\n\
13275 Set to nil to see Caps Lock as the key `capslock'.");
13276 Vw32_enable_caps_lock
= Qt
;
13278 DEFVAR_LISP ("w32-scroll-lock-modifier",
13279 &Vw32_scroll_lock_modifier
,
13280 "Modifier to use for the Scroll Lock on state.\n\
13281 The value can be hyper, super, meta, alt, control or shift for the\n\
13282 respective modifier, or nil to see Scroll Lock as the key `scroll'.\n\
13283 Any other value will cause the key to be ignored.");
13284 Vw32_scroll_lock_modifier
= Qt
;
13286 DEFVAR_LISP ("w32-lwindow-modifier",
13287 &Vw32_lwindow_modifier
,
13288 "Modifier to use for the left \"Windows\" key.\n\
13289 The value can be hyper, super, meta, alt, control or shift for the\n\
13290 respective modifier, or nil to appear as the key `lwindow'.\n\
13291 Any other value will cause the key to be ignored.");
13292 Vw32_lwindow_modifier
= Qnil
;
13294 DEFVAR_LISP ("w32-rwindow-modifier",
13295 &Vw32_rwindow_modifier
,
13296 "Modifier to use for the right \"Windows\" key.\n\
13297 The value can be hyper, super, meta, alt, control or shift for the\n\
13298 respective modifier, or nil to appear as the key `rwindow'.\n\
13299 Any other value will cause the key to be ignored.");
13300 Vw32_rwindow_modifier
= Qnil
;
13302 DEFVAR_LISP ("w32-apps-modifier",
13303 &Vw32_apps_modifier
,
13304 "Modifier to use for the \"Apps\" key.\n\
13305 The value can be hyper, super, meta, alt, control or shift for the\n\
13306 respective modifier, or nil to appear as the key `apps'.\n\
13307 Any other value will cause the key to be ignored.");
13308 Vw32_apps_modifier
= Qnil
;
13310 DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts
,
13311 "Non-nil enables selection of artificially italicized and bold fonts.");
13312 Vw32_enable_synthesized_fonts
= Qnil
;
13314 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
13315 "Non-nil enables Windows palette management to map colors exactly.");
13316 Vw32_enable_palette
= Qt
;
13318 DEFVAR_INT ("w32-mouse-button-tolerance",
13319 &Vw32_mouse_button_tolerance
,
13320 "Analogue of double click interval for faking middle mouse events.\n\
13321 The value is the minimum time in milliseconds that must elapse between\n\
13322 left/right button down events before they are considered distinct events.\n\
13323 If both mouse buttons are depressed within this interval, a middle mouse\n\
13324 button down event is generated instead.");
13325 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
13327 DEFVAR_INT ("w32-mouse-move-interval",
13328 &Vw32_mouse_move_interval
,
13329 "Minimum interval between mouse move events.\n\
13330 The value is the minimum time in milliseconds that must elapse between\n\
13331 successive mouse move (or scroll bar drag) events before they are\n\
13332 reported as lisp events.");
13333 XSETINT (Vw32_mouse_move_interval
, 0);
13335 init_x_parm_symbols ();
13337 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
13338 "List of directories to search for bitmap files for w32.");
13339 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
13341 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
13342 "The shape of the pointer when over text.\n\
13343 Changing the value does not affect existing frames\n\
13344 unless you set the mouse color.");
13345 Vx_pointer_shape
= Qnil
;
13347 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
13348 "The name Emacs uses to look up resources; for internal use only.\n\
13349 `x-get-resource' uses this as the first component of the instance name\n\
13350 when requesting resource values.\n\
13351 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
13352 was invoked, or to the value specified with the `-name' or `-rn'\n\
13353 switches, if present.");
13354 Vx_resource_name
= Qnil
;
13356 Vx_nontext_pointer_shape
= Qnil
;
13358 Vx_mode_pointer_shape
= Qnil
;
13360 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
13361 "The shape of the pointer when Emacs is busy.\n\
13362 This variable takes effect when you create a new frame\n\
13363 or when you set the mouse color.");
13364 Vx_busy_pointer_shape
= Qnil
;
13366 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
13367 "Non-zero means Emacs displays a busy cursor on window systems.");
13368 display_busy_cursor_p
= 1;
13370 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
13371 "*Seconds to wait before displaying a busy-cursor.\n\
13372 Value must be an integer or float.");
13373 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
13375 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
13376 &Vx_sensitive_text_pointer_shape
,
13377 "The shape of the pointer when over mouse-sensitive text.\n\
13378 This variable takes effect when you create a new frame\n\
13379 or when you set the mouse color.");
13380 Vx_sensitive_text_pointer_shape
= Qnil
;
13382 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
13383 &Vx_window_horizontal_drag_shape
,
13384 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
13385 This variable takes effect when you create a new frame\n\
13386 or when you set the mouse color.");
13387 Vx_window_horizontal_drag_shape
= Qnil
;
13389 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
13390 "A string indicating the foreground color of the cursor box.");
13391 Vx_cursor_fore_pixel
= Qnil
;
13393 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
13394 "Non-nil if no window manager is in use.\n\
13395 Emacs doesn't try to figure this out; this is always nil\n\
13396 unless you set it to something else.");
13397 /* We don't have any way to find this out, so set it to nil
13398 and maybe the user would like to set it to t. */
13399 Vx_no_window_manager
= Qnil
;
13401 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
13402 &Vx_pixel_size_width_font_regexp
,
13403 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
13405 Since Emacs gets width of a font matching with this regexp from\n\
13406 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
13407 such a font. This is especially effective for such large fonts as\n\
13408 Chinese, Japanese, and Korean.");
13409 Vx_pixel_size_width_font_regexp
= Qnil
;
13411 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
13412 "Time after which cached images are removed from the cache.\n\
13413 When an image has not been displayed this many seconds, remove it\n\
13414 from the image cache. Value must be an integer or nil with nil\n\
13415 meaning don't clear the cache.");
13416 Vimage_cache_eviction_delay
= make_number (30 * 60);
13418 DEFVAR_LISP ("w32-bdf-filename-alist",
13419 &Vw32_bdf_filename_alist
,
13420 "List of bdf fonts and their corresponding filenames.");
13421 Vw32_bdf_filename_alist
= Qnil
;
13423 DEFVAR_BOOL ("w32-strict-fontnames",
13424 &w32_strict_fontnames
,
13425 "Non-nil means only use fonts that are exact matches for those requested.\n\
13426 Default is nil, which allows old fontnames that are not XLFD compliant,\n\
13427 and allows third-party CJK display to work by specifying false charset\n\
13428 fields to trick Emacs into translating to Big5, SJIS etc.\n\
13429 Setting this to t will prevent wrong fonts being selected when\n\
13430 fontsets are automatically created.");
13431 w32_strict_fontnames
= 0;
13433 DEFVAR_BOOL ("w32-strict-painting",
13434 &w32_strict_painting
,
13435 "Non-nil means use strict rules for repainting frames.\n\
13436 Set this to nil to get the old behaviour for repainting; this should\n\
13437 only be necessary if the default setting causes problems.");
13438 w32_strict_painting
= 1;
13440 DEFVAR_LISP ("w32-system-coding-system",
13441 &Vw32_system_coding_system
,
13442 "Coding system used by Windows system functions, such as for font names.");
13443 Vw32_system_coding_system
= Qnil
;
13445 DEFVAR_LISP ("w32-charset-info-alist",
13446 &Vw32_charset_info_alist
,
13447 "Alist linking Emacs character sets to Windows fonts\n\
13448 and codepages. Each entry should be of the form:\n\
13450 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))\n\
13452 where CHARSET_NAME is a string used in font names to identify the charset,\n\
13453 WINDOWS_CHARSET is a symbol that can be one of:\n\
13454 w32-charset-ansi, w32-charset-default, w32-charset-symbol,\n\
13455 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,\n\
13456 w32-charset-chinesebig5, "
13457 #ifdef JOHAB_CHARSET
13458 "w32-charset-johab, w32-charset-hebrew,\n\
13459 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,\n\
13460 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,\n\
13461 w32-charset-russian, w32-charset-mac, w32-charset-baltic,\n"
13463 #ifdef UNICODE_CHARSET
13464 "w32-charset-unicode, "
13466 "or w32-charset-oem.\n\
13467 CODEPAGE should be an integer specifying the codepage that should be used\n\
13468 to display the character set, t to do no translation and output as Unicode,\n\
13469 or nil to do no translation and output as 8 bit (or multibyte on far-east\n\
13470 versions of Windows) characters.");
13471 Vw32_charset_info_alist
= Qnil
;
13473 staticpro (&Qw32_charset_ansi
);
13474 Qw32_charset_ansi
= intern ("w32-charset-ansi");
13475 staticpro (&Qw32_charset_symbol
);
13476 Qw32_charset_symbol
= intern ("w32-charset-symbol");
13477 staticpro (&Qw32_charset_shiftjis
);
13478 Qw32_charset_shiftjis
= intern ("w32-charset-shiftjis");
13479 staticpro (&Qw32_charset_hangeul
);
13480 Qw32_charset_hangeul
= intern ("w32-charset-hangeul");
13481 staticpro (&Qw32_charset_chinesebig5
);
13482 Qw32_charset_chinesebig5
= intern ("w32-charset-chinesebig5");
13483 staticpro (&Qw32_charset_gb2312
);
13484 Qw32_charset_gb2312
= intern ("w32-charset-gb2312");
13485 staticpro (&Qw32_charset_oem
);
13486 Qw32_charset_oem
= intern ("w32-charset-oem");
13488 #ifdef JOHAB_CHARSET
13490 static int w32_extra_charsets_defined
= 1;
13491 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
, "");
13493 staticpro (&Qw32_charset_johab
);
13494 Qw32_charset_johab
= intern ("w32-charset-johab");
13495 staticpro (&Qw32_charset_easteurope
);
13496 Qw32_charset_easteurope
= intern ("w32-charset-easteurope");
13497 staticpro (&Qw32_charset_turkish
);
13498 Qw32_charset_turkish
= intern ("w32-charset-turkish");
13499 staticpro (&Qw32_charset_baltic
);
13500 Qw32_charset_baltic
= intern ("w32-charset-baltic");
13501 staticpro (&Qw32_charset_russian
);
13502 Qw32_charset_russian
= intern ("w32-charset-russian");
13503 staticpro (&Qw32_charset_arabic
);
13504 Qw32_charset_arabic
= intern ("w32-charset-arabic");
13505 staticpro (&Qw32_charset_greek
);
13506 Qw32_charset_greek
= intern ("w32-charset-greek");
13507 staticpro (&Qw32_charset_hebrew
);
13508 Qw32_charset_hebrew
= intern ("w32-charset-hebrew");
13509 staticpro (&Qw32_charset_vietnamese
);
13510 Qw32_charset_vietnamese
= intern ("w32-charset-vietnamese");
13511 staticpro (&Qw32_charset_thai
);
13512 Qw32_charset_thai
= intern ("w32-charset-thai");
13513 staticpro (&Qw32_charset_mac
);
13514 Qw32_charset_mac
= intern ("w32-charset-mac");
13518 #ifdef UNICODE_CHARSET
13520 static int w32_unicode_charset_defined
= 1;
13521 DEFVAR_BOOL ("w32-unicode-charset-defined",
13522 &w32_unicode_charset_defined
, "");
13524 staticpro (&Qw32_charset_unicode
);
13525 Qw32_charset_unicode
= intern ("w32-charset-unicode");
13528 defsubr (&Sx_get_resource
);
13529 #if 0 /* TODO: Port to W32 */
13530 defsubr (&Sx_change_window_property
);
13531 defsubr (&Sx_delete_window_property
);
13532 defsubr (&Sx_window_property
);
13534 defsubr (&Sxw_display_color_p
);
13535 defsubr (&Sx_display_grayscale_p
);
13536 defsubr (&Sxw_color_defined_p
);
13537 defsubr (&Sxw_color_values
);
13538 defsubr (&Sx_server_max_request_size
);
13539 defsubr (&Sx_server_vendor
);
13540 defsubr (&Sx_server_version
);
13541 defsubr (&Sx_display_pixel_width
);
13542 defsubr (&Sx_display_pixel_height
);
13543 defsubr (&Sx_display_mm_width
);
13544 defsubr (&Sx_display_mm_height
);
13545 defsubr (&Sx_display_screens
);
13546 defsubr (&Sx_display_planes
);
13547 defsubr (&Sx_display_color_cells
);
13548 defsubr (&Sx_display_visual_class
);
13549 defsubr (&Sx_display_backing_store
);
13550 defsubr (&Sx_display_save_under
);
13551 defsubr (&Sx_parse_geometry
);
13552 defsubr (&Sx_create_frame
);
13553 defsubr (&Sx_open_connection
);
13554 defsubr (&Sx_close_connection
);
13555 defsubr (&Sx_display_list
);
13556 defsubr (&Sx_synchronize
);
13558 /* W32 specific functions */
13560 defsubr (&Sw32_focus_frame
);
13561 defsubr (&Sw32_select_font
);
13562 defsubr (&Sw32_define_rgb_color
);
13563 defsubr (&Sw32_default_color_map
);
13564 defsubr (&Sw32_load_color_file
);
13565 defsubr (&Sw32_send_sys_command
);
13566 defsubr (&Sw32_shell_execute
);
13567 defsubr (&Sw32_register_hot_key
);
13568 defsubr (&Sw32_unregister_hot_key
);
13569 defsubr (&Sw32_registered_hot_keys
);
13570 defsubr (&Sw32_reconstruct_hot_key
);
13571 defsubr (&Sw32_toggle_lock_key
);
13572 defsubr (&Sw32_find_bdf_fonts
);
13574 /* Setting callback functions for fontset handler. */
13575 get_font_info_func
= w32_get_font_info
;
13577 #if 0 /* This function pointer doesn't seem to be used anywhere.
13578 And the pointer assigned has the wrong type, anyway. */
13579 list_fonts_func
= w32_list_fonts
;
13582 load_font_func
= w32_load_font
;
13583 find_ccl_program_func
= w32_find_ccl_program
;
13584 query_font_func
= w32_query_font
;
13585 set_frame_fontset_func
= x_set_font
;
13586 check_window_system_func
= check_w32
;
13588 #if 0 /* TODO Image support for W32 */
13590 Qxbm
= intern ("xbm");
13592 QCtype
= intern (":type");
13593 staticpro (&QCtype
);
13594 QCalgorithm
= intern (":algorithm");
13595 staticpro (&QCalgorithm
);
13596 QCheuristic_mask
= intern (":heuristic-mask");
13597 staticpro (&QCheuristic_mask
);
13598 QCcolor_symbols
= intern (":color-symbols");
13599 staticpro (&QCcolor_symbols
);
13600 QCascent
= intern (":ascent");
13601 staticpro (&QCascent
);
13602 QCmargin
= intern (":margin");
13603 staticpro (&QCmargin
);
13604 QCrelief
= intern (":relief");
13605 staticpro (&QCrelief
);
13606 Qpostscript
= intern ("postscript");
13607 staticpro (&Qpostscript
);
13608 QCloader
= intern (":loader");
13609 staticpro (&QCloader
);
13610 QCbounding_box
= intern (":bounding-box");
13611 staticpro (&QCbounding_box
);
13612 QCpt_width
= intern (":pt-width");
13613 staticpro (&QCpt_width
);
13614 QCpt_height
= intern (":pt-height");
13615 staticpro (&QCpt_height
);
13616 QCindex
= intern (":index");
13617 staticpro (&QCindex
);
13618 Qpbm
= intern ("pbm");
13622 Qxpm
= intern ("xpm");
13627 Qjpeg
= intern ("jpeg");
13628 staticpro (&Qjpeg
);
13632 Qtiff
= intern ("tiff");
13633 staticpro (&Qtiff
);
13637 Qgif
= intern ("gif");
13642 Qpng
= intern ("png");
13646 defsubr (&Sclear_image_cache
);
13649 defsubr (&Simagep
);
13650 defsubr (&Slookup_image
);
13654 busy_cursor_atimer
= NULL
;
13655 busy_cursor_shown_p
= 0;
13656 #ifdef TODO /* Tooltip support not complete. */
13657 defsubr (&Sx_show_tip
);
13658 defsubr (&Sx_hide_tip
);
13660 staticpro (&tip_timer
);
13663 defsubr (&Sx_file_dialog
);
13670 image_types
= NULL
;
13671 Vimage_types
= Qnil
;
13673 #if 0 /* TODO : Image support for W32 */
13674 define_image_type (&xbm_type
);
13675 define_image_type (&gs_type
);
13676 define_image_type (&pbm_type
);
13679 define_image_type (&xpm_type
);
13683 define_image_type (&jpeg_type
);
13687 define_image_type (&tiff_type
);
13691 define_image_type (&gif_type
);
13695 define_image_type (&png_type
);
13706 button
= MessageBox (NULL
,
13707 "A fatal error has occurred!\n\n"
13708 "Select Abort to exit, Retry to debug, Ignore to continue",
13709 "Emacs Abort Dialog",
13710 MB_ICONEXCLAMATION
| MB_TASKMODAL
13711 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
13726 /* For convenience when debugging. */
13730 return GetLastError ();