1 /* Graphical user interface functions for Mac OS.
2 Copyright (C) 2000 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Contributed by Andrew Choi (akochoi@users.sourceforge.net). */
37 #include "dispextern.h"
39 #include "intervals.h"
41 #include "blockinput.h"
43 #include "termhooks.h"
48 /* #include "bitmaps/gray.xbm" */
51 static unsigned char gray_bits
[] = {
54 /*#include <commdlg.h>
55 #include <shellapi.h>*/
67 #include <TextUtils.h>
70 #define min(a,b) ((a) < (b) ? (a) : (b))
73 #define max(a,b) ((a) > (b) ? (a) : (b))
76 /*extern void free_frame_menubar ();
77 extern double atof ();
78 extern int w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state);
79 extern int quit_char;*/
81 /* A definition of XColor for non-X frames. */
82 #ifndef HAVE_X_WINDOWS
85 unsigned short red
, green
, blue
;
91 extern char *lispy_function_keys
[];
93 /* The gray bitmap `bitmaps/gray'. This is done because macterm.c uses
94 it, and including `bitmaps/gray' more than once is a problem when
95 config.h defines `static' as an empty replacement string. */
97 int gray_bitmap_width
= gray_width
;
98 int gray_bitmap_height
= gray_height
;
99 unsigned char *gray_bitmap_bits
= gray_bits
;
101 /* The name we're using in resource queries. */
103 Lisp_Object Vx_resource_name
;
105 /* Non-zero means we're allowed to display an hourglass cursor. */
107 int display_hourglass_p
;
109 /* The background and shape of the mouse pointer, and shape when not
110 over text or in the modeline. */
112 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
113 Lisp_Object Vx_hourglass_pointer_shape
;
115 /* The shape when over mouse-sensitive text. */
117 Lisp_Object Vx_sensitive_text_pointer_shape
;
119 /* If non-nil, the pointer shape to indicate that windows can be
120 dragged horizontally. */
122 Lisp_Object Vx_window_horizontal_drag_shape
;
124 /* Color of chars displayed in cursor box. */
126 Lisp_Object Vx_cursor_fore_pixel
;
128 /* Nonzero if using Windows. */
130 static int mac_in_use
;
132 /* Non nil if no window manager is in use. */
134 Lisp_Object Vx_no_window_manager
;
136 /* Search path for bitmap files. */
138 Lisp_Object Vx_bitmap_file_path
;
140 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
142 Lisp_Object Vx_pixel_size_width_font_regexp
;
144 /* Evaluate this expression to rebuild the section of syms_of_macfns
145 that initializes and staticpros the symbols declared below. Note
146 that Emacs 18 has a bug that keeps C-x C-e from being able to
147 evaluate this expression.
150 ;; Accumulate a list of the symbols we want to initialize from the
151 ;; declarations at the top of the file.
152 (goto-char (point-min))
153 (search-forward "/\*&&& symbols declared here &&&*\/\n")
155 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
157 (cons (buffer-substring (match-beginning 1) (match-end 1))
160 (setq symbol-list (nreverse symbol-list))
161 ;; Delete the section of syms_of_... where we initialize the symbols.
162 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
163 (let ((start (point)))
164 (while (looking-at "^ Q")
166 (kill-region start (point)))
167 ;; Write a new symbol initialization section.
169 (insert (format " %s = intern (\"" (car symbol-list)))
170 (let ((start (point)))
171 (insert (substring (car symbol-list) 1))
172 (subst-char-in-region start (point) ?_ ?-))
173 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
174 (setq symbol-list (cdr symbol-list)))))
178 /*&&& symbols declared here &&&*/
179 Lisp_Object Qauto_raise
;
180 Lisp_Object Qauto_lower
;
182 Lisp_Object Qborder_color
;
183 Lisp_Object Qborder_width
;
185 Lisp_Object Qcursor_color
;
186 Lisp_Object Qcursor_type
;
187 Lisp_Object Qgeometry
;
188 Lisp_Object Qicon_left
;
189 Lisp_Object Qicon_top
;
190 Lisp_Object Qicon_type
;
191 Lisp_Object Qicon_name
;
192 Lisp_Object Qinternal_border_width
;
195 Lisp_Object Qmouse_color
;
197 Lisp_Object Qparent_id
;
198 Lisp_Object Qscroll_bar_width
;
199 Lisp_Object Qsuppress_icon
;
200 Lisp_Object Qundefined_color
;
201 Lisp_Object Qvertical_scroll_bars
;
202 Lisp_Object Qvisibility
;
203 Lisp_Object Qwindow_id
;
204 Lisp_Object Qx_frame_parameter
;
205 Lisp_Object Qx_resource_name
;
206 Lisp_Object Quser_position
;
207 Lisp_Object Quser_size
;
208 Lisp_Object Qscreen_gamma
;
209 Lisp_Object Qline_spacing
;
211 Lisp_Object Qcancel_timer
;
217 Lisp_Object Qcontrol
;
220 extern Lisp_Object Qtop
;
221 extern Lisp_Object Qdisplay
;
222 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
223 extern Lisp_Object Qtool_bar_lines
;
225 /* These are defined in frame.c. */
226 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
227 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
228 extern Lisp_Object Qtool_bar_lines
;
230 extern Lisp_Object Vwindow_system_version
;
232 Lisp_Object Qface_set_after_frame_default
;
234 /* Functions in macterm.c. */
235 extern void x_set_offset (struct frame
*, int, int, int);
236 extern void x_wm_set_icon_position (struct frame
*, int, int);
237 extern void x_display_cursor (struct window
*, int, int, int, int, int);
238 extern void x_set_window_size (struct frame
*, int, int, int);
239 extern void x_make_frame_visible (struct frame
*);
240 extern struct mac_display_info
*x_term_init (Lisp_Object
, char *, char *);
241 extern struct font_info
*x_get_font_info (FRAME_PTR
, int);
242 extern struct font_info
*x_load_font (struct frame
*, char *, int);
243 extern void x_find_ccl_program (struct font_info
*);
244 extern struct font_info
*x_query_font (struct frame
*, char *);
247 /* compare two strings ignoring case */
250 stricmp (const char *s
, const char *t
)
252 for ( ; tolower (*s
) == tolower (*t
); s
++, t
++)
255 return tolower (*s
) - tolower (*t
);
258 /* compare two strings up to n characters, ignoring case */
261 strnicmp (const char *s
, const char *t
, unsigned int n
)
263 for ( ; n
-- > 0 && tolower (*s
) == tolower (*t
); s
++, t
++)
266 return n
== 0 ? 0 : tolower (*s
) - tolower (*t
);
270 /* Error if we are not running on Mac OS. */
276 error ("Mac OS not in use or not initialized");
279 /* Nonzero if we can use mouse menus.
280 You should not call this unless HAVE_MENUS is defined. */
288 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
289 and checking validity for Mac. */
292 check_x_frame (frame
)
298 frame
= selected_frame
;
299 CHECK_LIVE_FRAME (frame
, 0);
301 if (! FRAME_MAC_P (f
))
302 error ("non-mac frame used");
306 /* Let the user specify an display with a frame.
307 nil stands for the selected frame--or, if that is not a mac frame,
308 the first display on the list. */
310 static struct mac_display_info
*
311 check_x_display_info (frame
)
316 struct frame
*sf
= XFRAME (selected_frame
);
318 if (FRAME_MAC_P (sf
) && FRAME_LIVE_P (sf
))
319 return FRAME_MAC_DISPLAY_INFO (sf
);
321 return &one_mac_display_info
;
323 else if (STRINGP (frame
))
324 return x_display_info_for_name (frame
);
329 CHECK_LIVE_FRAME (frame
, 0);
331 if (! FRAME_MAC_P (f
))
332 error ("non-mac frame used");
333 return FRAME_MAC_DISPLAY_INFO (f
);
337 /* Return the Emacs frame-object corresponding to an mac window.
338 It could be the frame's main window or an icon window. */
340 /* This function can be called during GC, so use GC_xxx type test macros. */
343 x_window_to_frame (dpyinfo
, wdesc
)
344 struct mac_display_info
*dpyinfo
;
347 Lisp_Object tail
, frame
;
350 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
353 if (!GC_FRAMEP (frame
))
356 if (!FRAME_W32_P (f
) || FRAME_MAC_DISPLAY_INFO (f
) != dpyinfo
)
358 /*if (f->output_data.w32->busy_window == wdesc)
361 /* MAC_TODO: Check tooltips when supported. */
362 if (FRAME_MAC_WINDOW (f
) == wdesc
)
370 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
371 id, which is just an int that this section returns. Bitmaps are
372 reference counted so they can be shared among frames.
374 Bitmap indices are guaranteed to be > 0, so a negative number can
375 be used to indicate no bitmap.
377 If you use x_create_bitmap_from_data, then you must keep track of
378 the bitmaps yourself. That is, creating a bitmap from the same
379 data more than once will not be caught. */
382 /* Functions to access the contents of a bitmap, given an id. */
385 x_bitmap_height (f
, id
)
389 return FRAME_MAC_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
393 x_bitmap_width (f
, id
)
397 return FRAME_MAC_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
400 #if 0 /* MAC_TODO : not used anywhere (?) */
402 x_bitmap_pixmap (f
, id
)
406 return (int) FRAME_MAC_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
410 /* Allocate a new bitmap record. Returns index of new record. */
413 x_allocate_bitmap_record (f
)
416 struct mac_display_info
*dpyinfo
= FRAME_MAC_DISPLAY_INFO (f
);
419 if (dpyinfo
->bitmaps
== NULL
)
421 dpyinfo
->bitmaps_size
= 10;
422 dpyinfo
->bitmaps
= (struct mac_bitmap_record
*)
423 xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct mac_bitmap_record
));
424 dpyinfo
->bitmaps_last
= 1;
428 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
429 return ++dpyinfo
->bitmaps_last
;
431 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
432 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
435 dpyinfo
->bitmaps_size
*= 2;
436 dpyinfo
->bitmaps
= (struct mac_bitmap_record
*)
437 xrealloc (dpyinfo
->bitmaps
,
438 dpyinfo
->bitmaps_size
* sizeof (struct mac_bitmap_record
));
439 return ++dpyinfo
->bitmaps_last
;
442 /* Add one reference to the reference count of the bitmap with id
446 x_reference_bitmap (f
, id
)
450 ++FRAME_MAC_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
453 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at
457 x_create_bitmap_from_data (f
, bits
, width
, height
)
460 unsigned int width
, height
;
462 struct x_display_info
*dpyinfo
= FRAME_MAC_DISPLAY_INFO (f
);
465 /* MAC_TODO: for now fail if width is not mod 16 (toolbox requires it) */
467 id
= x_allocate_bitmap_record (f
);
472 dpyinfo
->bitmaps
[id
- 1].bitmap_data
= (char *) xmalloc (height
* width
);
473 if (! dpyinfo
->bitmaps
[id
- 1].bitmap_data
)
476 bcopy (bits
, dpyinfo
->bitmaps
[id
- 1].bitmap_data
, height
* width
);
478 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
479 dpyinfo
->bitmaps
[id
- 1].height
= height
;
480 dpyinfo
->bitmaps
[id
- 1].width
= width
;
485 /* Create bitmap from file FILE for frame F. */
488 x_create_bitmap_from_file (f
, file
)
493 #if 0 /* MAC_TODO : bitmap support */
494 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
495 unsigned int width
, height
;
497 int xhot
, yhot
, result
, id
;
503 /* Look for an existing bitmap with the same name. */
504 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
506 if (dpyinfo
->bitmaps
[id
].refcount
507 && dpyinfo
->bitmaps
[id
].file
508 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
510 ++dpyinfo
->bitmaps
[id
].refcount
;
515 /* Search bitmap-file-path for the file, if appropriate. */
516 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
519 /* LoadLibraryEx won't handle special files handled by Emacs handler. */
524 filename
= (char *) XSTRING (found
)->data
;
526 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
532 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
533 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
534 if (result
!= BitmapSuccess
)
537 id
= x_allocate_bitmap_record (f
);
538 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
539 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
540 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
541 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
542 dpyinfo
->bitmaps
[id
- 1].height
= height
;
543 dpyinfo
->bitmaps
[id
- 1].width
= width
;
544 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
547 #endif /* MAC_TODO */
550 /* Remove reference to bitmap with id number ID. */
553 x_destroy_bitmap (f
, id
)
557 struct mac_display_info
*dpyinfo
= FRAME_MAC_DISPLAY_INFO (f
);
561 --dpyinfo
->bitmaps
[id
- 1].refcount
;
562 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
565 dpyinfo
->bitmaps
[id
- 1].bitmap_data
= NULL
;
571 /* Free all the bitmaps for the display specified by DPYINFO. */
574 x_destroy_all_bitmaps (dpyinfo
)
575 struct mac_display_info
*dpyinfo
;
578 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
579 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
580 xfree (dpyinfo
->bitmaps
[i
].bitmap_data
);
581 dpyinfo
->bitmaps_last
= 0;
584 /* Connect the frame-parameter names for W32 frames
585 to the ways of passing the parameter values to the window system.
587 The name of a parameter, as a Lisp symbol,
588 has an `x-frame-parameter' property which is an integer in Lisp
589 but can be interpreted as an `enum x_frame_parm' in C. */
591 struct x_frame_parm_table
594 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
597 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
598 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
599 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
600 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
601 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
602 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
603 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
604 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
605 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
606 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
607 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
608 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
610 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
611 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
612 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
613 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
615 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
616 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
617 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
618 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
619 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
620 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
621 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
623 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
625 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
630 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
632 static struct x_frame_parm_table x_frame_parms
[] =
634 "auto-raise", x_set_autoraise
,
635 "auto-lower", x_set_autolower
,
636 "background-color", x_set_background_color
,
637 "border-color", x_set_border_color
,
638 "border-width", x_set_border_width
,
639 "cursor-color", x_set_cursor_color
,
640 "cursor-type", x_set_cursor_type
,
642 "foreground-color", x_set_foreground_color
,
643 "icon-name", x_set_icon_name
,
644 #if 0 /* MAC_TODO: no icons for Mac */
645 "icon-type", x_set_icon_type
,
647 "internal-border-width", x_set_internal_border_width
,
648 "menu-bar-lines", x_set_menu_bar_lines
,
649 "mouse-color", x_set_mouse_color
,
650 "name", x_explicitly_set_name
,
651 "scroll-bar-width", x_set_scroll_bar_width
,
652 "title", x_set_title
,
653 "unsplittable", x_set_unsplittable
,
654 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
655 "visibility", x_set_visibility
,
656 "tool-bar-lines", x_set_tool_bar_lines
,
657 #if 0 /* MAC_TODO: cannot set color of scroll bar on the Mac? */
658 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
659 "scroll-bar-background", x_set_scroll_bar_background
,
661 "screen-gamma", x_set_screen_gamma
,
662 "line-spacing", x_set_line_spacing
665 /* Attach the `x-frame-parameter' properties to
666 the Lisp symbol names of parameters relevant to Mac. */
669 init_x_parm_symbols ()
673 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
674 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
678 /* Change the parameters of frame F as specified by ALIST.
679 If a parameter is not specially recognized, do nothing;
680 otherwise call the `x_set_...' function for that parameter. */
683 x_set_frame_parameters (f
, alist
)
689 /* If both of these parameters are present, it's more efficient to
690 set them both at once. So we wait until we've looked at the
691 entire list before we set them. */
695 Lisp_Object left
, top
;
697 /* Same with these. */
698 Lisp_Object icon_left
, icon_top
;
700 /* Record in these vectors all the parms specified. */
704 int left_no_change
= 0, top_no_change
= 0;
705 int icon_left_no_change
= 0, icon_top_no_change
= 0;
707 struct gcpro gcpro1
, gcpro2
;
710 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
713 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
714 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
716 /* Extract parm names and values into those vectors. */
719 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
724 parms
[i
] = Fcar (elt
);
725 values
[i
] = Fcdr (elt
);
728 /* TAIL and ALIST are not used again below here. */
731 GCPRO2 (*parms
, *values
);
735 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
736 because their values appear in VALUES and strings are not valid. */
737 top
= left
= Qunbound
;
738 icon_left
= icon_top
= Qunbound
;
740 /* Provide default values for HEIGHT and WIDTH. */
741 if (FRAME_NEW_WIDTH (f
))
742 width
= FRAME_NEW_WIDTH (f
);
744 width
= FRAME_WIDTH (f
);
746 if (FRAME_NEW_HEIGHT (f
))
747 height
= FRAME_NEW_HEIGHT (f
);
749 height
= FRAME_HEIGHT (f
);
751 /* Process foreground_color and background_color before anything else.
752 They are independent of other properties, but other properties (e.g.,
753 cursor_color) are dependent upon them. */
754 for (p
= 0; p
< i
; p
++)
756 Lisp_Object prop
, val
;
760 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
762 register Lisp_Object param_index
, old_value
;
764 param_index
= Fget (prop
, Qx_frame_parameter
);
765 old_value
= get_frame_param (f
, prop
);
766 store_frame_param (f
, prop
, val
);
767 if (NATNUMP (param_index
)
768 && (XFASTINT (param_index
)
769 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
770 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
774 /* Now process them in reverse of specified order. */
775 for (i
--; i
>= 0; i
--)
777 Lisp_Object prop
, val
;
782 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
783 width
= XFASTINT (val
);
784 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
785 height
= XFASTINT (val
);
786 else if (EQ (prop
, Qtop
))
788 else if (EQ (prop
, Qleft
))
790 else if (EQ (prop
, Qicon_top
))
792 else if (EQ (prop
, Qicon_left
))
794 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
795 /* Processed above. */
799 register Lisp_Object param_index
, old_value
;
801 param_index
= Fget (prop
, Qx_frame_parameter
);
802 old_value
= get_frame_param (f
, prop
);
803 store_frame_param (f
, prop
, val
);
804 if (NATNUMP (param_index
)
805 && (XFASTINT (param_index
)
806 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
807 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
811 /* Don't die if just one of these was set. */
812 if (EQ (left
, Qunbound
))
815 if (f
->output_data
.mac
->left_pos
< 0)
817 Fcons (make_number (f
->output_data
.mac
->left_pos
),
820 XSETINT (left
, f
->output_data
.mac
->left_pos
);
822 if (EQ (top
, Qunbound
))
825 if (f
->output_data
.mac
->top_pos
< 0)
827 Fcons (make_number (f
->output_data
.mac
->top_pos
), Qnil
));
829 XSETINT (top
, f
->output_data
.mac
->top_pos
);
832 /* If one of the icon positions was not set, preserve or default it. */
833 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
835 icon_left_no_change
= 1;
836 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
837 if (NILP (icon_left
))
838 XSETINT (icon_left
, 0);
840 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
842 icon_top_no_change
= 1;
843 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
845 XSETINT (icon_top
, 0);
848 /* Don't set these parameters unless they've been explicitly
849 specified. The window might be mapped or resized while we're in
850 this function, and we don't want to override that unless the lisp
851 code has asked for it.
853 Don't set these parameters unless they actually differ from the
854 window's current parameters; the window may not actually exist
859 check_frame_size (f
, &height
, &width
);
861 XSETFRAME (frame
, f
);
863 if (width
!= FRAME_WIDTH (f
)
864 || height
!= FRAME_HEIGHT (f
)
865 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
866 Fset_frame_size (frame
, make_number (width
), make_number (height
));
868 if ((!NILP (left
) || !NILP (top
))
869 && ! (left_no_change
&& top_no_change
)
870 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.mac
->left_pos
871 && NUMBERP (top
) && XINT (top
) == f
->output_data
.mac
->top_pos
))
876 /* Record the signs. */
877 f
->output_data
.mac
->size_hint_flags
&= ~ (XNegative
| YNegative
);
878 if (EQ (left
, Qminus
))
879 f
->output_data
.mac
->size_hint_flags
|= XNegative
;
880 else if (INTEGERP (left
))
882 leftpos
= XINT (left
);
884 f
->output_data
.mac
->size_hint_flags
|= XNegative
;
886 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
887 && CONSP (XCDR (left
))
888 && INTEGERP (XCAR (XCDR (left
))))
890 leftpos
= - XINT (XCAR (XCDR (left
)));
891 f
->output_data
.mac
->size_hint_flags
|= XNegative
;
893 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
894 && CONSP (XCDR (left
))
895 && INTEGERP (XCAR (XCDR (left
))))
897 leftpos
= XINT (XCAR (XCDR (left
)));
900 if (EQ (top
, Qminus
))
901 f
->output_data
.mac
->size_hint_flags
|= YNegative
;
902 else if (INTEGERP (top
))
906 f
->output_data
.mac
->size_hint_flags
|= YNegative
;
908 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
909 && CONSP (XCDR (top
))
910 && INTEGERP (XCAR (XCDR (top
))))
912 toppos
= - XINT (XCAR (XCDR (top
)));
913 f
->output_data
.mac
->size_hint_flags
|= YNegative
;
915 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
916 && CONSP (XCDR (top
))
917 && INTEGERP (XCAR (XCDR (top
))))
919 toppos
= XINT (XCAR (XCDR (top
)));
923 /* Store the numeric value of the position. */
924 f
->output_data
.mac
->top_pos
= toppos
;
925 f
->output_data
.mac
->left_pos
= leftpos
;
927 f
->output_data
.mac
->win_gravity
= NorthWestGravity
;
929 /* Actually set that position, and convert to absolute. */
930 x_set_offset (f
, leftpos
, toppos
, -1);
933 if ((!NILP (icon_left
) || !NILP (icon_top
))
934 && ! (icon_left_no_change
&& icon_top_no_change
))
935 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
941 /* Store the screen positions of frame F into XPTR and YPTR.
942 These are the positions of the containing window manager window,
943 not Emacs's own window. */
946 x_real_positions (f
, xptr
, yptr
)
954 f
->output_data
.mac
->mWP
->portRect
.left
,
955 f
->output_data
.mac
->mWP
->portRect
.top
);
964 /* Insert a description of internally-recorded parameters of frame X
965 into the parameter alist *ALISTPTR that is to be given to the user.
966 Only parameters that are specific to Mac and whose values are not
967 correctly recorded in the frame's param_alist need to be considered
971 x_report_frame_params (f
, alistptr
)
973 Lisp_Object
*alistptr
;
978 /* Represent negative positions (off the top or left screen edge)
979 in a way that Fmodify_frame_parameters will understand correctly. */
980 XSETINT (tem
, f
->output_data
.mac
->left_pos
);
981 if (f
->output_data
.mac
->left_pos
>= 0)
982 store_in_alist (alistptr
, Qleft
, tem
);
984 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
986 XSETINT (tem
, f
->output_data
.mac
->top_pos
);
987 if (f
->output_data
.mac
->top_pos
>= 0)
988 store_in_alist (alistptr
, Qtop
, tem
);
990 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
992 store_in_alist (alistptr
, Qborder_width
,
993 make_number (f
->output_data
.mac
->border_width
));
994 store_in_alist (alistptr
, Qinternal_border_width
,
995 make_number (f
->output_data
.mac
->internal_border_width
));
996 sprintf (buf
, "%ld", (long) FRAME_MAC_WINDOW (f
));
997 store_in_alist (alistptr
, Qwindow_id
,
999 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1000 FRAME_SAMPLE_VISIBILITY (f
);
1001 store_in_alist (alistptr
, Qvisibility
,
1002 (FRAME_VISIBLE_P (f
) ? Qt
1003 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1004 store_in_alist (alistptr
, Qdisplay
,
1005 XCAR (FRAME_MAC_DISPLAY_INFO (f
)->name_list_element
));
1008 /* The default colors for the Mac color map */
1009 typedef struct colormap_t
1011 unsigned long color
;
1015 colormap_t mac_color_map
[] =
1017 { RGB_TO_ULONG(255, 250, 250), "snow" },
1018 { RGB_TO_ULONG(248, 248, 255), "ghost white" },
1019 { RGB_TO_ULONG(248, 248, 255), "GhostWhite" },
1020 { RGB_TO_ULONG(245, 245, 245), "white smoke" },
1021 { RGB_TO_ULONG(245, 245, 245), "WhiteSmoke" },
1022 { RGB_TO_ULONG(220, 220, 220), "gainsboro" },
1023 { RGB_TO_ULONG(255, 250, 240), "floral white" },
1024 { RGB_TO_ULONG(255, 250, 240), "FloralWhite" },
1025 { RGB_TO_ULONG(253, 245, 230), "old lace" },
1026 { RGB_TO_ULONG(253, 245, 230), "OldLace" },
1027 { RGB_TO_ULONG(250, 240, 230), "linen" },
1028 { RGB_TO_ULONG(250, 235, 215), "antique white" },
1029 { RGB_TO_ULONG(250, 235, 215), "AntiqueWhite" },
1030 { RGB_TO_ULONG(255, 239, 213), "papaya whip" },
1031 { RGB_TO_ULONG(255, 239, 213), "PapayaWhip" },
1032 { RGB_TO_ULONG(255, 235, 205), "blanched almond" },
1033 { RGB_TO_ULONG(255, 235, 205), "BlanchedAlmond" },
1034 { RGB_TO_ULONG(255, 228, 196), "bisque" },
1035 { RGB_TO_ULONG(255, 218, 185), "peach puff" },
1036 { RGB_TO_ULONG(255, 218, 185), "PeachPuff" },
1037 { RGB_TO_ULONG(255, 222, 173), "navajo white" },
1038 { RGB_TO_ULONG(255, 222, 173), "NavajoWhite" },
1039 { RGB_TO_ULONG(255, 228, 181), "moccasin" },
1040 { RGB_TO_ULONG(255, 248, 220), "cornsilk" },
1041 { RGB_TO_ULONG(255, 255, 240), "ivory" },
1042 { RGB_TO_ULONG(255, 250, 205), "lemon chiffon" },
1043 { RGB_TO_ULONG(255, 250, 205), "LemonChiffon" },
1044 { RGB_TO_ULONG(255, 245, 238), "seashell" },
1045 { RGB_TO_ULONG(240, 255, 240), "honeydew" },
1046 { RGB_TO_ULONG(245, 255, 250), "mint cream" },
1047 { RGB_TO_ULONG(245, 255, 250), "MintCream" },
1048 { RGB_TO_ULONG(240, 255, 255), "azure" },
1049 { RGB_TO_ULONG(240, 248, 255), "alice blue" },
1050 { RGB_TO_ULONG(240, 248, 255), "AliceBlue" },
1051 { RGB_TO_ULONG(230, 230, 250), "lavender" },
1052 { RGB_TO_ULONG(255, 240, 245), "lavender blush" },
1053 { RGB_TO_ULONG(255, 240, 245), "LavenderBlush" },
1054 { RGB_TO_ULONG(255, 228, 225), "misty rose" },
1055 { RGB_TO_ULONG(255, 228, 225), "MistyRose" },
1056 { RGB_TO_ULONG(255, 255, 255), "white" },
1057 { RGB_TO_ULONG(0 , 0 , 0 ), "black" },
1058 { RGB_TO_ULONG(47 , 79 , 79 ), "dark slate gray" },
1059 { RGB_TO_ULONG(47 , 79 , 79 ), "DarkSlateGray" },
1060 { RGB_TO_ULONG(47 , 79 , 79 ), "dark slate grey" },
1061 { RGB_TO_ULONG(47 , 79 , 79 ), "DarkSlateGrey" },
1062 { RGB_TO_ULONG(105, 105, 105), "dim gray" },
1063 { RGB_TO_ULONG(105, 105, 105), "DimGray" },
1064 { RGB_TO_ULONG(105, 105, 105), "dim grey" },
1065 { RGB_TO_ULONG(105, 105, 105), "DimGrey" },
1066 { RGB_TO_ULONG(112, 128, 144), "slate gray" },
1067 { RGB_TO_ULONG(112, 128, 144), "SlateGray" },
1068 { RGB_TO_ULONG(112, 128, 144), "slate grey" },
1069 { RGB_TO_ULONG(112, 128, 144), "SlateGrey" },
1070 { RGB_TO_ULONG(119, 136, 153), "light slate gray" },
1071 { RGB_TO_ULONG(119, 136, 153), "LightSlateGray" },
1072 { RGB_TO_ULONG(119, 136, 153), "light slate grey" },
1073 { RGB_TO_ULONG(119, 136, 153), "LightSlateGrey" },
1074 { RGB_TO_ULONG(190, 190, 190), "gray" },
1075 { RGB_TO_ULONG(190, 190, 190), "grey" },
1076 { RGB_TO_ULONG(211, 211, 211), "light grey" },
1077 { RGB_TO_ULONG(211, 211, 211), "LightGrey" },
1078 { RGB_TO_ULONG(211, 211, 211), "light gray" },
1079 { RGB_TO_ULONG(211, 211, 211), "LightGray" },
1080 { RGB_TO_ULONG(25 , 25 , 112), "midnight blue" },
1081 { RGB_TO_ULONG(25 , 25 , 112), "MidnightBlue" },
1082 { RGB_TO_ULONG(0 , 0 , 128), "navy" },
1083 { RGB_TO_ULONG(0 , 0 , 128), "navy blue" },
1084 { RGB_TO_ULONG(0 , 0 , 128), "NavyBlue" },
1085 { RGB_TO_ULONG(100, 149, 237), "cornflower blue" },
1086 { RGB_TO_ULONG(100, 149, 237), "CornflowerBlue" },
1087 { RGB_TO_ULONG(72 , 61 , 139), "dark slate blue" },
1088 { RGB_TO_ULONG(72 , 61 , 139), "DarkSlateBlue" },
1089 { RGB_TO_ULONG(106, 90 , 205), "slate blue" },
1090 { RGB_TO_ULONG(106, 90 , 205), "SlateBlue" },
1091 { RGB_TO_ULONG(123, 104, 238), "medium slate blue" },
1092 { RGB_TO_ULONG(123, 104, 238), "MediumSlateBlue" },
1093 { RGB_TO_ULONG(132, 112, 255), "light slate blue" },
1094 { RGB_TO_ULONG(132, 112, 255), "LightSlateBlue" },
1095 { RGB_TO_ULONG(0 , 0 , 205), "medium blue" },
1096 { RGB_TO_ULONG(0 , 0 , 205), "MediumBlue" },
1097 { RGB_TO_ULONG(65 , 105, 225), "royal blue" },
1098 { RGB_TO_ULONG(65 , 105, 225), "RoyalBlue" },
1099 { RGB_TO_ULONG(0 , 0 , 255), "blue" },
1100 { RGB_TO_ULONG(30 , 144, 255), "dodger blue" },
1101 { RGB_TO_ULONG(30 , 144, 255), "DodgerBlue" },
1102 { RGB_TO_ULONG(0 , 191, 255), "deep sky blue" },
1103 { RGB_TO_ULONG(0 , 191, 255), "DeepSkyBlue" },
1104 { RGB_TO_ULONG(135, 206, 235), "sky blue" },
1105 { RGB_TO_ULONG(135, 206, 235), "SkyBlue" },
1106 { RGB_TO_ULONG(135, 206, 250), "light sky blue" },
1107 { RGB_TO_ULONG(135, 206, 250), "LightSkyBlue" },
1108 { RGB_TO_ULONG(70 , 130, 180), "steel blue" },
1109 { RGB_TO_ULONG(70 , 130, 180), "SteelBlue" },
1110 { RGB_TO_ULONG(176, 196, 222), "light steel blue" },
1111 { RGB_TO_ULONG(176, 196, 222), "LightSteelBlue" },
1112 { RGB_TO_ULONG(173, 216, 230), "light blue" },
1113 { RGB_TO_ULONG(173, 216, 230), "LightBlue" },
1114 { RGB_TO_ULONG(176, 224, 230), "powder blue" },
1115 { RGB_TO_ULONG(176, 224, 230), "PowderBlue" },
1116 { RGB_TO_ULONG(175, 238, 238), "pale turquoise" },
1117 { RGB_TO_ULONG(175, 238, 238), "PaleTurquoise" },
1118 { RGB_TO_ULONG(0 , 206, 209), "dark turquoise" },
1119 { RGB_TO_ULONG(0 , 206, 209), "DarkTurquoise" },
1120 { RGB_TO_ULONG(72 , 209, 204), "medium turquoise" },
1121 { RGB_TO_ULONG(72 , 209, 204), "MediumTurquoise" },
1122 { RGB_TO_ULONG(64 , 224, 208), "turquoise" },
1123 { RGB_TO_ULONG(0 , 255, 255), "cyan" },
1124 { RGB_TO_ULONG(224, 255, 255), "light cyan" },
1125 { RGB_TO_ULONG(224, 255, 255), "LightCyan" },
1126 { RGB_TO_ULONG(95 , 158, 160), "cadet blue" },
1127 { RGB_TO_ULONG(95 , 158, 160), "CadetBlue" },
1128 { RGB_TO_ULONG(102, 205, 170), "medium aquamarine" },
1129 { RGB_TO_ULONG(102, 205, 170), "MediumAquamarine" },
1130 { RGB_TO_ULONG(127, 255, 212), "aquamarine" },
1131 { RGB_TO_ULONG(0 , 100, 0 ), "dark green" },
1132 { RGB_TO_ULONG(0 , 100, 0 ), "DarkGreen" },
1133 { RGB_TO_ULONG(85 , 107, 47 ), "dark olive green" },
1134 { RGB_TO_ULONG(85 , 107, 47 ), "DarkOliveGreen" },
1135 { RGB_TO_ULONG(143, 188, 143), "dark sea green" },
1136 { RGB_TO_ULONG(143, 188, 143), "DarkSeaGreen" },
1137 { RGB_TO_ULONG(46 , 139, 87 ), "sea green" },
1138 { RGB_TO_ULONG(46 , 139, 87 ), "SeaGreen" },
1139 { RGB_TO_ULONG(60 , 179, 113), "medium sea green" },
1140 { RGB_TO_ULONG(60 , 179, 113), "MediumSeaGreen" },
1141 { RGB_TO_ULONG(32 , 178, 170), "light sea green" },
1142 { RGB_TO_ULONG(32 , 178, 170), "LightSeaGreen" },
1143 { RGB_TO_ULONG(152, 251, 152), "pale green" },
1144 { RGB_TO_ULONG(152, 251, 152), "PaleGreen" },
1145 { RGB_TO_ULONG(0 , 255, 127), "spring green" },
1146 { RGB_TO_ULONG(0 , 255, 127), "SpringGreen" },
1147 { RGB_TO_ULONG(124, 252, 0 ), "lawn green" },
1148 { RGB_TO_ULONG(124, 252, 0 ), "LawnGreen" },
1149 { RGB_TO_ULONG(0 , 255, 0 ), "green" },
1150 { RGB_TO_ULONG(127, 255, 0 ), "chartreuse" },
1151 { RGB_TO_ULONG(0 , 250, 154), "medium spring green" },
1152 { RGB_TO_ULONG(0 , 250, 154), "MediumSpringGreen" },
1153 { RGB_TO_ULONG(173, 255, 47 ), "green yellow" },
1154 { RGB_TO_ULONG(173, 255, 47 ), "GreenYellow" },
1155 { RGB_TO_ULONG(50 , 205, 50 ), "lime green" },
1156 { RGB_TO_ULONG(50 , 205, 50 ), "LimeGreen" },
1157 { RGB_TO_ULONG(154, 205, 50 ), "yellow green" },
1158 { RGB_TO_ULONG(154, 205, 50 ), "YellowGreen" },
1159 { RGB_TO_ULONG(34 , 139, 34 ), "forest green" },
1160 { RGB_TO_ULONG(34 , 139, 34 ), "ForestGreen" },
1161 { RGB_TO_ULONG(107, 142, 35 ), "olive drab" },
1162 { RGB_TO_ULONG(107, 142, 35 ), "OliveDrab" },
1163 { RGB_TO_ULONG(189, 183, 107), "dark khaki" },
1164 { RGB_TO_ULONG(189, 183, 107), "DarkKhaki" },
1165 { RGB_TO_ULONG(240, 230, 140), "khaki" },
1166 { RGB_TO_ULONG(238, 232, 170), "pale goldenrod" },
1167 { RGB_TO_ULONG(238, 232, 170), "PaleGoldenrod" },
1168 { RGB_TO_ULONG(250, 250, 210), "light goldenrod yellow" },
1169 { RGB_TO_ULONG(250, 250, 210), "LightGoldenrodYellow" },
1170 { RGB_TO_ULONG(255, 255, 224), "light yellow" },
1171 { RGB_TO_ULONG(255, 255, 224), "LightYellow" },
1172 { RGB_TO_ULONG(255, 255, 0 ), "yellow" },
1173 { RGB_TO_ULONG(255, 215, 0 ), "gold" },
1174 { RGB_TO_ULONG(238, 221, 130), "light goldenrod" },
1175 { RGB_TO_ULONG(238, 221, 130), "LightGoldenrod" },
1176 { RGB_TO_ULONG(218, 165, 32 ), "goldenrod" },
1177 { RGB_TO_ULONG(184, 134, 11 ), "dark goldenrod" },
1178 { RGB_TO_ULONG(184, 134, 11 ), "DarkGoldenrod" },
1179 { RGB_TO_ULONG(188, 143, 143), "rosy brown" },
1180 { RGB_TO_ULONG(188, 143, 143), "RosyBrown" },
1181 { RGB_TO_ULONG(205, 92 , 92 ), "indian red" },
1182 { RGB_TO_ULONG(205, 92 , 92 ), "IndianRed" },
1183 { RGB_TO_ULONG(139, 69 , 19 ), "saddle brown" },
1184 { RGB_TO_ULONG(139, 69 , 19 ), "SaddleBrown" },
1185 { RGB_TO_ULONG(160, 82 , 45 ), "sienna" },
1186 { RGB_TO_ULONG(205, 133, 63 ), "peru" },
1187 { RGB_TO_ULONG(222, 184, 135), "burlywood" },
1188 { RGB_TO_ULONG(245, 245, 220), "beige" },
1189 { RGB_TO_ULONG(245, 222, 179), "wheat" },
1190 { RGB_TO_ULONG(244, 164, 96 ), "sandy brown" },
1191 { RGB_TO_ULONG(244, 164, 96 ), "SandyBrown" },
1192 { RGB_TO_ULONG(210, 180, 140), "tan" },
1193 { RGB_TO_ULONG(210, 105, 30 ), "chocolate" },
1194 { RGB_TO_ULONG(178, 34 , 34 ), "firebrick" },
1195 { RGB_TO_ULONG(165, 42 , 42 ), "brown" },
1196 { RGB_TO_ULONG(233, 150, 122), "dark salmon" },
1197 { RGB_TO_ULONG(233, 150, 122), "DarkSalmon" },
1198 { RGB_TO_ULONG(250, 128, 114), "salmon" },
1199 { RGB_TO_ULONG(255, 160, 122), "light salmon" },
1200 { RGB_TO_ULONG(255, 160, 122), "LightSalmon" },
1201 { RGB_TO_ULONG(255, 165, 0 ), "orange" },
1202 { RGB_TO_ULONG(255, 140, 0 ), "dark orange" },
1203 { RGB_TO_ULONG(255, 140, 0 ), "DarkOrange" },
1204 { RGB_TO_ULONG(255, 127, 80 ), "coral" },
1205 { RGB_TO_ULONG(240, 128, 128), "light coral" },
1206 { RGB_TO_ULONG(240, 128, 128), "LightCoral" },
1207 { RGB_TO_ULONG(255, 99 , 71 ), "tomato" },
1208 { RGB_TO_ULONG(255, 69 , 0 ), "orange red" },
1209 { RGB_TO_ULONG(255, 69 , 0 ), "OrangeRed" },
1210 { RGB_TO_ULONG(255, 0 , 0 ), "red" },
1211 { RGB_TO_ULONG(255, 105, 180), "hot pink" },
1212 { RGB_TO_ULONG(255, 105, 180), "HotPink" },
1213 { RGB_TO_ULONG(255, 20 , 147), "deep pink" },
1214 { RGB_TO_ULONG(255, 20 , 147), "DeepPink" },
1215 { RGB_TO_ULONG(255, 192, 203), "pink" },
1216 { RGB_TO_ULONG(255, 182, 193), "light pink" },
1217 { RGB_TO_ULONG(255, 182, 193), "LightPink" },
1218 { RGB_TO_ULONG(219, 112, 147), "pale violet red" },
1219 { RGB_TO_ULONG(219, 112, 147), "PaleVioletRed" },
1220 { RGB_TO_ULONG(176, 48 , 96 ), "maroon" },
1221 { RGB_TO_ULONG(199, 21 , 133), "medium violet red" },
1222 { RGB_TO_ULONG(199, 21 , 133), "MediumVioletRed" },
1223 { RGB_TO_ULONG(208, 32 , 144), "violet red" },
1224 { RGB_TO_ULONG(208, 32 , 144), "VioletRed" },
1225 { RGB_TO_ULONG(255, 0 , 255), "magenta" },
1226 { RGB_TO_ULONG(238, 130, 238), "violet" },
1227 { RGB_TO_ULONG(221, 160, 221), "plum" },
1228 { RGB_TO_ULONG(218, 112, 214), "orchid" },
1229 { RGB_TO_ULONG(186, 85 , 211), "medium orchid" },
1230 { RGB_TO_ULONG(186, 85 , 211), "MediumOrchid" },
1231 { RGB_TO_ULONG(153, 50 , 204), "dark orchid" },
1232 { RGB_TO_ULONG(153, 50 , 204), "DarkOrchid" },
1233 { RGB_TO_ULONG(148, 0 , 211), "dark violet" },
1234 { RGB_TO_ULONG(148, 0 , 211), "DarkViolet" },
1235 { RGB_TO_ULONG(138, 43 , 226), "blue violet" },
1236 { RGB_TO_ULONG(138, 43 , 226), "BlueViolet" },
1237 { RGB_TO_ULONG(160, 32 , 240), "purple" },
1238 { RGB_TO_ULONG(147, 112, 219), "medium purple" },
1239 { RGB_TO_ULONG(147, 112, 219), "MediumPurple" },
1240 { RGB_TO_ULONG(216, 191, 216), "thistle" },
1241 { RGB_TO_ULONG(255, 250, 250), "snow1" },
1242 { RGB_TO_ULONG(238, 233, 233), "snow2" },
1243 { RGB_TO_ULONG(205, 201, 201), "snow3" },
1244 { RGB_TO_ULONG(139, 137, 137), "snow4" },
1245 { RGB_TO_ULONG(255, 245, 238), "seashell1" },
1246 { RGB_TO_ULONG(238, 229, 222), "seashell2" },
1247 { RGB_TO_ULONG(205, 197, 191), "seashell3" },
1248 { RGB_TO_ULONG(139, 134, 130), "seashell4" },
1249 { RGB_TO_ULONG(255, 239, 219), "AntiqueWhite1" },
1250 { RGB_TO_ULONG(238, 223, 204), "AntiqueWhite2" },
1251 { RGB_TO_ULONG(205, 192, 176), "AntiqueWhite3" },
1252 { RGB_TO_ULONG(139, 131, 120), "AntiqueWhite4" },
1253 { RGB_TO_ULONG(255, 228, 196), "bisque1" },
1254 { RGB_TO_ULONG(238, 213, 183), "bisque2" },
1255 { RGB_TO_ULONG(205, 183, 158), "bisque3" },
1256 { RGB_TO_ULONG(139, 125, 107), "bisque4" },
1257 { RGB_TO_ULONG(255, 218, 185), "PeachPuff1" },
1258 { RGB_TO_ULONG(238, 203, 173), "PeachPuff2" },
1259 { RGB_TO_ULONG(205, 175, 149), "PeachPuff3" },
1260 { RGB_TO_ULONG(139, 119, 101), "PeachPuff4" },
1261 { RGB_TO_ULONG(255, 222, 173), "NavajoWhite1" },
1262 { RGB_TO_ULONG(238, 207, 161), "NavajoWhite2" },
1263 { RGB_TO_ULONG(205, 179, 139), "NavajoWhite3" },
1264 { RGB_TO_ULONG(139, 121, 94), "NavajoWhite4" },
1265 { RGB_TO_ULONG(255, 250, 205), "LemonChiffon1" },
1266 { RGB_TO_ULONG(238, 233, 191), "LemonChiffon2" },
1267 { RGB_TO_ULONG(205, 201, 165), "LemonChiffon3" },
1268 { RGB_TO_ULONG(139, 137, 112), "LemonChiffon4" },
1269 { RGB_TO_ULONG(255, 248, 220), "cornsilk1" },
1270 { RGB_TO_ULONG(238, 232, 205), "cornsilk2" },
1271 { RGB_TO_ULONG(205, 200, 177), "cornsilk3" },
1272 { RGB_TO_ULONG(139, 136, 120), "cornsilk4" },
1273 { RGB_TO_ULONG(255, 255, 240), "ivory1" },
1274 { RGB_TO_ULONG(238, 238, 224), "ivory2" },
1275 { RGB_TO_ULONG(205, 205, 193), "ivory3" },
1276 { RGB_TO_ULONG(139, 139, 131), "ivory4" },
1277 { RGB_TO_ULONG(240, 255, 240), "honeydew1" },
1278 { RGB_TO_ULONG(224, 238, 224), "honeydew2" },
1279 { RGB_TO_ULONG(193, 205, 193), "honeydew3" },
1280 { RGB_TO_ULONG(131, 139, 131), "honeydew4" },
1281 { RGB_TO_ULONG(255, 240, 245), "LavenderBlush1" },
1282 { RGB_TO_ULONG(238, 224, 229), "LavenderBlush2" },
1283 { RGB_TO_ULONG(205, 193, 197), "LavenderBlush3" },
1284 { RGB_TO_ULONG(139, 131, 134), "LavenderBlush4" },
1285 { RGB_TO_ULONG(255, 228, 225), "MistyRose1" },
1286 { RGB_TO_ULONG(238, 213, 210), "MistyRose2" },
1287 { RGB_TO_ULONG(205, 183, 181), "MistyRose3" },
1288 { RGB_TO_ULONG(139, 125, 123), "MistyRose4" },
1289 { RGB_TO_ULONG(240, 255, 255), "azure1" },
1290 { RGB_TO_ULONG(224, 238, 238), "azure2" },
1291 { RGB_TO_ULONG(193, 205, 205), "azure3" },
1292 { RGB_TO_ULONG(131, 139, 139), "azure4" },
1293 { RGB_TO_ULONG(131, 111, 255), "SlateBlue1" },
1294 { RGB_TO_ULONG(122, 103, 238), "SlateBlue2" },
1295 { RGB_TO_ULONG(105, 89 , 205), "SlateBlue3" },
1296 { RGB_TO_ULONG(71 , 60 , 139), "SlateBlue4" },
1297 { RGB_TO_ULONG(72 , 118, 255), "RoyalBlue1" },
1298 { RGB_TO_ULONG(67 , 110, 238), "RoyalBlue2" },
1299 { RGB_TO_ULONG(58 , 95 , 205), "RoyalBlue3" },
1300 { RGB_TO_ULONG(39 , 64 , 139), "RoyalBlue4" },
1301 { RGB_TO_ULONG(0 , 0 , 255), "blue1" },
1302 { RGB_TO_ULONG(0 , 0 , 238), "blue2" },
1303 { RGB_TO_ULONG(0 , 0 , 205), "blue3" },
1304 { RGB_TO_ULONG(0 , 0 , 139), "blue4" },
1305 { RGB_TO_ULONG(30 , 144, 255), "DodgerBlue1" },
1306 { RGB_TO_ULONG(28 , 134, 238), "DodgerBlue2" },
1307 { RGB_TO_ULONG(24 , 116, 205), "DodgerBlue3" },
1308 { RGB_TO_ULONG(16 , 78 , 139), "DodgerBlue4" },
1309 { RGB_TO_ULONG(99 , 184, 255), "SteelBlue1" },
1310 { RGB_TO_ULONG(92 , 172, 238), "SteelBlue2" },
1311 { RGB_TO_ULONG(79 , 148, 205), "SteelBlue3" },
1312 { RGB_TO_ULONG(54 , 100, 139), "SteelBlue4" },
1313 { RGB_TO_ULONG(0 , 191, 255), "DeepSkyBlue1" },
1314 { RGB_TO_ULONG(0 , 178, 238), "DeepSkyBlue2" },
1315 { RGB_TO_ULONG(0 , 154, 205), "DeepSkyBlue3" },
1316 { RGB_TO_ULONG(0 , 104, 139), "DeepSkyBlue4" },
1317 { RGB_TO_ULONG(135, 206, 255), "SkyBlue1" },
1318 { RGB_TO_ULONG(126, 192, 238), "SkyBlue2" },
1319 { RGB_TO_ULONG(108, 166, 205), "SkyBlue3" },
1320 { RGB_TO_ULONG(74 , 112, 139), "SkyBlue4" },
1321 { RGB_TO_ULONG(176, 226, 255), "LightSkyBlue1" },
1322 { RGB_TO_ULONG(164, 211, 238), "LightSkyBlue2" },
1323 { RGB_TO_ULONG(141, 182, 205), "LightSkyBlue3" },
1324 { RGB_TO_ULONG(96 , 123, 139), "LightSkyBlue4" },
1325 { RGB_TO_ULONG(198, 226, 255), "SlateGray1" },
1326 { RGB_TO_ULONG(185, 211, 238), "SlateGray2" },
1327 { RGB_TO_ULONG(159, 182, 205), "SlateGray3" },
1328 { RGB_TO_ULONG(108, 123, 139), "SlateGray4" },
1329 { RGB_TO_ULONG(202, 225, 255), "LightSteelBlue1" },
1330 { RGB_TO_ULONG(188, 210, 238), "LightSteelBlue2" },
1331 { RGB_TO_ULONG(162, 181, 205), "LightSteelBlue3" },
1332 { RGB_TO_ULONG(110, 123, 139), "LightSteelBlue4" },
1333 { RGB_TO_ULONG(191, 239, 255), "LightBlue1" },
1334 { RGB_TO_ULONG(178, 223, 238), "LightBlue2" },
1335 { RGB_TO_ULONG(154, 192, 205), "LightBlue3" },
1336 { RGB_TO_ULONG(104, 131, 139), "LightBlue4" },
1337 { RGB_TO_ULONG(224, 255, 255), "LightCyan1" },
1338 { RGB_TO_ULONG(209, 238, 238), "LightCyan2" },
1339 { RGB_TO_ULONG(180, 205, 205), "LightCyan3" },
1340 { RGB_TO_ULONG(122, 139, 139), "LightCyan4" },
1341 { RGB_TO_ULONG(187, 255, 255), "PaleTurquoise1" },
1342 { RGB_TO_ULONG(174, 238, 238), "PaleTurquoise2" },
1343 { RGB_TO_ULONG(150, 205, 205), "PaleTurquoise3" },
1344 { RGB_TO_ULONG(102, 139, 139), "PaleTurquoise4" },
1345 { RGB_TO_ULONG(152, 245, 255), "CadetBlue1" },
1346 { RGB_TO_ULONG(142, 229, 238), "CadetBlue2" },
1347 { RGB_TO_ULONG(122, 197, 205), "CadetBlue3" },
1348 { RGB_TO_ULONG(83 , 134, 139), "CadetBlue4" },
1349 { RGB_TO_ULONG(0 , 245, 255), "turquoise1" },
1350 { RGB_TO_ULONG(0 , 229, 238), "turquoise2" },
1351 { RGB_TO_ULONG(0 , 197, 205), "turquoise3" },
1352 { RGB_TO_ULONG(0 , 134, 139), "turquoise4" },
1353 { RGB_TO_ULONG(0 , 255, 255), "cyan1" },
1354 { RGB_TO_ULONG(0 , 238, 238), "cyan2" },
1355 { RGB_TO_ULONG(0 , 205, 205), "cyan3" },
1356 { RGB_TO_ULONG(0 , 139, 139), "cyan4" },
1357 { RGB_TO_ULONG(151, 255, 255), "DarkSlateGray1" },
1358 { RGB_TO_ULONG(141, 238, 238), "DarkSlateGray2" },
1359 { RGB_TO_ULONG(121, 205, 205), "DarkSlateGray3" },
1360 { RGB_TO_ULONG(82 , 139, 139), "DarkSlateGray4" },
1361 { RGB_TO_ULONG(127, 255, 212), "aquamarine1" },
1362 { RGB_TO_ULONG(118, 238, 198), "aquamarine2" },
1363 { RGB_TO_ULONG(102, 205, 170), "aquamarine3" },
1364 { RGB_TO_ULONG(69 , 139, 116), "aquamarine4" },
1365 { RGB_TO_ULONG(193, 255, 193), "DarkSeaGreen1" },
1366 { RGB_TO_ULONG(180, 238, 180), "DarkSeaGreen2" },
1367 { RGB_TO_ULONG(155, 205, 155), "DarkSeaGreen3" },
1368 { RGB_TO_ULONG(105, 139, 105), "DarkSeaGreen4" },
1369 { RGB_TO_ULONG(84 , 255, 159), "SeaGreen1" },
1370 { RGB_TO_ULONG(78 , 238, 148), "SeaGreen2" },
1371 { RGB_TO_ULONG(67 , 205, 128), "SeaGreen3" },
1372 { RGB_TO_ULONG(46 , 139, 87 ), "SeaGreen4" },
1373 { RGB_TO_ULONG(154, 255, 154), "PaleGreen1" },
1374 { RGB_TO_ULONG(144, 238, 144), "PaleGreen2" },
1375 { RGB_TO_ULONG(124, 205, 124), "PaleGreen3" },
1376 { RGB_TO_ULONG(84 , 139, 84 ), "PaleGreen4" },
1377 { RGB_TO_ULONG(0 , 255, 127), "SpringGreen1" },
1378 { RGB_TO_ULONG(0 , 238, 118), "SpringGreen2" },
1379 { RGB_TO_ULONG(0 , 205, 102), "SpringGreen3" },
1380 { RGB_TO_ULONG(0 , 139, 69 ), "SpringGreen4" },
1381 { RGB_TO_ULONG(0 , 255, 0 ), "green1" },
1382 { RGB_TO_ULONG(0 , 238, 0 ), "green2" },
1383 { RGB_TO_ULONG(0 , 205, 0 ), "green3" },
1384 { RGB_TO_ULONG(0 , 139, 0 ), "green4" },
1385 { RGB_TO_ULONG(127, 255, 0 ), "chartreuse1" },
1386 { RGB_TO_ULONG(118, 238, 0 ), "chartreuse2" },
1387 { RGB_TO_ULONG(102, 205, 0 ), "chartreuse3" },
1388 { RGB_TO_ULONG(69 , 139, 0 ), "chartreuse4" },
1389 { RGB_TO_ULONG(192, 255, 62 ), "OliveDrab1" },
1390 { RGB_TO_ULONG(179, 238, 58 ), "OliveDrab2" },
1391 { RGB_TO_ULONG(154, 205, 50 ), "OliveDrab3" },
1392 { RGB_TO_ULONG(105, 139, 34 ), "OliveDrab4" },
1393 { RGB_TO_ULONG(202, 255, 112), "DarkOliveGreen1" },
1394 { RGB_TO_ULONG(188, 238, 104), "DarkOliveGreen2" },
1395 { RGB_TO_ULONG(162, 205, 90 ), "DarkOliveGreen3" },
1396 { RGB_TO_ULONG(110, 139, 61 ), "DarkOliveGreen4" },
1397 { RGB_TO_ULONG(255, 246, 143), "khaki1" },
1398 { RGB_TO_ULONG(238, 230, 133), "khaki2" },
1399 { RGB_TO_ULONG(205, 198, 115), "khaki3" },
1400 { RGB_TO_ULONG(139, 134, 78 ), "khaki4" },
1401 { RGB_TO_ULONG(255, 236, 139), "LightGoldenrod1" },
1402 { RGB_TO_ULONG(238, 220, 130), "LightGoldenrod2" },
1403 { RGB_TO_ULONG(205, 190, 112), "LightGoldenrod3" },
1404 { RGB_TO_ULONG(139, 129, 76 ), "LightGoldenrod4" },
1405 { RGB_TO_ULONG(255, 255, 224), "LightYellow1" },
1406 { RGB_TO_ULONG(238, 238, 209), "LightYellow2" },
1407 { RGB_TO_ULONG(205, 205, 180), "LightYellow3" },
1408 { RGB_TO_ULONG(139, 139, 122), "LightYellow4" },
1409 { RGB_TO_ULONG(255, 255, 0 ), "yellow1" },
1410 { RGB_TO_ULONG(238, 238, 0 ), "yellow2" },
1411 { RGB_TO_ULONG(205, 205, 0 ), "yellow3" },
1412 { RGB_TO_ULONG(139, 139, 0 ), "yellow4" },
1413 { RGB_TO_ULONG(255, 215, 0 ), "gold1" },
1414 { RGB_TO_ULONG(238, 201, 0 ), "gold2" },
1415 { RGB_TO_ULONG(205, 173, 0 ), "gold3" },
1416 { RGB_TO_ULONG(139, 117, 0 ), "gold4" },
1417 { RGB_TO_ULONG(255, 193, 37 ), "goldenrod1" },
1418 { RGB_TO_ULONG(238, 180, 34 ), "goldenrod2" },
1419 { RGB_TO_ULONG(205, 155, 29 ), "goldenrod3" },
1420 { RGB_TO_ULONG(139, 105, 20 ), "goldenrod4" },
1421 { RGB_TO_ULONG(255, 185, 15 ), "DarkGoldenrod1" },
1422 { RGB_TO_ULONG(238, 173, 14 ), "DarkGoldenrod2" },
1423 { RGB_TO_ULONG(205, 149, 12 ), "DarkGoldenrod3" },
1424 { RGB_TO_ULONG(139, 101, 8 ), "DarkGoldenrod4" },
1425 { RGB_TO_ULONG(255, 193, 193), "RosyBrown1" },
1426 { RGB_TO_ULONG(238, 180, 180), "RosyBrown2" },
1427 { RGB_TO_ULONG(205, 155, 155), "RosyBrown3" },
1428 { RGB_TO_ULONG(139, 105, 105), "RosyBrown4" },
1429 { RGB_TO_ULONG(255, 106, 106), "IndianRed1" },
1430 { RGB_TO_ULONG(238, 99 , 99 ), "IndianRed2" },
1431 { RGB_TO_ULONG(205, 85 , 85 ), "IndianRed3" },
1432 { RGB_TO_ULONG(139, 58 , 58 ), "IndianRed4" },
1433 { RGB_TO_ULONG(255, 130, 71 ), "sienna1" },
1434 { RGB_TO_ULONG(238, 121, 66 ), "sienna2" },
1435 { RGB_TO_ULONG(205, 104, 57 ), "sienna3" },
1436 { RGB_TO_ULONG(139, 71 , 38 ), "sienna4" },
1437 { RGB_TO_ULONG(255, 211, 155), "burlywood1" },
1438 { RGB_TO_ULONG(238, 197, 145), "burlywood2" },
1439 { RGB_TO_ULONG(205, 170, 125), "burlywood3" },
1440 { RGB_TO_ULONG(139, 115, 85 ), "burlywood4" },
1441 { RGB_TO_ULONG(255, 231, 186), "wheat1" },
1442 { RGB_TO_ULONG(238, 216, 174), "wheat2" },
1443 { RGB_TO_ULONG(205, 186, 150), "wheat3" },
1444 { RGB_TO_ULONG(139, 126, 102), "wheat4" },
1445 { RGB_TO_ULONG(255, 165, 79 ), "tan1" },
1446 { RGB_TO_ULONG(238, 154, 73 ), "tan2" },
1447 { RGB_TO_ULONG(205, 133, 63 ), "tan3" },
1448 { RGB_TO_ULONG(139, 90 , 43 ), "tan4" },
1449 { RGB_TO_ULONG(255, 127, 36 ), "chocolate1" },
1450 { RGB_TO_ULONG(238, 118, 33 ), "chocolate2" },
1451 { RGB_TO_ULONG(205, 102, 29 ), "chocolate3" },
1452 { RGB_TO_ULONG(139, 69 , 19 ), "chocolate4" },
1453 { RGB_TO_ULONG(255, 48 , 48 ), "firebrick1" },
1454 { RGB_TO_ULONG(238, 44 , 44 ), "firebrick2" },
1455 { RGB_TO_ULONG(205, 38 , 38 ), "firebrick3" },
1456 { RGB_TO_ULONG(139, 26 , 26 ), "firebrick4" },
1457 { RGB_TO_ULONG(255, 64 , 64 ), "brown1" },
1458 { RGB_TO_ULONG(238, 59 , 59 ), "brown2" },
1459 { RGB_TO_ULONG(205, 51 , 51 ), "brown3" },
1460 { RGB_TO_ULONG(139, 35 , 35 ), "brown4" },
1461 { RGB_TO_ULONG(255, 140, 105), "salmon1" },
1462 { RGB_TO_ULONG(238, 130, 98 ), "salmon2" },
1463 { RGB_TO_ULONG(205, 112, 84 ), "salmon3" },
1464 { RGB_TO_ULONG(139, 76 , 57 ), "salmon4" },
1465 { RGB_TO_ULONG(255, 160, 122), "LightSalmon1" },
1466 { RGB_TO_ULONG(238, 149, 114), "LightSalmon2" },
1467 { RGB_TO_ULONG(205, 129, 98 ), "LightSalmon3" },
1468 { RGB_TO_ULONG(139, 87 , 66 ), "LightSalmon4" },
1469 { RGB_TO_ULONG(255, 165, 0 ), "orange1" },
1470 { RGB_TO_ULONG(238, 154, 0 ), "orange2" },
1471 { RGB_TO_ULONG(205, 133, 0 ), "orange3" },
1472 { RGB_TO_ULONG(139, 90 , 0 ), "orange4" },
1473 { RGB_TO_ULONG(255, 127, 0 ), "DarkOrange1" },
1474 { RGB_TO_ULONG(238, 118, 0 ), "DarkOrange2" },
1475 { RGB_TO_ULONG(205, 102, 0 ), "DarkOrange3" },
1476 { RGB_TO_ULONG(139, 69 , 0 ), "DarkOrange4" },
1477 { RGB_TO_ULONG(255, 114, 86 ), "coral1" },
1478 { RGB_TO_ULONG(238, 106, 80 ), "coral2" },
1479 { RGB_TO_ULONG(205, 91 , 69 ), "coral3" },
1480 { RGB_TO_ULONG(139, 62 , 47 ), "coral4" },
1481 { RGB_TO_ULONG(255, 99 , 71 ), "tomato1" },
1482 { RGB_TO_ULONG(238, 92 , 66 ), "tomato2" },
1483 { RGB_TO_ULONG(205, 79 , 57 ), "tomato3" },
1484 { RGB_TO_ULONG(139, 54 , 38 ), "tomato4" },
1485 { RGB_TO_ULONG(255, 69 , 0 ), "OrangeRed1" },
1486 { RGB_TO_ULONG(238, 64 , 0 ), "OrangeRed2" },
1487 { RGB_TO_ULONG(205, 55 , 0 ), "OrangeRed3" },
1488 { RGB_TO_ULONG(139, 37 , 0 ), "OrangeRed4" },
1489 { RGB_TO_ULONG(255, 0 , 0 ), "red1" },
1490 { RGB_TO_ULONG(238, 0 , 0 ), "red2" },
1491 { RGB_TO_ULONG(205, 0 , 0 ), "red3" },
1492 { RGB_TO_ULONG(139, 0 , 0 ), "red4" },
1493 { RGB_TO_ULONG(255, 20 , 147), "DeepPink1" },
1494 { RGB_TO_ULONG(238, 18 , 137), "DeepPink2" },
1495 { RGB_TO_ULONG(205, 16 , 118), "DeepPink3" },
1496 { RGB_TO_ULONG(139, 10 , 80 ), "DeepPink4" },
1497 { RGB_TO_ULONG(255, 110, 180), "HotPink1" },
1498 { RGB_TO_ULONG(238, 106, 167), "HotPink2" },
1499 { RGB_TO_ULONG(205, 96 , 144), "HotPink3" },
1500 { RGB_TO_ULONG(139, 58 , 98 ), "HotPink4" },
1501 { RGB_TO_ULONG(255, 181, 197), "pink1" },
1502 { RGB_TO_ULONG(238, 169, 184), "pink2" },
1503 { RGB_TO_ULONG(205, 145, 158), "pink3" },
1504 { RGB_TO_ULONG(139, 99 , 108), "pink4" },
1505 { RGB_TO_ULONG(255, 174, 185), "LightPink1" },
1506 { RGB_TO_ULONG(238, 162, 173), "LightPink2" },
1507 { RGB_TO_ULONG(205, 140, 149), "LightPink3" },
1508 { RGB_TO_ULONG(139, 95 , 101), "LightPink4" },
1509 { RGB_TO_ULONG(255, 130, 171), "PaleVioletRed1" },
1510 { RGB_TO_ULONG(238, 121, 159), "PaleVioletRed2" },
1511 { RGB_TO_ULONG(205, 104, 137), "PaleVioletRed3" },
1512 { RGB_TO_ULONG(139, 71 , 93 ), "PaleVioletRed4" },
1513 { RGB_TO_ULONG(255, 52 , 179), "maroon1" },
1514 { RGB_TO_ULONG(238, 48 , 167), "maroon2" },
1515 { RGB_TO_ULONG(205, 41 , 144), "maroon3" },
1516 { RGB_TO_ULONG(139, 28 , 98 ), "maroon4" },
1517 { RGB_TO_ULONG(255, 62 , 150), "VioletRed1" },
1518 { RGB_TO_ULONG(238, 58 , 140), "VioletRed2" },
1519 { RGB_TO_ULONG(205, 50 , 120), "VioletRed3" },
1520 { RGB_TO_ULONG(139, 34 , 82 ), "VioletRed4" },
1521 { RGB_TO_ULONG(255, 0 , 255), "magenta1" },
1522 { RGB_TO_ULONG(238, 0 , 238), "magenta2" },
1523 { RGB_TO_ULONG(205, 0 , 205), "magenta3" },
1524 { RGB_TO_ULONG(139, 0 , 139), "magenta4" },
1525 { RGB_TO_ULONG(255, 131, 250), "orchid1" },
1526 { RGB_TO_ULONG(238, 122, 233), "orchid2" },
1527 { RGB_TO_ULONG(205, 105, 201), "orchid3" },
1528 { RGB_TO_ULONG(139, 71 , 137), "orchid4" },
1529 { RGB_TO_ULONG(255, 187, 255), "plum1" },
1530 { RGB_TO_ULONG(238, 174, 238), "plum2" },
1531 { RGB_TO_ULONG(205, 150, 205), "plum3" },
1532 { RGB_TO_ULONG(139, 102, 139), "plum4" },
1533 { RGB_TO_ULONG(224, 102, 255), "MediumOrchid1" },
1534 { RGB_TO_ULONG(209, 95 , 238), "MediumOrchid2" },
1535 { RGB_TO_ULONG(180, 82 , 205), "MediumOrchid3" },
1536 { RGB_TO_ULONG(122, 55 , 139), "MediumOrchid4" },
1537 { RGB_TO_ULONG(191, 62 , 255), "DarkOrchid1" },
1538 { RGB_TO_ULONG(178, 58 , 238), "DarkOrchid2" },
1539 { RGB_TO_ULONG(154, 50 , 205), "DarkOrchid3" },
1540 { RGB_TO_ULONG(104, 34 , 139), "DarkOrchid4" },
1541 { RGB_TO_ULONG(155, 48 , 255), "purple1" },
1542 { RGB_TO_ULONG(145, 44 , 238), "purple2" },
1543 { RGB_TO_ULONG(125, 38 , 205), "purple3" },
1544 { RGB_TO_ULONG(85 , 26 , 139), "purple4" },
1545 { RGB_TO_ULONG(171, 130, 255), "MediumPurple1" },
1546 { RGB_TO_ULONG(159, 121, 238), "MediumPurple2" },
1547 { RGB_TO_ULONG(137, 104, 205), "MediumPurple3" },
1548 { RGB_TO_ULONG(93 , 71 , 139), "MediumPurple4" },
1549 { RGB_TO_ULONG(255, 225, 255), "thistle1" },
1550 { RGB_TO_ULONG(238, 210, 238), "thistle2" },
1551 { RGB_TO_ULONG(205, 181, 205), "thistle3" },
1552 { RGB_TO_ULONG(139, 123, 139), "thistle4" },
1553 { RGB_TO_ULONG(0 , 0 , 0 ), "gray0" },
1554 { RGB_TO_ULONG(0 , 0 , 0 ), "grey0" },
1555 { RGB_TO_ULONG(3 , 3 , 3 ), "gray1" },
1556 { RGB_TO_ULONG(3 , 3 , 3 ), "grey1" },
1557 { RGB_TO_ULONG(5 , 5 , 5 ), "gray2" },
1558 { RGB_TO_ULONG(5 , 5 , 5 ), "grey2" },
1559 { RGB_TO_ULONG(8 , 8 , 8 ), "gray3" },
1560 { RGB_TO_ULONG(8 , 8 , 8 ), "grey3" },
1561 { RGB_TO_ULONG(10 , 10 , 10 ), "gray4" },
1562 { RGB_TO_ULONG(10 , 10 , 10 ), "grey4" },
1563 { RGB_TO_ULONG(13 , 13 , 13 ), "gray5" },
1564 { RGB_TO_ULONG(13 , 13 , 13 ), "grey5" },
1565 { RGB_TO_ULONG(15 , 15 , 15 ), "gray6" },
1566 { RGB_TO_ULONG(15 , 15 , 15 ), "grey6" },
1567 { RGB_TO_ULONG(18 , 18 , 18 ), "gray7" },
1568 { RGB_TO_ULONG(18 , 18 , 18 ), "grey7" },
1569 { RGB_TO_ULONG(20 , 20 , 20 ), "gray8" },
1570 { RGB_TO_ULONG(20 , 20 , 20 ), "grey8" },
1571 { RGB_TO_ULONG(23 , 23 , 23 ), "gray9" },
1572 { RGB_TO_ULONG(23 , 23 , 23 ), "grey9" },
1573 { RGB_TO_ULONG(26 , 26 , 26 ), "gray10" },
1574 { RGB_TO_ULONG(26 , 26 , 26 ), "grey10" },
1575 { RGB_TO_ULONG(28 , 28 , 28 ), "gray11" },
1576 { RGB_TO_ULONG(28 , 28 , 28 ), "grey11" },
1577 { RGB_TO_ULONG(31 , 31 , 31 ), "gray12" },
1578 { RGB_TO_ULONG(31 , 31 , 31 ), "grey12" },
1579 { RGB_TO_ULONG(33 , 33 , 33 ), "gray13" },
1580 { RGB_TO_ULONG(33 , 33 , 33 ), "grey13" },
1581 { RGB_TO_ULONG(36 , 36 , 36 ), "gray14" },
1582 { RGB_TO_ULONG(36 , 36 , 36 ), "grey14" },
1583 { RGB_TO_ULONG(38 , 38 , 38 ), "gray15" },
1584 { RGB_TO_ULONG(38 , 38 , 38 ), "grey15" },
1585 { RGB_TO_ULONG(41 , 41 , 41 ), "gray16" },
1586 { RGB_TO_ULONG(41 , 41 , 41 ), "grey16" },
1587 { RGB_TO_ULONG(43 , 43 , 43 ), "gray17" },
1588 { RGB_TO_ULONG(43 , 43 , 43 ), "grey17" },
1589 { RGB_TO_ULONG(46 , 46 , 46 ), "gray18" },
1590 { RGB_TO_ULONG(46 , 46 , 46 ), "grey18" },
1591 { RGB_TO_ULONG(48 , 48 , 48 ), "gray19" },
1592 { RGB_TO_ULONG(48 , 48 , 48 ), "grey19" },
1593 { RGB_TO_ULONG(51 , 51 , 51 ), "gray20" },
1594 { RGB_TO_ULONG(51 , 51 , 51 ), "grey20" },
1595 { RGB_TO_ULONG(54 , 54 , 54 ), "gray21" },
1596 { RGB_TO_ULONG(54 , 54 , 54 ), "grey21" },
1597 { RGB_TO_ULONG(56 , 56 , 56 ), "gray22" },
1598 { RGB_TO_ULONG(56 , 56 , 56 ), "grey22" },
1599 { RGB_TO_ULONG(59 , 59 , 59 ), "gray23" },
1600 { RGB_TO_ULONG(59 , 59 , 59 ), "grey23" },
1601 { RGB_TO_ULONG(61 , 61 , 61 ), "gray24" },
1602 { RGB_TO_ULONG(61 , 61 , 61 ), "grey24" },
1603 { RGB_TO_ULONG(64 , 64 , 64 ), "gray25" },
1604 { RGB_TO_ULONG(64 , 64 , 64 ), "grey25" },
1605 { RGB_TO_ULONG(66 , 66 , 66 ), "gray26" },
1606 { RGB_TO_ULONG(66 , 66 , 66 ), "grey26" },
1607 { RGB_TO_ULONG(69 , 69 , 69 ), "gray27" },
1608 { RGB_TO_ULONG(69 , 69 , 69 ), "grey27" },
1609 { RGB_TO_ULONG(71 , 71 , 71 ), "gray28" },
1610 { RGB_TO_ULONG(71 , 71 , 71 ), "grey28" },
1611 { RGB_TO_ULONG(74 , 74 , 74 ), "gray29" },
1612 { RGB_TO_ULONG(74 , 74 , 74 ), "grey29" },
1613 { RGB_TO_ULONG(77 , 77 , 77 ), "gray30" },
1614 { RGB_TO_ULONG(77 , 77 , 77 ), "grey30" },
1615 { RGB_TO_ULONG(79 , 79 , 79 ), "gray31" },
1616 { RGB_TO_ULONG(79 , 79 , 79 ), "grey31" },
1617 { RGB_TO_ULONG(82 , 82 , 82 ), "gray32" },
1618 { RGB_TO_ULONG(82 , 82 , 82 ), "grey32" },
1619 { RGB_TO_ULONG(84 , 84 , 84 ), "gray33" },
1620 { RGB_TO_ULONG(84 , 84 , 84 ), "grey33" },
1621 { RGB_TO_ULONG(87 , 87 , 87 ), "gray34" },
1622 { RGB_TO_ULONG(87 , 87 , 87 ), "grey34" },
1623 { RGB_TO_ULONG(89 , 89 , 89 ), "gray35" },
1624 { RGB_TO_ULONG(89 , 89 , 89 ), "grey35" },
1625 { RGB_TO_ULONG(92 , 92 , 92 ), "gray36" },
1626 { RGB_TO_ULONG(92 , 92 , 92 ), "grey36" },
1627 { RGB_TO_ULONG(94 , 94 , 94 ), "gray37" },
1628 { RGB_TO_ULONG(94 , 94 , 94 ), "grey37" },
1629 { RGB_TO_ULONG(97 , 97 , 97 ), "gray38" },
1630 { RGB_TO_ULONG(97 , 97 , 97 ), "grey38" },
1631 { RGB_TO_ULONG(99 , 99 , 99 ), "gray39" },
1632 { RGB_TO_ULONG(99 , 99 , 99 ), "grey39" },
1633 { RGB_TO_ULONG(102, 102, 102), "gray40" },
1634 { RGB_TO_ULONG(102, 102, 102), "grey40" },
1635 { RGB_TO_ULONG(105, 105, 105), "gray41" },
1636 { RGB_TO_ULONG(105, 105, 105), "grey41" },
1637 { RGB_TO_ULONG(107, 107, 107), "gray42" },
1638 { RGB_TO_ULONG(107, 107, 107), "grey42" },
1639 { RGB_TO_ULONG(110, 110, 110), "gray43" },
1640 { RGB_TO_ULONG(110, 110, 110), "grey43" },
1641 { RGB_TO_ULONG(112, 112, 112), "gray44" },
1642 { RGB_TO_ULONG(112, 112, 112), "grey44" },
1643 { RGB_TO_ULONG(115, 115, 115), "gray45" },
1644 { RGB_TO_ULONG(115, 115, 115), "grey45" },
1645 { RGB_TO_ULONG(117, 117, 117), "gray46" },
1646 { RGB_TO_ULONG(117, 117, 117), "grey46" },
1647 { RGB_TO_ULONG(120, 120, 120), "gray47" },
1648 { RGB_TO_ULONG(120, 120, 120), "grey47" },
1649 { RGB_TO_ULONG(122, 122, 122), "gray48" },
1650 { RGB_TO_ULONG(122, 122, 122), "grey48" },
1651 { RGB_TO_ULONG(125, 125, 125), "gray49" },
1652 { RGB_TO_ULONG(125, 125, 125), "grey49" },
1653 { RGB_TO_ULONG(127, 127, 127), "gray50" },
1654 { RGB_TO_ULONG(127, 127, 127), "grey50" },
1655 { RGB_TO_ULONG(130, 130, 130), "gray51" },
1656 { RGB_TO_ULONG(130, 130, 130), "grey51" },
1657 { RGB_TO_ULONG(133, 133, 133), "gray52" },
1658 { RGB_TO_ULONG(133, 133, 133), "grey52" },
1659 { RGB_TO_ULONG(135, 135, 135), "gray53" },
1660 { RGB_TO_ULONG(135, 135, 135), "grey53" },
1661 { RGB_TO_ULONG(138, 138, 138), "gray54" },
1662 { RGB_TO_ULONG(138, 138, 138), "grey54" },
1663 { RGB_TO_ULONG(140, 140, 140), "gray55" },
1664 { RGB_TO_ULONG(140, 140, 140), "grey55" },
1665 { RGB_TO_ULONG(143, 143, 143), "gray56" },
1666 { RGB_TO_ULONG(143, 143, 143), "grey56" },
1667 { RGB_TO_ULONG(145, 145, 145), "gray57" },
1668 { RGB_TO_ULONG(145, 145, 145), "grey57" },
1669 { RGB_TO_ULONG(148, 148, 148), "gray58" },
1670 { RGB_TO_ULONG(148, 148, 148), "grey58" },
1671 { RGB_TO_ULONG(150, 150, 150), "gray59" },
1672 { RGB_TO_ULONG(150, 150, 150), "grey59" },
1673 { RGB_TO_ULONG(153, 153, 153), "gray60" },
1674 { RGB_TO_ULONG(153, 153, 153), "grey60" },
1675 { RGB_TO_ULONG(156, 156, 156), "gray61" },
1676 { RGB_TO_ULONG(156, 156, 156), "grey61" },
1677 { RGB_TO_ULONG(158, 158, 158), "gray62" },
1678 { RGB_TO_ULONG(158, 158, 158), "grey62" },
1679 { RGB_TO_ULONG(161, 161, 161), "gray63" },
1680 { RGB_TO_ULONG(161, 161, 161), "grey63" },
1681 { RGB_TO_ULONG(163, 163, 163), "gray64" },
1682 { RGB_TO_ULONG(163, 163, 163), "grey64" },
1683 { RGB_TO_ULONG(166, 166, 166), "gray65" },
1684 { RGB_TO_ULONG(166, 166, 166), "grey65" },
1685 { RGB_TO_ULONG(168, 168, 168), "gray66" },
1686 { RGB_TO_ULONG(168, 168, 168), "grey66" },
1687 { RGB_TO_ULONG(171, 171, 171), "gray67" },
1688 { RGB_TO_ULONG(171, 171, 171), "grey67" },
1689 { RGB_TO_ULONG(173, 173, 173), "gray68" },
1690 { RGB_TO_ULONG(173, 173, 173), "grey68" },
1691 { RGB_TO_ULONG(176, 176, 176), "gray69" },
1692 { RGB_TO_ULONG(176, 176, 176), "grey69" },
1693 { RGB_TO_ULONG(179, 179, 179), "gray70" },
1694 { RGB_TO_ULONG(179, 179, 179), "grey70" },
1695 { RGB_TO_ULONG(181, 181, 181), "gray71" },
1696 { RGB_TO_ULONG(181, 181, 181), "grey71" },
1697 { RGB_TO_ULONG(184, 184, 184), "gray72" },
1698 { RGB_TO_ULONG(184, 184, 184), "grey72" },
1699 { RGB_TO_ULONG(186, 186, 186), "gray73" },
1700 { RGB_TO_ULONG(186, 186, 186), "grey73" },
1701 { RGB_TO_ULONG(189, 189, 189), "gray74" },
1702 { RGB_TO_ULONG(189, 189, 189), "grey74" },
1703 { RGB_TO_ULONG(191, 191, 191), "gray75" },
1704 { RGB_TO_ULONG(191, 191, 191), "grey75" },
1705 { RGB_TO_ULONG(194, 194, 194), "gray76" },
1706 { RGB_TO_ULONG(194, 194, 194), "grey76" },
1707 { RGB_TO_ULONG(196, 196, 196), "gray77" },
1708 { RGB_TO_ULONG(196, 196, 196), "grey77" },
1709 { RGB_TO_ULONG(199, 199, 199), "gray78" },
1710 { RGB_TO_ULONG(199, 199, 199), "grey78" },
1711 { RGB_TO_ULONG(201, 201, 201), "gray79" },
1712 { RGB_TO_ULONG(201, 201, 201), "grey79" },
1713 { RGB_TO_ULONG(204, 204, 204), "gray80" },
1714 { RGB_TO_ULONG(204, 204, 204), "grey80" },
1715 { RGB_TO_ULONG(207, 207, 207), "gray81" },
1716 { RGB_TO_ULONG(207, 207, 207), "grey81" },
1717 { RGB_TO_ULONG(209, 209, 209), "gray82" },
1718 { RGB_TO_ULONG(209, 209, 209), "grey82" },
1719 { RGB_TO_ULONG(212, 212, 212), "gray83" },
1720 { RGB_TO_ULONG(212, 212, 212), "grey83" },
1721 { RGB_TO_ULONG(214, 214, 214), "gray84" },
1722 { RGB_TO_ULONG(214, 214, 214), "grey84" },
1723 { RGB_TO_ULONG(217, 217, 217), "gray85" },
1724 { RGB_TO_ULONG(217, 217, 217), "grey85" },
1725 { RGB_TO_ULONG(219, 219, 219), "gray86" },
1726 { RGB_TO_ULONG(219, 219, 219), "grey86" },
1727 { RGB_TO_ULONG(222, 222, 222), "gray87" },
1728 { RGB_TO_ULONG(222, 222, 222), "grey87" },
1729 { RGB_TO_ULONG(224, 224, 224), "gray88" },
1730 { RGB_TO_ULONG(224, 224, 224), "grey88" },
1731 { RGB_TO_ULONG(227, 227, 227), "gray89" },
1732 { RGB_TO_ULONG(227, 227, 227), "grey89" },
1733 { RGB_TO_ULONG(229, 229, 229), "gray90" },
1734 { RGB_TO_ULONG(229, 229, 229), "grey90" },
1735 { RGB_TO_ULONG(232, 232, 232), "gray91" },
1736 { RGB_TO_ULONG(232, 232, 232), "grey91" },
1737 { RGB_TO_ULONG(235, 235, 235), "gray92" },
1738 { RGB_TO_ULONG(235, 235, 235), "grey92" },
1739 { RGB_TO_ULONG(237, 237, 237), "gray93" },
1740 { RGB_TO_ULONG(237, 237, 237), "grey93" },
1741 { RGB_TO_ULONG(240, 240, 240), "gray94" },
1742 { RGB_TO_ULONG(240, 240, 240), "grey94" },
1743 { RGB_TO_ULONG(242, 242, 242), "gray95" },
1744 { RGB_TO_ULONG(242, 242, 242), "grey95" },
1745 { RGB_TO_ULONG(245, 245, 245), "gray96" },
1746 { RGB_TO_ULONG(245, 245, 245), "grey96" },
1747 { RGB_TO_ULONG(247, 247, 247), "gray97" },
1748 { RGB_TO_ULONG(247, 247, 247), "grey97" },
1749 { RGB_TO_ULONG(250, 250, 250), "gray98" },
1750 { RGB_TO_ULONG(250, 250, 250), "grey98" },
1751 { RGB_TO_ULONG(252, 252, 252), "gray99" },
1752 { RGB_TO_ULONG(252, 252, 252), "grey99" },
1753 { RGB_TO_ULONG(255, 255, 255), "gray100" },
1754 { RGB_TO_ULONG(255, 255, 255), "grey100" },
1755 { RGB_TO_ULONG(169, 169, 169), "dark grey" },
1756 { RGB_TO_ULONG(169, 169, 169), "DarkGrey" },
1757 { RGB_TO_ULONG(169, 169, 169), "dark gray" },
1758 { RGB_TO_ULONG(169, 169, 169), "DarkGray" },
1759 { RGB_TO_ULONG(0 , 0 , 139), "dark blue" },
1760 { RGB_TO_ULONG(0 , 0 , 139), "DarkBlue" },
1761 { RGB_TO_ULONG(0 , 139, 139), "dark cyan" },
1762 { RGB_TO_ULONG(0 , 139, 139), "DarkCyan" },
1763 { RGB_TO_ULONG(139, 0 , 139), "dark magenta" },
1764 { RGB_TO_ULONG(139, 0 , 139), "DarkMagenta" },
1765 { RGB_TO_ULONG(139, 0 , 0 ), "dark red" },
1766 { RGB_TO_ULONG(139, 0 , 0 ), "DarkRed" },
1767 { RGB_TO_ULONG(144, 238, 144), "light green" },
1768 { RGB_TO_ULONG(144, 238, 144), "LightGreen" }
1772 mac_color_map_lookup (colorname
)
1775 Lisp_Object ret
= Qnil
;
1780 for (i
= 0; i
< sizeof (mac_color_map
) / sizeof (mac_color_map
[0]); i
++)
1781 if (stricmp (colorname
, mac_color_map
[i
].name
) == 0)
1783 ret
= mac_color_map
[i
].color
;
1793 x_to_mac_color (colorname
)
1796 register Lisp_Object tail
, ret
= Qnil
;
1800 if (colorname
[0] == '#')
1802 /* Could be an old-style RGB Device specification. */
1805 color
= colorname
+ 1;
1807 size
= strlen(color
);
1808 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1810 unsigned long colorval
;
1816 for (i
= 0; i
< 3; i
++)
1820 unsigned long value
;
1822 /* The check for 'x' in the following conditional takes into
1823 account the fact that strtol allows a "0x" in front of
1824 our numbers, and we don't. */
1825 if (!isxdigit(color
[0]) || color
[1] == 'x')
1829 value
= strtoul(color
, &end
, 16);
1831 if (errno
== ERANGE
|| end
- color
!= size
)
1836 value
= value
* 0x10;
1847 colorval
|= (value
<< pos
);
1858 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1861 unsigned long colorval
;
1866 color
= colorname
+ 4;
1867 for (i
= 0; i
< 3; i
++)
1870 unsigned long value
;
1872 /* The check for 'x' in the following conditional takes into
1873 account the fact that strtol allows a "0x" in front of
1874 our numbers, and we don't. */
1875 if (!isxdigit(color
[0]) || color
[1] == 'x')
1877 value
= strtoul(color
, &end
, 16);
1878 if (errno
== ERANGE
)
1880 switch (end
- color
)
1883 value
= value
* 0x10 + value
;
1896 if (value
== ULONG_MAX
)
1898 colorval
|= (value
<< pos
);
1912 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1914 /* This is an RGB Intensity specification. */
1916 unsigned long colorval
;
1921 color
= colorname
+ 5;
1922 for (i
= 0; i
< 3; i
++)
1928 value
= strtod(color
, &end
);
1929 if (errno
== ERANGE
)
1931 if (value
< 0.0 || value
> 1.0)
1933 val
= (unsigned long)(0x100 * value
);
1934 /* We used 0x100 instead of 0xFF to give an continuous
1935 range between 0.0 and 1.0 inclusive. The next statement
1936 fixes the 1.0 case. */
1939 colorval
|= (val
<< pos
);
1954 ret
= mac_color_map_lookup (colorname
);
1960 /* Gamma-correct COLOR on frame F. */
1963 gamma_correct (f
, color
)
1965 unsigned long *color
;
1969 unsigned long red
, green
, blue
;
1971 red
= pow (RED_FROM_ULONG (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5;
1972 green
= pow (GREEN_FROM_ULONG (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5;
1973 blue
= pow (BLUE_FROM_ULONG (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5;
1974 *color
= RGB_TO_ULONG (red
, green
, blue
);
1978 /* Decide if color named COLOR is valid for the display associated
1979 with the selected frame; if so, return the rgb values in COLOR_DEF.
1980 If ALLOC is nonzero, allocate a new colormap cell. */
1983 mac_defined_color (f
, color
, color_def
, alloc
)
1989 register Lisp_Object tem
;
1990 unsigned long mac_color_ref
;
1992 tem
= x_to_mac_color (color
);
1998 /* Apply gamma correction. */
1999 mac_color_ref
= XUINT (tem
);
2000 gamma_correct (f
, &mac_color_ref
);
2001 XSETINT (tem
, mac_color_ref
);
2004 color_def
->pixel
= mac_color_ref
;
2005 color_def
->red
= RED_FROM_ULONG (mac_color_ref
);
2006 color_def
->green
= GREEN_FROM_ULONG (mac_color_ref
);
2007 color_def
->blue
= BLUE_FROM_ULONG (mac_color_ref
);
2017 /* Given a string ARG naming a color, compute a pixel value from it
2018 suitable for screen F.
2019 If F is not a color screen, return DEF (default) regardless of what
2023 x_decode_color (f
, arg
, def
)
2030 CHECK_STRING (arg
, 0);
2032 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
2033 return BLACK_PIX_DEFAULT (f
);
2034 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
2035 return WHITE_PIX_DEFAULT (f
);
2038 if ((FRAME_MAC_DISPLAY_INFO (f
)->n_planes
2039 * FRAME_MAC_DISPLAY_INFO (f
)->n_cbits
) == 1)
2043 if (mac_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
2046 /* defined_color failed; return an ultimate default. */
2050 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
2051 the previous value of that parameter, NEW_VALUE is the new value. */
2054 x_set_line_spacing (f
, new_value
, old_value
)
2056 Lisp_Object new_value
, old_value
;
2058 if (NILP (new_value
))
2059 f
->extra_line_spacing
= 0;
2060 else if (NATNUMP (new_value
))
2061 f
->extra_line_spacing
= XFASTINT (new_value
);
2063 Fsignal (Qerror
, Fcons (build_string ("Illegal line-spacing"),
2064 Fcons (new_value
, Qnil
)));
2065 if (FRAME_VISIBLE_P (f
))
2070 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
2071 the previous value of that parameter, NEW_VALUE is the new value. */
2074 x_set_screen_gamma (f
, new_value
, old_value
)
2076 Lisp_Object new_value
, old_value
;
2078 if (NILP (new_value
))
2080 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
2081 /* The value 0.4545 is the normal viewing gamma. */
2082 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
2084 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
2085 Fcons (new_value
, Qnil
)));
2087 clear_face_cache (0);
2091 /* Functions called only from `x_set_frame_param'
2092 to set individual parameters.
2094 If FRAME_MAC_WINDOW (f) is 0,
2095 the frame is being created and its window does not exist yet.
2096 In that case, just record the parameter's new value
2097 in the standard place; do not attempt to change the window. */
2100 x_set_foreground_color (f
, arg
, oldval
)
2102 Lisp_Object arg
, oldval
;
2104 FRAME_FOREGROUND_PIXEL (f
)
2105 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2107 if (FRAME_MAC_WINDOW (f
) != 0)
2109 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
2110 if (FRAME_VISIBLE_P (f
))
2116 x_set_background_color (f
, arg
, oldval
)
2118 Lisp_Object arg
, oldval
;
2120 FRAME_BACKGROUND_PIXEL (f
)
2121 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
2123 if (FRAME_MAC_WINDOW (f
) != 0)
2125 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
2127 if (FRAME_VISIBLE_P (f
))
2133 x_set_mouse_color (f
, arg
, oldval
)
2135 Lisp_Object arg
, oldval
;
2137 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
2141 if (!EQ (Qnil
, arg
))
2142 f
->output_data
.mac
->mouse_pixel
2143 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2144 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
2146 /* Don't let pointers be invisible. */
2147 if (mask_color
== f
->output_data
.mac
->mouse_pixel
2148 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
2149 f
->output_data
.mac
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
2151 #if 0 /* MAC_TODO : cursor changes */
2154 /* It's not okay to crash if the user selects a screwy cursor. */
2155 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
2157 if (!EQ (Qnil
, Vx_pointer_shape
))
2159 CHECK_NUMBER (Vx_pointer_shape
, 0);
2160 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
2163 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2164 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
2166 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
2168 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
2169 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2170 XINT (Vx_nontext_pointer_shape
));
2173 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
2174 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2176 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
2178 CHECK_NUMBER (Vx_hourglass_pointer_shape
, 0);
2179 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2180 XINT (Vx_hourglass_pointer_shape
));
2183 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
2184 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
2186 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
2187 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
2189 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
2190 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2191 XINT (Vx_mode_pointer_shape
));
2194 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
2195 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
2197 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
2199 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
2201 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
2202 XINT (Vx_sensitive_text_pointer_shape
));
2205 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
2207 if (!NILP (Vx_window_horizontal_drag_shape
))
2209 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
2210 horizontal_drag_cursor
2211 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
2212 XINT (Vx_window_horizontal_drag_shape
));
2215 horizontal_drag_cursor
2216 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
2218 /* Check and report errors with the above calls. */
2219 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
2220 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
2223 XColor fore_color
, back_color
;
2225 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
2226 back_color
.pixel
= mask_color
;
2227 XQueryColor (FRAME_W32_DISPLAY (f
),
2228 DefaultColormap (FRAME_W32_DISPLAY (f
),
2229 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2231 XQueryColor (FRAME_W32_DISPLAY (f
),
2232 DefaultColormap (FRAME_W32_DISPLAY (f
),
2233 DefaultScreen (FRAME_W32_DISPLAY (f
))),
2235 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
2236 &fore_color
, &back_color
);
2237 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
2238 &fore_color
, &back_color
);
2239 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
2240 &fore_color
, &back_color
);
2241 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
2242 &fore_color
, &back_color
);
2243 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
2244 &fore_color
, &back_color
);
2247 if (FRAME_W32_WINDOW (f
) != 0)
2248 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
2250 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
2251 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
2252 f
->output_data
.w32
->text_cursor
= cursor
;
2254 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
2255 && f
->output_data
.w32
->nontext_cursor
!= 0)
2256 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
2257 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
2259 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
2260 && f
->output_data
.w32
->hourglass_cursor
!= 0)
2261 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
2262 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
2264 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
2265 && f
->output_data
.w32
->modeline_cursor
!= 0)
2266 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
2267 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
2269 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
2270 && f
->output_data
.w32
->cross_cursor
!= 0)
2271 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
2272 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
2274 XFlush (FRAME_W32_DISPLAY (f
));
2277 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
2278 #endif /* MAC_TODO */
2282 x_set_cursor_color (f
, arg
, oldval
)
2284 Lisp_Object arg
, oldval
;
2286 unsigned long fore_pixel
;
2288 if (!NILP (Vx_cursor_fore_pixel
))
2289 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
2290 WHITE_PIX_DEFAULT (f
));
2292 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2293 f
->output_data
.mac
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2295 /* Make sure that the cursor color differs from the background color. */
2296 if (f
->output_data
.mac
->cursor_pixel
== FRAME_BACKGROUND_PIXEL (f
))
2298 f
->output_data
.mac
->cursor_pixel
= f
->output_data
.mac
->mouse_pixel
;
2299 if (f
->output_data
.mac
->cursor_pixel
== fore_pixel
)
2300 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
2302 FRAME_FOREGROUND_PIXEL (f
) = fore_pixel
;
2304 #if 0 /* MAC_TODO: cannot figure out what to do (wrong number of params) */
2305 if (FRAME_MAC_WINDOW (f
) != 0)
2307 if (FRAME_VISIBLE_P (f
))
2309 x_display_cursor (f
, 0);
2310 x_display_cursor (f
, 1);
2315 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
2318 /* Set the border-color of frame F to pixel value PIX.
2319 Note that this does not fully take effect if done before
2322 x_set_border_pixel (f
, pix
)
2326 f
->output_data
.mac
->border_pixel
= pix
;
2328 if (FRAME_MAC_WINDOW (f
) != 0 && f
->output_data
.mac
->border_width
> 0)
2330 if (FRAME_VISIBLE_P (f
))
2335 /* Set the border-color of frame F to value described by ARG.
2336 ARG can be a string naming a color.
2337 The border-color is used for the border that is drawn by the server.
2338 Note that this does not fully take effect if done before
2339 F has a window; it must be redone when the window is created. */
2342 x_set_border_color (f
, arg
, oldval
)
2344 Lisp_Object arg
, oldval
;
2348 CHECK_STRING (arg
, 0);
2349 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2350 x_set_border_pixel (f
, pix
);
2351 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
2354 /* Value is the internal representation of the specified cursor type
2355 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
2356 of the bar cursor. */
2358 enum text_cursor_kinds
2359 x_specified_cursor_type (arg
, width
)
2363 enum text_cursor_kinds type
;
2370 else if (CONSP (arg
)
2371 && EQ (XCAR (arg
), Qbar
)
2372 && INTEGERP (XCDR (arg
))
2373 && XINT (XCDR (arg
)) >= 0)
2376 *width
= XINT (XCDR (arg
));
2378 else if (NILP (arg
))
2381 /* Treat anything unknown as "box cursor".
2382 It was bad to signal an error; people have trouble fixing
2383 .Xdefaults with Emacs, when it has something bad in it. */
2384 type
= FILLED_BOX_CURSOR
;
2390 x_set_cursor_type (f
, arg
, oldval
)
2392 Lisp_Object arg
, oldval
;
2396 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
2397 f
->output_data
.mac
->cursor_width
= width
;
2399 /* Make sure the cursor gets redrawn. This is overkill, but how
2400 often do people change cursor types? */
2401 update_mode_lines
++;
2404 #if 0 /* MAC_TODO: really no icon for Mac */
2406 x_set_icon_type (f
, arg
, oldval
)
2408 Lisp_Object arg
, oldval
;
2412 if (NILP (arg
) && NILP (oldval
))
2415 if (STRINGP (arg
) && STRINGP (oldval
)
2416 && EQ (Fstring_equal (oldval
, arg
), Qt
))
2419 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
2424 result
= x_bitmap_icon (f
, arg
);
2428 error ("No icon window available");
2435 /* Return non-nil if frame F wants a bitmap icon. */
2443 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
2451 x_set_icon_name (f
, arg
, oldval
)
2453 Lisp_Object arg
, oldval
;
2459 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2462 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2468 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2473 result
= x_text_icon (f
,
2474 (char *) XSTRING ((!NILP (f
->icon_name
)
2483 error ("No icon window available");
2486 /* If the window was unmapped (and its icon was mapped),
2487 the new icon is not mapped, so map the window in its stead. */
2488 if (FRAME_VISIBLE_P (f
))
2490 #ifdef USE_X_TOOLKIT
2491 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2493 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2496 XFlush (FRAME_W32_DISPLAY (f
));
2501 extern Lisp_Object
x_new_font ();
2502 extern Lisp_Object
x_new_fontset();
2505 x_set_font (f
, arg
, oldval
)
2507 Lisp_Object arg
, oldval
;
2510 Lisp_Object fontset_name
;
2513 CHECK_STRING (arg
, 1);
2515 fontset_name
= Fquery_fontset (arg
, Qnil
);
2518 result
= (STRINGP (fontset_name
)
2519 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
2520 : x_new_font (f
, XSTRING (arg
)->data
));
2523 if (EQ (result
, Qnil
))
2524 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
2525 else if (EQ (result
, Qt
))
2526 error ("The characters of the given font have varying widths");
2527 else if (STRINGP (result
))
2529 if (!NILP (Fequal (result
, oldval
)))
2531 store_frame_param (f
, Qfont
, result
);
2532 recompute_basic_faces (f
);
2537 do_pending_window_change (0);
2539 /* Don't call `face-set-after-frame-default' when faces haven't been
2540 initialized yet. This is the case when called from
2541 Fx_create_frame. In that case, the X widget or window doesn't
2542 exist either, and we can end up in x_report_frame_params with a
2543 null widget which gives a segfault. */
2544 if (FRAME_FACE_CACHE (f
))
2546 XSETFRAME (frame
, f
);
2547 call1 (Qface_set_after_frame_default
, frame
);
2552 x_set_border_width (f
, arg
, oldval
)
2554 Lisp_Object arg
, oldval
;
2556 CHECK_NUMBER (arg
, 0);
2558 if (XINT (arg
) == f
->output_data
.mac
->border_width
)
2562 if (FRAME_MAC_WINDOW (f
) != 0)
2563 error ("Cannot change the border width of a window");
2566 f
->output_data
.mac
->border_width
= XINT (arg
);
2570 x_set_internal_border_width (f
, arg
, oldval
)
2572 Lisp_Object arg
, oldval
;
2574 int old
= f
->output_data
.mac
->internal_border_width
;
2576 CHECK_NUMBER (arg
, 0);
2577 f
->output_data
.mac
->internal_border_width
= XINT (arg
);
2578 if (f
->output_data
.mac
->internal_border_width
< 0)
2579 f
->output_data
.mac
->internal_border_width
= 0;
2581 if (f
->output_data
.mac
->internal_border_width
== old
)
2584 if (FRAME_MAC_WINDOW (f
) != 0)
2586 x_set_window_size (f
, 0, f
->width
, f
->height
);
2587 SET_FRAME_GARBAGED (f
);
2588 do_pending_window_change (0);
2593 x_set_visibility (f
, value
, oldval
)
2595 Lisp_Object value
, oldval
;
2598 XSETFRAME (frame
, f
);
2601 Fmake_frame_invisible (frame
, Qt
);
2602 else if (EQ (value
, Qicon
))
2603 Ficonify_frame (frame
);
2605 Fmake_frame_visible (frame
);
2609 /* Change window heights in windows rooted in WINDOW by N lines. */
2612 x_change_window_heights (window
, n
)
2616 struct window
*w
= XWINDOW (window
);
2618 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
2619 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
2621 if (INTEGERP (w
->orig_top
))
2622 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
2623 if (INTEGERP (w
->orig_height
))
2624 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
2626 /* Handle just the top child in a vertical split. */
2627 if (!NILP (w
->vchild
))
2628 x_change_window_heights (w
->vchild
, n
);
2630 /* Adjust all children in a horizontal split. */
2631 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
2633 w
= XWINDOW (window
);
2634 x_change_window_heights (window
, n
);
2639 x_set_menu_bar_lines (f
, value
, oldval
)
2641 Lisp_Object value
, oldval
;
2644 int olines
= FRAME_MENU_BAR_LINES (f
);
2646 /* Right now, menu bars don't work properly in minibuf-only frames;
2647 most of the commands try to apply themselves to the minibuffer
2648 frame itself, and get an error because you can't switch buffers
2649 in or split the minibuffer window. */
2650 if (FRAME_MINIBUF_ONLY_P (f
))
2653 if (INTEGERP (value
))
2654 nlines
= XINT (value
);
2658 FRAME_MENU_BAR_LINES (f
) = 0;
2660 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2663 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2664 free_frame_menubar (f
);
2665 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2667 /* Adjust the frame size so that the client (text) dimensions
2668 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2670 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2671 do_pending_window_change (0);
2676 /* Set the number of lines used for the tool bar of frame F to VALUE.
2677 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2678 is the old number of tool bar lines. This function changes the
2679 height of all windows on frame F to match the new tool bar height.
2680 The frame's height doesn't change. */
2683 x_set_tool_bar_lines (f
, value
, oldval
)
2685 Lisp_Object value
, oldval
;
2687 int delta
, nlines
, root_height
;
2688 Lisp_Object root_window
;
2690 /* Treat tool bars like menu bars. */
2691 if (FRAME_MINIBUF_ONLY_P (f
))
2694 /* Use VALUE only if an integer >= 0. */
2695 if (INTEGERP (value
) && XINT (value
) >= 0)
2696 nlines
= XFASTINT (value
);
2700 /* Make sure we redisplay all windows in this frame. */
2701 ++windows_or_buffers_changed
;
2703 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2705 /* Don't resize the tool-bar to more than we have room for. */
2706 root_window
= FRAME_ROOT_WINDOW (f
);
2707 root_height
= XINT (XWINDOW (root_window
)->height
);
2708 if (root_height
- delta
< 1)
2710 delta
= root_height
- 1;
2711 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2714 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2715 x_change_window_heights (root_window
, delta
);
2718 /* We also have to make sure that the internal border at the top of
2719 the frame, below the menu bar or tool bar, is redrawn when the
2720 tool bar disappears. This is so because the internal border is
2721 below the tool bar if one is displayed, but is below the menu bar
2722 if there isn't a tool bar. The tool bar draws into the area
2723 below the menu bar. */
2724 if (FRAME_MAC_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2728 clear_current_matrices (f
);
2729 updating_frame
= NULL
;
2732 /* If the tool bar gets smaller, the internal border below it
2733 has to be cleared. It was formerly part of the display
2734 of the larger tool bar, and updating windows won't clear it. */
2737 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2738 int width
= PIXEL_WIDTH (f
);
2739 int y
= nlines
* CANON_Y_UNIT (f
);
2742 XClearArea (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
),
2743 0, y
, width
, height
, 0);
2749 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2752 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2753 name; if NAME is a string, set F's name to NAME and set
2754 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2756 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2757 suggesting a new name, which lisp code should override; if
2758 F->explicit_name is set, ignore the new name; otherwise, set it. */
2761 x_set_name (f
, name
, explicit)
2766 /* Make sure that requests from lisp code override requests from
2767 Emacs redisplay code. */
2770 /* If we're switching from explicit to implicit, we had better
2771 update the mode lines and thereby update the title. */
2772 if (f
->explicit_name
&& NILP (name
))
2773 update_mode_lines
= 1;
2775 f
->explicit_name
= ! NILP (name
);
2777 else if (f
->explicit_name
)
2780 /* If NAME is nil, set the name to the w32_id_name. */
2783 /* Check for no change needed in this very common case
2784 before we do any consing. */
2785 if (!strcmp (FRAME_MAC_DISPLAY_INFO (f
)->mac_id_name
,
2786 XSTRING (f
->name
)->data
))
2788 name
= build_string (FRAME_MAC_DISPLAY_INFO (f
)->mac_id_name
);
2791 CHECK_STRING (name
, 0);
2793 /* Don't change the name if it's already NAME. */
2794 if (! NILP (Fstring_equal (name
, f
->name
)))
2799 /* For setting the frame title, the title parameter should override
2800 the name parameter. */
2801 if (! NILP (f
->title
))
2804 if (FRAME_MAC_WINDOW (f
))
2806 if (STRING_MULTIBYTE (name
))
2807 #if 0 /* MAC_TODO: encoding title string */
2808 name
= ENCODE_SYSTEM (name
);
2817 if (strlen (XSTRING (name
)->data
) < 255)
2819 strcpy (windowTitle
, XSTRING (name
)->data
);
2820 c2pstr (windowTitle
);
2821 SetWTitle (FRAME_MAC_WINDOW (f
), windowTitle
);
2829 /* This function should be called when the user's lisp code has
2830 specified a name for the frame; the name will override any set by the
2833 x_explicitly_set_name (f
, arg
, oldval
)
2835 Lisp_Object arg
, oldval
;
2837 x_set_name (f
, arg
, 1);
2840 /* This function should be called by Emacs redisplay code to set the
2841 name; names set this way will never override names set by the user's
2844 x_implicitly_set_name (f
, arg
, oldval
)
2846 Lisp_Object arg
, oldval
;
2848 x_set_name (f
, arg
, 0);
2851 /* Change the title of frame F to NAME.
2852 If NAME is nil, use the frame name as the title.
2854 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2855 name; if NAME is a string, set F's name to NAME and set
2856 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2858 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2859 suggesting a new name, which lisp code should override; if
2860 F->explicit_name is set, ignore the new name; otherwise, set it. */
2863 x_set_title (f
, name
, old_name
)
2865 Lisp_Object name
, old_name
;
2867 /* Don't change the title if it's already NAME. */
2868 if (EQ (name
, f
->title
))
2871 update_mode_lines
= 1;
2878 if (FRAME_MAC_WINDOW (f
))
2880 if (STRING_MULTIBYTE (name
))
2881 #if 0 /* MAC_TODO: encoding title string */
2882 name
= ENCODE_SYSTEM (name
);
2891 if (strlen (XSTRING (name
)->data
) < 255)
2893 strcpy (windowTitle
, XSTRING (name
)->data
);
2894 c2pstr (windowTitle
);
2895 SetWTitle (FRAME_MAC_WINDOW (f
), windowTitle
);
2904 x_set_autoraise (f
, arg
, oldval
)
2906 Lisp_Object arg
, oldval
;
2908 f
->auto_raise
= !EQ (Qnil
, arg
);
2912 x_set_autolower (f
, arg
, oldval
)
2914 Lisp_Object arg
, oldval
;
2916 f
->auto_lower
= !EQ (Qnil
, arg
);
2920 x_set_unsplittable (f
, arg
, oldval
)
2922 Lisp_Object arg
, oldval
;
2924 f
->no_split
= !NILP (arg
);
2928 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2930 Lisp_Object arg
, oldval
;
2932 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2933 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2934 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2935 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2937 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2939 ? vertical_scroll_bar_none
2941 ? vertical_scroll_bar_right
2942 : vertical_scroll_bar_left
);
2944 /* We set this parameter before creating the window for the
2945 frame, so we can get the geometry right from the start.
2946 However, if the window hasn't been created yet, we shouldn't
2947 call x_set_window_size. */
2948 if (FRAME_MAC_WINDOW (f
))
2949 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2950 do_pending_window_change (0);
2955 x_set_scroll_bar_width (f
, arg
, oldval
)
2957 Lisp_Object arg
, oldval
;
2959 /* Imitate X without X Toolkit */
2961 int wid
= FONT_WIDTH (f
->output_data
.mac
->font
);
2965 /* Make the actual width at least 14 pixels and a multiple of a
2967 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2969 /* Use all of that space (aside from required margins) for the
2971 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2973 if (FRAME_MAC_WINDOW (f
))
2974 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2975 do_pending_window_change (0);
2977 else if (INTEGERP (arg
) && XINT (arg
) > 0
2978 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2980 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2981 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2983 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2984 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2985 if (FRAME_MAC_WINDOW (f
))
2986 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2987 do_pending_window_change (0);
2989 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2990 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2991 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2994 /* Subroutines of creating an frame. */
2996 /* Make sure that Vx_resource_name is set to a reasonable value.
2997 Fix it up, or set it to `emacs' if it is too hopeless. */
3000 validate_x_resource_name ()
3003 /* Number of valid characters in the resource name. */
3005 /* Number of invalid characters in the resource name. */
3010 if (STRINGP (Vx_resource_name
))
3012 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
3015 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
3017 /* Only letters, digits, - and _ are valid in resource names.
3018 Count the valid characters and count the invalid ones. */
3019 for (i
= 0; i
< len
; i
++)
3022 if (! ((c
>= 'a' && c
<= 'z')
3023 || (c
>= 'A' && c
<= 'Z')
3024 || (c
>= '0' && c
<= '9')
3025 || c
== '-' || c
== '_'))
3032 /* Not a string => completely invalid. */
3033 bad_count
= 5, good_count
= 0;
3035 /* If name is valid already, return. */
3039 /* If name is entirely invalid, or nearly so, use `emacs'. */
3041 || (good_count
== 1 && bad_count
> 0))
3043 Vx_resource_name
= build_string ("emacs");
3047 /* Name is partly valid. Copy it and replace the invalid characters
3048 with underscores. */
3050 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
3052 for (i
= 0; i
< len
; i
++)
3054 int c
= XSTRING (new)->data
[i
];
3055 if (! ((c
>= 'a' && c
<= 'z')
3056 || (c
>= 'A' && c
<= 'Z')
3057 || (c
>= '0' && c
<= '9')
3058 || c
== '-' || c
== '_'))
3059 XSTRING (new)->data
[i
] = '_';
3064 #if 0 /* MAC_TODO: implement resource strings */
3065 extern char *x_get_string_resource ();
3067 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
3068 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
3069 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
3070 class, where INSTANCE is the name under which Emacs was invoked, or\n\
3071 the name specified by the `-name' or `-rn' command-line arguments.\n\
3073 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
3074 class, respectively. You must specify both of them or neither.\n\
3075 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
3076 and the class is `Emacs.CLASS.SUBCLASS'.")
3077 (attribute
, class, component
, subclass
)
3078 Lisp_Object attribute
, class, component
, subclass
;
3080 register char *value
;
3084 CHECK_STRING (attribute
, 0);
3085 CHECK_STRING (class, 0);
3087 if (!NILP (component
))
3088 CHECK_STRING (component
, 1);
3089 if (!NILP (subclass
))
3090 CHECK_STRING (subclass
, 2);
3091 if (NILP (component
) != NILP (subclass
))
3092 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3094 validate_x_resource_name ();
3096 /* Allocate space for the components, the dots which separate them,
3097 and the final '\0'. Make them big enough for the worst case. */
3098 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
3099 + (STRINGP (component
)
3100 ? STRING_BYTES (XSTRING (component
)) : 0)
3101 + STRING_BYTES (XSTRING (attribute
))
3104 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3105 + STRING_BYTES (XSTRING (class))
3106 + (STRINGP (subclass
)
3107 ? STRING_BYTES (XSTRING (subclass
)) : 0)
3110 /* Start with emacs.FRAMENAME for the name (the specific one)
3111 and with `Emacs' for the class key (the general one). */
3112 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
3113 strcpy (class_key
, EMACS_CLASS
);
3115 strcat (class_key
, ".");
3116 strcat (class_key
, XSTRING (class)->data
);
3118 if (!NILP (component
))
3120 strcat (class_key
, ".");
3121 strcat (class_key
, XSTRING (subclass
)->data
);
3123 strcat (name_key
, ".");
3124 strcat (name_key
, XSTRING (component
)->data
);
3127 strcat (name_key
, ".");
3128 strcat (name_key
, XSTRING (attribute
)->data
);
3130 value
= x_get_string_resource (Qnil
,
3131 name_key
, class_key
);
3133 if (value
!= (char *) 0)
3134 return build_string (value
);
3139 /* Used when C code wants a resource value. */
3142 x_get_resource_string (attribute
, class)
3143 char *attribute
, *class;
3147 struct frame
*sf
= SELECTED_FRAME ();
3149 /* Allocate space for the components, the dots which separate them,
3150 and the final '\0'. */
3151 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
3152 + strlen (attribute
) + 2);
3153 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
3154 + strlen (class) + 2);
3156 sprintf (name_key
, "%s.%s",
3157 XSTRING (Vinvocation_name
)->data
,
3159 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
3161 return x_get_string_resource (sf
, name_key
, class_key
);
3165 /* Types we might convert a resource string into. */
3175 /* Return the value of parameter PARAM.
3177 First search ALIST, then Vdefault_frame_alist, then the X defaults
3178 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3180 Convert the resource to the type specified by desired_type.
3182 If no default is specified, return Qunbound. If you call
3183 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
3184 and don't let it get stored in any Lisp-visible variables! */
3187 mac_get_arg (alist
, param
, attribute
, class, type
)
3188 Lisp_Object alist
, param
;
3191 enum resource_types type
;
3193 register Lisp_Object tem
;
3195 tem
= Fassq (param
, alist
);
3197 tem
= Fassq (param
, Vdefault_frame_alist
);
3201 #if 0 /* MAC_TODO: search resource also */
3204 tem
= Fx_get_resource (build_string (attribute
),
3205 build_string (class),
3213 case RES_TYPE_NUMBER
:
3214 return make_number (atoi (XSTRING (tem
)->data
));
3216 case RES_TYPE_FLOAT
:
3217 return make_float (atof (XSTRING (tem
)->data
));
3219 case RES_TYPE_BOOLEAN
:
3220 tem
= Fdowncase (tem
);
3221 if (!strcmp (XSTRING (tem
)->data
, "on")
3222 || !strcmp (XSTRING (tem
)->data
, "true"))
3227 case RES_TYPE_STRING
:
3230 case RES_TYPE_SYMBOL
:
3231 /* As a special case, we map the values `true' and `on'
3232 to Qt, and `false' and `off' to Qnil. */
3235 lower
= Fdowncase (tem
);
3236 if (!strcmp (XSTRING (lower
)->data
, "on")
3237 || !strcmp (XSTRING (lower
)->data
, "true"))
3239 else if (!strcmp (XSTRING (lower
)->data
, "off")
3240 || !strcmp (XSTRING (lower
)->data
, "false"))
3243 return Fintern (tem
, Qnil
);
3257 /* Record in frame F the specified or default value according to ALIST
3258 of the parameter named PROP (a Lisp symbol).
3259 If no value is specified for PROP, look for an X default for XPROP
3260 on the frame named NAME.
3261 If that is not found either, use the value DEFLT. */
3264 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
3271 enum resource_types type
;
3275 tem
= mac_get_arg (alist
, prop
, xprop
, xclass
, type
);
3276 if (EQ (tem
, Qunbound
))
3278 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
3282 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
3283 "Parse an X-style geometry string STRING.\n\
3284 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
3285 The properties returned may include `top', `left', `height', and `width'.\n\
3286 The value of `left' or `top' may be an integer,\n\
3287 or a list (+ N) meaning N pixels relative to top/left corner,\n\
3288 or a list (- N) meaning -N pixels relative to bottom/right corner.")
3293 unsigned int width
, height
;
3296 CHECK_STRING (string
, 0);
3298 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
3299 &x
, &y
, &width
, &height
);
3302 if (geometry
& XValue
)
3304 Lisp_Object element
;
3306 if (x
>= 0 && (geometry
& XNegative
))
3307 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
3308 else if (x
< 0 && ! (geometry
& XNegative
))
3309 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
3311 element
= Fcons (Qleft
, make_number (x
));
3312 result
= Fcons (element
, result
);
3315 if (geometry
& YValue
)
3317 Lisp_Object element
;
3319 if (y
>= 0 && (geometry
& YNegative
))
3320 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3321 else if (y
< 0 && ! (geometry
& YNegative
))
3322 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3324 element
= Fcons (Qtop
, make_number (y
));
3325 result
= Fcons (element
, result
);
3328 if (geometry
& WidthValue
)
3329 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3330 if (geometry
& HeightValue
)
3331 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3336 /* Calculate the desired size and position of this window,
3337 and return the flags saying which aspects were specified.
3339 This function does not make the coordinates positive. */
3341 #define DEFAULT_ROWS 40
3342 #define DEFAULT_COLS 80
3345 x_figure_window_size (f
, parms
)
3349 register Lisp_Object tem0
, tem1
, tem2
;
3350 long window_prompting
= 0;
3352 /* Default values if we fall through.
3353 Actually, if that happens we should get
3354 window manager prompting. */
3355 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3356 f
->height
= DEFAULT_ROWS
;
3357 /* Window managers expect that if program-specified
3358 positions are not (0,0), they're intentional, not defaults. */
3359 f
->output_data
.mac
->top_pos
= 0;
3360 f
->output_data
.mac
->left_pos
= 0;
3362 tem0
= mac_get_arg (parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3363 tem1
= mac_get_arg (parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3364 tem2
= mac_get_arg (parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3365 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3367 if (!EQ (tem0
, Qunbound
))
3369 CHECK_NUMBER (tem0
, 0);
3370 f
->height
= XINT (tem0
);
3372 if (!EQ (tem1
, Qunbound
))
3374 CHECK_NUMBER (tem1
, 0);
3375 SET_FRAME_WIDTH (f
, XINT (tem1
));
3377 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3378 window_prompting
|= USSize
;
3380 window_prompting
|= PSize
;
3383 f
->output_data
.mac
->vertical_scroll_bar_extra
3384 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3386 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
3387 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
3388 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.mac
->font
)));
3389 f
->output_data
.mac
->flags_areas_extra
3390 = FRAME_FLAGS_AREA_WIDTH (f
);
3391 f
->output_data
.mac
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3392 f
->output_data
.mac
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3394 tem0
= mac_get_arg (parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3395 tem1
= mac_get_arg (parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3396 tem2
= mac_get_arg (parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3397 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3399 if (EQ (tem0
, Qminus
))
3401 f
->output_data
.mac
->top_pos
= 0;
3402 window_prompting
|= YNegative
;
3404 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3405 && CONSP (XCDR (tem0
))
3406 && INTEGERP (XCAR (XCDR (tem0
))))
3408 f
->output_data
.mac
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3409 window_prompting
|= YNegative
;
3411 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3412 && CONSP (XCDR (tem0
))
3413 && INTEGERP (XCAR (XCDR (tem0
))))
3415 f
->output_data
.mac
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3417 else if (EQ (tem0
, Qunbound
))
3418 f
->output_data
.mac
->top_pos
= 0;
3421 CHECK_NUMBER (tem0
, 0);
3422 f
->output_data
.mac
->top_pos
= XINT (tem0
);
3423 if (f
->output_data
.mac
->top_pos
< 0)
3424 window_prompting
|= YNegative
;
3427 if (EQ (tem1
, Qminus
))
3429 f
->output_data
.mac
->left_pos
= 0;
3430 window_prompting
|= XNegative
;
3432 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3433 && CONSP (XCDR (tem1
))
3434 && INTEGERP (XCAR (XCDR (tem1
))))
3436 f
->output_data
.mac
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3437 window_prompting
|= XNegative
;
3439 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3440 && CONSP (XCDR (tem1
))
3441 && INTEGERP (XCAR (XCDR (tem1
))))
3443 f
->output_data
.mac
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3445 else if (EQ (tem1
, Qunbound
))
3446 f
->output_data
.mac
->left_pos
= 0;
3449 CHECK_NUMBER (tem1
, 0);
3450 f
->output_data
.mac
->left_pos
= XINT (tem1
);
3451 if (f
->output_data
.mac
->left_pos
< 0)
3452 window_prompting
|= XNegative
;
3455 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3456 window_prompting
|= USPosition
;
3458 window_prompting
|= PPosition
;
3461 return window_prompting
;
3466 /* Create and set up the Mac window for frame F. */
3469 mac_window (f
, window_prompting
, minibuffer_only
)
3471 long window_prompting
;
3472 int minibuffer_only
;
3478 /* Use the resource name as the top-level window name
3479 for looking up resources. Make a non-Lisp copy
3480 for the window manager, so GC relocation won't bother it.
3482 Elsewhere we specify the window name for the window manager. */
3485 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3486 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3487 strcpy (f
->namebuf
, str
);
3490 SetRect (&r
, f
->output_data
.mac
->left_pos
, f
->output_data
.mac
->top_pos
,
3491 f
->output_data
.mac
->left_pos
+ PIXEL_WIDTH (f
),
3492 f
->output_data
.mac
->top_pos
+ PIXEL_HEIGHT (f
));
3493 FRAME_MAC_WINDOW (f
)
3494 = NewCWindow (NULL
, &r
, "\p", 1, zoomDocProc
, (WindowPtr
) -1, 1, (long) f
->output_data
.mac
);
3496 validate_x_resource_name ();
3498 /* x_set_name normally ignores requests to set the name if the
3499 requested name is the same as the current name. This is the one
3500 place where that assumption isn't correct; f->name is set, but
3501 the server hasn't been told. */
3504 int explicit = f
->explicit_name
;
3506 f
->explicit_name
= 0;
3509 x_set_name (f
, name
, explicit);
3512 ShowWindow (FRAME_MAC_WINDOW (f
));
3516 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3517 initialize_frame_menubar (f
);
3519 if (FRAME_MAC_WINDOW (f
) == 0)
3520 error ("Unable to create window");
3524 /* Handle the icon stuff for this window. Perhaps later we might
3525 want an x_set_icon_position which can be called interactively as
3533 Lisp_Object icon_x
, icon_y
;
3535 /* Set the position of the icon. Note that Windows 95 groups all
3536 icons in the tray. */
3537 icon_x
= mac_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3538 icon_y
= mac_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3539 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3541 CHECK_NUMBER (icon_x
, 0);
3542 CHECK_NUMBER (icon_y
, 0);
3544 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3545 error ("Both left and top icon corners of icon must be specified");
3549 if (! EQ (icon_x
, Qunbound
))
3550 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3553 /* Start up iconic or window? */
3554 x_wm_set_window_state
3555 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
3559 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3572 XGCValues gc_values
;
3576 /* Create the GC's of this frame.
3577 Note that many default values are used. */
3580 gc_values
.font
= f
->output_data
.mac
->font
;
3581 gc_values
.foreground
= f
->output_data
.mac
->foreground_pixel
;
3582 gc_values
.background
= f
->output_data
.mac
->background_pixel
;
3583 f
->output_data
.mac
->normal_gc
= XCreateGC (FRAME_MAC_DISPLAY (f
),
3584 FRAME_MAC_WINDOW (f
),
3585 GCFont
| GCForeground
| GCBackground
,
3588 /* Reverse video style. */
3589 gc_values
.foreground
= f
->output_data
.mac
->background_pixel
;
3590 gc_values
.background
= f
->output_data
.mac
->foreground_pixel
;
3591 f
->output_data
.mac
->reverse_gc
= XCreateGC (FRAME_MAC_DISPLAY (f
),
3592 FRAME_MAC_WINDOW (f
),
3593 GCFont
| GCForeground
| GCBackground
,
3596 /* Cursor has cursor-color background, background-color foreground. */
3597 gc_values
.foreground
= f
->output_data
.mac
->background_pixel
;
3598 gc_values
.background
= f
->output_data
.mac
->cursor_pixel
;
3599 f
->output_data
.mac
->cursor_gc
= XCreateGC (FRAME_MAC_DISPLAY (f
),
3600 FRAME_MAC_WINDOW (f
),
3601 GCFont
| GCForeground
| GCBackground
,
3605 f
->output_data
.mac
->white_relief
.gc
= 0;
3606 f
->output_data
.mac
->black_relief
.gc
= 0;
3612 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3614 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
3615 Returns an Emacs frame object.\n\
3616 ALIST is an alist of frame parameters.\n\
3617 If the parameters specify that the frame should not have a minibuffer,\n\
3618 and do not specify a specific minibuffer window to use,\n\
3619 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3620 be shared by the new frame.\n\
3622 This function is an internal primitive--use `make-frame' instead.")
3627 Lisp_Object frame
, tem
;
3629 int minibuffer_only
= 0;
3630 long window_prompting
= 0;
3632 int count
= BINDING_STACK_SIZE ();
3633 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3634 Lisp_Object display
;
3635 struct mac_display_info
*dpyinfo
= NULL
;
3638 char x_frame_name
[10];
3639 static int x_frame_count
= 2; /* starts from 2 because terminal frame is F1 */
3643 /* Use this general default value to start with
3644 until we know if this frame has a specified name. */
3645 Vx_resource_name
= Vinvocation_name
;
3647 display
= mac_get_arg (parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3648 if (EQ (display
, Qunbound
))
3650 dpyinfo
= check_x_display_info (display
);
3652 kb
= dpyinfo
->kboard
;
3654 kb
= &the_only_kboard
;
3657 name
= mac_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3659 && ! EQ (name
, Qunbound
)
3661 error ("Invalid frame name--not a string or nil");
3664 Vx_resource_name
= name
;
3666 /* See if parent window is specified. */
3667 parent
= mac_get_arg (parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3668 if (EQ (parent
, Qunbound
))
3670 if (! NILP (parent
))
3671 CHECK_NUMBER (parent
, 0);
3673 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3674 /* No need to protect DISPLAY because that's not used after passing
3675 it to make_frame_without_minibuffer. */
3677 GCPRO4 (parms
, parent
, name
, frame
);
3678 tem
= mac_get_arg (parms
, Qminibuffer
, 0, 0, RES_TYPE_SYMBOL
);
3679 if (EQ (tem
, Qnone
) || NILP (tem
))
3680 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3681 else if (EQ (tem
, Qonly
))
3683 f
= make_minibuffer_frame ();
3684 minibuffer_only
= 1;
3686 else if (WINDOWP (tem
))
3687 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3691 if (EQ (name
, Qunbound
) || NILP (name
))
3693 sprintf (x_frame_name
, "F%d", x_frame_count
++);
3694 f
->name
= build_string (x_frame_name
);
3695 f
->explicit_name
= 0;
3700 f
->explicit_name
= 1;
3703 XSETFRAME (frame
, f
);
3705 /* Note that X Windows does support scroll bars. */
3706 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3708 f
->output_method
= output_mac
;
3709 f
->output_data
.mac
= (struct mac_output
*) xmalloc (sizeof (struct mac_output
));
3710 bzero (f
->output_data
.mac
, sizeof (struct mac_output
));
3711 f
->output_data
.mac
->fontset
= -1;
3712 f
->output_data
.mac
->scroll_bar_foreground_pixel
= -1;
3713 f
->output_data
.mac
->scroll_bar_background_pixel
= -1;
3716 FRAME_FONTSET (f
) = -1;
3720 = mac_get_arg (parms
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
3721 if (! STRINGP (f
->icon_name
))
3722 f
->icon_name
= Qnil
;
3724 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
3726 FRAME_KBOARD (f
) = kb
;
3729 /* Specify the parent under which to make this window. */
3733 f
->output_data
.mac
->parent_desc
= (Window
) parent
;
3734 f
->output_data
.mac
->explicit_parent
= 1;
3738 f
->output_data
.mac
->parent_desc
= FRAME_MAC_DISPLAY_INFO (f
)->root_window
;
3739 f
->output_data
.mac
->explicit_parent
= 0;
3742 /* Set the name; the functions to which we pass f expect the name to
3744 if (EQ (name
, Qunbound
) || NILP (name
))
3746 f
->name
= build_string (dpyinfo
->mac_id_name
);
3747 f
->explicit_name
= 0;
3752 f
->explicit_name
= 1;
3753 /* use the frame's title when getting resources for this frame. */
3754 specbind (Qx_resource_name
, name
);
3757 /* Extract the window parameters from the supplied values
3758 that are needed to determine window geometry. */
3762 font
= mac_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3765 /* First, try whatever font the caller has specified. */
3768 tem
= Fquery_fontset (font
, Qnil
);
3770 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3772 font
= x_new_font (f
, XSTRING (font
)->data
);
3774 /* Try out a font which we hope has bold and italic variations. */
3775 if (! STRINGP (font
))
3776 font
= x_new_font (f
, "-ETL-fixed-medium-r-*--*-160-*-*-*-*-iso8859-1");
3777 /* If those didn't work, look for something which will at least work. */
3778 if (!STRINGP (font
))
3779 font
= x_new_font (f
, "-*-monaco-*-12-*-mac-roman");
3780 if (! STRINGP (font
))
3781 font
= x_new_font (f
, "-*-courier-*-10-*-mac-roman");
3782 if (! STRINGP (font
))
3783 error ("Cannot find any usable font");
3786 x_default_parameter (f
, parms
, Qfont
, font
,
3787 "font", "Font", RES_TYPE_STRING
);
3790 x_default_parameter (f
, parms
, Qborder_width
, make_number (0),
3791 "borderwidth", "BorderWidth", RES_TYPE_NUMBER
);
3792 /* This defaults to 2 in order to match xterm. We recognize either
3793 internalBorderWidth or internalBorder (which is what xterm calls
3795 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3799 value
= mac_get_arg (parms
, Qinternal_border_width
,
3800 "internalBorder", "BorderWidth", RES_TYPE_NUMBER
);
3801 if (! EQ (value
, Qunbound
))
3802 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3806 /* Default internalBorderWidth to 0 on Windows to match other programs. */
3807 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
3808 "internalBorderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3810 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
3811 "verticalScrollBars", "ScrollBars", RES_TYPE_BOOLEAN
);
3813 /* Also do the stuff which must be set before the window exists. */
3814 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3815 "foreground", "Foreground", RES_TYPE_STRING
);
3816 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3817 "background", "Background", RES_TYPE_STRING
);
3818 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3819 "pointerColor", "Foreground", RES_TYPE_STRING
);
3820 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3821 "cursorColor", "Foreground", RES_TYPE_STRING
);
3822 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3823 "borderColor", "BorderColor", RES_TYPE_STRING
);
3824 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
3825 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
3826 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
3827 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
3829 /* Init faces before x_default_parameter is called for scroll-bar
3830 parameters because that function calls x_set_scroll_bar_width,
3831 which calls change_frame_size, which calls Fset_window_buffer,
3832 which runs hooks, which call Fvertical_motion. At the end, we
3833 end up in init_iterator with a null face cache, which should not
3835 init_frame_faces (f
);
3837 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3838 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
3839 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
3840 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
3842 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3843 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
3845 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
3846 "title", "Title", RES_TYPE_STRING
);
3848 f
->output_data
.mac
->parent_desc
= FRAME_MAC_DISPLAY_INFO (f
)->root_window
;
3849 window_prompting
= x_figure_window_size (f
, parms
);
3851 if (window_prompting
& XNegative
)
3853 if (window_prompting
& YNegative
)
3854 f
->output_data
.mac
->win_gravity
= SouthEastGravity
;
3856 f
->output_data
.mac
->win_gravity
= NorthEastGravity
;
3860 if (window_prompting
& YNegative
)
3861 f
->output_data
.mac
->win_gravity
= SouthWestGravity
;
3863 f
->output_data
.mac
->win_gravity
= NorthWestGravity
;
3866 f
->output_data
.mac
->size_hint_flags
= window_prompting
;
3868 tem
= mac_get_arg (parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
3869 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3871 /* Create the window. Add the tool-bar height to the initial frame
3872 height so that the user gets a text display area of the size he
3873 specified with -g or via the registry. Later changes of the
3874 tool-bar height don't change the frame size. This is done so that
3875 users can create tall Emacs frames without having to guess how
3876 tall the tool-bar will get. */
3877 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
3879 /* mac_window (f, window_prompting, minibuffer_only); */
3886 /* Now consider the frame official. */
3887 FRAME_MAC_DISPLAY_INFO (f
)->reference_count
++;
3888 Vframe_list
= Fcons (frame
, Vframe_list
);
3890 /* We need to do this after creating the window, so that the
3891 icon-creation functions can say whose icon they're describing. */
3892 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3893 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
3895 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3896 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3897 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3898 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3899 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3900 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
3901 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3902 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
3904 /* Dimensions, especially f->height, must be done via change_frame_size.
3905 Change will not be effected unless different from the current
3911 SET_FRAME_WIDTH (f
, 0);
3912 change_frame_size (f
, height
, width
, 1, 0, 0);
3914 /* Set up faces after all frame parameters are known. */
3915 call1 (Qface_set_after_frame_default
, frame
);
3917 #if 0 /* MAC_TODO: when we have window manager hints */
3918 /* Tell the server what size and position, etc, we want, and how
3919 badly we want them. This should be done after we have the menu
3920 bar so that its size can be taken into account. */
3922 x_wm_set_size_hint (f
, window_prompting
, 0);
3926 /* Make the window appear on the frame and enable display, unless
3927 the caller says not to. However, with explicit parent, Emacs
3928 cannot control visibility, so don't try. */
3929 if (! f
->output_data
.mac
->explicit_parent
)
3931 Lisp_Object visibility
;
3933 visibility
= mac_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
3934 if (EQ (visibility
, Qunbound
))
3937 #if 0 /* MAC_TODO: really no iconify on Mac */
3938 if (EQ (visibility
, Qicon
))
3939 x_iconify_frame (f
);
3942 if (! NILP (visibility
))
3943 x_make_frame_visible (f
);
3945 /* Must have been Qnil. */
3950 return unbind_to (count
, frame
);
3953 /* FRAME is used only to get a handle on the X display. We don't pass the
3954 display info directly because we're called from frame.c, which doesn't
3955 know about that structure. */
3957 x_get_focus_frame (frame
)
3958 struct frame
*frame
;
3960 struct mac_display_info
*dpyinfo
= FRAME_MAC_DISPLAY_INFO (frame
);
3962 if (! dpyinfo
->x_focus_frame
)
3965 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3969 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
3970 "Internal function called by `color-defined-p', which see.")
3972 Lisp_Object color
, frame
;
3975 FRAME_PTR f
= check_x_frame (frame
);
3977 CHECK_STRING (color
, 1);
3979 if (mac_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3985 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
3986 "Internal function called by `color-values', which see.")
3988 Lisp_Object color
, frame
;
3991 FRAME_PTR f
= check_x_frame (frame
);
3993 CHECK_STRING (color
, 1);
3995 if (mac_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3999 rgb
[0] = make_number ((RED_FROM_ULONG (foo
.pixel
) << 8)
4000 | RED_FROM_ULONG (foo
.pixel
));
4001 rgb
[1] = make_number ((GREEN_FROM_ULONG (foo
.pixel
) << 8)
4002 | GREEN_FROM_ULONG (foo
.pixel
));
4003 rgb
[2] = make_number ((BLUE_FROM_ULONG (foo
.pixel
) << 8)
4004 | BLUE_FROM_ULONG (foo
.pixel
));
4005 return Flist (3, rgb
);
4011 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4012 "Internal function called by `display-color-p', which see.")
4014 Lisp_Object display
;
4016 struct mac_display_info
*dpyinfo
= check_x_display_info (display
);
4018 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
4024 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4026 "Return t if the X display supports shades of gray.\n\
4027 Note that color displays do support shades of gray.\n\
4028 The optional argument DISPLAY specifies which display to ask about.\n\
4029 DISPLAY should be either a frame or a display name (a string).\n\
4030 If omitted or nil, that stands for the selected frame's display.")
4032 Lisp_Object display
;
4034 struct mac_display_info
*dpyinfo
= check_x_display_info (display
);
4036 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
4042 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4044 "Returns the width in pixels of the X display DISPLAY.\n\
4045 The optional argument DISPLAY specifies which display to ask about.\n\
4046 DISPLAY should be either a frame or a display name (a string).\n\
4047 If omitted or nil, that stands for the selected frame's display.")
4049 Lisp_Object display
;
4051 struct mac_display_info
*dpyinfo
= check_x_display_info (display
);
4053 return make_number (dpyinfo
->width
);
4056 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4057 Sx_display_pixel_height
, 0, 1, 0,
4058 "Returns the height in pixels of the X display DISPLAY.\n\
4059 The optional argument DISPLAY specifies which display to ask about.\n\
4060 DISPLAY should be either a frame or a display name (a string).\n\
4061 If omitted or nil, that stands for the selected frame's display.")
4063 Lisp_Object display
;
4065 struct mac_display_info
*dpyinfo
= check_x_display_info (display
);
4067 return make_number (dpyinfo
->height
);
4070 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4072 "Returns the number of bitplanes of the display DISPLAY.\n\
4073 The optional argument DISPLAY specifies which display to ask about.\n\
4074 DISPLAY should be either a frame or a display name (a string).\n\
4075 If omitted or nil, that stands for the selected frame's display.")
4077 Lisp_Object display
;
4079 struct mac_display_info
*dpyinfo
= check_x_display_info (display
);
4081 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
4084 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4086 "Returns the number of color cells of the display DISPLAY.\n\
4087 The optional argument DISPLAY specifies which display to ask about.\n\
4088 DISPLAY should be either a frame or a display name (a string).\n\
4089 If omitted or nil, that stands for the selected frame's display.")
4091 Lisp_Object display
;
4093 struct mac_display_info
*dpyinfo
= check_x_display_info (display
);
4095 /* MAC_TODO: check whether this is right */
4096 return make_number ((unsigned long) (pow (2, dpyinfo
->n_cbits
)));
4099 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4100 Sx_server_max_request_size
,
4102 "Returns the maximum request size of the server of display DISPLAY.\n\
4103 The optional argument DISPLAY specifies which display to ask about.\n\
4104 DISPLAY should be either a frame or a display name (a string).\n\
4105 If omitted or nil, that stands for the selected frame's display.")
4107 Lisp_Object display
;
4109 struct mac_display_info
*dpyinfo
= check_x_display_info (display
);
4111 return make_number (1);
4114 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4115 "Returns the vendor ID string of the W32 system (Microsoft).\n\
4116 The optional argument DISPLAY specifies which display to ask about.\n\
4117 DISPLAY should be either a frame or a display name (a string).\n\
4118 If omitted or nil, that stands for the selected frame's display.")
4120 Lisp_Object display
;
4122 return build_string ("Apple Computers");
4125 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4126 "Returns the version numbers of the server of display DISPLAY.\n\
4127 The value is a list of three integers: the major and minor\n\
4128 version numbers, and the vendor-specific release\n\
4129 number. See also the function `x-server-vendor'.\n\n\
4130 The optional argument DISPLAY specifies which display to ask about.\n\
4131 DISPLAY should be either a frame or a display name (a string).\n\
4132 If omitted or nil, that stands for the selected frame's display.")
4134 Lisp_Object display
;
4136 int mac_major_version
, mac_minor_version
;
4139 if (Gestalt (gestaltSystemVersion
, &response
) != noErr
)
4140 error ("Cannot get Mac OS version");
4142 mac_major_version
= (response
>> 8) & 0xf;
4143 mac_minor_version
= (response
>> 4) & 0xf;
4145 return Fcons (make_number (mac_major_version
),
4146 Fcons (make_number (mac_minor_version
), Qnil
));
4149 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4150 "Returns the number of screens on the server of display DISPLAY.\n\
4151 The optional argument DISPLAY specifies which display to ask about.\n\
4152 DISPLAY should be either a frame or a display name (a string).\n\
4153 If omitted or nil, that stands for the selected frame's display.")
4155 Lisp_Object display
;
4157 return make_number (1);
4160 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4161 "Returns the height in millimeters of the X display DISPLAY.\n\
4162 The optional argument DISPLAY specifies which display to ask about.\n\
4163 DISPLAY should be either a frame or a display name (a string).\n\
4164 If omitted or nil, that stands for the selected frame's display.")
4166 Lisp_Object display
;
4168 /* MAC_TODO: this is an approximation, and only of the main display */
4170 struct mac_display_info
*dpyinfo
= check_x_display_info (display
);
4175 return make_number ((int) (v
/ 72.0 * 25.4));
4178 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4179 "Returns the width in millimeters of the X display DISPLAY.\n\
4180 The optional argument DISPLAY specifies which display to ask about.\n\
4181 DISPLAY should be either a frame or a display name (a string).\n\
4182 If omitted or nil, that stands for the selected frame's display.")
4184 Lisp_Object display
;
4186 /* MAC_TODO: this is an approximation, and only of the main display */
4188 struct mac_display_info
*dpyinfo
= check_x_display_info (display
);
4193 return make_number ((int) (h
/ 72.0 * 25.4));
4196 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4197 Sx_display_backing_store
, 0, 1, 0,
4198 "Returns an indication of whether display DISPLAY does backing store.\n\
4199 The value may be `always', `when-mapped', or `not-useful'.\n\
4200 The optional argument DISPLAY specifies which display to ask about.\n\
4201 DISPLAY should be either a frame or a display name (a string).\n\
4202 If omitted or nil, that stands for the selected frame's display.")
4204 Lisp_Object display
;
4206 return intern ("not-useful");
4209 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4210 Sx_display_visual_class
, 0, 1, 0,
4211 "Returns the visual class of the display DISPLAY.\n\
4212 The value is one of the symbols `static-gray', `gray-scale',\n\
4213 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4214 The optional argument DISPLAY specifies which display to ask about.\n\
4215 DISPLAY should be either a frame or a display name (a string).\n\
4216 If omitted or nil, that stands for the selected frame's display.")
4218 Lisp_Object display
;
4220 struct mac_display_info
*dpyinfo
= check_x_display_info (display
);
4223 switch (dpyinfo
->visual
->class)
4225 case StaticGray
: return (intern ("static-gray"));
4226 case GrayScale
: return (intern ("gray-scale"));
4227 case StaticColor
: return (intern ("static-color"));
4228 case PseudoColor
: return (intern ("pseudo-color"));
4229 case TrueColor
: return (intern ("true-color"));
4230 case DirectColor
: return (intern ("direct-color"));
4232 error ("Display has an unknown visual class");
4236 error ("Display has an unknown visual class");
4239 DEFUN ("x-display-save-under", Fx_display_save_under
,
4240 Sx_display_save_under
, 0, 1, 0,
4241 "Returns t if the display DISPLAY supports the save-under feature.\n\
4242 The optional argument DISPLAY specifies which display to ask about.\n\
4243 DISPLAY should be either a frame or a display name (a string).\n\
4244 If omitted or nil, that stands for the selected frame's display.")
4246 Lisp_Object display
;
4253 register struct frame
*f
;
4255 return PIXEL_WIDTH (f
);
4260 register struct frame
*f
;
4262 return PIXEL_HEIGHT (f
);
4267 register struct frame
*f
;
4269 return FONT_WIDTH (f
->output_data
.mac
->font
);
4274 register struct frame
*f
;
4276 return f
->output_data
.mac
->line_height
;
4281 register struct frame
*f
;
4283 return FRAME_MAC_DISPLAY_INFO (f
)->n_planes
;
4286 /* Return the display structure for the display named NAME.
4287 Open a new connection if necessary. */
4289 struct mac_display_info
*
4290 x_display_info_for_name (name
)
4294 struct mac_display_info
*dpyinfo
;
4296 CHECK_STRING (name
, 0);
4298 for (dpyinfo
= &one_mac_display_info
, names
= x_display_name_list
;
4300 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
4303 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
4308 /* Use this general default value to start with. */
4309 Vx_resource_name
= Vinvocation_name
;
4311 validate_x_resource_name ();
4313 dpyinfo
= x_term_init (name
, (unsigned char *) 0,
4314 (char *) XSTRING (Vx_resource_name
)->data
);
4317 error ("Cannot connect to server %s", XSTRING (name
)->data
);
4320 XSETFASTINT (Vwindow_system_version
, 3);
4325 #if 0 /* MAC_TODO: implement network support */
4326 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4327 1, 3, 0, "Open a connection to a server.\n\
4328 DISPLAY is the name of the display to connect to.\n\
4329 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4330 If the optional third arg MUST-SUCCEED is non-nil,\n\
4331 terminate Emacs if we can't open the connection.")
4332 (display
, xrm_string
, must_succeed
)
4333 Lisp_Object display
, xrm_string
, must_succeed
;
4335 unsigned char *xrm_option
;
4336 struct mac_display_info
*dpyinfo
;
4338 CHECK_STRING (display
, 0);
4339 if (! NILP (xrm_string
))
4340 CHECK_STRING (xrm_string
, 1);
4342 if (! EQ (Vwindow_system
, intern ("mac")))
4343 error ("Not using Mac OS");
4345 if (! NILP (xrm_string
))
4346 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4348 xrm_option
= (unsigned char *) 0;
4350 validate_x_resource_name ();
4352 /* This is what opens the connection and sets x_current_display.
4353 This also initializes many symbols, such as those used for input. */
4354 dpyinfo
= mac_term_init (display
, xrm_option
,
4355 (char *) XSTRING (Vx_resource_name
)->data
);
4359 if (!NILP (must_succeed
))
4360 fatal ("Cannot connect to server %s.\n",
4361 XSTRING (display
)->data
);
4363 error ("Cannot connect to server %s", XSTRING (display
)->data
);
4368 XSETFASTINT (Vwindow_system_version
, 3);
4372 DEFUN ("x-close-connection", Fx_close_connection
,
4373 Sx_close_connection
, 1, 1, 0,
4374 "Close the connection to DISPLAY's server.\n\
4375 For DISPLAY, specify either a frame or a display name (a string).\n\
4376 If DISPLAY is nil, that stands for the selected frame's display.")
4378 Lisp_Object display
;
4380 struct mac_display_info
*dpyinfo
= check_x_display_info (display
);
4383 if (dpyinfo
->reference_count
> 0)
4384 error ("Display still has frames on it");
4387 /* Free the fonts in the font table. */
4388 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4389 if (dpyinfo
->font_table
[i
].name
)
4391 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
4392 xfree (dpyinfo
->font_table
[i
].full_name
);
4393 xfree (dpyinfo
->font_table
[i
].name
);
4394 x_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
4396 x_destroy_all_bitmaps (dpyinfo
);
4398 x_delete_display (dpyinfo
);
4405 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4406 "Return the list of display names that Emacs has connections to.")
4409 Lisp_Object tail
, result
;
4412 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
4413 result
= Fcons (XCAR (XCAR (tail
)), result
);
4418 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4419 "If ON is non-nil, report errors as soon as the erring request is made.\n\
4420 If ON is nil, allow buffering of requests.\n\
4421 This is a noop on W32 systems.\n\
4422 The optional second argument DISPLAY specifies which display to act on.\n\
4423 DISPLAY should be either a frame or a display name (a string).\n\
4424 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4426 Lisp_Object display
, on
;
4432 /***********************************************************************
4434 ***********************************************************************/
4436 /* Value is the number of elements of vector VECTOR. */
4438 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4440 /* List of supported image types. Use define_image_type to add new
4441 types. Use lookup_image_type to find a type for a given symbol. */
4443 static struct image_type
*image_types
;
4445 /* The symbol `image' which is the car of the lists used to represent
4448 extern Lisp_Object Qimage
;
4450 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4456 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
4457 extern Lisp_Object QCdata
;
4458 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
4459 Lisp_Object QCconversion
, QCcolor_symbols
, QCheuristic_mask
;
4460 Lisp_Object QCindex
;
4462 /* Other symbols. */
4464 Lisp_Object Qlaplace
;
4466 /* Time in seconds after which images should be removed from the cache
4467 if not displayed. */
4469 Lisp_Object Vimage_cache_eviction_delay
;
4471 /* Function prototypes. */
4473 static void define_image_type
P_ ((struct image_type
*type
));
4474 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
4475 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
4476 static void x_laplace
P_ ((struct frame
*, struct image
*));
4477 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
4481 /* Define a new image type from TYPE. This adds a copy of TYPE to
4482 image_types and adds the symbol *TYPE->type to Vimage_types. */
4485 define_image_type (type
)
4486 struct image_type
*type
;
4488 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4489 The initialized data segment is read-only. */
4490 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
4491 bcopy (type
, p
, sizeof *p
);
4492 p
->next
= image_types
;
4494 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
4498 /* Look up image type SYMBOL, and return a pointer to its image_type
4499 structure. Value is null if SYMBOL is not a known image type. */
4501 static INLINE
struct image_type
*
4502 lookup_image_type (symbol
)
4505 struct image_type
*type
;
4507 for (type
= image_types
; type
; type
= type
->next
)
4508 if (EQ (symbol
, *type
->type
))
4515 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4516 valid image specification is a list whose car is the symbol
4517 `image', and whose rest is a property list. The property list must
4518 contain a value for key `:type'. That value must be the name of a
4519 supported image type. The rest of the property list depends on the
4523 valid_image_p (object
)
4528 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
4530 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
4531 struct image_type
*type
= lookup_image_type (symbol
);
4534 valid_p
= type
->valid_p (object
);
4541 /* Log error message with format string FORMAT and argument ARG.
4542 Signaling an error, e.g. when an image cannot be loaded, is not a
4543 good idea because this would interrupt redisplay, and the error
4544 message display would lead to another redisplay. This function
4545 therefore simply displays a message. */
4548 image_error (format
, arg1
, arg2
)
4550 Lisp_Object arg1
, arg2
;
4552 add_to_log (format
, arg1
, arg2
);
4557 /***********************************************************************
4558 Image specifications
4559 ***********************************************************************/
4561 enum image_value_type
4563 IMAGE_DONT_CHECK_VALUE_TYPE
,
4566 IMAGE_POSITIVE_INTEGER_VALUE
,
4567 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
,
4568 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
4570 IMAGE_INTEGER_VALUE
,
4571 IMAGE_FUNCTION_VALUE
,
4576 /* Structure used when parsing image specifications. */
4578 struct image_keyword
4580 /* Name of keyword. */
4583 /* The type of value allowed. */
4584 enum image_value_type type
;
4586 /* Non-zero means key must be present. */
4589 /* Used to recognize duplicate keywords in a property list. */
4592 /* The value that was found. */
4597 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
4599 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
4602 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
4603 has the format (image KEYWORD VALUE ...). One of the keyword/
4604 value pairs must be `:type TYPE'. KEYWORDS is a vector of
4605 image_keywords structures of size NKEYWORDS describing other
4606 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
4609 parse_image_spec (spec
, keywords
, nkeywords
, type
)
4611 struct image_keyword
*keywords
;
4618 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
4621 plist
= XCDR (spec
);
4622 while (CONSP (plist
))
4624 Lisp_Object key
, value
;
4626 /* First element of a pair must be a symbol. */
4628 plist
= XCDR (plist
);
4632 /* There must follow a value. */
4635 value
= XCAR (plist
);
4636 plist
= XCDR (plist
);
4638 /* Find key in KEYWORDS. Error if not found. */
4639 for (i
= 0; i
< nkeywords
; ++i
)
4640 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
4646 /* Record that we recognized the keyword. If a keywords
4647 was found more than once, it's an error. */
4648 keywords
[i
].value
= value
;
4649 ++keywords
[i
].count
;
4651 if (keywords
[i
].count
> 1)
4654 /* Check type of value against allowed type. */
4655 switch (keywords
[i
].type
)
4657 case IMAGE_STRING_VALUE
:
4658 if (!STRINGP (value
))
4662 case IMAGE_SYMBOL_VALUE
:
4663 if (!SYMBOLP (value
))
4667 case IMAGE_POSITIVE_INTEGER_VALUE
:
4668 if (!INTEGERP (value
) || XINT (value
) <= 0)
4672 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
:
4673 if (INTEGERP (value
) && XINT (value
) >= 0)
4676 && INTEGERP (XCAR (value
)) && INTEGERP (XCDR (value
))
4677 && XINT (XCAR (value
)) >= 0 && XINT (XCDR (value
)) >= 0)
4681 case IMAGE_ASCENT_VALUE
:
4682 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
4684 else if (INTEGERP (value
)
4685 && XINT (value
) >= 0
4686 && XINT (value
) <= 100)
4690 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
4691 if (!INTEGERP (value
) || XINT (value
) < 0)
4695 case IMAGE_DONT_CHECK_VALUE_TYPE
:
4698 case IMAGE_FUNCTION_VALUE
:
4699 value
= indirect_function (value
);
4701 || COMPILEDP (value
)
4702 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
4706 case IMAGE_NUMBER_VALUE
:
4707 if (!INTEGERP (value
) && !FLOATP (value
))
4711 case IMAGE_INTEGER_VALUE
:
4712 if (!INTEGERP (value
))
4716 case IMAGE_BOOL_VALUE
:
4717 if (!NILP (value
) && !EQ (value
, Qt
))
4726 if (EQ (key
, QCtype
) && !EQ (type
, value
))
4730 /* Check that all mandatory fields are present. */
4731 for (i
= 0; i
< nkeywords
; ++i
)
4732 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
4735 return NILP (plist
);
4739 /* Return the value of KEY in image specification SPEC. Value is nil
4740 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
4741 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
4744 image_spec_value (spec
, key
, found
)
4745 Lisp_Object spec
, key
;
4750 xassert (valid_image_p (spec
));
4752 for (tail
= XCDR (spec
);
4753 CONSP (tail
) && CONSP (XCDR (tail
));
4754 tail
= XCDR (XCDR (tail
)))
4756 if (EQ (XCAR (tail
), key
))
4760 return XCAR (XCDR (tail
));
4772 /***********************************************************************
4773 Image type independent image structures
4774 ***********************************************************************/
4776 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
4777 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
4780 /* Allocate and return a new image structure for image specification
4781 SPEC. SPEC has a hash value of HASH. */
4783 static struct image
*
4784 make_image (spec
, hash
)
4788 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
4790 xassert (valid_image_p (spec
));
4791 bzero (img
, sizeof *img
);
4792 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
4793 xassert (img
->type
!= NULL
);
4795 img
->data
.lisp_val
= Qnil
;
4796 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
4802 /* Free image IMG which was used on frame F, including its resources. */
4811 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
4813 /* Remove IMG from the hash table of its cache. */
4815 img
->prev
->next
= img
->next
;
4817 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
4820 img
->next
->prev
= img
->prev
;
4822 c
->images
[img
->id
] = NULL
;
4824 /* Free resources, then free IMG. */
4825 img
->type
->free (f
, img
);
4831 /* Prepare image IMG for display on frame F. Must be called before
4832 drawing an image. */
4835 prepare_image_for_display (f
, img
)
4841 /* We're about to display IMG, so set its timestamp to `now'. */
4843 img
->timestamp
= EMACS_SECS (t
);
4845 /* If IMG doesn't have a pixmap yet, load it now, using the image
4846 type dependent loader function. */
4847 if (img
->pixmap
== 0 && !img
->load_failed_p
)
4848 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
4852 /* Value is the number of pixels for the ascent of image IMG when
4853 drawn in face FACE. */
4856 image_ascent (img
, face
)
4860 int height
= img
->height
+ img
->vmargin
;
4863 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
4866 ascent
= height
/ 2 - (FONT_DESCENT(face
->font
)
4867 - FONT_BASE(face
->font
)) / 2;
4869 ascent
= height
/ 2;
4872 ascent
= height
* img
->ascent
/ 100.0;
4879 /***********************************************************************
4880 Helper functions for X image types
4881 ***********************************************************************/
4883 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
4884 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
4886 Lisp_Object color_name
,
4887 unsigned long dflt
));
4889 /* Free X resources of image IMG which is used on frame F. */
4892 x_clear_image (f
, img
)
4896 #if 0 /* MAC_TODO: W32 image support */
4901 XFreePixmap (NULL
, img
->pixmap
);
4908 int class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
4910 /* If display has an immutable color map, freeing colors is not
4911 necessary and some servers don't allow it. So don't do it. */
4912 if (class != StaticColor
4913 && class != StaticGray
4914 && class != TrueColor
)
4918 cmap
= DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f
)->screen
);
4919 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
, img
->colors
,
4924 xfree (img
->colors
);
4932 /* Allocate color COLOR_NAME for image IMG on frame F. If color
4933 cannot be allocated, use DFLT. Add a newly allocated color to
4934 IMG->colors, so that it can be freed again. Value is the pixel
4937 static unsigned long
4938 x_alloc_image_color (f
, img
, color_name
, dflt
)
4941 Lisp_Object color_name
;
4944 #if 0 /* MAC_TODO: allocing colors. */
4946 unsigned long result
;
4948 xassert (STRINGP (color_name
));
4950 if (w32_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
4952 /* This isn't called frequently so we get away with simply
4953 reallocating the color vector to the needed size, here. */
4956 (unsigned long *) xrealloc (img
->colors
,
4957 img
->ncolors
* sizeof *img
->colors
);
4958 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
4959 result
= color
.pixel
;
4970 /***********************************************************************
4972 ***********************************************************************/
4974 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
4977 /* Return a new, initialized image cache that is allocated from the
4978 heap. Call free_image_cache to free an image cache. */
4980 struct image_cache
*
4983 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
4986 bzero (c
, sizeof *c
);
4988 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
4989 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4990 c
->buckets
= (struct image
**) xmalloc (size
);
4991 bzero (c
->buckets
, size
);
4996 /* Free image cache of frame F. Be aware that X frames share images
5000 free_image_cache (f
)
5003 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5008 /* Cache should not be referenced by any frame when freed. */
5009 xassert (c
->refcount
== 0);
5011 for (i
= 0; i
< c
->used
; ++i
)
5012 free_image (f
, c
->images
[i
]);
5016 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5021 /* Clear image cache of frame F. FORCE_P non-zero means free all
5022 images. FORCE_P zero means clear only images that haven't been
5023 displayed for some time. Should be called from time to time to
5024 reduce the number of loaded images. If image-eviction-seconds is
5025 non-nil, this frees images in the cache which weren't displayed for
5026 at least that many seconds. */
5029 clear_image_cache (f
, force_p
)
5033 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5035 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5039 int i
, any_freed_p
= 0;
5042 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5044 for (i
= 0; i
< c
->used
; ++i
)
5046 struct image
*img
= c
->images
[i
];
5049 || (img
->timestamp
> old
)))
5051 free_image (f
, img
);
5056 /* We may be clearing the image cache because, for example,
5057 Emacs was iconified for a longer period of time. In that
5058 case, current matrices may still contain references to
5059 images freed above. So, clear these matrices. */
5062 clear_current_matrices (f
);
5063 ++windows_or_buffers_changed
;
5069 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5071 "Clear the image cache of FRAME.\n\
5072 FRAME nil or omitted means use the selected frame.\n\
5073 FRAME t means clear the image caches of all frames.")
5081 FOR_EACH_FRAME (tail
, frame
)
5082 if (FRAME_MAC_P (XFRAME (frame
)))
5083 clear_image_cache (XFRAME (frame
), 1);
5086 clear_image_cache (check_x_frame (frame
), 1);
5092 /* Return the id of image with Lisp specification SPEC on frame F.
5093 SPEC must be a valid Lisp image specification (see valid_image_p). */
5096 lookup_image (f
, spec
)
5100 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5104 struct gcpro gcpro1
;
5107 /* F must be a window-system frame, and SPEC must be a valid image
5109 xassert (FRAME_WINDOW_P (f
));
5110 xassert (valid_image_p (spec
));
5114 /* Look up SPEC in the hash table of the image cache. */
5115 hash
= sxhash (spec
, 0);
5116 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5118 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5119 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5122 /* If not found, create a new image and cache it. */
5126 img
= make_image (spec
, hash
);
5127 cache_image (f
, img
);
5128 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5130 /* If we can't load the image, and we don't have a width and
5131 height, use some arbitrary width and height so that we can
5132 draw a rectangle for it. */
5133 if (img
->load_failed_p
)
5137 value
= image_spec_value (spec
, QCwidth
, NULL
);
5138 img
->width
= (INTEGERP (value
)
5139 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5140 value
= image_spec_value (spec
, QCheight
, NULL
);
5141 img
->height
= (INTEGERP (value
)
5142 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5146 /* Handle image type independent image attributes
5147 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
5148 Lisp_Object ascent
, margin
, relief
;
5150 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5151 if (INTEGERP (ascent
))
5152 img
->ascent
= XFASTINT (ascent
);
5153 else if (EQ (ascent
, Qcenter
))
5154 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5156 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5157 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5158 img
->vmargin
= img
->hmargin
= XFASTINT (margin
);
5159 else if (CONSP (margin
) && INTEGERP (XCAR (margin
))
5160 && INTEGERP (XCDR (margin
)))
5162 if (XINT (XCAR (margin
)) > 0)
5163 img
->hmargin
= XFASTINT (XCAR (margin
));
5164 if (XINT (XCDR (margin
)) > 0)
5165 img
->vmargin
= XFASTINT (XCDR (margin
));
5168 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5169 if (INTEGERP (relief
))
5171 img
->relief
= XINT (relief
);
5172 img
->hmargin
+= abs (img
->relief
);
5173 img
->vmargin
+= abs (img
->relief
);
5178 /* We're using IMG, so set its timestamp to `now'. */
5179 EMACS_GET_TIME (now
);
5180 img
->timestamp
= EMACS_SECS (now
);
5184 /* Value is the image id. */
5189 /* Cache image IMG in the image cache of frame F. */
5192 cache_image (f
, img
)
5196 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5199 /* Find a free slot in c->images. */
5200 for (i
= 0; i
< c
->used
; ++i
)
5201 if (c
->images
[i
] == NULL
)
5204 /* If no free slot found, maybe enlarge c->images. */
5205 if (i
== c
->used
&& c
->used
== c
->size
)
5208 c
->images
= (struct image
**) xrealloc (c
->images
,
5209 c
->size
* sizeof *c
->images
);
5212 /* Add IMG to c->images, and assign IMG an id. */
5218 /* Add IMG to the cache's hash table. */
5219 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5220 img
->next
= c
->buckets
[i
];
5222 img
->next
->prev
= img
;
5224 c
->buckets
[i
] = img
;
5228 /* Call FN on every image in the image cache of frame F. Used to mark
5229 Lisp Objects in the image cache. */
5232 forall_images_in_image_cache (f
, fn
)
5234 void (*fn
) P_ ((struct image
*img
));
5236 if (FRAME_LIVE_P (f
) && FRAME_MAC_P (f
))
5238 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5242 for (i
= 0; i
< c
->used
; ++i
)
5251 /***********************************************************************
5253 ***********************************************************************/
5255 #if 0 /* MAC_TODO: Mac specific image code. */
5257 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
5258 XImage
**, Pixmap
*));
5259 static void x_destroy_x_image
P_ ((XImage
*));
5260 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
5263 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5264 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5265 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5266 via xmalloc. Print error messages via image_error if an error
5267 occurs. Value is non-zero if successful. */
5270 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
5272 int width
, height
, depth
;
5276 #if 0 /* MAC_TODO: Image support for Mac */
5277 Display
*display
= FRAME_W32_DISPLAY (f
);
5278 Screen
*screen
= FRAME_X_SCREEN (f
);
5279 Window window
= FRAME_W32_WINDOW (f
);
5281 xassert (interrupt_input_blocked
);
5284 depth
= DefaultDepthOfScreen (screen
);
5285 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
5286 depth
, ZPixmap
, 0, NULL
, width
, height
,
5287 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
5290 image_error ("Unable to allocate X image", Qnil
, Qnil
);
5294 /* Allocate image raster. */
5295 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
5297 /* Allocate a pixmap of the same size. */
5298 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
5301 x_destroy_x_image (*ximg
);
5303 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
5311 /* Destroy XImage XIMG. Free XIMG->data. */
5314 x_destroy_x_image (ximg
)
5317 xassert (interrupt_input_blocked
);
5322 XDestroyImage (ximg
);
5327 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5328 are width and height of both the image and pixmap. */
5331 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
5338 xassert (interrupt_input_blocked
);
5339 gc
= XCreateGC (NULL
, pixmap
, 0, NULL
);
5340 XPutImage (NULL
, pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
5347 /***********************************************************************
5349 ***********************************************************************/
5351 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
5353 /* Find image file FILE. Look in data-directory, then
5354 x-bitmap-file-path. Value is the full name of the file found, or
5355 nil if not found. */
5358 x_find_image_file (file
)
5361 Lisp_Object file_found
, search_path
;
5362 struct gcpro gcpro1
, gcpro2
;
5366 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
5367 GCPRO2 (file_found
, search_path
);
5369 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5370 fd
= openp (search_path
, file
, "", &file_found
, 0);
5382 /***********************************************************************
5384 ***********************************************************************/
5386 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
5387 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
5389 static int xbm_image_p
P_ ((Lisp_Object object
));
5390 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
5394 /* Indices of image specification fields in xbm_format, below. */
5396 enum xbm_keyword_index
5413 /* Vector of image_keyword structures describing the format
5414 of valid XBM image specifications. */
5416 static struct image_keyword xbm_format
[XBM_LAST
] =
5418 {":type", IMAGE_SYMBOL_VALUE
, 1},
5419 {":file", IMAGE_STRING_VALUE
, 0},
5420 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5421 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5422 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
5423 {":foreground", IMAGE_STRING_VALUE
, 0},
5424 {":background", IMAGE_STRING_VALUE
, 0},
5425 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
5426 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
5427 {":relief", IMAGE_INTEGER_VALUE
, 0},
5428 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
5429 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
5432 /* Structure describing the image type XBM. */
5434 static struct image_type xbm_type
=
5443 /* Tokens returned from xbm_scan. */
5452 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5453 A valid specification is a list starting with the symbol `image'
5454 The rest of the list is a property list which must contain an
5457 If the specification specifies a file to load, it must contain
5458 an entry `:file FILENAME' where FILENAME is a string.
5460 If the specification is for a bitmap loaded from memory it must
5461 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5462 WIDTH and HEIGHT are integers > 0. DATA may be:
5464 1. a string large enough to hold the bitmap data, i.e. it must
5465 have a size >= (WIDTH + 7) / 8 * HEIGHT
5467 2. a bool-vector of size >= WIDTH * HEIGHT
5469 3. a vector of strings or bool-vectors, one for each line of the
5472 Both the file and data forms may contain the additional entries
5473 `:background COLOR' and `:foreground COLOR'. If not present,
5474 foreground and background of the frame on which the image is
5475 displayed, is used. */
5478 xbm_image_p (object
)
5481 struct image_keyword kw
[XBM_LAST
];
5483 bcopy (xbm_format
, kw
, sizeof kw
);
5484 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
5487 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
5489 if (kw
[XBM_FILE
].count
)
5491 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
5499 /* Entries for `:width', `:height' and `:data' must be present. */
5500 if (!kw
[XBM_WIDTH
].count
5501 || !kw
[XBM_HEIGHT
].count
5502 || !kw
[XBM_DATA
].count
)
5505 data
= kw
[XBM_DATA
].value
;
5506 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
5507 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
5509 /* Check type of data, and width and height against contents of
5515 /* Number of elements of the vector must be >= height. */
5516 if (XVECTOR (data
)->size
< height
)
5519 /* Each string or bool-vector in data must be large enough
5520 for one line of the image. */
5521 for (i
= 0; i
< height
; ++i
)
5523 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
5527 if (XSTRING (elt
)->size
5528 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
5531 else if (BOOL_VECTOR_P (elt
))
5533 if (XBOOL_VECTOR (elt
)->size
< width
)
5540 else if (STRINGP (data
))
5542 if (XSTRING (data
)->size
5543 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
5546 else if (BOOL_VECTOR_P (data
))
5548 if (XBOOL_VECTOR (data
)->size
< width
* height
)
5555 /* Baseline must be a value between 0 and 100 (a percentage). */
5556 if (kw
[XBM_ASCENT
].count
5557 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
5564 /* Scan a bitmap file. FP is the stream to read from. Value is
5565 either an enumerator from enum xbm_token, or a character for a
5566 single-character token, or 0 at end of file. If scanning an
5567 identifier, store the lexeme of the identifier in SVAL. If
5568 scanning a number, store its value in *IVAL. */
5571 xbm_scan (fp
, sval
, ival
)
5578 /* Skip white space. */
5579 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
5584 else if (isdigit (c
))
5586 int value
= 0, digit
;
5591 if (c
== 'x' || c
== 'X')
5593 while ((c
= fgetc (fp
)) != EOF
)
5597 else if (c
>= 'a' && c
<= 'f')
5598 digit
= c
- 'a' + 10;
5599 else if (c
>= 'A' && c
<= 'F')
5600 digit
= c
- 'A' + 10;
5603 value
= 16 * value
+ digit
;
5606 else if (isdigit (c
))
5609 while ((c
= fgetc (fp
)) != EOF
5611 value
= 8 * value
+ c
- '0';
5617 while ((c
= fgetc (fp
)) != EOF
5619 value
= 10 * value
+ c
- '0';
5627 else if (isalpha (c
) || c
== '_')
5630 while ((c
= fgetc (fp
)) != EOF
5631 && (isalnum (c
) || c
== '_'))
5643 /* Replacement for XReadBitmapFileData which isn't available under old
5644 X versions. FILE is the name of the bitmap file to read. Set
5645 *WIDTH and *HEIGHT to the width and height of the image. Return in
5646 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
5650 xbm_read_bitmap_file_data (file
, width
, height
, data
)
5652 int *width
, *height
;
5653 unsigned char **data
;
5656 char buffer
[BUFSIZ
];
5659 int bytes_per_line
, i
, nbytes
;
5665 LA1 = xbm_scan (fp, buffer, &value)
5667 #define expect(TOKEN) \
5668 if (LA1 != (TOKEN)) \
5673 #define expect_ident(IDENT) \
5674 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
5679 fp
= fopen (file
, "r");
5683 *width
= *height
= -1;
5685 LA1
= xbm_scan (fp
, buffer
, &value
);
5687 /* Parse defines for width, height and hot-spots. */
5691 expect_ident ("define");
5692 expect (XBM_TK_IDENT
);
5694 if (LA1
== XBM_TK_NUMBER
);
5696 char *p
= strrchr (buffer
, '_');
5697 p
= p
? p
+ 1 : buffer
;
5698 if (strcmp (p
, "width") == 0)
5700 else if (strcmp (p
, "height") == 0)
5703 expect (XBM_TK_NUMBER
);
5706 if (*width
< 0 || *height
< 0)
5709 /* Parse bits. Must start with `static'. */
5710 expect_ident ("static");
5711 if (LA1
== XBM_TK_IDENT
)
5713 if (strcmp (buffer
, "unsigned") == 0)
5716 expect_ident ("char");
5718 else if (strcmp (buffer
, "short") == 0)
5722 if (*width
% 16 && *width
% 16 < 9)
5725 else if (strcmp (buffer
, "char") == 0)
5733 expect (XBM_TK_IDENT
);
5739 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
5740 nbytes
= bytes_per_line
* *height
;
5741 p
= *data
= (char *) xmalloc (nbytes
);
5746 for (i
= 0; i
< nbytes
; i
+= 2)
5749 expect (XBM_TK_NUMBER
);
5752 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
5755 if (LA1
== ',' || LA1
== '}')
5763 for (i
= 0; i
< nbytes
; ++i
)
5766 expect (XBM_TK_NUMBER
);
5770 if (LA1
== ',' || LA1
== '}')
5796 /* Load XBM image IMG which will be displayed on frame F from file
5797 SPECIFIED_FILE. Value is non-zero if successful. */
5800 xbm_load_image_from_file (f
, img
, specified_file
)
5803 Lisp_Object specified_file
;
5806 unsigned char *data
;
5809 struct gcpro gcpro1
;
5811 xassert (STRINGP (specified_file
));
5815 file
= x_find_image_file (specified_file
);
5816 if (!STRINGP (file
))
5818 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
5823 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
5824 &img
->height
, &data
);
5827 int depth
= one_mac_display_info
.n_cbits
;
5828 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
5829 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
5832 xassert (img
->width
> 0 && img
->height
> 0);
5834 /* Get foreground and background colors, maybe allocate colors. */
5835 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
5837 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
5839 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
5841 background
= x_alloc_image_color (f
, img
, value
, background
);
5843 #if 0 /* MAC_TODO : Port image display to Mac */
5846 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f
),
5847 FRAME_W32_WINDOW (f
),
5849 img
->width
, img
->height
,
5850 foreground
, background
,
5854 if (img
->pixmap
== 0)
5856 x_clear_image (f
, img
);
5857 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
5866 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
5873 /* Fill image IMG which is used on frame F with pixmap data. Value is
5874 non-zero if successful. */
5882 Lisp_Object file_name
;
5884 xassert (xbm_image_p (img
->spec
));
5886 /* If IMG->spec specifies a file name, create a non-file spec from it. */
5887 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
5888 if (STRINGP (file_name
))
5889 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
5892 struct image_keyword fmt
[XBM_LAST
];
5895 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
5896 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
5900 /* Parse the list specification. */
5901 bcopy (xbm_format
, fmt
, sizeof fmt
);
5902 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
5905 /* Get specified width, and height. */
5906 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
5907 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
5908 xassert (img
->width
> 0 && img
->height
> 0);
5912 if (fmt
[XBM_ASCENT
].count
)
5913 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
5915 /* Get foreground and background colors, maybe allocate colors. */
5916 if (fmt
[XBM_FOREGROUND
].count
)
5917 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
5919 if (fmt
[XBM_BACKGROUND
].count
)
5920 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
5923 /* Set bits to the bitmap image data. */
5924 data
= fmt
[XBM_DATA
].value
;
5929 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
5931 p
= bits
= (char *) alloca (nbytes
* img
->height
);
5932 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
5934 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
5936 bcopy (XSTRING (line
)->data
, p
, nbytes
);
5938 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
5941 else if (STRINGP (data
))
5942 bits
= XSTRING (data
)->data
;
5944 bits
= XBOOL_VECTOR (data
)->data
;
5946 #if 0 /* MAC_TODO : port Mac display code */
5947 /* Create the pixmap. */
5948 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
5950 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f
),
5951 FRAME_W32_WINDOW (f
),
5953 img
->width
, img
->height
,
5954 foreground
, background
,
5956 #endif /* MAC_TODO */
5962 image_error ("Unable to create pixmap for XBM image `%s'",
5964 x_clear_image (f
, img
);
5975 /***********************************************************************
5977 ***********************************************************************/
5981 static int xpm_image_p
P_ ((Lisp_Object object
));
5982 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
5983 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
5985 #include "X11/xpm.h"
5987 /* The symbol `xpm' identifying XPM-format images. */
5991 /* Indices of image specification fields in xpm_format, below. */
5993 enum xpm_keyword_index
6007 /* Vector of image_keyword structures describing the format
6008 of valid XPM image specifications. */
6010 static struct image_keyword xpm_format
[XPM_LAST
] =
6012 {":type", IMAGE_SYMBOL_VALUE
, 1},
6013 {":file", IMAGE_STRING_VALUE
, 0},
6014 {":data", IMAGE_STRING_VALUE
, 0},
6015 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6016 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6017 {":relief", IMAGE_INTEGER_VALUE
, 0},
6018 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6019 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6020 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6023 /* Structure describing the image type XBM. */
6025 static struct image_type xpm_type
=
6035 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6036 for XPM images. Such a list must consist of conses whose car and
6040 xpm_valid_color_symbols_p (color_symbols
)
6041 Lisp_Object color_symbols
;
6043 while (CONSP (color_symbols
))
6045 Lisp_Object sym
= XCAR (color_symbols
);
6047 || !STRINGP (XCAR (sym
))
6048 || !STRINGP (XCDR (sym
)))
6050 color_symbols
= XCDR (color_symbols
);
6053 return NILP (color_symbols
);
6057 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6060 xpm_image_p (object
)
6063 struct image_keyword fmt
[XPM_LAST
];
6064 bcopy (xpm_format
, fmt
, sizeof fmt
);
6065 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
6066 /* Either `:file' or `:data' must be present. */
6067 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
6068 /* Either no `:color-symbols' or it's a list of conses
6069 whose car and cdr are strings. */
6070 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
6071 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
6072 && (fmt
[XPM_ASCENT
].count
== 0
6073 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
6077 /* Load image IMG which will be displayed on frame F. Value is
6078 non-zero if successful. */
6086 XpmAttributes attrs
;
6087 Lisp_Object specified_file
, color_symbols
;
6089 /* Configure the XPM lib. Use the visual of frame F. Allocate
6090 close colors. Return colors allocated. */
6091 bzero (&attrs
, sizeof attrs
);
6092 attrs
.visual
= FRAME_X_VISUAL (f
);
6093 attrs
.colormap
= FRAME_X_COLORMAP (f
);
6094 attrs
.valuemask
|= XpmVisual
;
6095 attrs
.valuemask
|= XpmColormap
;
6096 attrs
.valuemask
|= XpmReturnAllocPixels
;
6097 #ifdef XpmAllocCloseColors
6098 attrs
.alloc_close_colors
= 1;
6099 attrs
.valuemask
|= XpmAllocCloseColors
;
6101 attrs
.closeness
= 600;
6102 attrs
.valuemask
|= XpmCloseness
;
6105 /* If image specification contains symbolic color definitions, add
6106 these to `attrs'. */
6107 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
6108 if (CONSP (color_symbols
))
6111 XpmColorSymbol
*xpm_syms
;
6114 attrs
.valuemask
|= XpmColorSymbols
;
6116 /* Count number of symbols. */
6117 attrs
.numsymbols
= 0;
6118 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
6121 /* Allocate an XpmColorSymbol array. */
6122 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
6123 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
6124 bzero (xpm_syms
, size
);
6125 attrs
.colorsymbols
= xpm_syms
;
6127 /* Fill the color symbol array. */
6128 for (tail
= color_symbols
, i
= 0;
6130 ++i
, tail
= XCDR (tail
))
6132 Lisp_Object name
= XCAR (XCAR (tail
));
6133 Lisp_Object color
= XCDR (XCAR (tail
));
6134 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
6135 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
6136 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
6137 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
6141 /* Create a pixmap for the image, either from a file, or from a
6142 string buffer containing data in the same format as an XPM file. */
6144 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
6145 if (STRINGP (specified_file
))
6147 Lisp_Object file
= x_find_image_file (specified_file
);
6148 if (!STRINGP (file
))
6150 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6155 rc
= XpmReadFileToPixmap (NULL
, FRAME_W32_WINDOW (f
),
6156 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
6161 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
6162 rc
= XpmCreatePixmapFromBuffer (NULL
, FRAME_W32_WINDOW (f
),
6163 XSTRING (buffer
)->data
,
6164 &img
->pixmap
, &img
->mask
,
6169 if (rc
== XpmSuccess
)
6171 /* Remember allocated colors. */
6172 img
->ncolors
= attrs
.nalloc_pixels
;
6173 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
6174 * sizeof *img
->colors
);
6175 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
6176 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
6178 img
->width
= attrs
.width
;
6179 img
->height
= attrs
.height
;
6180 xassert (img
->width
> 0 && img
->height
> 0);
6182 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6184 XpmFreeAttributes (&attrs
);
6192 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
6195 case XpmFileInvalid
:
6196 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
6200 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
6203 case XpmColorFailed
:
6204 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
6208 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
6213 return rc
== XpmSuccess
;
6216 #endif /* HAVE_XPM != 0 */
6219 #if 0 /* MAC_TODO : Color tables on Mac. */
6220 /***********************************************************************
6222 ***********************************************************************/
6224 /* An entry in the color table mapping an RGB color to a pixel color. */
6229 unsigned long pixel
;
6231 /* Next in color table collision list. */
6232 struct ct_color
*next
;
6235 /* The bucket vector size to use. Must be prime. */
6239 /* Value is a hash of the RGB color given by R, G, and B. */
6241 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6243 /* The color hash table. */
6245 struct ct_color
**ct_table
;
6247 /* Number of entries in the color table. */
6249 int ct_colors_allocated
;
6251 /* Function prototypes. */
6253 static void init_color_table
P_ ((void));
6254 static void free_color_table
P_ ((void));
6255 static unsigned long *colors_in_color_table
P_ ((int *n
));
6256 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
6257 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
6260 /* Initialize the color table. */
6265 int size
= CT_SIZE
* sizeof (*ct_table
);
6266 ct_table
= (struct ct_color
**) xmalloc (size
);
6267 bzero (ct_table
, size
);
6268 ct_colors_allocated
= 0;
6272 /* Free memory associated with the color table. */
6278 struct ct_color
*p
, *next
;
6280 for (i
= 0; i
< CT_SIZE
; ++i
)
6281 for (p
= ct_table
[i
]; p
; p
= next
)
6292 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6293 entry for that color already is in the color table, return the
6294 pixel color of that entry. Otherwise, allocate a new color for R,
6295 G, B, and make an entry in the color table. */
6297 static unsigned long
6298 lookup_rgb_color (f
, r
, g
, b
)
6302 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
6303 int i
= hash
% CT_SIZE
;
6306 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6307 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
6316 color
= RGB_TO_ULONG (r
, g
, b
);
6318 ++ct_colors_allocated
;
6320 p
= (struct ct_color
*) xmalloc (sizeof *p
);
6325 p
->next
= ct_table
[i
];
6333 /* Look up pixel color PIXEL which is used on frame F in the color
6334 table. If not already present, allocate it. Value is PIXEL. */
6336 static unsigned long
6337 lookup_pixel_color (f
, pixel
)
6339 unsigned long pixel
;
6341 int i
= pixel
% CT_SIZE
;
6344 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6345 if (p
->pixel
== pixel
)
6356 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
6357 color
.pixel
= pixel
;
6358 XQueryColor (NULL
, cmap
, &color
);
6359 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
6364 ++ct_colors_allocated
;
6366 p
= (struct ct_color
*) xmalloc (sizeof *p
);
6371 p
->next
= ct_table
[i
];
6375 return FRAME_FOREGROUND_PIXEL (f
);
6381 /* Value is a vector of all pixel colors contained in the color table,
6382 allocated via xmalloc. Set *N to the number of colors. */
6384 static unsigned long *
6385 colors_in_color_table (n
)
6390 unsigned long *colors
;
6392 if (ct_colors_allocated
== 0)
6399 colors
= (unsigned long *) xmalloc (ct_colors_allocated
6401 *n
= ct_colors_allocated
;
6403 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
6404 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6405 colors
[j
++] = p
->pixel
;
6411 #endif /* MAC_TODO */
6414 /***********************************************************************
6416 ***********************************************************************/
6418 #if 0 /* MAC_TODO : Mac versions of low level algorithms */
6419 static void x_laplace_write_row
P_ ((struct frame
*, long *,
6420 int, XImage
*, int));
6421 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
6422 XColor
*, int, XImage
*, int));
6425 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
6426 frame we operate on, CMAP is the color-map in effect, and WIDTH is
6427 the width of one row in the image. */
6430 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
6440 for (x
= 0; x
< width
; ++x
)
6441 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
6443 XQueryColors (NULL
, cmap
, colors
, width
);
6447 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
6448 containing the pixel colors to write. F is the frame we are
6452 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
6461 for (x
= 0; x
< width
; ++x
)
6462 XPutPixel (ximg
, x
, y
, pixels
[x
]);
6466 /* Transform image IMG which is used on frame F with a Laplace
6467 edge-detection algorithm. The result is an image that can be used
6468 to draw disabled buttons, for example. */
6475 #if 0 /* MAC_TODO : Mac version */
6476 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
6477 XImage
*ximg
, *oimg
;
6483 int in_y
, out_y
, rc
;
6488 /* Get the X image IMG->pixmap. */
6489 ximg
= XGetImage (NULL
, img
->pixmap
,
6490 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6492 /* Allocate 3 input rows, and one output row of colors. */
6493 for (i
= 0; i
< 3; ++i
)
6494 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
6495 out
= (long *) alloca (img
->width
* sizeof (long));
6497 /* Create an X image for output. */
6498 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
6501 /* Fill first two rows. */
6502 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
6503 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
6506 /* Write first row, all zeros. */
6507 init_color_table ();
6508 pixel
= lookup_rgb_color (f
, 0, 0, 0);
6509 for (x
= 0; x
< img
->width
; ++x
)
6511 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
6514 for (y
= 2; y
< img
->height
; ++y
)
6517 int rowb
= (y
+ 2) % 3;
6519 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
6521 for (x
= 0; x
< img
->width
- 2; ++x
)
6523 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
6524 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
6525 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
6527 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
6531 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
6534 /* Write last line, all zeros. */
6535 for (x
= 0; x
< img
->width
; ++x
)
6537 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
6539 /* Free the input image, and free resources of IMG. */
6540 XDestroyImage (ximg
);
6541 x_clear_image (f
, img
);
6543 /* Put the output image into pixmap, and destroy it. */
6544 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
6545 x_destroy_x_image (oimg
);
6547 /* Remember new pixmap and colors in IMG. */
6548 img
->pixmap
= pixmap
;
6549 img
->colors
= colors_in_color_table (&img
->ncolors
);
6550 free_color_table ();
6553 #endif /* MAC_TODO */
6557 /* Build a mask for image IMG which is used on frame F. FILE is the
6558 name of an image file, for error messages. HOW determines how to
6559 determine the background color of IMG. If it is a list '(R G B)',
6560 with R, G, and B being integers >= 0, take that as the color of the
6561 background. Otherwise, determine the background color of IMG
6562 heuristically. Value is non-zero if successful. */
6565 x_build_heuristic_mask (f
, img
, how
)
6570 #if 0 /* MAC_TODO : Mac version */
6571 Display
*dpy
= FRAME_W32_DISPLAY (f
);
6572 XImage
*ximg
, *mask_img
;
6573 int x
, y
, rc
, look_at_corners_p
;
6578 /* Create an image and pixmap serving as mask. */
6579 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
6580 &mask_img
, &img
->mask
);
6587 /* Get the X image of IMG->pixmap. */
6588 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
6591 /* Determine the background color of ximg. If HOW is `(R G B)'
6592 take that as color. Otherwise, try to determine the color
6594 look_at_corners_p
= 1;
6602 && NATNUMP (XCAR (how
)))
6604 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
6608 if (i
== 3 && NILP (how
))
6610 char color_name
[30];
6611 XColor exact
, color
;
6614 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
6616 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
6617 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
6620 look_at_corners_p
= 0;
6625 if (look_at_corners_p
)
6627 unsigned long corners
[4];
6630 /* Get the colors at the corners of ximg. */
6631 corners
[0] = XGetPixel (ximg
, 0, 0);
6632 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
6633 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
6634 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
6636 /* Choose the most frequently found color as background. */
6637 for (i
= best_count
= 0; i
< 4; ++i
)
6641 for (j
= n
= 0; j
< 4; ++j
)
6642 if (corners
[i
] == corners
[j
])
6646 bg
= corners
[i
], best_count
= n
;
6650 /* Set all bits in mask_img to 1 whose color in ximg is different
6651 from the background color bg. */
6652 for (y
= 0; y
< img
->height
; ++y
)
6653 for (x
= 0; x
< img
->width
; ++x
)
6654 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
6656 /* Put mask_img into img->mask. */
6657 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
6658 x_destroy_x_image (mask_img
);
6659 XDestroyImage (ximg
);
6662 #endif /* MAC_TODO */
6669 /***********************************************************************
6670 PBM (mono, gray, color)
6671 ***********************************************************************/
6674 static int pbm_image_p
P_ ((Lisp_Object object
));
6675 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
6676 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
6678 /* The symbol `pbm' identifying images of this type. */
6682 /* Indices of image specification fields in gs_format, below. */
6684 enum pbm_keyword_index
6697 /* Vector of image_keyword structures describing the format
6698 of valid user-defined image specifications. */
6700 static struct image_keyword pbm_format
[PBM_LAST
] =
6702 {":type", IMAGE_SYMBOL_VALUE
, 1},
6703 {":file", IMAGE_STRING_VALUE
, 0},
6704 {":data", IMAGE_STRING_VALUE
, 0},
6705 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6706 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
6707 {":relief", IMAGE_INTEGER_VALUE
, 0},
6708 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6709 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6712 /* Structure describing the image type `pbm'. */
6714 static struct image_type pbm_type
=
6724 /* Return non-zero if OBJECT is a valid PBM image specification. */
6727 pbm_image_p (object
)
6730 struct image_keyword fmt
[PBM_LAST
];
6732 bcopy (pbm_format
, fmt
, sizeof fmt
);
6734 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
6735 || (fmt
[PBM_ASCENT
].count
6736 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
6739 /* Must specify either :data or :file. */
6740 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
6744 /* Scan a decimal number from *S and return it. Advance *S while
6745 reading the number. END is the end of the string. Value is -1 at
6749 pbm_scan_number (s
, end
)
6750 unsigned char **s
, *end
;
6756 /* Skip white-space. */
6757 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6762 /* Skip comment to end of line. */
6763 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
6766 else if (isdigit (c
))
6768 /* Read decimal number. */
6770 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
6771 val
= 10 * val
+ c
- '0';
6782 /* Read FILE into memory. Value is a pointer to a buffer allocated
6783 with xmalloc holding FILE's contents. Value is null if an error
6784 occured. *SIZE is set to the size of the file. */
6787 pbm_read_file (file
, size
)
6795 if (stat (XSTRING (file
)->data
, &st
) == 0
6796 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
6797 && (buf
= (char *) xmalloc (st
.st_size
),
6798 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6818 /* Load PBM image IMG for use on frame F. */
6826 int width
, height
, max_color_idx
= 0;
6828 Lisp_Object file
, specified_file
;
6829 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
6830 struct gcpro gcpro1
;
6831 unsigned char *contents
= NULL
;
6832 unsigned char *end
, *p
;
6835 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
6839 if (STRINGP (specified_file
))
6841 file
= x_find_image_file (specified_file
);
6842 if (!STRINGP (file
))
6844 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6849 contents
= pbm_read_file (file
, &size
);
6850 if (contents
== NULL
)
6852 image_error ("Error reading `%s'", file
, Qnil
);
6858 end
= contents
+ size
;
6863 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6864 p
= XSTRING (data
)->data
;
6865 end
= p
+ STRING_BYTES (XSTRING (data
));
6868 /* Check magic number. */
6869 if (end
- p
< 2 || *p
++ != 'P')
6871 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
6881 raw_p
= 0, type
= PBM_MONO
;
6885 raw_p
= 0, type
= PBM_GRAY
;
6889 raw_p
= 0, type
= PBM_COLOR
;
6893 raw_p
= 1, type
= PBM_MONO
;
6897 raw_p
= 1, type
= PBM_GRAY
;
6901 raw_p
= 1, type
= PBM_COLOR
;
6905 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
6909 /* Read width, height, maximum color-component. Characters
6910 starting with `#' up to the end of a line are ignored. */
6911 width
= pbm_scan_number (&p
, end
);
6912 height
= pbm_scan_number (&p
, end
);
6914 if (type
!= PBM_MONO
)
6916 max_color_idx
= pbm_scan_number (&p
, end
);
6917 if (raw_p
&& max_color_idx
> 255)
6918 max_color_idx
= 255;
6923 || (type
!= PBM_MONO
&& max_color_idx
< 0))
6927 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
6928 &ximg
, &img
->pixmap
))
6934 /* Initialize the color hash table. */
6935 init_color_table ();
6937 if (type
== PBM_MONO
)
6941 for (y
= 0; y
< height
; ++y
)
6942 for (x
= 0; x
< width
; ++x
)
6952 g
= pbm_scan_number (&p
, end
);
6954 XPutPixel (ximg
, x
, y
, (g
6955 ? FRAME_FOREGROUND_PIXEL (f
)
6956 : FRAME_BACKGROUND_PIXEL (f
)));
6961 for (y
= 0; y
< height
; ++y
)
6962 for (x
= 0; x
< width
; ++x
)
6966 if (type
== PBM_GRAY
)
6967 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
6976 r
= pbm_scan_number (&p
, end
);
6977 g
= pbm_scan_number (&p
, end
);
6978 b
= pbm_scan_number (&p
, end
);
6981 if (r
< 0 || g
< 0 || b
< 0)
6985 XDestroyImage (ximg
);
6987 image_error ("Invalid pixel value in image `%s'",
6992 /* RGB values are now in the range 0..max_color_idx.
6993 Scale this to the range 0..0xffff supported by X. */
6994 r
= (double) r
* 65535 / max_color_idx
;
6995 g
= (double) g
* 65535 / max_color_idx
;
6996 b
= (double) b
* 65535 / max_color_idx
;
6997 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7001 /* Store in IMG->colors the colors allocated for the image, and
7002 free the color table. */
7003 img
->colors
= colors_in_color_table (&img
->ncolors
);
7004 free_color_table ();
7006 /* Put the image into a pixmap. */
7007 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7008 x_destroy_x_image (ximg
);
7012 img
->height
= height
;
7018 #endif /* HAVE_PBM */
7021 /***********************************************************************
7023 ***********************************************************************/
7029 /* Function prototypes. */
7031 static int png_image_p
P_ ((Lisp_Object object
));
7032 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7034 /* The symbol `png' identifying images of this type. */
7038 /* Indices of image specification fields in png_format, below. */
7040 enum png_keyword_index
7053 /* Vector of image_keyword structures describing the format
7054 of valid user-defined image specifications. */
7056 static struct image_keyword png_format
[PNG_LAST
] =
7058 {":type", IMAGE_SYMBOL_VALUE
, 1},
7059 {":data", IMAGE_STRING_VALUE
, 0},
7060 {":file", IMAGE_STRING_VALUE
, 0},
7061 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7062 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7063 {":relief", IMAGE_INTEGER_VALUE
, 0},
7064 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7065 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7068 /* Structure describing the image type `png'. */
7070 static struct image_type png_type
=
7080 /* Return non-zero if OBJECT is a valid PNG image specification. */
7083 png_image_p (object
)
7086 struct image_keyword fmt
[PNG_LAST
];
7087 bcopy (png_format
, fmt
, sizeof fmt
);
7089 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
7090 || (fmt
[PNG_ASCENT
].count
7091 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
7094 /* Must specify either the :data or :file keyword. */
7095 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
7099 /* Error and warning handlers installed when the PNG library
7103 my_png_error (png_ptr
, msg
)
7104 png_struct
*png_ptr
;
7107 xassert (png_ptr
!= NULL
);
7108 image_error ("PNG error: %s", build_string (msg
), Qnil
);
7109 longjmp (png_ptr
->jmpbuf
, 1);
7114 my_png_warning (png_ptr
, msg
)
7115 png_struct
*png_ptr
;
7118 xassert (png_ptr
!= NULL
);
7119 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
7122 /* Memory source for PNG decoding. */
7124 struct png_memory_storage
7126 unsigned char *bytes
; /* The data */
7127 size_t len
; /* How big is it? */
7128 int index
; /* Where are we? */
7132 /* Function set as reader function when reading PNG image from memory.
7133 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7134 bytes from the input to DATA. */
7137 png_read_from_memory (png_ptr
, data
, length
)
7138 png_structp png_ptr
;
7142 struct png_memory_storage
*tbr
7143 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
7145 if (length
> tbr
->len
- tbr
->index
)
7146 png_error (png_ptr
, "Read error");
7148 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
7149 tbr
->index
= tbr
->index
+ length
;
7152 /* Load PNG image IMG for use on frame F. Value is non-zero if
7160 Lisp_Object file
, specified_file
;
7161 Lisp_Object specified_data
;
7163 XImage
*ximg
, *mask_img
= NULL
;
7164 struct gcpro gcpro1
;
7165 png_struct
*png_ptr
= NULL
;
7166 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
7169 png_byte
*pixels
= NULL
;
7170 png_byte
**rows
= NULL
;
7171 png_uint_32 width
, height
;
7172 int bit_depth
, color_type
, interlace_type
;
7174 png_uint_32 row_bytes
;
7177 double screen_gamma
, image_gamma
;
7179 struct png_memory_storage tbr
; /* Data to be read */
7181 /* Find out what file to load. */
7182 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7183 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7187 if (NILP (specified_data
))
7189 file
= x_find_image_file (specified_file
);
7190 if (!STRINGP (file
))
7192 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7197 /* Open the image file. */
7198 fp
= fopen (XSTRING (file
)->data
, "rb");
7201 image_error ("Cannot open image file `%s'", file
, Qnil
);
7207 /* Check PNG signature. */
7208 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
7209 || !png_check_sig (sig
, sizeof sig
))
7211 image_error ("Not a PNG file:` %s'", file
, Qnil
);
7219 /* Read from memory. */
7220 tbr
.bytes
= XSTRING (specified_data
)->data
;
7221 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
7224 /* Check PNG signature. */
7225 if (tbr
.len
< sizeof sig
7226 || !png_check_sig (tbr
.bytes
, sizeof sig
))
7228 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
7233 /* Need to skip past the signature. */
7234 tbr
.bytes
+= sizeof (sig
);
7237 /* Initialize read and info structs for PNG lib. */
7238 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
7239 my_png_error
, my_png_warning
);
7242 if (fp
) fclose (fp
);
7247 info_ptr
= png_create_info_struct (png_ptr
);
7250 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
7251 if (fp
) fclose (fp
);
7256 end_info
= png_create_info_struct (png_ptr
);
7259 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
7260 if (fp
) fclose (fp
);
7265 /* Set error jump-back. We come back here when the PNG library
7266 detects an error. */
7267 if (setjmp (png_ptr
->jmpbuf
))
7271 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
7274 if (fp
) fclose (fp
);
7279 /* Read image info. */
7280 if (!NILP (specified_data
))
7281 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
7283 png_init_io (png_ptr
, fp
);
7285 png_set_sig_bytes (png_ptr
, sizeof sig
);
7286 png_read_info (png_ptr
, info_ptr
);
7287 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
7288 &interlace_type
, NULL
, NULL
);
7290 /* If image contains simply transparency data, we prefer to
7291 construct a clipping mask. */
7292 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
7297 /* This function is easier to write if we only have to handle
7298 one data format: RGB or RGBA with 8 bits per channel. Let's
7299 transform other formats into that format. */
7301 /* Strip more than 8 bits per channel. */
7302 if (bit_depth
== 16)
7303 png_set_strip_16 (png_ptr
);
7305 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
7307 png_set_expand (png_ptr
);
7309 /* Convert grayscale images to RGB. */
7310 if (color_type
== PNG_COLOR_TYPE_GRAY
7311 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
7312 png_set_gray_to_rgb (png_ptr
);
7314 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
7315 gamma_str
= getenv ("SCREEN_GAMMA");
7316 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
7318 /* Tell the PNG lib to handle gamma correction for us. */
7320 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
7321 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
7322 /* There is a special chunk in the image specifying the gamma. */
7323 png_set_sRGB (png_ptr
, info_ptr
, intent
);
7326 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
7327 /* Image contains gamma information. */
7328 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
7330 /* Use a default of 0.5 for the image gamma. */
7331 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
7333 /* Handle alpha channel by combining the image with a background
7334 color. Do this only if a real alpha channel is supplied. For
7335 simple transparency, we prefer a clipping mask. */
7338 png_color_16
*image_background
;
7340 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
7341 /* Image contains a background color with which to
7342 combine the image. */
7343 png_set_background (png_ptr
, image_background
,
7344 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
7347 /* Image does not contain a background color with which
7348 to combine the image data via an alpha channel. Use
7349 the frame's background instead. */
7352 png_color_16 frame_background
;
7355 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7356 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
7357 XQueryColor (FRAME_W32_DISPLAY (f
), cmap
, &color
);
7360 bzero (&frame_background
, sizeof frame_background
);
7361 frame_background
.red
= color
.red
;
7362 frame_background
.green
= color
.green
;
7363 frame_background
.blue
= color
.blue
;
7365 png_set_background (png_ptr
, &frame_background
,
7366 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
7370 /* Update info structure. */
7371 png_read_update_info (png_ptr
, info_ptr
);
7373 /* Get number of channels. Valid values are 1 for grayscale images
7374 and images with a palette, 2 for grayscale images with transparency
7375 information (alpha channel), 3 for RGB images, and 4 for RGB
7376 images with alpha channel, i.e. RGBA. If conversions above were
7377 sufficient we should only have 3 or 4 channels here. */
7378 channels
= png_get_channels (png_ptr
, info_ptr
);
7379 xassert (channels
== 3 || channels
== 4);
7381 /* Number of bytes needed for one row of the image. */
7382 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
7384 /* Allocate memory for the image. */
7385 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
7386 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
7387 for (i
= 0; i
< height
; ++i
)
7388 rows
[i
] = pixels
+ i
* row_bytes
;
7390 /* Read the entire image. */
7391 png_read_image (png_ptr
, rows
);
7392 png_read_end (png_ptr
, info_ptr
);
7401 /* Create the X image and pixmap. */
7402 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
7409 /* Create an image and pixmap serving as mask if the PNG image
7410 contains an alpha channel. */
7413 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
7414 &mask_img
, &img
->mask
))
7416 x_destroy_x_image (ximg
);
7417 XFreePixmap (FRAME_W32_DISPLAY (f
), img
->pixmap
);
7423 /* Fill the X image and mask from PNG data. */
7424 init_color_table ();
7426 for (y
= 0; y
< height
; ++y
)
7428 png_byte
*p
= rows
[y
];
7430 for (x
= 0; x
< width
; ++x
)
7437 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7439 /* An alpha channel, aka mask channel, associates variable
7440 transparency with an image. Where other image formats
7441 support binary transparency---fully transparent or fully
7442 opaque---PNG allows up to 254 levels of partial transparency.
7443 The PNG library implements partial transparency by combining
7444 the image with a specified background color.
7446 I'm not sure how to handle this here nicely: because the
7447 background on which the image is displayed may change, for
7448 real alpha channel support, it would be necessary to create
7449 a new image for each possible background.
7451 What I'm doing now is that a mask is created if we have
7452 boolean transparency information. Otherwise I'm using
7453 the frame's background color to combine the image with. */
7458 XPutPixel (mask_img
, x
, y
, *p
> 0);
7464 /* Remember colors allocated for this image. */
7465 img
->colors
= colors_in_color_table (&img
->ncolors
);
7466 free_color_table ();
7469 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
7474 img
->height
= height
;
7476 /* Put the image into the pixmap, then free the X image and its buffer. */
7477 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7478 x_destroy_x_image (ximg
);
7480 /* Same for the mask. */
7483 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7484 x_destroy_x_image (mask_img
);
7492 #endif /* HAVE_PNG != 0 */
7496 /***********************************************************************
7498 ***********************************************************************/
7502 /* Work around a warning about HAVE_STDLIB_H being redefined in
7504 #ifdef HAVE_STDLIB_H
7505 #define HAVE_STDLIB_H_1
7506 #undef HAVE_STDLIB_H
7507 #endif /* HAVE_STLIB_H */
7509 #include <jpeglib.h>
7513 #ifdef HAVE_STLIB_H_1
7514 #define HAVE_STDLIB_H 1
7517 static int jpeg_image_p
P_ ((Lisp_Object object
));
7518 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
7520 /* The symbol `jpeg' identifying images of this type. */
7524 /* Indices of image specification fields in gs_format, below. */
7526 enum jpeg_keyword_index
7535 JPEG_HEURISTIC_MASK
,
7539 /* Vector of image_keyword structures describing the format
7540 of valid user-defined image specifications. */
7542 static struct image_keyword jpeg_format
[JPEG_LAST
] =
7544 {":type", IMAGE_SYMBOL_VALUE
, 1},
7545 {":data", IMAGE_STRING_VALUE
, 0},
7546 {":file", IMAGE_STRING_VALUE
, 0},
7547 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7548 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7549 {":relief", IMAGE_INTEGER_VALUE
, 0},
7550 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7551 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7554 /* Structure describing the image type `jpeg'. */
7556 static struct image_type jpeg_type
=
7566 /* Return non-zero if OBJECT is a valid JPEG image specification. */
7569 jpeg_image_p (object
)
7572 struct image_keyword fmt
[JPEG_LAST
];
7574 bcopy (jpeg_format
, fmt
, sizeof fmt
);
7576 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
7577 || (fmt
[JPEG_ASCENT
].count
7578 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
7581 /* Must specify either the :data or :file keyword. */
7582 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
7586 struct my_jpeg_error_mgr
7588 struct jpeg_error_mgr pub
;
7589 jmp_buf setjmp_buffer
;
7593 my_error_exit (cinfo
)
7596 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
7597 longjmp (mgr
->setjmp_buffer
, 1);
7600 /* Init source method for JPEG data source manager. Called by
7601 jpeg_read_header() before any data is actually read. See
7602 libjpeg.doc from the JPEG lib distribution. */
7605 our_init_source (cinfo
)
7606 j_decompress_ptr cinfo
;
7611 /* Fill input buffer method for JPEG data source manager. Called
7612 whenever more data is needed. We read the whole image in one step,
7613 so this only adds a fake end of input marker at the end. */
7616 our_fill_input_buffer (cinfo
)
7617 j_decompress_ptr cinfo
;
7619 /* Insert a fake EOI marker. */
7620 struct jpeg_source_mgr
*src
= cinfo
->src
;
7621 static JOCTET buffer
[2];
7623 buffer
[0] = (JOCTET
) 0xFF;
7624 buffer
[1] = (JOCTET
) JPEG_EOI
;
7626 src
->next_input_byte
= buffer
;
7627 src
->bytes_in_buffer
= 2;
7632 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
7633 is the JPEG data source manager. */
7636 our_skip_input_data (cinfo
, num_bytes
)
7637 j_decompress_ptr cinfo
;
7640 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
7644 if (num_bytes
> src
->bytes_in_buffer
)
7645 ERREXIT (cinfo
, JERR_INPUT_EOF
);
7647 src
->bytes_in_buffer
-= num_bytes
;
7648 src
->next_input_byte
+= num_bytes
;
7653 /* Method to terminate data source. Called by
7654 jpeg_finish_decompress() after all data has been processed. */
7657 our_term_source (cinfo
)
7658 j_decompress_ptr cinfo
;
7663 /* Set up the JPEG lib for reading an image from DATA which contains
7664 LEN bytes. CINFO is the decompression info structure created for
7665 reading the image. */
7668 jpeg_memory_src (cinfo
, data
, len
)
7669 j_decompress_ptr cinfo
;
7673 struct jpeg_source_mgr
*src
;
7675 if (cinfo
->src
== NULL
)
7677 /* First time for this JPEG object? */
7678 cinfo
->src
= (struct jpeg_source_mgr
*)
7679 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
7680 sizeof (struct jpeg_source_mgr
));
7681 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
7682 src
->next_input_byte
= data
;
7685 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
7686 src
->init_source
= our_init_source
;
7687 src
->fill_input_buffer
= our_fill_input_buffer
;
7688 src
->skip_input_data
= our_skip_input_data
;
7689 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
7690 src
->term_source
= our_term_source
;
7691 src
->bytes_in_buffer
= len
;
7692 src
->next_input_byte
= data
;
7696 /* Load image IMG for use on frame F. Patterned after example.c
7697 from the JPEG lib. */
7704 struct jpeg_decompress_struct cinfo
;
7705 struct my_jpeg_error_mgr mgr
;
7706 Lisp_Object file
, specified_file
;
7707 Lisp_Object specified_data
;
7710 int row_stride
, x
, y
;
7711 XImage
*ximg
= NULL
;
7713 unsigned long *colors
;
7715 struct gcpro gcpro1
;
7717 /* Open the JPEG file. */
7718 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7719 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7723 if (NILP (specified_data
))
7725 file
= x_find_image_file (specified_file
);
7726 if (!STRINGP (file
))
7728 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7733 fp
= fopen (XSTRING (file
)->data
, "r");
7736 image_error ("Cannot open `%s'", file
, Qnil
);
7742 /* Customize libjpeg's error handling to call my_error_exit when an
7743 error is detected. This function will perform a longjmp. */
7744 mgr
.pub
.error_exit
= my_error_exit
;
7745 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
7747 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
7751 /* Called from my_error_exit. Display a JPEG error. */
7752 char buffer
[JMSG_LENGTH_MAX
];
7753 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
7754 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
7755 build_string (buffer
));
7758 /* Close the input file and destroy the JPEG object. */
7761 jpeg_destroy_decompress (&cinfo
);
7765 /* If we already have an XImage, free that. */
7766 x_destroy_x_image (ximg
);
7768 /* Free pixmap and colors. */
7769 x_clear_image (f
, img
);
7776 /* Create the JPEG decompression object. Let it read from fp.
7777 Read the JPEG image header. */
7778 jpeg_create_decompress (&cinfo
);
7780 if (NILP (specified_data
))
7781 jpeg_stdio_src (&cinfo
, fp
);
7783 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
7784 STRING_BYTES (XSTRING (specified_data
)));
7786 jpeg_read_header (&cinfo
, TRUE
);
7788 /* Customize decompression so that color quantization will be used.
7789 Start decompression. */
7790 cinfo
.quantize_colors
= TRUE
;
7791 jpeg_start_decompress (&cinfo
);
7792 width
= img
->width
= cinfo
.output_width
;
7793 height
= img
->height
= cinfo
.output_height
;
7797 /* Create X image and pixmap. */
7798 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
7802 longjmp (mgr
.setjmp_buffer
, 2);
7805 /* Allocate colors. When color quantization is used,
7806 cinfo.actual_number_of_colors has been set with the number of
7807 colors generated, and cinfo.colormap is a two-dimensional array
7808 of color indices in the range 0..cinfo.actual_number_of_colors.
7809 No more than 255 colors will be generated. */
7813 if (cinfo
.out_color_components
> 2)
7814 ir
= 0, ig
= 1, ib
= 2;
7815 else if (cinfo
.out_color_components
> 1)
7816 ir
= 0, ig
= 1, ib
= 0;
7818 ir
= 0, ig
= 0, ib
= 0;
7820 /* Use the color table mechanism because it handles colors that
7821 cannot be allocated nicely. Such colors will be replaced with
7822 a default color, and we don't have to care about which colors
7823 can be freed safely, and which can't. */
7824 init_color_table ();
7825 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
7828 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
7830 /* Multiply RGB values with 255 because X expects RGB values
7831 in the range 0..0xffff. */
7832 int r
= cinfo
.colormap
[ir
][i
] << 8;
7833 int g
= cinfo
.colormap
[ig
][i
] << 8;
7834 int b
= cinfo
.colormap
[ib
][i
] << 8;
7835 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
7838 /* Remember those colors actually allocated. */
7839 img
->colors
= colors_in_color_table (&img
->ncolors
);
7840 free_color_table ();
7844 row_stride
= width
* cinfo
.output_components
;
7845 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
7847 for (y
= 0; y
< height
; ++y
)
7849 jpeg_read_scanlines (&cinfo
, buffer
, 1);
7850 for (x
= 0; x
< cinfo
.output_width
; ++x
)
7851 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
7855 jpeg_finish_decompress (&cinfo
);
7856 jpeg_destroy_decompress (&cinfo
);
7860 /* Put the image into the pixmap. */
7861 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7862 x_destroy_x_image (ximg
);
7868 #endif /* HAVE_JPEG */
7872 /***********************************************************************
7874 ***********************************************************************/
7880 static int tiff_image_p
P_ ((Lisp_Object object
));
7881 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
7883 /* The symbol `tiff' identifying images of this type. */
7887 /* Indices of image specification fields in tiff_format, below. */
7889 enum tiff_keyword_index
7898 TIFF_HEURISTIC_MASK
,
7902 /* Vector of image_keyword structures describing the format
7903 of valid user-defined image specifications. */
7905 static struct image_keyword tiff_format
[TIFF_LAST
] =
7907 {":type", IMAGE_SYMBOL_VALUE
, 1},
7908 {":data", IMAGE_STRING_VALUE
, 0},
7909 {":file", IMAGE_STRING_VALUE
, 0},
7910 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7911 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
7912 {":relief", IMAGE_INTEGER_VALUE
, 0},
7913 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7914 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7917 /* Structure describing the image type `tiff'. */
7919 static struct image_type tiff_type
=
7929 /* Return non-zero if OBJECT is a valid TIFF image specification. */
7932 tiff_image_p (object
)
7935 struct image_keyword fmt
[TIFF_LAST
];
7936 bcopy (tiff_format
, fmt
, sizeof fmt
);
7938 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
7939 || (fmt
[TIFF_ASCENT
].count
7940 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
7943 /* Must specify either the :data or :file keyword. */
7944 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
7948 /* Reading from a memory buffer for TIFF images Based on the PNG
7949 memory source, but we have to provide a lot of extra functions.
7952 We really only need to implement read and seek, but I am not
7953 convinced that the TIFF library is smart enough not to destroy
7954 itself if we only hand it the function pointers we need to
7959 unsigned char *bytes
;
7966 tiff_read_from_memory (data
, buf
, size
)
7971 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
7973 if (size
> src
->len
- src
->index
)
7975 bcopy (src
->bytes
+ src
->index
, buf
, size
);
7981 tiff_write_from_memory (data
, buf
, size
)
7990 tiff_seek_in_memory (data
, off
, whence
)
7995 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8000 case SEEK_SET
: /* Go from beginning of source. */
8004 case SEEK_END
: /* Go from end of source. */
8005 idx
= src
->len
+ off
;
8008 case SEEK_CUR
: /* Go from current position. */
8009 idx
= src
->index
+ off
;
8012 default: /* Invalid `whence'. */
8016 if (idx
> src
->len
|| idx
< 0)
8024 tiff_close_memory (data
)
8032 tiff_mmap_memory (data
, pbase
, psize
)
8037 /* It is already _IN_ memory. */
8042 tiff_unmap_memory (data
, base
, size
)
8047 /* We don't need to do this. */
8051 tiff_size_of_memory (data
)
8054 return ((tiff_memory_source
*) data
)->len
;
8057 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8065 Lisp_Object file
, specified_file
;
8066 Lisp_Object specified_data
;
8068 int width
, height
, x
, y
;
8072 struct gcpro gcpro1
;
8073 tiff_memory_source memsrc
;
8075 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8076 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8080 if (NILP (specified_data
))
8082 /* Read from a file */
8083 file
= x_find_image_file (specified_file
);
8084 if (!STRINGP (file
))
8086 image_error ("Cannot find image file `%s'", file
, Qnil
);
8091 /* Try to open the image file. */
8092 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
8095 image_error ("Cannot open `%s'", file
, Qnil
);
8102 /* Memory source! */
8103 memsrc
.bytes
= XSTRING (specified_data
)->data
;
8104 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
8107 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
8108 (TIFFReadWriteProc
) tiff_read_from_memory
,
8109 (TIFFReadWriteProc
) tiff_write_from_memory
,
8110 tiff_seek_in_memory
,
8112 tiff_size_of_memory
,
8118 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
8124 /* Get width and height of the image, and allocate a raster buffer
8125 of width x height 32-bit values. */
8126 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
8127 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
8128 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
8130 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
8134 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
8142 /* Create the X image and pixmap. */
8143 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8151 /* Initialize the color table. */
8152 init_color_table ();
8154 /* Process the pixel raster. Origin is in the lower-left corner. */
8155 for (y
= 0; y
< height
; ++y
)
8157 uint32
*row
= buf
+ y
* width
;
8159 for (x
= 0; x
< width
; ++x
)
8161 uint32 abgr
= row
[x
];
8162 int r
= TIFFGetR (abgr
) << 8;
8163 int g
= TIFFGetG (abgr
) << 8;
8164 int b
= TIFFGetB (abgr
) << 8;
8165 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
8169 /* Remember the colors allocated for the image. Free the color table. */
8170 img
->colors
= colors_in_color_table (&img
->ncolors
);
8171 free_color_table ();
8173 /* Put the image into the pixmap, then free the X image and its buffer. */
8174 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8175 x_destroy_x_image (ximg
);
8180 img
->height
= height
;
8186 #endif /* HAVE_TIFF != 0 */
8190 /***********************************************************************
8192 ***********************************************************************/
8196 #include <gif_lib.h>
8198 static int gif_image_p
P_ ((Lisp_Object object
));
8199 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
8201 /* The symbol `gif' identifying images of this type. */
8205 /* Indices of image specification fields in gif_format, below. */
8207 enum gif_keyword_index
8221 /* Vector of image_keyword structures describing the format
8222 of valid user-defined image specifications. */
8224 static struct image_keyword gif_format
[GIF_LAST
] =
8226 {":type", IMAGE_SYMBOL_VALUE
, 1},
8227 {":data", IMAGE_STRING_VALUE
, 0},
8228 {":file", IMAGE_STRING_VALUE
, 0},
8229 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8230 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8231 {":relief", IMAGE_INTEGER_VALUE
, 0},
8232 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8233 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8234 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
8237 /* Structure describing the image type `gif'. */
8239 static struct image_type gif_type
=
8248 /* Return non-zero if OBJECT is a valid GIF image specification. */
8251 gif_image_p (object
)
8254 struct image_keyword fmt
[GIF_LAST
];
8255 bcopy (gif_format
, fmt
, sizeof fmt
);
8257 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
8258 || (fmt
[GIF_ASCENT
].count
8259 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
8262 /* Must specify either the :data or :file keyword. */
8263 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
8266 /* Reading a GIF image from memory
8267 Based on the PNG memory stuff to a certain extent. */
8271 unsigned char *bytes
;
8277 /* Make the current memory source available to gif_read_from_memory.
8278 It's done this way because not all versions of libungif support
8279 a UserData field in the GifFileType structure. */
8280 static gif_memory_source
*current_gif_memory_src
;
8283 gif_read_from_memory (file
, buf
, len
)
8288 gif_memory_source
*src
= current_gif_memory_src
;
8290 if (len
> src
->len
- src
->index
)
8293 bcopy (src
->bytes
+ src
->index
, buf
, len
);
8299 /* Load GIF image IMG for use on frame F. Value is non-zero if
8307 Lisp_Object file
, specified_file
;
8308 Lisp_Object specified_data
;
8309 int rc
, width
, height
, x
, y
, i
;
8311 ColorMapObject
*gif_color_map
;
8312 unsigned long pixel_colors
[256];
8314 struct gcpro gcpro1
;
8316 int ino
, image_left
, image_top
, image_width
, image_height
;
8317 gif_memory_source memsrc
;
8318 unsigned char *raster
;
8320 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8321 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8325 if (NILP (specified_data
))
8327 file
= x_find_image_file (specified_file
);
8328 if (!STRINGP (file
))
8330 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8335 /* Open the GIF file. */
8336 gif
= DGifOpenFileName (XSTRING (file
)->data
);
8339 image_error ("Cannot open `%s'", file
, Qnil
);
8346 /* Read from memory! */
8347 current_gif_memory_src
= &memsrc
;
8348 memsrc
.bytes
= XSTRING (specified_data
)->data
;
8349 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
8352 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
8355 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
8361 /* Read entire contents. */
8362 rc
= DGifSlurp (gif
);
8363 if (rc
== GIF_ERROR
)
8365 image_error ("Error reading `%s'", img
->spec
, Qnil
);
8366 DGifCloseFile (gif
);
8371 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
8372 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
8373 if (ino
>= gif
->ImageCount
)
8375 image_error ("Invalid image number `%s' in image `%s'",
8377 DGifCloseFile (gif
);
8382 width
= img
->width
= gif
->SWidth
;
8383 height
= img
->height
= gif
->SHeight
;
8387 /* Create the X image and pixmap. */
8388 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8391 DGifCloseFile (gif
);
8396 /* Allocate colors. */
8397 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
8399 gif_color_map
= gif
->SColorMap
;
8400 init_color_table ();
8401 bzero (pixel_colors
, sizeof pixel_colors
);
8403 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
8405 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
8406 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
8407 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
8408 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8411 img
->colors
= colors_in_color_table (&img
->ncolors
);
8412 free_color_table ();
8414 /* Clear the part of the screen image that are not covered by
8415 the image from the GIF file. Full animated GIF support
8416 requires more than can be done here (see the gif89 spec,
8417 disposal methods). Let's simply assume that the part
8418 not covered by a sub-image is in the frame's background color. */
8419 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
8420 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
8421 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
8422 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
8424 for (y
= 0; y
< image_top
; ++y
)
8425 for (x
= 0; x
< width
; ++x
)
8426 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8428 for (y
= image_top
+ image_height
; y
< height
; ++y
)
8429 for (x
= 0; x
< width
; ++x
)
8430 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8432 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
8434 for (x
= 0; x
< image_left
; ++x
)
8435 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8436 for (x
= image_left
+ image_width
; x
< width
; ++x
)
8437 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8440 /* Read the GIF image into the X image. We use a local variable
8441 `raster' here because RasterBits below is a char *, and invites
8442 problems with bytes >= 0x80. */
8443 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
8445 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
8447 static int interlace_start
[] = {0, 4, 2, 1};
8448 static int interlace_increment
[] = {8, 8, 4, 2};
8450 int row
= interlace_start
[0];
8454 for (y
= 0; y
< image_height
; y
++)
8456 if (row
>= image_height
)
8458 row
= interlace_start
[++pass
];
8459 while (row
>= image_height
)
8460 row
= interlace_start
[++pass
];
8463 for (x
= 0; x
< image_width
; x
++)
8465 int i
= raster
[(y
* image_width
) + x
];
8466 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
8470 row
+= interlace_increment
[pass
];
8475 for (y
= 0; y
< image_height
; ++y
)
8476 for (x
= 0; x
< image_width
; ++x
)
8478 int i
= raster
[y
* image_width
+ x
];
8479 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
8483 DGifCloseFile (gif
);
8485 /* Put the image into the pixmap, then free the X image and its buffer. */
8486 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8487 x_destroy_x_image (ximg
);
8494 #endif /* HAVE_GIF != 0 */
8498 /***********************************************************************
8500 ***********************************************************************/
8502 #ifdef HAVE_GHOSTSCRIPT
8503 static int gs_image_p
P_ ((Lisp_Object object
));
8504 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
8505 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8507 /* The symbol `postscript' identifying images of this type. */
8509 Lisp_Object Qpostscript
;
8511 /* Keyword symbols. */
8513 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
8515 /* Indices of image specification fields in gs_format, below. */
8517 enum gs_keyword_index
8533 /* Vector of image_keyword structures describing the format
8534 of valid user-defined image specifications. */
8536 static struct image_keyword gs_format
[GS_LAST
] =
8538 {":type", IMAGE_SYMBOL_VALUE
, 1},
8539 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
8540 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
8541 {":file", IMAGE_STRING_VALUE
, 1},
8542 {":loader", IMAGE_FUNCTION_VALUE
, 0},
8543 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
8544 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8545 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR
, 0},
8546 {":relief", IMAGE_INTEGER_VALUE
, 0},
8547 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8548 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8551 /* Structure describing the image type `ghostscript'. */
8553 static struct image_type gs_type
=
8563 /* Free X resources of Ghostscript image IMG which is used on frame F. */
8566 gs_clear_image (f
, img
)
8570 /* IMG->data.ptr_val may contain a recorded colormap. */
8571 xfree (img
->data
.ptr_val
);
8572 x_clear_image (f
, img
);
8576 /* Return non-zero if OBJECT is a valid Ghostscript image
8583 struct image_keyword fmt
[GS_LAST
];
8587 bcopy (gs_format
, fmt
, sizeof fmt
);
8589 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
8590 || (fmt
[GS_ASCENT
].count
8591 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
8594 /* Bounding box must be a list or vector containing 4 integers. */
8595 tem
= fmt
[GS_BOUNDING_BOX
].value
;
8598 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
8599 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
8604 else if (VECTORP (tem
))
8606 if (XVECTOR (tem
)->size
!= 4)
8608 for (i
= 0; i
< 4; ++i
)
8609 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
8619 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
8628 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
8629 struct gcpro gcpro1
, gcpro2
;
8631 double in_width
, in_height
;
8632 Lisp_Object pixel_colors
= Qnil
;
8634 /* Compute pixel size of pixmap needed from the given size in the
8635 image specification. Sizes in the specification are in pt. 1 pt
8636 = 1/72 in, xdpi and ydpi are stored in the frame's X display
8638 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
8639 in_width
= XFASTINT (pt_width
) / 72.0;
8640 img
->width
= in_width
* FRAME_W32_DISPLAY_INFO (f
)->resx
;
8641 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
8642 in_height
= XFASTINT (pt_height
) / 72.0;
8643 img
->height
= in_height
* FRAME_W32_DISPLAY_INFO (f
)->resy
;
8645 /* Create the pixmap. */
8647 xassert (img
->pixmap
== 0);
8648 img
->pixmap
= XCreatePixmap (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
8649 img
->width
, img
->height
,
8650 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
8655 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
8659 /* Call the loader to fill the pixmap. It returns a process object
8660 if successful. We do not record_unwind_protect here because
8661 other places in redisplay like calling window scroll functions
8662 don't either. Let the Lisp loader use `unwind-protect' instead. */
8663 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
8665 sprintf (buffer
, "%lu %lu",
8666 (unsigned long) FRAME_W32_WINDOW (f
),
8667 (unsigned long) img
->pixmap
);
8668 window_and_pixmap_id
= build_string (buffer
);
8670 sprintf (buffer
, "%lu %lu",
8671 FRAME_FOREGROUND_PIXEL (f
),
8672 FRAME_BACKGROUND_PIXEL (f
));
8673 pixel_colors
= build_string (buffer
);
8675 XSETFRAME (frame
, f
);
8676 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
8678 loader
= intern ("gs-load-image");
8680 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
8681 make_number (img
->width
),
8682 make_number (img
->height
),
8683 window_and_pixmap_id
,
8686 return PROCESSP (img
->data
.lisp_val
);
8690 /* Kill the Ghostscript process that was started to fill PIXMAP on
8691 frame F. Called from XTread_socket when receiving an event
8692 telling Emacs that Ghostscript has finished drawing. */
8695 x_kill_gs_process (pixmap
, f
)
8699 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
8703 /* Find the image containing PIXMAP. */
8704 for (i
= 0; i
< c
->used
; ++i
)
8705 if (c
->images
[i
]->pixmap
== pixmap
)
8708 /* Kill the GS process. We should have found PIXMAP in the image
8709 cache and its image should contain a process object. */
8710 xassert (i
< c
->used
);
8712 xassert (PROCESSP (img
->data
.lisp_val
));
8713 Fkill_process (img
->data
.lisp_val
, Qnil
);
8714 img
->data
.lisp_val
= Qnil
;
8716 /* On displays with a mutable colormap, figure out the colors
8717 allocated for the image by looking at the pixels of an XImage for
8719 class = FRAME_W32_DISPLAY_INFO (f
)->visual
->class;
8720 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
8726 /* Try to get an XImage for img->pixmep. */
8727 ximg
= XGetImage (FRAME_W32_DISPLAY (f
), img
->pixmap
,
8728 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
8733 /* Initialize the color table. */
8734 init_color_table ();
8736 /* For each pixel of the image, look its color up in the
8737 color table. After having done so, the color table will
8738 contain an entry for each color used by the image. */
8739 for (y
= 0; y
< img
->height
; ++y
)
8740 for (x
= 0; x
< img
->width
; ++x
)
8742 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
8743 lookup_pixel_color (f
, pixel
);
8746 /* Record colors in the image. Free color table and XImage. */
8747 img
->colors
= colors_in_color_table (&img
->ncolors
);
8748 free_color_table ();
8749 XDestroyImage (ximg
);
8751 #if 0 /* This doesn't seem to be the case. If we free the colors
8752 here, we get a BadAccess later in x_clear_image when
8753 freeing the colors. */
8754 /* We have allocated colors once, but Ghostscript has also
8755 allocated colors on behalf of us. So, to get the
8756 reference counts right, free them once. */
8759 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
8760 XFreeColors (FRAME_W32_DISPLAY (f
), cmap
,
8761 img
->colors
, img
->ncolors
, 0);
8766 image_error ("Cannot get X image of `%s'; colors will not be freed",
8773 #endif /* HAVE_GHOSTSCRIPT */
8776 /***********************************************************************
8778 ***********************************************************************/
8780 DEFUN ("x-change-window-property", Fx_change_window_property
,
8781 Sx_change_window_property
, 2, 3, 0,
8782 "Change window property PROP to VALUE on the X window of FRAME.\n\
8783 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
8784 selected frame. Value is VALUE.")
8785 (prop
, value
, frame
)
8786 Lisp_Object frame
, prop
, value
;
8788 #if 0 /* MAC_TODO : port window properties to Mac */
8789 struct frame
*f
= check_x_frame (frame
);
8792 CHECK_STRING (prop
, 1);
8793 CHECK_STRING (value
, 2);
8796 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
8797 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
8798 prop_atom
, XA_STRING
, 8, PropModeReplace
,
8799 XSTRING (value
)->data
, XSTRING (value
)->size
);
8801 /* Make sure the property is set when we return. */
8802 XFlush (FRAME_W32_DISPLAY (f
));
8805 #endif /* MAC_TODO */
8811 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
8812 Sx_delete_window_property
, 1, 2, 0,
8813 "Remove window property PROP from X window of FRAME.\n\
8814 FRAME nil or omitted means use the selected frame. Value is PROP.")
8816 Lisp_Object prop
, frame
;
8818 #if 0 /* MAC_TODO : port window properties to Mac */
8820 struct frame
*f
= check_x_frame (frame
);
8823 CHECK_STRING (prop
, 1);
8825 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
8826 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
8828 /* Make sure the property is removed when we return. */
8829 XFlush (FRAME_W32_DISPLAY (f
));
8831 #endif /* MAC_TODO */
8837 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
8839 "Value is the value of window property PROP on FRAME.\n\
8840 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
8841 if FRAME hasn't a property with name PROP or if PROP has no string\n\
8844 Lisp_Object prop
, frame
;
8846 #if 0 /* MAC_TODO : port window properties to Mac */
8848 struct frame
*f
= check_x_frame (frame
);
8851 Lisp_Object prop_value
= Qnil
;
8852 char *tmp_data
= NULL
;
8855 unsigned long actual_size
, bytes_remaining
;
8857 CHECK_STRING (prop
, 1);
8859 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), XSTRING (prop
)->data
, False
);
8860 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
8861 prop_atom
, 0, 0, False
, XA_STRING
,
8862 &actual_type
, &actual_format
, &actual_size
,
8863 &bytes_remaining
, (unsigned char **) &tmp_data
);
8866 int size
= bytes_remaining
;
8871 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
8872 prop_atom
, 0, bytes_remaining
,
8874 &actual_type
, &actual_format
,
8875 &actual_size
, &bytes_remaining
,
8876 (unsigned char **) &tmp_data
);
8878 prop_value
= make_string (tmp_data
, size
);
8887 #endif /* MAC_TODO */
8893 /***********************************************************************
8895 ***********************************************************************/
8897 /* If non-null, an asynchronous timer that, when it expires, displays
8898 an hourglass cursor on all frames. */
8900 static struct atimer
*hourglass_atimer
;
8902 /* Non-zero means an hourglass cursor is currently shown. */
8904 static int hourglass_shown_p
;
8906 /* Number of seconds to wait before displaying an hourglass cursor. */
8908 static Lisp_Object Vhourglass_delay
;
8910 /* Default number of seconds to wait before displaying an hourglass
8913 #define DEFAULT_HOURGLASS_DELAY 1
8915 /* Function prototypes. */
8917 static void show_hourglass
P_ ((struct atimer
*));
8918 static void hide_hourglass
P_ ((void));
8921 /* Cancel a currently active hourglass timer, and start a new one. */
8926 #if 0 /* TODO: cursor shape changes. */
8928 int secs
, usecs
= 0;
8930 cancel_hourglass ();
8932 if (INTEGERP (Vhourglass_delay
)
8933 && XINT (Vhourglass_delay
) > 0)
8934 secs
= XFASTINT (Vhourglass_delay
);
8935 else if (FLOATP (Vhourglass_delay
)
8936 && XFLOAT_DATA (Vhourglass_delay
) > 0)
8939 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
8940 secs
= XFASTINT (tem
);
8941 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
8944 secs
= DEFAULT_HOURGLASS_DELAY
;
8946 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
8947 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
8948 show_hourglass
, NULL
);
8953 /* Cancel the hourglass cursor timer if active, hide an hourglass
8959 if (hourglass_atimer
)
8961 cancel_atimer (hourglass_atimer
);
8962 hourglass_atimer
= NULL
;
8965 if (hourglass_shown_p
)
8970 /* Timer function of hourglass_atimer. TIMER is equal to
8973 Display an hourglass cursor on all frames by mapping the frames'
8974 hourglass_window. Set the hourglass_p flag in the frames'
8975 output_data.x structure to indicate that an hourglass cursor is
8976 shown on the frames. */
8979 show_hourglass (timer
)
8980 struct atimer
*timer
;
8982 #if 0 /* MAC_TODO: cursor shape changes. */
8983 /* The timer implementation will cancel this timer automatically
8984 after this function has run. Set hourglass_atimer to null
8985 so that we know the timer doesn't have to be canceled. */
8986 hourglass_atimer
= NULL
;
8988 if (!hourglass_shown_p
)
8990 Lisp_Object rest
, frame
;
8994 FOR_EACH_FRAME (rest
, frame
)
8995 if (FRAME_W32_P (XFRAME (frame
)))
8997 struct frame
*f
= XFRAME (frame
);
8999 f
->output_data
.w32
->hourglass_p
= 1;
9001 if (!f
->output_data
.w32
->hourglass_window
)
9003 unsigned long mask
= CWCursor
;
9004 XSetWindowAttributes attrs
;
9006 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
9008 f
->output_data
.w32
->hourglass_window
9009 = XCreateWindow (FRAME_X_DISPLAY (f
),
9010 FRAME_OUTER_WINDOW (f
),
9011 0, 0, 32000, 32000, 0, 0,
9017 XMapRaised (FRAME_X_DISPLAY (f
),
9018 f
->output_data
.w32
->hourglass_window
);
9019 XFlush (FRAME_X_DISPLAY (f
));
9022 hourglass_shown_p
= 1;
9029 /* Hide the hourglass cursor on all frames, if it is currently shown. */
9034 #if 0 /* TODO: cursor shape changes. */
9035 if (hourglass_shown_p
)
9037 Lisp_Object rest
, frame
;
9040 FOR_EACH_FRAME (rest
, frame
)
9042 struct frame
*f
= XFRAME (frame
);
9045 /* Watch out for newly created frames. */
9046 && f
->output_data
.x
->hourglass_window
)
9048 XUnmapWindow (FRAME_X_DISPLAY (f
),
9049 f
->output_data
.x
->hourglass_window
);
9050 /* Sync here because XTread_socket looks at the
9051 hourglass_p flag that is reset to zero below. */
9052 XSync (FRAME_X_DISPLAY (f
), False
);
9053 f
->output_data
.x
->hourglass_p
= 0;
9057 hourglass_shown_p
= 0;
9065 /***********************************************************************
9067 ***********************************************************************/
9069 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
9072 /* The frame of a currently visible tooltip, or null. */
9074 Lisp_Object tip_frame
;
9076 /* If non-nil, a timer started that hides the last tooltip when it
9079 Lisp_Object tip_timer
;
9082 /* Create a frame for a tooltip on the display described by DPYINFO.
9083 PARMS is a list of frame parameters. Value is the frame. */
9086 x_create_tip_frame (dpyinfo
, parms
)
9087 struct w32_display_info
*dpyinfo
;
9090 #if 0 /* MAC_TODO : Mac version */
9092 Lisp_Object frame
, tem
;
9094 long window_prompting
= 0;
9096 int count
= specpdl_ptr
- specpdl
;
9097 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9102 /* Use this general default value to start with until we know if
9103 this frame has a specified name. */
9104 Vx_resource_name
= Vinvocation_name
;
9107 kb
= dpyinfo
->kboard
;
9109 kb
= &the_only_kboard
;
9112 /* Get the name of the frame to use for resource lookup. */
9113 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9115 && !EQ (name
, Qunbound
)
9117 error ("Invalid frame name--not a string or nil");
9118 Vx_resource_name
= name
;
9121 GCPRO3 (parms
, name
, frame
);
9122 tip_frame
= f
= make_frame (1);
9123 XSETFRAME (frame
, f
);
9124 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9126 f
->output_method
= output_w32
;
9127 f
->output_data
.w32
=
9128 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
9129 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
9131 f
->output_data
.w32
->icon_bitmap
= -1;
9133 f
->output_data
.w32
->fontset
= -1;
9134 f
->icon_name
= Qnil
;
9137 FRAME_KBOARD (f
) = kb
;
9139 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
9140 f
->output_data
.w32
->explicit_parent
= 0;
9142 /* Set the name; the functions to which we pass f expect the name to
9144 if (EQ (name
, Qunbound
) || NILP (name
))
9146 f
->name
= build_string (dpyinfo
->x_id_name
);
9147 f
->explicit_name
= 0;
9152 f
->explicit_name
= 1;
9153 /* use the frame's title when getting resources for this frame. */
9154 specbind (Qx_resource_name
, name
);
9157 /* Extract the window parameters from the supplied values
9158 that are needed to determine window geometry. */
9162 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9165 /* First, try whatever font the caller has specified. */
9168 tem
= Fquery_fontset (font
, Qnil
);
9170 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
9172 font
= x_new_font (f
, XSTRING (font
)->data
);
9175 /* Try out a font which we hope has bold and italic variations. */
9176 if (!STRINGP (font
))
9177 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9178 if (!STRINGP (font
))
9179 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9180 if (! STRINGP (font
))
9181 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9182 if (! STRINGP (font
))
9183 /* This was formerly the first thing tried, but it finds too many fonts
9184 and takes too long. */
9185 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9186 /* If those didn't work, look for something which will at least work. */
9187 if (! STRINGP (font
))
9188 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9190 if (! STRINGP (font
))
9191 font
= build_string ("fixed");
9193 x_default_parameter (f
, parms
, Qfont
, font
,
9194 "font", "Font", RES_TYPE_STRING
);
9197 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
9198 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
9200 /* This defaults to 2 in order to match xterm. We recognize either
9201 internalBorderWidth or internalBorder (which is what xterm calls
9203 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9207 value
= w32_get_arg (parms
, Qinternal_border_width
,
9208 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
9209 if (! EQ (value
, Qunbound
))
9210 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
9214 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
9215 "internalBorderWidth", "internalBorderWidth",
9218 /* Also do the stuff which must be set before the window exists. */
9219 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
9220 "foreground", "Foreground", RES_TYPE_STRING
);
9221 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
9222 "background", "Background", RES_TYPE_STRING
);
9223 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
9224 "pointerColor", "Foreground", RES_TYPE_STRING
);
9225 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
9226 "cursorColor", "Foreground", RES_TYPE_STRING
);
9227 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
9228 "borderColor", "BorderColor", RES_TYPE_STRING
);
9230 /* Init faces before x_default_parameter is called for scroll-bar
9231 parameters because that function calls x_set_scroll_bar_width,
9232 which calls change_frame_size, which calls Fset_window_buffer,
9233 which runs hooks, which call Fvertical_motion. At the end, we
9234 end up in init_iterator with a null face cache, which should not
9236 init_frame_faces (f
);
9238 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
9239 window_prompting
= x_figure_window_size (f
, parms
);
9241 if (window_prompting
& XNegative
)
9243 if (window_prompting
& YNegative
)
9244 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
9246 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
9250 if (window_prompting
& YNegative
)
9251 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
9253 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
9256 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
9258 XSetWindowAttributes attrs
;
9262 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
9263 /* Window managers looks at the override-redirect flag to
9264 determine whether or net to give windows a decoration (Xlib
9266 attrs
.override_redirect
= True
;
9267 attrs
.save_under
= True
;
9268 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
9269 /* Arrange for getting MapNotify and UnmapNotify events. */
9270 attrs
.event_mask
= StructureNotifyMask
;
9272 = FRAME_W32_WINDOW (f
)
9273 = XCreateWindow (FRAME_W32_DISPLAY (f
),
9274 FRAME_W32_DISPLAY_INFO (f
)->root_window
,
9275 /* x, y, width, height */
9279 CopyFromParent
, InputOutput
, CopyFromParent
,
9286 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
9287 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9288 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
9289 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9290 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
9291 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
9293 /* Dimensions, especially f->height, must be done via change_frame_size.
9294 Change will not be effected unless different from the current
9299 SET_FRAME_WIDTH (f
, 0);
9300 change_frame_size (f
, height
, width
, 1, 0, 0);
9306 /* It is now ok to make the frame official even if we get an error
9307 below. And the frame needs to be on Vframe_list or making it
9308 visible won't work. */
9309 Vframe_list
= Fcons (frame
, Vframe_list
);
9311 /* Now that the frame is official, it counts as a reference to
9313 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
9315 return unbind_to (count
, frame
);
9316 #endif /* MAC_TODO */
9320 #ifdef TODO /* Tooltip support not complete. */
9321 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
9322 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9323 A tooltip window is a small window displaying a string.\n\
9325 FRAME nil or omitted means use the selected frame.\n\
9327 PARMS is an optional list of frame parameters which can be\n\
9328 used to change the tooltip's appearance.\n\
9330 Automatically hide the tooltip after TIMEOUT seconds.\n\
9331 TIMEOUT nil means use the default timeout of 5 seconds.\n\
9333 If the list of frame parameters PARAMS contains a `left' parameters,\n\
9334 the tooltip is displayed at that x-position. Otherwise it is\n\
9335 displayed at the mouse position, with offset DX added (default is 5 if\n\
9336 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
9337 parameter is specified, it determines the y-position of the tooltip\n\
9338 window, otherwise it is displayed at the mouse position, with offset\n\
9339 DY added (default is 10).")
9340 (string
, frame
, parms
, timeout
, dx
, dy
)
9341 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
9346 Lisp_Object buffer
, top
, left
;
9347 struct buffer
*old_buffer
;
9348 struct text_pos pos
;
9349 int i
, width
, height
;
9350 int root_x
, root_y
, win_x
, win_y
;
9352 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
9353 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
9354 int count
= specpdl_ptr
- specpdl
;
9356 specbind (Qinhibit_redisplay
, Qt
);
9358 GCPRO4 (string
, parms
, frame
, timeout
);
9360 CHECK_STRING (string
, 0);
9361 f
= check_x_frame (frame
);
9363 timeout
= make_number (5);
9365 CHECK_NATNUM (timeout
, 2);
9368 dx
= make_number (5);
9370 CHECK_NUMBER (dx
, 5);
9373 dy
= make_number (-10);
9375 CHECK_NUMBER (dy
, 6);
9377 if (NILP (last_show_tip_args
))
9378 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
9380 if (!NILP (tip_frame
))
9382 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
9383 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
9384 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
9386 if (EQ (frame
, last_frame
)
9387 && !NILP (Fequal (last_string
, string
))
9388 && !NILP (Fequal (last_parms
, parms
)))
9390 struct frame
*f
= XFRAME (tip_frame
);
9392 /* Only DX and DY have changed. */
9393 if (!NILP (tip_timer
))
9395 Lisp_Object timer
= tip_timer
;
9397 call1 (Qcancel_timer
, timer
);
9401 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
9402 XMoveWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9403 root_x
, root_y
- PIXEL_HEIGHT (f
));
9409 /* Hide a previous tip, if any. */
9412 ASET (last_show_tip_args
, 0, string
);
9413 ASET (last_show_tip_args
, 1, frame
);
9414 ASET (last_show_tip_args
, 2, parms
);
9416 /* Add default values to frame parameters. */
9417 if (NILP (Fassq (Qname
, parms
)))
9418 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
9419 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9420 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
9421 if (NILP (Fassq (Qborder_width
, parms
)))
9422 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
9423 if (NILP (Fassq (Qborder_color
, parms
)))
9424 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
9425 if (NILP (Fassq (Qbackground_color
, parms
)))
9426 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
9429 /* Create a frame for the tooltip, and record it in the global
9430 variable tip_frame. */
9431 frame
= x_create_tip_frame (FRAME_MAC_DISPLAY_INFO (f
), parms
);
9434 /* Set up the frame's root window. Currently we use a size of 80
9435 columns x 40 lines. If someone wants to show a larger tip, he
9436 will loose. I don't think this is a realistic case. */
9437 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
9438 w
->left
= w
->top
= make_number (0);
9439 w
->width
= make_number (80);
9440 w
->height
= make_number (40);
9442 w
->pseudo_window_p
= 1;
9444 /* Display the tooltip text in a temporary buffer. */
9445 buffer
= Fget_buffer_create (build_string (" *tip*"));
9446 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
9447 old_buffer
= current_buffer
;
9448 set_buffer_internal_1 (XBUFFER (buffer
));
9450 Finsert (1, &string
);
9451 clear_glyph_matrix (w
->desired_matrix
);
9452 clear_glyph_matrix (w
->current_matrix
);
9453 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
9454 try_window (FRAME_ROOT_WINDOW (f
), pos
);
9456 /* Compute width and height of the tooltip. */
9458 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
9460 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
9464 /* Stop at the first empty row at the end. */
9465 if (!row
->enabled_p
|| !row
->displays_text_p
)
9468 /* Let the row go over the full width of the frame. */
9469 row
->full_width_p
= 1;
9471 /* There's a glyph at the end of rows that is use to place
9472 the cursor there. Don't include the width of this glyph. */
9473 if (row
->used
[TEXT_AREA
])
9475 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
9476 row_width
= row
->pixel_width
- last
->pixel_width
;
9479 row_width
= row
->pixel_width
;
9481 height
+= row
->height
;
9482 width
= max (width
, row_width
);
9485 /* Add the frame's internal border to the width and height the X
9486 window should have. */
9487 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9488 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9490 /* Move the tooltip window where the mouse pointer is. Resize and
9492 compute_tip_xy (f
, parms
, dx
, dy
, &root_x
, &root_y
);
9494 #if 0 /* TODO : Mac specifics */
9496 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9497 root_x
, root_y
- height
, width
, height
);
9498 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
9502 /* Draw into the window. */
9503 w
->must_be_updated_p
= 1;
9504 update_single_window (w
, 1);
9506 /* Restore original current buffer. */
9507 set_buffer_internal_1 (old_buffer
);
9508 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
9511 /* Let the tip disappear after timeout seconds. */
9512 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
9513 intern ("x-hide-tip"));
9516 return unbind_to (count
, Qnil
);
9520 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
9521 "Hide the current tooltip window, if there is any.\n\
9522 Value is t is tooltip was open, nil otherwise.")
9526 Lisp_Object deleted
, frame
, timer
;
9527 struct gcpro gcpro1
, gcpro2
;
9529 /* Return quickly if nothing to do. */
9530 if (NILP (tip_timer
) && NILP (tip_frame
))
9535 GCPRO2 (frame
, timer
);
9536 tip_frame
= tip_timer
= deleted
= Qnil
;
9538 count
= BINDING_STACK_SIZE ();
9539 specbind (Qinhibit_redisplay
, Qt
);
9540 specbind (Qinhibit_quit
, Qt
);
9543 call1 (Qcancel_timer
, timer
);
9547 Fdelete_frame (frame
, Qnil
);
9552 return unbind_to (count
, deleted
);
9558 /***********************************************************************
9559 File selection dialog
9560 ***********************************************************************/
9562 #if 0 /* MAC_TODO: can standard file dialog */
9563 extern Lisp_Object Qfile_name_history
;
9565 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
9566 "Read file name, prompting with PROMPT in directory DIR.\n\
9567 Use a file selection dialog.\n\
9568 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9569 specified. Don't let the user enter a file name in the file\n\
9570 selection dialog's entry field, if MUSTMATCH is non-nil.")
9571 (prompt
, dir
, default_filename
, mustmatch
)
9572 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
9574 struct frame
*f
= SELECTED_FRAME ();
9575 Lisp_Object file
= Qnil
;
9576 int count
= specpdl_ptr
- specpdl
;
9577 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
9578 char filename
[MAX_PATH
+ 1];
9579 char init_dir
[MAX_PATH
+ 1];
9580 int use_dialog_p
= 1;
9582 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
9583 CHECK_STRING (prompt
, 0);
9584 CHECK_STRING (dir
, 1);
9586 /* Create the dialog with PROMPT as title, using DIR as initial
9587 directory and using "*" as pattern. */
9588 dir
= Fexpand_file_name (dir
, Qnil
);
9589 strncpy (init_dir
, XSTRING (dir
)->data
, MAX_PATH
);
9590 init_dir
[MAX_PATH
] = '\0';
9591 unixtodos_filename (init_dir
);
9593 if (STRINGP (default_filename
))
9595 char *file_name_only
;
9596 char *full_path_name
= XSTRING (default_filename
)->data
;
9598 unixtodos_filename (full_path_name
);
9600 file_name_only
= strrchr (full_path_name
, '\\');
9601 if (!file_name_only
)
9602 file_name_only
= full_path_name
;
9607 /* If default_file_name is a directory, don't use the open
9608 file dialog, as it does not support selecting
9610 if (!(*file_name_only
))
9614 strncpy (filename
, file_name_only
, MAX_PATH
);
9615 filename
[MAX_PATH
] = '\0';
9622 OPENFILENAME file_details
;
9623 char *filename_file
;
9625 /* Prevent redisplay. */
9626 specbind (Qinhibit_redisplay
, Qt
);
9629 bzero (&file_details
, sizeof (file_details
));
9630 file_details
.lStructSize
= sizeof (file_details
);
9631 file_details
.hwndOwner
= FRAME_W32_WINDOW (f
);
9632 file_details
.lpstrFile
= filename
;
9633 file_details
.nMaxFile
= sizeof (filename
);
9634 file_details
.lpstrInitialDir
= init_dir
;
9635 file_details
.lpstrTitle
= XSTRING (prompt
)->data
;
9636 file_details
.Flags
= OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
;
9638 if (!NILP (mustmatch
))
9639 file_details
.Flags
|= OFN_FILEMUSTEXIST
| OFN_PATHMUSTEXIST
;
9641 if (GetOpenFileName (&file_details
))
9643 dostounix_filename (filename
);
9644 file
= build_string (filename
);
9650 file
= unbind_to (count
, file
);
9652 /* Open File dialog will not allow folders to be selected, so resort
9653 to minibuffer completing reads for directories. */
9655 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
9656 dir
, mustmatch
, dir
, Qfile_name_history
,
9657 default_filename
, Qnil
);
9661 /* Make "Cancel" equivalent to C-g. */
9663 Fsignal (Qquit
, Qnil
);
9665 return unbind_to (count
, file
);
9671 /***********************************************************************
9673 ***********************************************************************/
9677 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
9678 "Value is non-nil if SPEC is a valid image specification.")
9682 return valid_image_p (spec
) ? Qt
: Qnil
;
9686 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
9692 if (valid_image_p (spec
))
9693 id
= lookup_image (SELECTED_FRAME (), spec
);
9696 return make_number (id
);
9699 #endif /* GLYPH_DEBUG != 0 */
9706 /* Certainly running on Mac. */
9709 /* The section below is built by the lisp expression at the top of the file,
9710 just above where these variables are declared. */
9711 /*&&& init symbols here &&&*/
9712 Qauto_raise
= intern ("auto-raise");
9713 staticpro (&Qauto_raise
);
9714 Qauto_lower
= intern ("auto-lower");
9715 staticpro (&Qauto_lower
);
9716 Qbar
= intern ("bar");
9718 Qborder_color
= intern ("border-color");
9719 staticpro (&Qborder_color
);
9720 Qborder_width
= intern ("border-width");
9721 staticpro (&Qborder_width
);
9722 Qbox
= intern ("box");
9724 Qcursor_color
= intern ("cursor-color");
9725 staticpro (&Qcursor_color
);
9726 Qcursor_type
= intern ("cursor-type");
9727 staticpro (&Qcursor_type
);
9728 Qgeometry
= intern ("geometry");
9729 staticpro (&Qgeometry
);
9730 Qicon_left
= intern ("icon-left");
9731 staticpro (&Qicon_left
);
9732 Qicon_top
= intern ("icon-top");
9733 staticpro (&Qicon_top
);
9734 Qicon_type
= intern ("icon-type");
9735 staticpro (&Qicon_type
);
9736 Qicon_name
= intern ("icon-name");
9737 staticpro (&Qicon_name
);
9738 Qinternal_border_width
= intern ("internal-border-width");
9739 staticpro (&Qinternal_border_width
);
9740 Qleft
= intern ("left");
9742 Qright
= intern ("right");
9743 staticpro (&Qright
);
9744 Qmouse_color
= intern ("mouse-color");
9745 staticpro (&Qmouse_color
);
9746 Qnone
= intern ("none");
9748 Qparent_id
= intern ("parent-id");
9749 staticpro (&Qparent_id
);
9750 Qscroll_bar_width
= intern ("scroll-bar-width");
9751 staticpro (&Qscroll_bar_width
);
9752 Qsuppress_icon
= intern ("suppress-icon");
9753 staticpro (&Qsuppress_icon
);
9754 Qundefined_color
= intern ("undefined-color");
9755 staticpro (&Qundefined_color
);
9756 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
9757 staticpro (&Qvertical_scroll_bars
);
9758 Qvisibility
= intern ("visibility");
9759 staticpro (&Qvisibility
);
9760 Qwindow_id
= intern ("window-id");
9761 staticpro (&Qwindow_id
);
9762 Qx_frame_parameter
= intern ("x-frame-parameter");
9763 staticpro (&Qx_frame_parameter
);
9764 Qx_resource_name
= intern ("x-resource-name");
9765 staticpro (&Qx_resource_name
);
9766 Quser_position
= intern ("user-position");
9767 staticpro (&Quser_position
);
9768 Quser_size
= intern ("user-size");
9769 staticpro (&Quser_size
);
9770 Qscreen_gamma
= intern ("screen-gamma");
9771 staticpro (&Qscreen_gamma
);
9772 Qline_spacing
= intern ("line-spacing");
9773 staticpro (&Qline_spacing
);
9774 Qcenter
= intern ("center");
9775 staticpro (&Qcenter
);
9776 Qcancel_timer
= intern ("cancel-timer");
9777 staticpro (&Qcancel_timer
);
9778 /* This is the end of symbol initialization. */
9780 Qhyper
= intern ("hyper");
9781 staticpro (&Qhyper
);
9782 Qsuper
= intern ("super");
9783 staticpro (&Qsuper
);
9784 Qmeta
= intern ("meta");
9786 Qalt
= intern ("alt");
9788 Qctrl
= intern ("ctrl");
9790 Qcontrol
= intern ("control");
9791 staticpro (&Qcontrol
);
9792 Qshift
= intern ("shift");
9793 staticpro (&Qshift
);
9795 /* Text property `display' should be nonsticky by default. */
9796 Vtext_property_default_nonsticky
9797 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
9800 Qlaplace
= intern ("laplace");
9801 staticpro (&Qlaplace
);
9803 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
9804 staticpro (&Qface_set_after_frame_default
);
9806 Fput (Qundefined_color
, Qerror_conditions
,
9807 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
9808 Fput (Qundefined_color
, Qerror_message
,
9809 build_string ("Undefined color"));
9811 init_x_parm_symbols ();
9813 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
9814 "List of directories to search for bitmap files for w32.");
9815 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
9817 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
9818 "The shape of the pointer when over text.\n\
9819 Changing the value does not affect existing frames\n\
9820 unless you set the mouse color.");
9821 Vx_pointer_shape
= Qnil
;
9823 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
9824 "The name Emacs uses to look up resources; for internal use only.\n\
9825 `x-get-resource' uses this as the first component of the instance name\n\
9826 when requesting resource values.\n\
9827 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
9828 was invoked, or to the value specified with the `-name' or `-rn'\n\
9829 switches, if present.");
9830 Vx_resource_name
= Qnil
;
9832 Vx_nontext_pointer_shape
= Qnil
;
9834 Vx_mode_pointer_shape
= Qnil
;
9836 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
9837 "The shape of the pointer when Emacs is busy.\n\
9838 This variable takes effect when you create a new frame\n\
9839 or when you set the mouse color.");
9840 Vx_hourglass_pointer_shape
= Qnil
;
9842 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
9843 "Non-zero means Emacs displays an hourglass pointer on window systems.");
9844 display_hourglass_p
= 1;
9846 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
9847 "*Seconds to wait before displaying an hourglass pointer.\n\
9848 Value must be an integer or float.");
9849 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
9851 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
9852 &Vx_sensitive_text_pointer_shape
,
9853 "The shape of the pointer when over mouse-sensitive text.\n\
9854 This variable takes effect when you create a new frame\n\
9855 or when you set the mouse color.");
9856 Vx_sensitive_text_pointer_shape
= Qnil
;
9858 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
9859 "A string indicating the foreground color of the cursor box.");
9860 Vx_cursor_fore_pixel
= Qnil
;
9862 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
9863 "Non-nil if no window manager is in use.\n\
9864 Emacs doesn't try to figure this out; this is always nil\n\
9865 unless you set it to something else.");
9866 /* We don't have any way to find this out, so set it to nil
9867 and maybe the user would like to set it to t. */
9868 Vx_no_window_manager
= Qnil
;
9870 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9871 &Vx_pixel_size_width_font_regexp
,
9872 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
9874 Since Emacs gets width of a font matching with this regexp from\n\
9875 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
9876 such a font. This is especially effective for such large fonts as\n\
9877 Chinese, Japanese, and Korean.");
9878 Vx_pixel_size_width_font_regexp
= Qnil
;
9880 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
9881 "Time after which cached images are removed from the cache.\n\
9882 When an image has not been displayed this many seconds, remove it\n\
9883 from the image cache. Value must be an integer or nil with nil\n\
9884 meaning don't clear the cache.");
9885 Vimage_cache_eviction_delay
= make_number (30 * 60);
9887 #if 0 /* MAC_TODO: implement get X resource */
9888 defsubr (&Sx_get_resource
);
9890 defsubr (&Sx_change_window_property
);
9891 defsubr (&Sx_delete_window_property
);
9892 defsubr (&Sx_window_property
);
9893 defsubr (&Sxw_display_color_p
);
9894 defsubr (&Sx_display_grayscale_p
);
9895 defsubr (&Sxw_color_defined_p
);
9896 defsubr (&Sxw_color_values
);
9897 defsubr (&Sx_server_max_request_size
);
9898 defsubr (&Sx_server_vendor
);
9899 defsubr (&Sx_server_version
);
9900 defsubr (&Sx_display_pixel_width
);
9901 defsubr (&Sx_display_pixel_height
);
9902 defsubr (&Sx_display_mm_width
);
9903 defsubr (&Sx_display_mm_height
);
9904 defsubr (&Sx_display_screens
);
9905 defsubr (&Sx_display_planes
);
9906 defsubr (&Sx_display_color_cells
);
9907 defsubr (&Sx_display_visual_class
);
9908 defsubr (&Sx_display_backing_store
);
9909 defsubr (&Sx_display_save_under
);
9910 #if 0 /* MAC_TODO: implement XParseGeometry */
9911 defsubr (&Sx_parse_geometry
);
9913 defsubr (&Sx_create_frame
);
9914 #if 0 /* MAC_TODO: implement network support */
9915 defsubr (&Sx_open_connection
);
9916 defsubr (&Sx_close_connection
);
9918 defsubr (&Sx_display_list
);
9919 defsubr (&Sx_synchronize
);
9921 /* Setting callback functions for fontset handler. */
9922 get_font_info_func
= x_get_font_info
;
9924 #if 0 /* This function pointer doesn't seem to be used anywhere.
9925 And the pointer assigned has the wrong type, anyway. */
9926 list_fonts_func
= x_list_fonts
;
9929 load_font_func
= x_load_font
;
9930 find_ccl_program_func
= x_find_ccl_program
;
9931 query_font_func
= x_query_font
;
9933 set_frame_fontset_func
= x_set_font
;
9934 check_window_system_func
= check_mac
;
9936 #if 0 /* MAC_TODO: Image support for Mac Images. */
9937 Qxbm
= intern ("xbm");
9939 QCtype
= intern (":type");
9940 staticpro (&QCtype
);
9941 QCconversion
= intern (":conversion");
9942 staticpro (&QCconversion
);
9943 QCheuristic_mask
= intern (":heuristic-mask");
9944 staticpro (&QCheuristic_mask
);
9945 QCcolor_symbols
= intern (":color-symbols");
9946 staticpro (&QCcolor_symbols
);
9947 QCascent
= intern (":ascent");
9948 staticpro (&QCascent
);
9949 QCmargin
= intern (":margin");
9950 staticpro (&QCmargin
);
9951 QCrelief
= intern (":relief");
9952 staticpro (&QCrelief
);
9953 Qpostscript
= intern ("postscript");
9954 staticpro (&Qpostscript
);
9955 QCloader
= intern (":loader");
9956 staticpro (&QCloader
);
9957 QCbounding_box
= intern (":bounding-box");
9958 staticpro (&QCbounding_box
);
9959 QCpt_width
= intern (":pt-width");
9960 staticpro (&QCpt_width
);
9961 QCpt_height
= intern (":pt-height");
9962 staticpro (&QCpt_height
);
9963 QCindex
= intern (":index");
9964 staticpro (&QCindex
);
9965 Qpbm
= intern ("pbm");
9969 Qxpm
= intern ("xpm");
9974 Qjpeg
= intern ("jpeg");
9979 Qtiff
= intern ("tiff");
9984 Qgif
= intern ("gif");
9989 Qpng
= intern ("png");
9993 defsubr (&Sclear_image_cache
);
9997 defsubr (&Slookup_image
);
10001 hourglass_atimer
= NULL
;
10002 hourglass_shown_p
= 0;
10003 #ifdef TODO /* Tooltip support not complete. */
10004 defsubr (&Sx_show_tip
);
10005 defsubr (&Sx_hide_tip
);
10008 staticpro (&tip_timer
);
10010 staticpro (&tip_frame
);
10012 #if 0 /* MAC_TODO */
10013 defsubr (&Sx_file_dialog
);
10021 image_types
= NULL
;
10022 Vimage_types
= Qnil
;
10024 #if 0 /* TODO : Image support for W32 */
10025 define_image_type (&xbm_type
);
10026 define_image_type (&gs_type
);
10027 define_image_type (&pbm_type
);
10030 define_image_type (&xpm_type
);
10034 define_image_type (&jpeg_type
);
10038 define_image_type (&tiff_type
);
10042 define_image_type (&gif_type
);
10046 define_image_type (&png_type
);
10048 #endif /* NTEMACS_TODO */
10058 button
= MessageBox (NULL
,
10059 "A fatal error has occurred!\n\n"
10060 "Select Abort to exit, Retry to debug, Ignore to continue",
10061 "Emacs Abort Dialog",
10062 MB_ICONEXCLAMATION
| MB_TASKMODAL
10063 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
10078 /* For convenience when debugging. */
10082 return GetLastError ();