(customize-face-other-window): Make it work similarly.
[bpt/emacs.git] / mac / src / macfns.c
1 /* Graphical user interface functions for Mac OS.
2 Copyright (C) 2000 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
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)
9 any later version.
10
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.
15
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. */
20
21 /* Contributed by Andrew Choi (akochoi@users.sourceforge.net). */
22
23 #include <config.h>
24
25 #include <signal.h>
26 #include <stdio.h>
27 #include <math.h>
28 #include <limits.h>
29 #include <errno.h>
30
31 #include "lisp.h"
32 #include "charset.h"
33 #include "macterm.h"
34 #include "frame.h"
35 #include "window.h"
36 #include "buffer.h"
37 #include "dispextern.h"
38 #include "fontset.h"
39 #include "intervals.h"
40 #include "keyboard.h"
41 #include "blockinput.h"
42 #include "epaths.h"
43 #include "termhooks.h"
44 #include "coding.h"
45 #include "ccl.h"
46 #include "systime.h"
47
48 /* #include "bitmaps/gray.xbm" */
49 #define gray_width 2
50 #define gray_height 2
51 static unsigned char gray_bits[] = {
52 0x01, 0x02};
53
54 /*#include <commdlg.h>
55 #include <shellapi.h>*/
56 #include <ctype.h>
57
58 #include <stdlib.h>
59 #include <string.h>
60 #include <alloca.h>
61 #if 0
62 #include <unistd.h>
63 #endif
64
65 #include <Windows.h>
66 #include <Gestalt.h>
67 #include <TextUtils.h>
68
69 #ifndef min
70 #define min(a,b) ((a) < (b) ? (a) : (b))
71 #endif
72 #ifndef max
73 #define max(a,b) ((a) > (b) ? (a) : (b))
74 #endif
75
76 /*extern void free_frame_menubar ();
77 extern void x_compute_fringe_widths (struct frame *, int);
78 extern double atof ();
79 extern int w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state);
80 extern int quit_char;*/
81
82 /* A definition of XColor for non-X frames. */
83 #ifndef HAVE_X_WINDOWS
84 typedef struct {
85 unsigned long pixel;
86 unsigned short red, green, blue;
87 char flags;
88 char pad;
89 } XColor;
90 #endif
91
92 extern char *lispy_function_keys[];
93
94 /* The gray bitmap `bitmaps/gray'. This is done because macterm.c uses
95 it, and including `bitmaps/gray' more than once is a problem when
96 config.h defines `static' as an empty replacement string. */
97
98 int gray_bitmap_width = gray_width;
99 int gray_bitmap_height = gray_height;
100 unsigned char *gray_bitmap_bits = gray_bits;
101
102 /* The name we're using in resource queries. */
103
104 Lisp_Object Vx_resource_name;
105
106 /* Non-zero means we're allowed to display an hourglass cursor. */
107
108 int display_hourglass_p;
109
110 /* The background and shape of the mouse pointer, and shape when not
111 over text or in the modeline. */
112
113 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
114 Lisp_Object Vx_hourglass_pointer_shape;
115
116 /* The shape when over mouse-sensitive text. */
117
118 Lisp_Object Vx_sensitive_text_pointer_shape;
119
120 /* If non-nil, the pointer shape to indicate that windows can be
121 dragged horizontally. */
122
123 Lisp_Object Vx_window_horizontal_drag_shape;
124
125 /* Color of chars displayed in cursor box. */
126
127 Lisp_Object Vx_cursor_fore_pixel;
128
129 /* Nonzero if using Windows. */
130
131 static int mac_in_use;
132
133 /* Non nil if no window manager is in use. */
134
135 Lisp_Object Vx_no_window_manager;
136
137 /* Search path for bitmap files. */
138
139 Lisp_Object Vx_bitmap_file_path;
140
141 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
142
143 Lisp_Object Vx_pixel_size_width_font_regexp;
144
145 /* Evaluate this expression to rebuild the section of syms_of_macfns
146 that initializes and staticpros the symbols declared below. Note
147 that Emacs 18 has a bug that keeps C-x C-e from being able to
148 evaluate this expression.
149
150 (progn
151 ;; Accumulate a list of the symbols we want to initialize from the
152 ;; declarations at the top of the file.
153 (goto-char (point-min))
154 (search-forward "/\*&&& symbols declared here &&&*\/\n")
155 (let (symbol-list)
156 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
157 (setq symbol-list
158 (cons (buffer-substring (match-beginning 1) (match-end 1))
159 symbol-list))
160 (forward-line 1))
161 (setq symbol-list (nreverse symbol-list))
162 ;; Delete the section of syms_of_... where we initialize the symbols.
163 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
164 (let ((start (point)))
165 (while (looking-at "^ Q")
166 (forward-line 2))
167 (kill-region start (point)))
168 ;; Write a new symbol initialization section.
169 (while symbol-list
170 (insert (format " %s = intern (\"" (car symbol-list)))
171 (let ((start (point)))
172 (insert (substring (car symbol-list) 1))
173 (subst-char-in-region start (point) ?_ ?-))
174 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
175 (setq symbol-list (cdr symbol-list)))))
176
177 */
178
179 /*&&& symbols declared here &&&*/
180 Lisp_Object Qauto_raise;
181 Lisp_Object Qauto_lower;
182 Lisp_Object Qbar;
183 Lisp_Object Qborder_color;
184 Lisp_Object Qborder_width;
185 Lisp_Object Qbox;
186 Lisp_Object Qcursor_color;
187 Lisp_Object Qcursor_type;
188 Lisp_Object Qgeometry;
189 Lisp_Object Qicon_left;
190 Lisp_Object Qicon_top;
191 Lisp_Object Qicon_type;
192 Lisp_Object Qicon_name;
193 Lisp_Object Qinternal_border_width;
194 Lisp_Object Qleft;
195 Lisp_Object Qright;
196 Lisp_Object Qmouse_color;
197 Lisp_Object Qnone;
198 Lisp_Object Qparent_id;
199 Lisp_Object Qscroll_bar_width;
200 Lisp_Object Qsuppress_icon;
201 Lisp_Object Qundefined_color;
202 Lisp_Object Qvertical_scroll_bars;
203 Lisp_Object Qvisibility;
204 Lisp_Object Qwindow_id;
205 Lisp_Object Qx_frame_parameter;
206 Lisp_Object Qx_resource_name;
207 Lisp_Object Quser_position;
208 Lisp_Object Quser_size;
209 Lisp_Object Qscreen_gamma;
210 Lisp_Object Qline_spacing;
211 Lisp_Object Qcenter;
212 Lisp_Object Qcancel_timer;
213 Lisp_Object Qhyper;
214 Lisp_Object Qsuper;
215 Lisp_Object Qmeta;
216 Lisp_Object Qalt;
217 Lisp_Object Qctrl;
218 Lisp_Object Qcontrol;
219 Lisp_Object Qshift;
220
221 extern Lisp_Object Qtop;
222 extern Lisp_Object Qdisplay;
223 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
224 extern Lisp_Object Qtool_bar_lines;
225
226 /* These are defined in frame.c. */
227 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
228 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
229 extern Lisp_Object Qtool_bar_lines;
230
231 extern Lisp_Object Vwindow_system_version;
232
233 Lisp_Object Qface_set_after_frame_default;
234
235 /* Functions in macterm.c. */
236 extern void x_set_offset (struct frame *, int, int, int);
237 extern void x_wm_set_icon_position (struct frame *, int, int);
238 extern void x_display_cursor (struct window *, int, int, int, int, int);
239 extern void x_set_window_size (struct frame *, int, int, int);
240 extern void x_make_frame_visible (struct frame *);
241 extern struct mac_display_info *x_term_init (Lisp_Object, char *, char *);
242 extern struct font_info *x_get_font_info (FRAME_PTR, int);
243 extern struct font_info *x_load_font (struct frame *, char *, int);
244 extern void x_find_ccl_program (struct font_info *);
245 extern struct font_info *x_query_font (struct frame *, char *);
246
247
248 /* compare two strings ignoring case */
249
250 static int
251 stricmp (const char *s, const char *t)
252 {
253 for ( ; tolower (*s) == tolower (*t); s++, t++)
254 if (*s == '\0')
255 return 0;
256 return tolower (*s) - tolower (*t);
257 }
258
259 /* compare two strings up to n characters, ignoring case */
260
261 static int
262 strnicmp (const char *s, const char *t, unsigned int n)
263 {
264 for ( ; n-- > 0 && tolower (*s) == tolower (*t); s++, t++)
265 if (*s == '\0')
266 return 0;
267 return n == 0 ? 0 : tolower (*s) - tolower (*t);
268 }
269
270 \f
271 /* Error if we are not running on Mac OS. */
272
273 void
274 check_mac ()
275 {
276 if (! mac_in_use)
277 error ("Mac OS not in use or not initialized");
278 }
279
280 /* Nonzero if we can use mouse menus.
281 You should not call this unless HAVE_MENUS is defined. */
282
283 int
284 have_menus_p ()
285 {
286 return mac_in_use;
287 }
288
289 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
290 and checking validity for Mac. */
291
292 FRAME_PTR
293 check_x_frame (frame)
294 Lisp_Object frame;
295 {
296 FRAME_PTR f;
297
298 if (NILP (frame))
299 frame = selected_frame;
300 CHECK_LIVE_FRAME (frame, 0);
301 f = XFRAME (frame);
302 if (! FRAME_MAC_P (f))
303 error ("non-mac frame used");
304 return f;
305 }
306
307 /* Let the user specify an display with a frame.
308 nil stands for the selected frame--or, if that is not a mac frame,
309 the first display on the list. */
310
311 static struct mac_display_info *
312 check_x_display_info (frame)
313 Lisp_Object frame;
314 {
315 if (NILP (frame))
316 {
317 struct frame *sf = XFRAME (selected_frame);
318
319 if (FRAME_MAC_P (sf) && FRAME_LIVE_P (sf))
320 return FRAME_MAC_DISPLAY_INFO (sf);
321 else
322 return &one_mac_display_info;
323 }
324 else if (STRINGP (frame))
325 return x_display_info_for_name (frame);
326 else
327 {
328 FRAME_PTR f;
329
330 CHECK_LIVE_FRAME (frame, 0);
331 f = XFRAME (frame);
332 if (! FRAME_MAC_P (f))
333 error ("non-mac frame used");
334 return FRAME_MAC_DISPLAY_INFO (f);
335 }
336 }
337 \f
338 /* Return the Emacs frame-object corresponding to an mac window.
339 It could be the frame's main window or an icon window. */
340
341 /* This function can be called during GC, so use GC_xxx type test macros. */
342
343 struct frame *
344 x_window_to_frame (dpyinfo, wdesc)
345 struct mac_display_info *dpyinfo;
346 WindowPtr wdesc;
347 {
348 Lisp_Object tail, frame;
349 struct frame *f;
350
351 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
352 {
353 frame = XCAR (tail);
354 if (!GC_FRAMEP (frame))
355 continue;
356 f = XFRAME (frame);
357 if (!FRAME_W32_P (f) || FRAME_MAC_DISPLAY_INFO (f) != dpyinfo)
358 continue;
359 /*if (f->output_data.w32->busy_window == wdesc)
360 return f;*/
361
362 /* MAC_TODO: Check tooltips when supported. */
363 if (FRAME_MAC_WINDOW (f) == wdesc)
364 return f;
365 }
366 return 0;
367 }
368
369 \f
370
371 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
372 id, which is just an int that this section returns. Bitmaps are
373 reference counted so they can be shared among frames.
374
375 Bitmap indices are guaranteed to be > 0, so a negative number can
376 be used to indicate no bitmap.
377
378 If you use x_create_bitmap_from_data, then you must keep track of
379 the bitmaps yourself. That is, creating a bitmap from the same
380 data more than once will not be caught. */
381
382
383 /* Functions to access the contents of a bitmap, given an id. */
384
385 int
386 x_bitmap_height (f, id)
387 FRAME_PTR f;
388 int id;
389 {
390 return FRAME_MAC_DISPLAY_INFO (f)->bitmaps[id - 1].height;
391 }
392
393 int
394 x_bitmap_width (f, id)
395 FRAME_PTR f;
396 int id;
397 {
398 return FRAME_MAC_DISPLAY_INFO (f)->bitmaps[id - 1].width;
399 }
400
401 #if 0 /* MAC_TODO : not used anywhere (?) */
402 int
403 x_bitmap_pixmap (f, id)
404 FRAME_PTR f;
405 int id;
406 {
407 return (int) FRAME_MAC_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
408 }
409 #endif
410
411 /* Allocate a new bitmap record. Returns index of new record. */
412
413 static int
414 x_allocate_bitmap_record (f)
415 FRAME_PTR f;
416 {
417 struct mac_display_info *dpyinfo = FRAME_MAC_DISPLAY_INFO (f);
418 int i;
419
420 if (dpyinfo->bitmaps == NULL)
421 {
422 dpyinfo->bitmaps_size = 10;
423 dpyinfo->bitmaps = (struct mac_bitmap_record *)
424 xmalloc (dpyinfo->bitmaps_size * sizeof (struct mac_bitmap_record));
425 dpyinfo->bitmaps_last = 1;
426 return 1;
427 }
428
429 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
430 return ++dpyinfo->bitmaps_last;
431
432 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
433 if (dpyinfo->bitmaps[i].refcount == 0)
434 return i + 1;
435
436 dpyinfo->bitmaps_size *= 2;
437 dpyinfo->bitmaps = (struct mac_bitmap_record *)
438 xrealloc (dpyinfo->bitmaps,
439 dpyinfo->bitmaps_size * sizeof (struct mac_bitmap_record));
440 return ++dpyinfo->bitmaps_last;
441 }
442
443 /* Add one reference to the reference count of the bitmap with id
444 ID. */
445
446 void
447 x_reference_bitmap (f, id)
448 FRAME_PTR f;
449 int id;
450 {
451 ++FRAME_MAC_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
452 }
453
454 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at
455 BITS. */
456
457 int
458 x_create_bitmap_from_data (f, bits, width, height)
459 struct frame *f;
460 char *bits;
461 unsigned int width, height;
462 {
463 struct x_display_info *dpyinfo = FRAME_MAC_DISPLAY_INFO (f);
464 int id;
465
466 /* MAC_TODO: for now fail if width is not mod 16 (toolbox requires it) */
467
468 id = x_allocate_bitmap_record (f);
469
470 if (width % 16 != 0)
471 return -1;
472
473 dpyinfo->bitmaps[id - 1].bitmap_data = (char *) xmalloc (height * width);
474 if (! dpyinfo->bitmaps[id - 1].bitmap_data)
475 return -1;
476
477 bcopy (bits, dpyinfo->bitmaps[id - 1].bitmap_data, height * width);
478
479 dpyinfo->bitmaps[id - 1].refcount = 1;
480 dpyinfo->bitmaps[id - 1].height = height;
481 dpyinfo->bitmaps[id - 1].width = width;
482
483 return id;
484 }
485
486 /* Create bitmap from file FILE for frame F. */
487
488 int
489 x_create_bitmap_from_file (f, file)
490 struct frame *f;
491 Lisp_Object file;
492 {
493 return -1;
494 #if 0 /* MAC_TODO : bitmap support */
495 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
496 unsigned int width, height;
497 HBITMAP bitmap;
498 int xhot, yhot, result, id;
499 Lisp_Object found;
500 int fd;
501 char *filename;
502 HINSTANCE hinst;
503
504 /* Look for an existing bitmap with the same name. */
505 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
506 {
507 if (dpyinfo->bitmaps[id].refcount
508 && dpyinfo->bitmaps[id].file
509 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
510 {
511 ++dpyinfo->bitmaps[id].refcount;
512 return id + 1;
513 }
514 }
515
516 /* Search bitmap-file-path for the file, if appropriate. */
517 fd = openp (Vx_bitmap_file_path, file, Qnil, &found, 0);
518 if (fd < 0)
519 return -1;
520 /* LoadLibraryEx won't handle special files handled by Emacs handler. */
521 if (fd == 0)
522 return -1;
523 emacs_close (fd);
524
525 filename = (char *) XSTRING (found)->data;
526
527 hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
528
529 if (hinst == NULL)
530 return -1;
531
532
533 result = XReadBitmapFile (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
534 filename, &width, &height, &bitmap, &xhot, &yhot);
535 if (result != BitmapSuccess)
536 return -1;
537
538 id = x_allocate_bitmap_record (f);
539 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
540 dpyinfo->bitmaps[id - 1].refcount = 1;
541 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
542 dpyinfo->bitmaps[id - 1].depth = 1;
543 dpyinfo->bitmaps[id - 1].height = height;
544 dpyinfo->bitmaps[id - 1].width = width;
545 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
546
547 return id;
548 #endif /* MAC_TODO */
549 }
550
551 /* Remove reference to bitmap with id number ID. */
552
553 void
554 x_destroy_bitmap (f, id)
555 FRAME_PTR f;
556 int id;
557 {
558 struct mac_display_info *dpyinfo = FRAME_MAC_DISPLAY_INFO (f);
559
560 if (id > 0)
561 {
562 --dpyinfo->bitmaps[id - 1].refcount;
563 if (dpyinfo->bitmaps[id - 1].refcount == 0)
564 {
565 BLOCK_INPUT;
566 dpyinfo->bitmaps[id - 1].bitmap_data = NULL;
567 UNBLOCK_INPUT;
568 }
569 }
570 }
571
572 /* Free all the bitmaps for the display specified by DPYINFO. */
573
574 static void
575 x_destroy_all_bitmaps (dpyinfo)
576 struct mac_display_info *dpyinfo;
577 {
578 int i;
579 for (i = 0; i < dpyinfo->bitmaps_last; i++)
580 if (dpyinfo->bitmaps[i].refcount > 0)
581 xfree (dpyinfo->bitmaps[i].bitmap_data);
582 dpyinfo->bitmaps_last = 0;
583 }
584 \f
585 /* Connect the frame-parameter names for W32 frames
586 to the ways of passing the parameter values to the window system.
587
588 The name of a parameter, as a Lisp symbol,
589 has an `x-frame-parameter' property which is an integer in Lisp
590 but can be interpreted as an `enum x_frame_parm' in C. */
591
592 struct x_frame_parm_table
593 {
594 char *name;
595 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
596 };
597
598 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
599 static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
600 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
601 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
602 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
603 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
604 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
605 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
606 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
607 void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
608 static void x_set_fringe_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
609 void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
610 void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
611 Lisp_Object));
612 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
613 void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
614 void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
615 void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
616 Lisp_Object));
617 void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
618 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
619 void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
620 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
621 void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
622 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
623 void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
624 Lisp_Object));
625 void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
626 Lisp_Object));
627 static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
628 Lisp_Object,
629 Lisp_Object,
630 char *, char *,
631 int));
632 static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
633
634 static struct x_frame_parm_table x_frame_parms[] =
635 {
636 "auto-raise", x_set_autoraise,
637 "auto-lower", x_set_autolower,
638 "background-color", x_set_background_color,
639 "border-color", x_set_border_color,
640 "border-width", x_set_border_width,
641 "cursor-color", x_set_cursor_color,
642 "cursor-type", x_set_cursor_type,
643 "font", x_set_font,
644 "foreground-color", x_set_foreground_color,
645 "icon-name", x_set_icon_name,
646 #if 0 /* MAC_TODO: no icons for Mac */
647 "icon-type", x_set_icon_type,
648 #endif
649 "internal-border-width", x_set_internal_border_width,
650 "menu-bar-lines", x_set_menu_bar_lines,
651 "mouse-color", x_set_mouse_color,
652 "name", x_explicitly_set_name,
653 "scroll-bar-width", x_set_scroll_bar_width,
654 "title", x_set_title,
655 "unsplittable", x_set_unsplittable,
656 "vertical-scroll-bars", x_set_vertical_scroll_bars,
657 "visibility", x_set_visibility,
658 "tool-bar-lines", x_set_tool_bar_lines,
659 #if 0 /* MAC_TODO: cannot set color of scroll bar on the Mac? */
660 "scroll-bar-foreground", x_set_scroll_bar_foreground,
661 "scroll-bar-background", x_set_scroll_bar_background,
662 #endif
663 "screen-gamma", x_set_screen_gamma,
664 "line-spacing", x_set_line_spacing,
665 "left-fringe", x_set_fringe_width,
666 "right-fringe", x_set_fringe_width
667 };
668
669 /* Attach the `x-frame-parameter' properties to
670 the Lisp symbol names of parameters relevant to Mac. */
671
672 void
673 init_x_parm_symbols ()
674 {
675 int i;
676
677 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
678 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
679 make_number (i));
680 }
681 \f
682 /* Change the parameters of frame F as specified by ALIST.
683 If a parameter is not specially recognized, do nothing;
684 otherwise call the `x_set_...' function for that parameter. */
685
686 void
687 x_set_frame_parameters (f, alist)
688 FRAME_PTR f;
689 Lisp_Object alist;
690 {
691 Lisp_Object tail;
692
693 /* If both of these parameters are present, it's more efficient to
694 set them both at once. So we wait until we've looked at the
695 entire list before we set them. */
696 int width, height;
697
698 /* Same here. */
699 Lisp_Object left, top;
700
701 /* Same with these. */
702 Lisp_Object icon_left, icon_top;
703
704 /* Record in these vectors all the parms specified. */
705 Lisp_Object *parms;
706 Lisp_Object *values;
707 int i, p;
708 int left_no_change = 0, top_no_change = 0;
709 int icon_left_no_change = 0, icon_top_no_change = 0;
710
711 struct gcpro gcpro1, gcpro2;
712
713 i = 0;
714 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
715 i++;
716
717 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
718 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
719
720 /* Extract parm names and values into those vectors. */
721
722 i = 0;
723 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
724 {
725 Lisp_Object elt;
726
727 elt = Fcar (tail);
728 parms[i] = Fcar (elt);
729 values[i] = Fcdr (elt);
730 i++;
731 }
732 /* TAIL and ALIST are not used again below here. */
733 alist = tail = Qnil;
734
735 GCPRO2 (*parms, *values);
736 gcpro1.nvars = i;
737 gcpro2.nvars = i;
738
739 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
740 because their values appear in VALUES and strings are not valid. */
741 top = left = Qunbound;
742 icon_left = icon_top = Qunbound;
743
744 /* Provide default values for HEIGHT and WIDTH. */
745 if (FRAME_NEW_WIDTH (f))
746 width = FRAME_NEW_WIDTH (f);
747 else
748 width = FRAME_WIDTH (f);
749
750 if (FRAME_NEW_HEIGHT (f))
751 height = FRAME_NEW_HEIGHT (f);
752 else
753 height = FRAME_HEIGHT (f);
754
755 /* Process foreground_color and background_color before anything else.
756 They are independent of other properties, but other properties (e.g.,
757 cursor_color) are dependent upon them. */
758 /* Process default font as well, since fringe widths depends on it. */
759 for (p = 0; p < i; p++)
760 {
761 Lisp_Object prop, val;
762
763 prop = parms[p];
764 val = values[p];
765 if (EQ (prop, Qforeground_color)
766 || EQ (prop, Qbackground_color)
767 || EQ (prop, Qfont))
768 {
769 register Lisp_Object param_index, old_value;
770
771 param_index = Fget (prop, Qx_frame_parameter);
772 old_value = get_frame_param (f, prop);
773 store_frame_param (f, prop, val);
774 if (NATNUMP (param_index)
775 && (XFASTINT (param_index)
776 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
777 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
778 }
779 }
780
781 /* Now process them in reverse of specified order. */
782 for (i--; i >= 0; i--)
783 {
784 Lisp_Object prop, val;
785
786 prop = parms[i];
787 val = values[i];
788
789 if (EQ (prop, Qwidth) && NUMBERP (val))
790 width = XFASTINT (val);
791 else if (EQ (prop, Qheight) && NUMBERP (val))
792 height = XFASTINT (val);
793 else if (EQ (prop, Qtop))
794 top = val;
795 else if (EQ (prop, Qleft))
796 left = val;
797 else if (EQ (prop, Qicon_top))
798 icon_top = val;
799 else if (EQ (prop, Qicon_left))
800 icon_left = val;
801 else if (EQ (prop, Qforeground_color)
802 || EQ (prop, Qbackground_color)
803 || EQ (prop, Qfont))
804 /* Processed above. */
805 continue;
806 else
807 {
808 register Lisp_Object param_index, old_value;
809
810 param_index = Fget (prop, Qx_frame_parameter);
811 old_value = get_frame_param (f, prop);
812 store_frame_param (f, prop, val);
813 if (NATNUMP (param_index)
814 && (XFASTINT (param_index)
815 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
816 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
817 }
818 }
819
820 /* Don't die if just one of these was set. */
821 if (EQ (left, Qunbound))
822 {
823 left_no_change = 1;
824 if (f->output_data.mac->left_pos < 0)
825 left = Fcons (Qplus,
826 Fcons (make_number (f->output_data.mac->left_pos),
827 Qnil));
828 else
829 XSETINT (left, f->output_data.mac->left_pos);
830 }
831 if (EQ (top, Qunbound))
832 {
833 top_no_change = 1;
834 if (f->output_data.mac->top_pos < 0)
835 top = Fcons (Qplus,
836 Fcons (make_number (f->output_data.mac->top_pos), Qnil));
837 else
838 XSETINT (top, f->output_data.mac->top_pos);
839 }
840
841 /* If one of the icon positions was not set, preserve or default it. */
842 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
843 {
844 icon_left_no_change = 1;
845 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
846 if (NILP (icon_left))
847 XSETINT (icon_left, 0);
848 }
849 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
850 {
851 icon_top_no_change = 1;
852 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
853 if (NILP (icon_top))
854 XSETINT (icon_top, 0);
855 }
856
857 /* Don't set these parameters unless they've been explicitly
858 specified. The window might be mapped or resized while we're in
859 this function, and we don't want to override that unless the lisp
860 code has asked for it.
861
862 Don't set these parameters unless they actually differ from the
863 window's current parameters; the window may not actually exist
864 yet. */
865 {
866 Lisp_Object frame;
867
868 check_frame_size (f, &height, &width);
869
870 XSETFRAME (frame, f);
871
872 if (width != FRAME_WIDTH (f)
873 || height != FRAME_HEIGHT (f)
874 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
875 Fset_frame_size (frame, make_number (width), make_number (height));
876
877 if ((!NILP (left) || !NILP (top))
878 && ! (left_no_change && top_no_change)
879 && ! (NUMBERP (left) && XINT (left) == f->output_data.mac->left_pos
880 && NUMBERP (top) && XINT (top) == f->output_data.mac->top_pos))
881 {
882 int leftpos = 0;
883 int toppos = 0;
884
885 /* Record the signs. */
886 f->output_data.mac->size_hint_flags &= ~ (XNegative | YNegative);
887 if (EQ (left, Qminus))
888 f->output_data.mac->size_hint_flags |= XNegative;
889 else if (INTEGERP (left))
890 {
891 leftpos = XINT (left);
892 if (leftpos < 0)
893 f->output_data.mac->size_hint_flags |= XNegative;
894 }
895 else if (CONSP (left) && EQ (XCAR (left), Qminus)
896 && CONSP (XCDR (left))
897 && INTEGERP (XCAR (XCDR (left))))
898 {
899 leftpos = - XINT (XCAR (XCDR (left)));
900 f->output_data.mac->size_hint_flags |= XNegative;
901 }
902 else if (CONSP (left) && EQ (XCAR (left), Qplus)
903 && CONSP (XCDR (left))
904 && INTEGERP (XCAR (XCDR (left))))
905 {
906 leftpos = XINT (XCAR (XCDR (left)));
907 }
908
909 if (EQ (top, Qminus))
910 f->output_data.mac->size_hint_flags |= YNegative;
911 else if (INTEGERP (top))
912 {
913 toppos = XINT (top);
914 if (toppos < 0)
915 f->output_data.mac->size_hint_flags |= YNegative;
916 }
917 else if (CONSP (top) && EQ (XCAR (top), Qminus)
918 && CONSP (XCDR (top))
919 && INTEGERP (XCAR (XCDR (top))))
920 {
921 toppos = - XINT (XCAR (XCDR (top)));
922 f->output_data.mac->size_hint_flags |= YNegative;
923 }
924 else if (CONSP (top) && EQ (XCAR (top), Qplus)
925 && CONSP (XCDR (top))
926 && INTEGERP (XCAR (XCDR (top))))
927 {
928 toppos = XINT (XCAR (XCDR (top)));
929 }
930
931
932 /* Store the numeric value of the position. */
933 f->output_data.mac->top_pos = toppos;
934 f->output_data.mac->left_pos = leftpos;
935
936 f->output_data.mac->win_gravity = NorthWestGravity;
937
938 /* Actually set that position, and convert to absolute. */
939 x_set_offset (f, leftpos, toppos, -1);
940 }
941
942 if ((!NILP (icon_left) || !NILP (icon_top))
943 && ! (icon_left_no_change && icon_top_no_change))
944 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
945 }
946
947 UNGCPRO;
948 }
949
950 /* Store the screen positions of frame F into XPTR and YPTR.
951 These are the positions of the containing window manager window,
952 not Emacs's own window. */
953
954 void
955 x_real_positions (f, xptr, yptr)
956 FRAME_PTR f;
957 int *xptr, *yptr;
958 {
959 Point pt;
960 GrafPtr oldport;
961
962 SetPt (&pt,
963 f->output_data.mac->mWP->portRect.left,
964 f->output_data.mac->mWP->portRect.top);
965 GetPort (&oldport);
966 LocalToGlobal (&pt);
967 SetPort (oldport);
968
969 *xptr = pt.h;
970 *yptr = pt.v;
971 }
972
973 /* Insert a description of internally-recorded parameters of frame X
974 into the parameter alist *ALISTPTR that is to be given to the user.
975 Only parameters that are specific to Mac and whose values are not
976 correctly recorded in the frame's param_alist need to be considered
977 here. */
978
979 void
980 x_report_frame_params (f, alistptr)
981 struct frame *f;
982 Lisp_Object *alistptr;
983 {
984 char buf[16];
985 Lisp_Object tem;
986
987 /* Represent negative positions (off the top or left screen edge)
988 in a way that Fmodify_frame_parameters will understand correctly. */
989 XSETINT (tem, f->output_data.mac->left_pos);
990 if (f->output_data.mac->left_pos >= 0)
991 store_in_alist (alistptr, Qleft, tem);
992 else
993 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
994
995 XSETINT (tem, f->output_data.mac->top_pos);
996 if (f->output_data.mac->top_pos >= 0)
997 store_in_alist (alistptr, Qtop, tem);
998 else
999 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1000
1001 store_in_alist (alistptr, Qborder_width,
1002 make_number (f->output_data.mac->border_width));
1003 store_in_alist (alistptr, Qinternal_border_width,
1004 make_number (f->output_data.mac->internal_border_width));
1005 store_in_alist (alistptr, Qleft_fringe,
1006 make_number (f->output_data.mac->left_fringe_width));
1007 store_in_alist (alistptr, Qright_fringe,
1008 make_number (f->output_data.mac->right_fringe_width));
1009 store_in_alist (alistptr, Qscroll_bar_width,
1010 make_number (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1011 ? FRAME_SCROLL_BAR_PIXEL_WIDTH(f)
1012 : 0));
1013 sprintf (buf, "%ld", (long) FRAME_MAC_WINDOW (f));
1014 store_in_alist (alistptr, Qwindow_id,
1015 build_string (buf));
1016 store_in_alist (alistptr, Qicon_name, f->icon_name);
1017 FRAME_SAMPLE_VISIBILITY (f);
1018 store_in_alist (alistptr, Qvisibility,
1019 (FRAME_VISIBLE_P (f) ? Qt
1020 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1021 store_in_alist (alistptr, Qdisplay,
1022 XCAR (FRAME_MAC_DISPLAY_INFO (f)->name_list_element));
1023 }
1024 \f
1025 /* The default colors for the Mac color map */
1026 typedef struct colormap_t
1027 {
1028 unsigned long color;
1029 char *name;
1030 } colormap_t;
1031
1032 colormap_t mac_color_map[] =
1033 {
1034 { RGB_TO_ULONG(255, 250, 250), "snow" },
1035 { RGB_TO_ULONG(248, 248, 255), "ghost white" },
1036 { RGB_TO_ULONG(248, 248, 255), "GhostWhite" },
1037 { RGB_TO_ULONG(245, 245, 245), "white smoke" },
1038 { RGB_TO_ULONG(245, 245, 245), "WhiteSmoke" },
1039 { RGB_TO_ULONG(220, 220, 220), "gainsboro" },
1040 { RGB_TO_ULONG(255, 250, 240), "floral white" },
1041 { RGB_TO_ULONG(255, 250, 240), "FloralWhite" },
1042 { RGB_TO_ULONG(253, 245, 230), "old lace" },
1043 { RGB_TO_ULONG(253, 245, 230), "OldLace" },
1044 { RGB_TO_ULONG(250, 240, 230), "linen" },
1045 { RGB_TO_ULONG(250, 235, 215), "antique white" },
1046 { RGB_TO_ULONG(250, 235, 215), "AntiqueWhite" },
1047 { RGB_TO_ULONG(255, 239, 213), "papaya whip" },
1048 { RGB_TO_ULONG(255, 239, 213), "PapayaWhip" },
1049 { RGB_TO_ULONG(255, 235, 205), "blanched almond" },
1050 { RGB_TO_ULONG(255, 235, 205), "BlanchedAlmond" },
1051 { RGB_TO_ULONG(255, 228, 196), "bisque" },
1052 { RGB_TO_ULONG(255, 218, 185), "peach puff" },
1053 { RGB_TO_ULONG(255, 218, 185), "PeachPuff" },
1054 { RGB_TO_ULONG(255, 222, 173), "navajo white" },
1055 { RGB_TO_ULONG(255, 222, 173), "NavajoWhite" },
1056 { RGB_TO_ULONG(255, 228, 181), "moccasin" },
1057 { RGB_TO_ULONG(255, 248, 220), "cornsilk" },
1058 { RGB_TO_ULONG(255, 255, 240), "ivory" },
1059 { RGB_TO_ULONG(255, 250, 205), "lemon chiffon" },
1060 { RGB_TO_ULONG(255, 250, 205), "LemonChiffon" },
1061 { RGB_TO_ULONG(255, 245, 238), "seashell" },
1062 { RGB_TO_ULONG(240, 255, 240), "honeydew" },
1063 { RGB_TO_ULONG(245, 255, 250), "mint cream" },
1064 { RGB_TO_ULONG(245, 255, 250), "MintCream" },
1065 { RGB_TO_ULONG(240, 255, 255), "azure" },
1066 { RGB_TO_ULONG(240, 248, 255), "alice blue" },
1067 { RGB_TO_ULONG(240, 248, 255), "AliceBlue" },
1068 { RGB_TO_ULONG(230, 230, 250), "lavender" },
1069 { RGB_TO_ULONG(255, 240, 245), "lavender blush" },
1070 { RGB_TO_ULONG(255, 240, 245), "LavenderBlush" },
1071 { RGB_TO_ULONG(255, 228, 225), "misty rose" },
1072 { RGB_TO_ULONG(255, 228, 225), "MistyRose" },
1073 { RGB_TO_ULONG(255, 255, 255), "white" },
1074 { RGB_TO_ULONG(0 , 0 , 0 ), "black" },
1075 { RGB_TO_ULONG(47 , 79 , 79 ), "dark slate gray" },
1076 { RGB_TO_ULONG(47 , 79 , 79 ), "DarkSlateGray" },
1077 { RGB_TO_ULONG(47 , 79 , 79 ), "dark slate grey" },
1078 { RGB_TO_ULONG(47 , 79 , 79 ), "DarkSlateGrey" },
1079 { RGB_TO_ULONG(105, 105, 105), "dim gray" },
1080 { RGB_TO_ULONG(105, 105, 105), "DimGray" },
1081 { RGB_TO_ULONG(105, 105, 105), "dim grey" },
1082 { RGB_TO_ULONG(105, 105, 105), "DimGrey" },
1083 { RGB_TO_ULONG(112, 128, 144), "slate gray" },
1084 { RGB_TO_ULONG(112, 128, 144), "SlateGray" },
1085 { RGB_TO_ULONG(112, 128, 144), "slate grey" },
1086 { RGB_TO_ULONG(112, 128, 144), "SlateGrey" },
1087 { RGB_TO_ULONG(119, 136, 153), "light slate gray" },
1088 { RGB_TO_ULONG(119, 136, 153), "LightSlateGray" },
1089 { RGB_TO_ULONG(119, 136, 153), "light slate grey" },
1090 { RGB_TO_ULONG(119, 136, 153), "LightSlateGrey" },
1091 { RGB_TO_ULONG(190, 190, 190), "gray" },
1092 { RGB_TO_ULONG(190, 190, 190), "grey" },
1093 { RGB_TO_ULONG(211, 211, 211), "light grey" },
1094 { RGB_TO_ULONG(211, 211, 211), "LightGrey" },
1095 { RGB_TO_ULONG(211, 211, 211), "light gray" },
1096 { RGB_TO_ULONG(211, 211, 211), "LightGray" },
1097 { RGB_TO_ULONG(25 , 25 , 112), "midnight blue" },
1098 { RGB_TO_ULONG(25 , 25 , 112), "MidnightBlue" },
1099 { RGB_TO_ULONG(0 , 0 , 128), "navy" },
1100 { RGB_TO_ULONG(0 , 0 , 128), "navy blue" },
1101 { RGB_TO_ULONG(0 , 0 , 128), "NavyBlue" },
1102 { RGB_TO_ULONG(100, 149, 237), "cornflower blue" },
1103 { RGB_TO_ULONG(100, 149, 237), "CornflowerBlue" },
1104 { RGB_TO_ULONG(72 , 61 , 139), "dark slate blue" },
1105 { RGB_TO_ULONG(72 , 61 , 139), "DarkSlateBlue" },
1106 { RGB_TO_ULONG(106, 90 , 205), "slate blue" },
1107 { RGB_TO_ULONG(106, 90 , 205), "SlateBlue" },
1108 { RGB_TO_ULONG(123, 104, 238), "medium slate blue" },
1109 { RGB_TO_ULONG(123, 104, 238), "MediumSlateBlue" },
1110 { RGB_TO_ULONG(132, 112, 255), "light slate blue" },
1111 { RGB_TO_ULONG(132, 112, 255), "LightSlateBlue" },
1112 { RGB_TO_ULONG(0 , 0 , 205), "medium blue" },
1113 { RGB_TO_ULONG(0 , 0 , 205), "MediumBlue" },
1114 { RGB_TO_ULONG(65 , 105, 225), "royal blue" },
1115 { RGB_TO_ULONG(65 , 105, 225), "RoyalBlue" },
1116 { RGB_TO_ULONG(0 , 0 , 255), "blue" },
1117 { RGB_TO_ULONG(30 , 144, 255), "dodger blue" },
1118 { RGB_TO_ULONG(30 , 144, 255), "DodgerBlue" },
1119 { RGB_TO_ULONG(0 , 191, 255), "deep sky blue" },
1120 { RGB_TO_ULONG(0 , 191, 255), "DeepSkyBlue" },
1121 { RGB_TO_ULONG(135, 206, 235), "sky blue" },
1122 { RGB_TO_ULONG(135, 206, 235), "SkyBlue" },
1123 { RGB_TO_ULONG(135, 206, 250), "light sky blue" },
1124 { RGB_TO_ULONG(135, 206, 250), "LightSkyBlue" },
1125 { RGB_TO_ULONG(70 , 130, 180), "steel blue" },
1126 { RGB_TO_ULONG(70 , 130, 180), "SteelBlue" },
1127 { RGB_TO_ULONG(176, 196, 222), "light steel blue" },
1128 { RGB_TO_ULONG(176, 196, 222), "LightSteelBlue" },
1129 { RGB_TO_ULONG(173, 216, 230), "light blue" },
1130 { RGB_TO_ULONG(173, 216, 230), "LightBlue" },
1131 { RGB_TO_ULONG(176, 224, 230), "powder blue" },
1132 { RGB_TO_ULONG(176, 224, 230), "PowderBlue" },
1133 { RGB_TO_ULONG(175, 238, 238), "pale turquoise" },
1134 { RGB_TO_ULONG(175, 238, 238), "PaleTurquoise" },
1135 { RGB_TO_ULONG(0 , 206, 209), "dark turquoise" },
1136 { RGB_TO_ULONG(0 , 206, 209), "DarkTurquoise" },
1137 { RGB_TO_ULONG(72 , 209, 204), "medium turquoise" },
1138 { RGB_TO_ULONG(72 , 209, 204), "MediumTurquoise" },
1139 { RGB_TO_ULONG(64 , 224, 208), "turquoise" },
1140 { RGB_TO_ULONG(0 , 255, 255), "cyan" },
1141 { RGB_TO_ULONG(224, 255, 255), "light cyan" },
1142 { RGB_TO_ULONG(224, 255, 255), "LightCyan" },
1143 { RGB_TO_ULONG(95 , 158, 160), "cadet blue" },
1144 { RGB_TO_ULONG(95 , 158, 160), "CadetBlue" },
1145 { RGB_TO_ULONG(102, 205, 170), "medium aquamarine" },
1146 { RGB_TO_ULONG(102, 205, 170), "MediumAquamarine" },
1147 { RGB_TO_ULONG(127, 255, 212), "aquamarine" },
1148 { RGB_TO_ULONG(0 , 100, 0 ), "dark green" },
1149 { RGB_TO_ULONG(0 , 100, 0 ), "DarkGreen" },
1150 { RGB_TO_ULONG(85 , 107, 47 ), "dark olive green" },
1151 { RGB_TO_ULONG(85 , 107, 47 ), "DarkOliveGreen" },
1152 { RGB_TO_ULONG(143, 188, 143), "dark sea green" },
1153 { RGB_TO_ULONG(143, 188, 143), "DarkSeaGreen" },
1154 { RGB_TO_ULONG(46 , 139, 87 ), "sea green" },
1155 { RGB_TO_ULONG(46 , 139, 87 ), "SeaGreen" },
1156 { RGB_TO_ULONG(60 , 179, 113), "medium sea green" },
1157 { RGB_TO_ULONG(60 , 179, 113), "MediumSeaGreen" },
1158 { RGB_TO_ULONG(32 , 178, 170), "light sea green" },
1159 { RGB_TO_ULONG(32 , 178, 170), "LightSeaGreen" },
1160 { RGB_TO_ULONG(152, 251, 152), "pale green" },
1161 { RGB_TO_ULONG(152, 251, 152), "PaleGreen" },
1162 { RGB_TO_ULONG(0 , 255, 127), "spring green" },
1163 { RGB_TO_ULONG(0 , 255, 127), "SpringGreen" },
1164 { RGB_TO_ULONG(124, 252, 0 ), "lawn green" },
1165 { RGB_TO_ULONG(124, 252, 0 ), "LawnGreen" },
1166 { RGB_TO_ULONG(0 , 255, 0 ), "green" },
1167 { RGB_TO_ULONG(127, 255, 0 ), "chartreuse" },
1168 { RGB_TO_ULONG(0 , 250, 154), "medium spring green" },
1169 { RGB_TO_ULONG(0 , 250, 154), "MediumSpringGreen" },
1170 { RGB_TO_ULONG(173, 255, 47 ), "green yellow" },
1171 { RGB_TO_ULONG(173, 255, 47 ), "GreenYellow" },
1172 { RGB_TO_ULONG(50 , 205, 50 ), "lime green" },
1173 { RGB_TO_ULONG(50 , 205, 50 ), "LimeGreen" },
1174 { RGB_TO_ULONG(154, 205, 50 ), "yellow green" },
1175 { RGB_TO_ULONG(154, 205, 50 ), "YellowGreen" },
1176 { RGB_TO_ULONG(34 , 139, 34 ), "forest green" },
1177 { RGB_TO_ULONG(34 , 139, 34 ), "ForestGreen" },
1178 { RGB_TO_ULONG(107, 142, 35 ), "olive drab" },
1179 { RGB_TO_ULONG(107, 142, 35 ), "OliveDrab" },
1180 { RGB_TO_ULONG(189, 183, 107), "dark khaki" },
1181 { RGB_TO_ULONG(189, 183, 107), "DarkKhaki" },
1182 { RGB_TO_ULONG(240, 230, 140), "khaki" },
1183 { RGB_TO_ULONG(238, 232, 170), "pale goldenrod" },
1184 { RGB_TO_ULONG(238, 232, 170), "PaleGoldenrod" },
1185 { RGB_TO_ULONG(250, 250, 210), "light goldenrod yellow" },
1186 { RGB_TO_ULONG(250, 250, 210), "LightGoldenrodYellow" },
1187 { RGB_TO_ULONG(255, 255, 224), "light yellow" },
1188 { RGB_TO_ULONG(255, 255, 224), "LightYellow" },
1189 { RGB_TO_ULONG(255, 255, 0 ), "yellow" },
1190 { RGB_TO_ULONG(255, 215, 0 ), "gold" },
1191 { RGB_TO_ULONG(238, 221, 130), "light goldenrod" },
1192 { RGB_TO_ULONG(238, 221, 130), "LightGoldenrod" },
1193 { RGB_TO_ULONG(218, 165, 32 ), "goldenrod" },
1194 { RGB_TO_ULONG(184, 134, 11 ), "dark goldenrod" },
1195 { RGB_TO_ULONG(184, 134, 11 ), "DarkGoldenrod" },
1196 { RGB_TO_ULONG(188, 143, 143), "rosy brown" },
1197 { RGB_TO_ULONG(188, 143, 143), "RosyBrown" },
1198 { RGB_TO_ULONG(205, 92 , 92 ), "indian red" },
1199 { RGB_TO_ULONG(205, 92 , 92 ), "IndianRed" },
1200 { RGB_TO_ULONG(139, 69 , 19 ), "saddle brown" },
1201 { RGB_TO_ULONG(139, 69 , 19 ), "SaddleBrown" },
1202 { RGB_TO_ULONG(160, 82 , 45 ), "sienna" },
1203 { RGB_TO_ULONG(205, 133, 63 ), "peru" },
1204 { RGB_TO_ULONG(222, 184, 135), "burlywood" },
1205 { RGB_TO_ULONG(245, 245, 220), "beige" },
1206 { RGB_TO_ULONG(245, 222, 179), "wheat" },
1207 { RGB_TO_ULONG(244, 164, 96 ), "sandy brown" },
1208 { RGB_TO_ULONG(244, 164, 96 ), "SandyBrown" },
1209 { RGB_TO_ULONG(210, 180, 140), "tan" },
1210 { RGB_TO_ULONG(210, 105, 30 ), "chocolate" },
1211 { RGB_TO_ULONG(178, 34 , 34 ), "firebrick" },
1212 { RGB_TO_ULONG(165, 42 , 42 ), "brown" },
1213 { RGB_TO_ULONG(233, 150, 122), "dark salmon" },
1214 { RGB_TO_ULONG(233, 150, 122), "DarkSalmon" },
1215 { RGB_TO_ULONG(250, 128, 114), "salmon" },
1216 { RGB_TO_ULONG(255, 160, 122), "light salmon" },
1217 { RGB_TO_ULONG(255, 160, 122), "LightSalmon" },
1218 { RGB_TO_ULONG(255, 165, 0 ), "orange" },
1219 { RGB_TO_ULONG(255, 140, 0 ), "dark orange" },
1220 { RGB_TO_ULONG(255, 140, 0 ), "DarkOrange" },
1221 { RGB_TO_ULONG(255, 127, 80 ), "coral" },
1222 { RGB_TO_ULONG(240, 128, 128), "light coral" },
1223 { RGB_TO_ULONG(240, 128, 128), "LightCoral" },
1224 { RGB_TO_ULONG(255, 99 , 71 ), "tomato" },
1225 { RGB_TO_ULONG(255, 69 , 0 ), "orange red" },
1226 { RGB_TO_ULONG(255, 69 , 0 ), "OrangeRed" },
1227 { RGB_TO_ULONG(255, 0 , 0 ), "red" },
1228 { RGB_TO_ULONG(255, 105, 180), "hot pink" },
1229 { RGB_TO_ULONG(255, 105, 180), "HotPink" },
1230 { RGB_TO_ULONG(255, 20 , 147), "deep pink" },
1231 { RGB_TO_ULONG(255, 20 , 147), "DeepPink" },
1232 { RGB_TO_ULONG(255, 192, 203), "pink" },
1233 { RGB_TO_ULONG(255, 182, 193), "light pink" },
1234 { RGB_TO_ULONG(255, 182, 193), "LightPink" },
1235 { RGB_TO_ULONG(219, 112, 147), "pale violet red" },
1236 { RGB_TO_ULONG(219, 112, 147), "PaleVioletRed" },
1237 { RGB_TO_ULONG(176, 48 , 96 ), "maroon" },
1238 { RGB_TO_ULONG(199, 21 , 133), "medium violet red" },
1239 { RGB_TO_ULONG(199, 21 , 133), "MediumVioletRed" },
1240 { RGB_TO_ULONG(208, 32 , 144), "violet red" },
1241 { RGB_TO_ULONG(208, 32 , 144), "VioletRed" },
1242 { RGB_TO_ULONG(255, 0 , 255), "magenta" },
1243 { RGB_TO_ULONG(238, 130, 238), "violet" },
1244 { RGB_TO_ULONG(221, 160, 221), "plum" },
1245 { RGB_TO_ULONG(218, 112, 214), "orchid" },
1246 { RGB_TO_ULONG(186, 85 , 211), "medium orchid" },
1247 { RGB_TO_ULONG(186, 85 , 211), "MediumOrchid" },
1248 { RGB_TO_ULONG(153, 50 , 204), "dark orchid" },
1249 { RGB_TO_ULONG(153, 50 , 204), "DarkOrchid" },
1250 { RGB_TO_ULONG(148, 0 , 211), "dark violet" },
1251 { RGB_TO_ULONG(148, 0 , 211), "DarkViolet" },
1252 { RGB_TO_ULONG(138, 43 , 226), "blue violet" },
1253 { RGB_TO_ULONG(138, 43 , 226), "BlueViolet" },
1254 { RGB_TO_ULONG(160, 32 , 240), "purple" },
1255 { RGB_TO_ULONG(147, 112, 219), "medium purple" },
1256 { RGB_TO_ULONG(147, 112, 219), "MediumPurple" },
1257 { RGB_TO_ULONG(216, 191, 216), "thistle" },
1258 { RGB_TO_ULONG(255, 250, 250), "snow1" },
1259 { RGB_TO_ULONG(238, 233, 233), "snow2" },
1260 { RGB_TO_ULONG(205, 201, 201), "snow3" },
1261 { RGB_TO_ULONG(139, 137, 137), "snow4" },
1262 { RGB_TO_ULONG(255, 245, 238), "seashell1" },
1263 { RGB_TO_ULONG(238, 229, 222), "seashell2" },
1264 { RGB_TO_ULONG(205, 197, 191), "seashell3" },
1265 { RGB_TO_ULONG(139, 134, 130), "seashell4" },
1266 { RGB_TO_ULONG(255, 239, 219), "AntiqueWhite1" },
1267 { RGB_TO_ULONG(238, 223, 204), "AntiqueWhite2" },
1268 { RGB_TO_ULONG(205, 192, 176), "AntiqueWhite3" },
1269 { RGB_TO_ULONG(139, 131, 120), "AntiqueWhite4" },
1270 { RGB_TO_ULONG(255, 228, 196), "bisque1" },
1271 { RGB_TO_ULONG(238, 213, 183), "bisque2" },
1272 { RGB_TO_ULONG(205, 183, 158), "bisque3" },
1273 { RGB_TO_ULONG(139, 125, 107), "bisque4" },
1274 { RGB_TO_ULONG(255, 218, 185), "PeachPuff1" },
1275 { RGB_TO_ULONG(238, 203, 173), "PeachPuff2" },
1276 { RGB_TO_ULONG(205, 175, 149), "PeachPuff3" },
1277 { RGB_TO_ULONG(139, 119, 101), "PeachPuff4" },
1278 { RGB_TO_ULONG(255, 222, 173), "NavajoWhite1" },
1279 { RGB_TO_ULONG(238, 207, 161), "NavajoWhite2" },
1280 { RGB_TO_ULONG(205, 179, 139), "NavajoWhite3" },
1281 { RGB_TO_ULONG(139, 121, 94), "NavajoWhite4" },
1282 { RGB_TO_ULONG(255, 250, 205), "LemonChiffon1" },
1283 { RGB_TO_ULONG(238, 233, 191), "LemonChiffon2" },
1284 { RGB_TO_ULONG(205, 201, 165), "LemonChiffon3" },
1285 { RGB_TO_ULONG(139, 137, 112), "LemonChiffon4" },
1286 { RGB_TO_ULONG(255, 248, 220), "cornsilk1" },
1287 { RGB_TO_ULONG(238, 232, 205), "cornsilk2" },
1288 { RGB_TO_ULONG(205, 200, 177), "cornsilk3" },
1289 { RGB_TO_ULONG(139, 136, 120), "cornsilk4" },
1290 { RGB_TO_ULONG(255, 255, 240), "ivory1" },
1291 { RGB_TO_ULONG(238, 238, 224), "ivory2" },
1292 { RGB_TO_ULONG(205, 205, 193), "ivory3" },
1293 { RGB_TO_ULONG(139, 139, 131), "ivory4" },
1294 { RGB_TO_ULONG(240, 255, 240), "honeydew1" },
1295 { RGB_TO_ULONG(224, 238, 224), "honeydew2" },
1296 { RGB_TO_ULONG(193, 205, 193), "honeydew3" },
1297 { RGB_TO_ULONG(131, 139, 131), "honeydew4" },
1298 { RGB_TO_ULONG(255, 240, 245), "LavenderBlush1" },
1299 { RGB_TO_ULONG(238, 224, 229), "LavenderBlush2" },
1300 { RGB_TO_ULONG(205, 193, 197), "LavenderBlush3" },
1301 { RGB_TO_ULONG(139, 131, 134), "LavenderBlush4" },
1302 { RGB_TO_ULONG(255, 228, 225), "MistyRose1" },
1303 { RGB_TO_ULONG(238, 213, 210), "MistyRose2" },
1304 { RGB_TO_ULONG(205, 183, 181), "MistyRose3" },
1305 { RGB_TO_ULONG(139, 125, 123), "MistyRose4" },
1306 { RGB_TO_ULONG(240, 255, 255), "azure1" },
1307 { RGB_TO_ULONG(224, 238, 238), "azure2" },
1308 { RGB_TO_ULONG(193, 205, 205), "azure3" },
1309 { RGB_TO_ULONG(131, 139, 139), "azure4" },
1310 { RGB_TO_ULONG(131, 111, 255), "SlateBlue1" },
1311 { RGB_TO_ULONG(122, 103, 238), "SlateBlue2" },
1312 { RGB_TO_ULONG(105, 89 , 205), "SlateBlue3" },
1313 { RGB_TO_ULONG(71 , 60 , 139), "SlateBlue4" },
1314 { RGB_TO_ULONG(72 , 118, 255), "RoyalBlue1" },
1315 { RGB_TO_ULONG(67 , 110, 238), "RoyalBlue2" },
1316 { RGB_TO_ULONG(58 , 95 , 205), "RoyalBlue3" },
1317 { RGB_TO_ULONG(39 , 64 , 139), "RoyalBlue4" },
1318 { RGB_TO_ULONG(0 , 0 , 255), "blue1" },
1319 { RGB_TO_ULONG(0 , 0 , 238), "blue2" },
1320 { RGB_TO_ULONG(0 , 0 , 205), "blue3" },
1321 { RGB_TO_ULONG(0 , 0 , 139), "blue4" },
1322 { RGB_TO_ULONG(30 , 144, 255), "DodgerBlue1" },
1323 { RGB_TO_ULONG(28 , 134, 238), "DodgerBlue2" },
1324 { RGB_TO_ULONG(24 , 116, 205), "DodgerBlue3" },
1325 { RGB_TO_ULONG(16 , 78 , 139), "DodgerBlue4" },
1326 { RGB_TO_ULONG(99 , 184, 255), "SteelBlue1" },
1327 { RGB_TO_ULONG(92 , 172, 238), "SteelBlue2" },
1328 { RGB_TO_ULONG(79 , 148, 205), "SteelBlue3" },
1329 { RGB_TO_ULONG(54 , 100, 139), "SteelBlue4" },
1330 { RGB_TO_ULONG(0 , 191, 255), "DeepSkyBlue1" },
1331 { RGB_TO_ULONG(0 , 178, 238), "DeepSkyBlue2" },
1332 { RGB_TO_ULONG(0 , 154, 205), "DeepSkyBlue3" },
1333 { RGB_TO_ULONG(0 , 104, 139), "DeepSkyBlue4" },
1334 { RGB_TO_ULONG(135, 206, 255), "SkyBlue1" },
1335 { RGB_TO_ULONG(126, 192, 238), "SkyBlue2" },
1336 { RGB_TO_ULONG(108, 166, 205), "SkyBlue3" },
1337 { RGB_TO_ULONG(74 , 112, 139), "SkyBlue4" },
1338 { RGB_TO_ULONG(176, 226, 255), "LightSkyBlue1" },
1339 { RGB_TO_ULONG(164, 211, 238), "LightSkyBlue2" },
1340 { RGB_TO_ULONG(141, 182, 205), "LightSkyBlue3" },
1341 { RGB_TO_ULONG(96 , 123, 139), "LightSkyBlue4" },
1342 { RGB_TO_ULONG(198, 226, 255), "SlateGray1" },
1343 { RGB_TO_ULONG(185, 211, 238), "SlateGray2" },
1344 { RGB_TO_ULONG(159, 182, 205), "SlateGray3" },
1345 { RGB_TO_ULONG(108, 123, 139), "SlateGray4" },
1346 { RGB_TO_ULONG(202, 225, 255), "LightSteelBlue1" },
1347 { RGB_TO_ULONG(188, 210, 238), "LightSteelBlue2" },
1348 { RGB_TO_ULONG(162, 181, 205), "LightSteelBlue3" },
1349 { RGB_TO_ULONG(110, 123, 139), "LightSteelBlue4" },
1350 { RGB_TO_ULONG(191, 239, 255), "LightBlue1" },
1351 { RGB_TO_ULONG(178, 223, 238), "LightBlue2" },
1352 { RGB_TO_ULONG(154, 192, 205), "LightBlue3" },
1353 { RGB_TO_ULONG(104, 131, 139), "LightBlue4" },
1354 { RGB_TO_ULONG(224, 255, 255), "LightCyan1" },
1355 { RGB_TO_ULONG(209, 238, 238), "LightCyan2" },
1356 { RGB_TO_ULONG(180, 205, 205), "LightCyan3" },
1357 { RGB_TO_ULONG(122, 139, 139), "LightCyan4" },
1358 { RGB_TO_ULONG(187, 255, 255), "PaleTurquoise1" },
1359 { RGB_TO_ULONG(174, 238, 238), "PaleTurquoise2" },
1360 { RGB_TO_ULONG(150, 205, 205), "PaleTurquoise3" },
1361 { RGB_TO_ULONG(102, 139, 139), "PaleTurquoise4" },
1362 { RGB_TO_ULONG(152, 245, 255), "CadetBlue1" },
1363 { RGB_TO_ULONG(142, 229, 238), "CadetBlue2" },
1364 { RGB_TO_ULONG(122, 197, 205), "CadetBlue3" },
1365 { RGB_TO_ULONG(83 , 134, 139), "CadetBlue4" },
1366 { RGB_TO_ULONG(0 , 245, 255), "turquoise1" },
1367 { RGB_TO_ULONG(0 , 229, 238), "turquoise2" },
1368 { RGB_TO_ULONG(0 , 197, 205), "turquoise3" },
1369 { RGB_TO_ULONG(0 , 134, 139), "turquoise4" },
1370 { RGB_TO_ULONG(0 , 255, 255), "cyan1" },
1371 { RGB_TO_ULONG(0 , 238, 238), "cyan2" },
1372 { RGB_TO_ULONG(0 , 205, 205), "cyan3" },
1373 { RGB_TO_ULONG(0 , 139, 139), "cyan4" },
1374 { RGB_TO_ULONG(151, 255, 255), "DarkSlateGray1" },
1375 { RGB_TO_ULONG(141, 238, 238), "DarkSlateGray2" },
1376 { RGB_TO_ULONG(121, 205, 205), "DarkSlateGray3" },
1377 { RGB_TO_ULONG(82 , 139, 139), "DarkSlateGray4" },
1378 { RGB_TO_ULONG(127, 255, 212), "aquamarine1" },
1379 { RGB_TO_ULONG(118, 238, 198), "aquamarine2" },
1380 { RGB_TO_ULONG(102, 205, 170), "aquamarine3" },
1381 { RGB_TO_ULONG(69 , 139, 116), "aquamarine4" },
1382 { RGB_TO_ULONG(193, 255, 193), "DarkSeaGreen1" },
1383 { RGB_TO_ULONG(180, 238, 180), "DarkSeaGreen2" },
1384 { RGB_TO_ULONG(155, 205, 155), "DarkSeaGreen3" },
1385 { RGB_TO_ULONG(105, 139, 105), "DarkSeaGreen4" },
1386 { RGB_TO_ULONG(84 , 255, 159), "SeaGreen1" },
1387 { RGB_TO_ULONG(78 , 238, 148), "SeaGreen2" },
1388 { RGB_TO_ULONG(67 , 205, 128), "SeaGreen3" },
1389 { RGB_TO_ULONG(46 , 139, 87 ), "SeaGreen4" },
1390 { RGB_TO_ULONG(154, 255, 154), "PaleGreen1" },
1391 { RGB_TO_ULONG(144, 238, 144), "PaleGreen2" },
1392 { RGB_TO_ULONG(124, 205, 124), "PaleGreen3" },
1393 { RGB_TO_ULONG(84 , 139, 84 ), "PaleGreen4" },
1394 { RGB_TO_ULONG(0 , 255, 127), "SpringGreen1" },
1395 { RGB_TO_ULONG(0 , 238, 118), "SpringGreen2" },
1396 { RGB_TO_ULONG(0 , 205, 102), "SpringGreen3" },
1397 { RGB_TO_ULONG(0 , 139, 69 ), "SpringGreen4" },
1398 { RGB_TO_ULONG(0 , 255, 0 ), "green1" },
1399 { RGB_TO_ULONG(0 , 238, 0 ), "green2" },
1400 { RGB_TO_ULONG(0 , 205, 0 ), "green3" },
1401 { RGB_TO_ULONG(0 , 139, 0 ), "green4" },
1402 { RGB_TO_ULONG(127, 255, 0 ), "chartreuse1" },
1403 { RGB_TO_ULONG(118, 238, 0 ), "chartreuse2" },
1404 { RGB_TO_ULONG(102, 205, 0 ), "chartreuse3" },
1405 { RGB_TO_ULONG(69 , 139, 0 ), "chartreuse4" },
1406 { RGB_TO_ULONG(192, 255, 62 ), "OliveDrab1" },
1407 { RGB_TO_ULONG(179, 238, 58 ), "OliveDrab2" },
1408 { RGB_TO_ULONG(154, 205, 50 ), "OliveDrab3" },
1409 { RGB_TO_ULONG(105, 139, 34 ), "OliveDrab4" },
1410 { RGB_TO_ULONG(202, 255, 112), "DarkOliveGreen1" },
1411 { RGB_TO_ULONG(188, 238, 104), "DarkOliveGreen2" },
1412 { RGB_TO_ULONG(162, 205, 90 ), "DarkOliveGreen3" },
1413 { RGB_TO_ULONG(110, 139, 61 ), "DarkOliveGreen4" },
1414 { RGB_TO_ULONG(255, 246, 143), "khaki1" },
1415 { RGB_TO_ULONG(238, 230, 133), "khaki2" },
1416 { RGB_TO_ULONG(205, 198, 115), "khaki3" },
1417 { RGB_TO_ULONG(139, 134, 78 ), "khaki4" },
1418 { RGB_TO_ULONG(255, 236, 139), "LightGoldenrod1" },
1419 { RGB_TO_ULONG(238, 220, 130), "LightGoldenrod2" },
1420 { RGB_TO_ULONG(205, 190, 112), "LightGoldenrod3" },
1421 { RGB_TO_ULONG(139, 129, 76 ), "LightGoldenrod4" },
1422 { RGB_TO_ULONG(255, 255, 224), "LightYellow1" },
1423 { RGB_TO_ULONG(238, 238, 209), "LightYellow2" },
1424 { RGB_TO_ULONG(205, 205, 180), "LightYellow3" },
1425 { RGB_TO_ULONG(139, 139, 122), "LightYellow4" },
1426 { RGB_TO_ULONG(255, 255, 0 ), "yellow1" },
1427 { RGB_TO_ULONG(238, 238, 0 ), "yellow2" },
1428 { RGB_TO_ULONG(205, 205, 0 ), "yellow3" },
1429 { RGB_TO_ULONG(139, 139, 0 ), "yellow4" },
1430 { RGB_TO_ULONG(255, 215, 0 ), "gold1" },
1431 { RGB_TO_ULONG(238, 201, 0 ), "gold2" },
1432 { RGB_TO_ULONG(205, 173, 0 ), "gold3" },
1433 { RGB_TO_ULONG(139, 117, 0 ), "gold4" },
1434 { RGB_TO_ULONG(255, 193, 37 ), "goldenrod1" },
1435 { RGB_TO_ULONG(238, 180, 34 ), "goldenrod2" },
1436 { RGB_TO_ULONG(205, 155, 29 ), "goldenrod3" },
1437 { RGB_TO_ULONG(139, 105, 20 ), "goldenrod4" },
1438 { RGB_TO_ULONG(255, 185, 15 ), "DarkGoldenrod1" },
1439 { RGB_TO_ULONG(238, 173, 14 ), "DarkGoldenrod2" },
1440 { RGB_TO_ULONG(205, 149, 12 ), "DarkGoldenrod3" },
1441 { RGB_TO_ULONG(139, 101, 8 ), "DarkGoldenrod4" },
1442 { RGB_TO_ULONG(255, 193, 193), "RosyBrown1" },
1443 { RGB_TO_ULONG(238, 180, 180), "RosyBrown2" },
1444 { RGB_TO_ULONG(205, 155, 155), "RosyBrown3" },
1445 { RGB_TO_ULONG(139, 105, 105), "RosyBrown4" },
1446 { RGB_TO_ULONG(255, 106, 106), "IndianRed1" },
1447 { RGB_TO_ULONG(238, 99 , 99 ), "IndianRed2" },
1448 { RGB_TO_ULONG(205, 85 , 85 ), "IndianRed3" },
1449 { RGB_TO_ULONG(139, 58 , 58 ), "IndianRed4" },
1450 { RGB_TO_ULONG(255, 130, 71 ), "sienna1" },
1451 { RGB_TO_ULONG(238, 121, 66 ), "sienna2" },
1452 { RGB_TO_ULONG(205, 104, 57 ), "sienna3" },
1453 { RGB_TO_ULONG(139, 71 , 38 ), "sienna4" },
1454 { RGB_TO_ULONG(255, 211, 155), "burlywood1" },
1455 { RGB_TO_ULONG(238, 197, 145), "burlywood2" },
1456 { RGB_TO_ULONG(205, 170, 125), "burlywood3" },
1457 { RGB_TO_ULONG(139, 115, 85 ), "burlywood4" },
1458 { RGB_TO_ULONG(255, 231, 186), "wheat1" },
1459 { RGB_TO_ULONG(238, 216, 174), "wheat2" },
1460 { RGB_TO_ULONG(205, 186, 150), "wheat3" },
1461 { RGB_TO_ULONG(139, 126, 102), "wheat4" },
1462 { RGB_TO_ULONG(255, 165, 79 ), "tan1" },
1463 { RGB_TO_ULONG(238, 154, 73 ), "tan2" },
1464 { RGB_TO_ULONG(205, 133, 63 ), "tan3" },
1465 { RGB_TO_ULONG(139, 90 , 43 ), "tan4" },
1466 { RGB_TO_ULONG(255, 127, 36 ), "chocolate1" },
1467 { RGB_TO_ULONG(238, 118, 33 ), "chocolate2" },
1468 { RGB_TO_ULONG(205, 102, 29 ), "chocolate3" },
1469 { RGB_TO_ULONG(139, 69 , 19 ), "chocolate4" },
1470 { RGB_TO_ULONG(255, 48 , 48 ), "firebrick1" },
1471 { RGB_TO_ULONG(238, 44 , 44 ), "firebrick2" },
1472 { RGB_TO_ULONG(205, 38 , 38 ), "firebrick3" },
1473 { RGB_TO_ULONG(139, 26 , 26 ), "firebrick4" },
1474 { RGB_TO_ULONG(255, 64 , 64 ), "brown1" },
1475 { RGB_TO_ULONG(238, 59 , 59 ), "brown2" },
1476 { RGB_TO_ULONG(205, 51 , 51 ), "brown3" },
1477 { RGB_TO_ULONG(139, 35 , 35 ), "brown4" },
1478 { RGB_TO_ULONG(255, 140, 105), "salmon1" },
1479 { RGB_TO_ULONG(238, 130, 98 ), "salmon2" },
1480 { RGB_TO_ULONG(205, 112, 84 ), "salmon3" },
1481 { RGB_TO_ULONG(139, 76 , 57 ), "salmon4" },
1482 { RGB_TO_ULONG(255, 160, 122), "LightSalmon1" },
1483 { RGB_TO_ULONG(238, 149, 114), "LightSalmon2" },
1484 { RGB_TO_ULONG(205, 129, 98 ), "LightSalmon3" },
1485 { RGB_TO_ULONG(139, 87 , 66 ), "LightSalmon4" },
1486 { RGB_TO_ULONG(255, 165, 0 ), "orange1" },
1487 { RGB_TO_ULONG(238, 154, 0 ), "orange2" },
1488 { RGB_TO_ULONG(205, 133, 0 ), "orange3" },
1489 { RGB_TO_ULONG(139, 90 , 0 ), "orange4" },
1490 { RGB_TO_ULONG(255, 127, 0 ), "DarkOrange1" },
1491 { RGB_TO_ULONG(238, 118, 0 ), "DarkOrange2" },
1492 { RGB_TO_ULONG(205, 102, 0 ), "DarkOrange3" },
1493 { RGB_TO_ULONG(139, 69 , 0 ), "DarkOrange4" },
1494 { RGB_TO_ULONG(255, 114, 86 ), "coral1" },
1495 { RGB_TO_ULONG(238, 106, 80 ), "coral2" },
1496 { RGB_TO_ULONG(205, 91 , 69 ), "coral3" },
1497 { RGB_TO_ULONG(139, 62 , 47 ), "coral4" },
1498 { RGB_TO_ULONG(255, 99 , 71 ), "tomato1" },
1499 { RGB_TO_ULONG(238, 92 , 66 ), "tomato2" },
1500 { RGB_TO_ULONG(205, 79 , 57 ), "tomato3" },
1501 { RGB_TO_ULONG(139, 54 , 38 ), "tomato4" },
1502 { RGB_TO_ULONG(255, 69 , 0 ), "OrangeRed1" },
1503 { RGB_TO_ULONG(238, 64 , 0 ), "OrangeRed2" },
1504 { RGB_TO_ULONG(205, 55 , 0 ), "OrangeRed3" },
1505 { RGB_TO_ULONG(139, 37 , 0 ), "OrangeRed4" },
1506 { RGB_TO_ULONG(255, 0 , 0 ), "red1" },
1507 { RGB_TO_ULONG(238, 0 , 0 ), "red2" },
1508 { RGB_TO_ULONG(205, 0 , 0 ), "red3" },
1509 { RGB_TO_ULONG(139, 0 , 0 ), "red4" },
1510 { RGB_TO_ULONG(255, 20 , 147), "DeepPink1" },
1511 { RGB_TO_ULONG(238, 18 , 137), "DeepPink2" },
1512 { RGB_TO_ULONG(205, 16 , 118), "DeepPink3" },
1513 { RGB_TO_ULONG(139, 10 , 80 ), "DeepPink4" },
1514 { RGB_TO_ULONG(255, 110, 180), "HotPink1" },
1515 { RGB_TO_ULONG(238, 106, 167), "HotPink2" },
1516 { RGB_TO_ULONG(205, 96 , 144), "HotPink3" },
1517 { RGB_TO_ULONG(139, 58 , 98 ), "HotPink4" },
1518 { RGB_TO_ULONG(255, 181, 197), "pink1" },
1519 { RGB_TO_ULONG(238, 169, 184), "pink2" },
1520 { RGB_TO_ULONG(205, 145, 158), "pink3" },
1521 { RGB_TO_ULONG(139, 99 , 108), "pink4" },
1522 { RGB_TO_ULONG(255, 174, 185), "LightPink1" },
1523 { RGB_TO_ULONG(238, 162, 173), "LightPink2" },
1524 { RGB_TO_ULONG(205, 140, 149), "LightPink3" },
1525 { RGB_TO_ULONG(139, 95 , 101), "LightPink4" },
1526 { RGB_TO_ULONG(255, 130, 171), "PaleVioletRed1" },
1527 { RGB_TO_ULONG(238, 121, 159), "PaleVioletRed2" },
1528 { RGB_TO_ULONG(205, 104, 137), "PaleVioletRed3" },
1529 { RGB_TO_ULONG(139, 71 , 93 ), "PaleVioletRed4" },
1530 { RGB_TO_ULONG(255, 52 , 179), "maroon1" },
1531 { RGB_TO_ULONG(238, 48 , 167), "maroon2" },
1532 { RGB_TO_ULONG(205, 41 , 144), "maroon3" },
1533 { RGB_TO_ULONG(139, 28 , 98 ), "maroon4" },
1534 { RGB_TO_ULONG(255, 62 , 150), "VioletRed1" },
1535 { RGB_TO_ULONG(238, 58 , 140), "VioletRed2" },
1536 { RGB_TO_ULONG(205, 50 , 120), "VioletRed3" },
1537 { RGB_TO_ULONG(139, 34 , 82 ), "VioletRed4" },
1538 { RGB_TO_ULONG(255, 0 , 255), "magenta1" },
1539 { RGB_TO_ULONG(238, 0 , 238), "magenta2" },
1540 { RGB_TO_ULONG(205, 0 , 205), "magenta3" },
1541 { RGB_TO_ULONG(139, 0 , 139), "magenta4" },
1542 { RGB_TO_ULONG(255, 131, 250), "orchid1" },
1543 { RGB_TO_ULONG(238, 122, 233), "orchid2" },
1544 { RGB_TO_ULONG(205, 105, 201), "orchid3" },
1545 { RGB_TO_ULONG(139, 71 , 137), "orchid4" },
1546 { RGB_TO_ULONG(255, 187, 255), "plum1" },
1547 { RGB_TO_ULONG(238, 174, 238), "plum2" },
1548 { RGB_TO_ULONG(205, 150, 205), "plum3" },
1549 { RGB_TO_ULONG(139, 102, 139), "plum4" },
1550 { RGB_TO_ULONG(224, 102, 255), "MediumOrchid1" },
1551 { RGB_TO_ULONG(209, 95 , 238), "MediumOrchid2" },
1552 { RGB_TO_ULONG(180, 82 , 205), "MediumOrchid3" },
1553 { RGB_TO_ULONG(122, 55 , 139), "MediumOrchid4" },
1554 { RGB_TO_ULONG(191, 62 , 255), "DarkOrchid1" },
1555 { RGB_TO_ULONG(178, 58 , 238), "DarkOrchid2" },
1556 { RGB_TO_ULONG(154, 50 , 205), "DarkOrchid3" },
1557 { RGB_TO_ULONG(104, 34 , 139), "DarkOrchid4" },
1558 { RGB_TO_ULONG(155, 48 , 255), "purple1" },
1559 { RGB_TO_ULONG(145, 44 , 238), "purple2" },
1560 { RGB_TO_ULONG(125, 38 , 205), "purple3" },
1561 { RGB_TO_ULONG(85 , 26 , 139), "purple4" },
1562 { RGB_TO_ULONG(171, 130, 255), "MediumPurple1" },
1563 { RGB_TO_ULONG(159, 121, 238), "MediumPurple2" },
1564 { RGB_TO_ULONG(137, 104, 205), "MediumPurple3" },
1565 { RGB_TO_ULONG(93 , 71 , 139), "MediumPurple4" },
1566 { RGB_TO_ULONG(255, 225, 255), "thistle1" },
1567 { RGB_TO_ULONG(238, 210, 238), "thistle2" },
1568 { RGB_TO_ULONG(205, 181, 205), "thistle3" },
1569 { RGB_TO_ULONG(139, 123, 139), "thistle4" },
1570 { RGB_TO_ULONG(0 , 0 , 0 ), "gray0" },
1571 { RGB_TO_ULONG(0 , 0 , 0 ), "grey0" },
1572 { RGB_TO_ULONG(3 , 3 , 3 ), "gray1" },
1573 { RGB_TO_ULONG(3 , 3 , 3 ), "grey1" },
1574 { RGB_TO_ULONG(5 , 5 , 5 ), "gray2" },
1575 { RGB_TO_ULONG(5 , 5 , 5 ), "grey2" },
1576 { RGB_TO_ULONG(8 , 8 , 8 ), "gray3" },
1577 { RGB_TO_ULONG(8 , 8 , 8 ), "grey3" },
1578 { RGB_TO_ULONG(10 , 10 , 10 ), "gray4" },
1579 { RGB_TO_ULONG(10 , 10 , 10 ), "grey4" },
1580 { RGB_TO_ULONG(13 , 13 , 13 ), "gray5" },
1581 { RGB_TO_ULONG(13 , 13 , 13 ), "grey5" },
1582 { RGB_TO_ULONG(15 , 15 , 15 ), "gray6" },
1583 { RGB_TO_ULONG(15 , 15 , 15 ), "grey6" },
1584 { RGB_TO_ULONG(18 , 18 , 18 ), "gray7" },
1585 { RGB_TO_ULONG(18 , 18 , 18 ), "grey7" },
1586 { RGB_TO_ULONG(20 , 20 , 20 ), "gray8" },
1587 { RGB_TO_ULONG(20 , 20 , 20 ), "grey8" },
1588 { RGB_TO_ULONG(23 , 23 , 23 ), "gray9" },
1589 { RGB_TO_ULONG(23 , 23 , 23 ), "grey9" },
1590 { RGB_TO_ULONG(26 , 26 , 26 ), "gray10" },
1591 { RGB_TO_ULONG(26 , 26 , 26 ), "grey10" },
1592 { RGB_TO_ULONG(28 , 28 , 28 ), "gray11" },
1593 { RGB_TO_ULONG(28 , 28 , 28 ), "grey11" },
1594 { RGB_TO_ULONG(31 , 31 , 31 ), "gray12" },
1595 { RGB_TO_ULONG(31 , 31 , 31 ), "grey12" },
1596 { RGB_TO_ULONG(33 , 33 , 33 ), "gray13" },
1597 { RGB_TO_ULONG(33 , 33 , 33 ), "grey13" },
1598 { RGB_TO_ULONG(36 , 36 , 36 ), "gray14" },
1599 { RGB_TO_ULONG(36 , 36 , 36 ), "grey14" },
1600 { RGB_TO_ULONG(38 , 38 , 38 ), "gray15" },
1601 { RGB_TO_ULONG(38 , 38 , 38 ), "grey15" },
1602 { RGB_TO_ULONG(41 , 41 , 41 ), "gray16" },
1603 { RGB_TO_ULONG(41 , 41 , 41 ), "grey16" },
1604 { RGB_TO_ULONG(43 , 43 , 43 ), "gray17" },
1605 { RGB_TO_ULONG(43 , 43 , 43 ), "grey17" },
1606 { RGB_TO_ULONG(46 , 46 , 46 ), "gray18" },
1607 { RGB_TO_ULONG(46 , 46 , 46 ), "grey18" },
1608 { RGB_TO_ULONG(48 , 48 , 48 ), "gray19" },
1609 { RGB_TO_ULONG(48 , 48 , 48 ), "grey19" },
1610 { RGB_TO_ULONG(51 , 51 , 51 ), "gray20" },
1611 { RGB_TO_ULONG(51 , 51 , 51 ), "grey20" },
1612 { RGB_TO_ULONG(54 , 54 , 54 ), "gray21" },
1613 { RGB_TO_ULONG(54 , 54 , 54 ), "grey21" },
1614 { RGB_TO_ULONG(56 , 56 , 56 ), "gray22" },
1615 { RGB_TO_ULONG(56 , 56 , 56 ), "grey22" },
1616 { RGB_TO_ULONG(59 , 59 , 59 ), "gray23" },
1617 { RGB_TO_ULONG(59 , 59 , 59 ), "grey23" },
1618 { RGB_TO_ULONG(61 , 61 , 61 ), "gray24" },
1619 { RGB_TO_ULONG(61 , 61 , 61 ), "grey24" },
1620 { RGB_TO_ULONG(64 , 64 , 64 ), "gray25" },
1621 { RGB_TO_ULONG(64 , 64 , 64 ), "grey25" },
1622 { RGB_TO_ULONG(66 , 66 , 66 ), "gray26" },
1623 { RGB_TO_ULONG(66 , 66 , 66 ), "grey26" },
1624 { RGB_TO_ULONG(69 , 69 , 69 ), "gray27" },
1625 { RGB_TO_ULONG(69 , 69 , 69 ), "grey27" },
1626 { RGB_TO_ULONG(71 , 71 , 71 ), "gray28" },
1627 { RGB_TO_ULONG(71 , 71 , 71 ), "grey28" },
1628 { RGB_TO_ULONG(74 , 74 , 74 ), "gray29" },
1629 { RGB_TO_ULONG(74 , 74 , 74 ), "grey29" },
1630 { RGB_TO_ULONG(77 , 77 , 77 ), "gray30" },
1631 { RGB_TO_ULONG(77 , 77 , 77 ), "grey30" },
1632 { RGB_TO_ULONG(79 , 79 , 79 ), "gray31" },
1633 { RGB_TO_ULONG(79 , 79 , 79 ), "grey31" },
1634 { RGB_TO_ULONG(82 , 82 , 82 ), "gray32" },
1635 { RGB_TO_ULONG(82 , 82 , 82 ), "grey32" },
1636 { RGB_TO_ULONG(84 , 84 , 84 ), "gray33" },
1637 { RGB_TO_ULONG(84 , 84 , 84 ), "grey33" },
1638 { RGB_TO_ULONG(87 , 87 , 87 ), "gray34" },
1639 { RGB_TO_ULONG(87 , 87 , 87 ), "grey34" },
1640 { RGB_TO_ULONG(89 , 89 , 89 ), "gray35" },
1641 { RGB_TO_ULONG(89 , 89 , 89 ), "grey35" },
1642 { RGB_TO_ULONG(92 , 92 , 92 ), "gray36" },
1643 { RGB_TO_ULONG(92 , 92 , 92 ), "grey36" },
1644 { RGB_TO_ULONG(94 , 94 , 94 ), "gray37" },
1645 { RGB_TO_ULONG(94 , 94 , 94 ), "grey37" },
1646 { RGB_TO_ULONG(97 , 97 , 97 ), "gray38" },
1647 { RGB_TO_ULONG(97 , 97 , 97 ), "grey38" },
1648 { RGB_TO_ULONG(99 , 99 , 99 ), "gray39" },
1649 { RGB_TO_ULONG(99 , 99 , 99 ), "grey39" },
1650 { RGB_TO_ULONG(102, 102, 102), "gray40" },
1651 { RGB_TO_ULONG(102, 102, 102), "grey40" },
1652 { RGB_TO_ULONG(105, 105, 105), "gray41" },
1653 { RGB_TO_ULONG(105, 105, 105), "grey41" },
1654 { RGB_TO_ULONG(107, 107, 107), "gray42" },
1655 { RGB_TO_ULONG(107, 107, 107), "grey42" },
1656 { RGB_TO_ULONG(110, 110, 110), "gray43" },
1657 { RGB_TO_ULONG(110, 110, 110), "grey43" },
1658 { RGB_TO_ULONG(112, 112, 112), "gray44" },
1659 { RGB_TO_ULONG(112, 112, 112), "grey44" },
1660 { RGB_TO_ULONG(115, 115, 115), "gray45" },
1661 { RGB_TO_ULONG(115, 115, 115), "grey45" },
1662 { RGB_TO_ULONG(117, 117, 117), "gray46" },
1663 { RGB_TO_ULONG(117, 117, 117), "grey46" },
1664 { RGB_TO_ULONG(120, 120, 120), "gray47" },
1665 { RGB_TO_ULONG(120, 120, 120), "grey47" },
1666 { RGB_TO_ULONG(122, 122, 122), "gray48" },
1667 { RGB_TO_ULONG(122, 122, 122), "grey48" },
1668 { RGB_TO_ULONG(125, 125, 125), "gray49" },
1669 { RGB_TO_ULONG(125, 125, 125), "grey49" },
1670 { RGB_TO_ULONG(127, 127, 127), "gray50" },
1671 { RGB_TO_ULONG(127, 127, 127), "grey50" },
1672 { RGB_TO_ULONG(130, 130, 130), "gray51" },
1673 { RGB_TO_ULONG(130, 130, 130), "grey51" },
1674 { RGB_TO_ULONG(133, 133, 133), "gray52" },
1675 { RGB_TO_ULONG(133, 133, 133), "grey52" },
1676 { RGB_TO_ULONG(135, 135, 135), "gray53" },
1677 { RGB_TO_ULONG(135, 135, 135), "grey53" },
1678 { RGB_TO_ULONG(138, 138, 138), "gray54" },
1679 { RGB_TO_ULONG(138, 138, 138), "grey54" },
1680 { RGB_TO_ULONG(140, 140, 140), "gray55" },
1681 { RGB_TO_ULONG(140, 140, 140), "grey55" },
1682 { RGB_TO_ULONG(143, 143, 143), "gray56" },
1683 { RGB_TO_ULONG(143, 143, 143), "grey56" },
1684 { RGB_TO_ULONG(145, 145, 145), "gray57" },
1685 { RGB_TO_ULONG(145, 145, 145), "grey57" },
1686 { RGB_TO_ULONG(148, 148, 148), "gray58" },
1687 { RGB_TO_ULONG(148, 148, 148), "grey58" },
1688 { RGB_TO_ULONG(150, 150, 150), "gray59" },
1689 { RGB_TO_ULONG(150, 150, 150), "grey59" },
1690 { RGB_TO_ULONG(153, 153, 153), "gray60" },
1691 { RGB_TO_ULONG(153, 153, 153), "grey60" },
1692 { RGB_TO_ULONG(156, 156, 156), "gray61" },
1693 { RGB_TO_ULONG(156, 156, 156), "grey61" },
1694 { RGB_TO_ULONG(158, 158, 158), "gray62" },
1695 { RGB_TO_ULONG(158, 158, 158), "grey62" },
1696 { RGB_TO_ULONG(161, 161, 161), "gray63" },
1697 { RGB_TO_ULONG(161, 161, 161), "grey63" },
1698 { RGB_TO_ULONG(163, 163, 163), "gray64" },
1699 { RGB_TO_ULONG(163, 163, 163), "grey64" },
1700 { RGB_TO_ULONG(166, 166, 166), "gray65" },
1701 { RGB_TO_ULONG(166, 166, 166), "grey65" },
1702 { RGB_TO_ULONG(168, 168, 168), "gray66" },
1703 { RGB_TO_ULONG(168, 168, 168), "grey66" },
1704 { RGB_TO_ULONG(171, 171, 171), "gray67" },
1705 { RGB_TO_ULONG(171, 171, 171), "grey67" },
1706 { RGB_TO_ULONG(173, 173, 173), "gray68" },
1707 { RGB_TO_ULONG(173, 173, 173), "grey68" },
1708 { RGB_TO_ULONG(176, 176, 176), "gray69" },
1709 { RGB_TO_ULONG(176, 176, 176), "grey69" },
1710 { RGB_TO_ULONG(179, 179, 179), "gray70" },
1711 { RGB_TO_ULONG(179, 179, 179), "grey70" },
1712 { RGB_TO_ULONG(181, 181, 181), "gray71" },
1713 { RGB_TO_ULONG(181, 181, 181), "grey71" },
1714 { RGB_TO_ULONG(184, 184, 184), "gray72" },
1715 { RGB_TO_ULONG(184, 184, 184), "grey72" },
1716 { RGB_TO_ULONG(186, 186, 186), "gray73" },
1717 { RGB_TO_ULONG(186, 186, 186), "grey73" },
1718 { RGB_TO_ULONG(189, 189, 189), "gray74" },
1719 { RGB_TO_ULONG(189, 189, 189), "grey74" },
1720 { RGB_TO_ULONG(191, 191, 191), "gray75" },
1721 { RGB_TO_ULONG(191, 191, 191), "grey75" },
1722 { RGB_TO_ULONG(194, 194, 194), "gray76" },
1723 { RGB_TO_ULONG(194, 194, 194), "grey76" },
1724 { RGB_TO_ULONG(196, 196, 196), "gray77" },
1725 { RGB_TO_ULONG(196, 196, 196), "grey77" },
1726 { RGB_TO_ULONG(199, 199, 199), "gray78" },
1727 { RGB_TO_ULONG(199, 199, 199), "grey78" },
1728 { RGB_TO_ULONG(201, 201, 201), "gray79" },
1729 { RGB_TO_ULONG(201, 201, 201), "grey79" },
1730 { RGB_TO_ULONG(204, 204, 204), "gray80" },
1731 { RGB_TO_ULONG(204, 204, 204), "grey80" },
1732 { RGB_TO_ULONG(207, 207, 207), "gray81" },
1733 { RGB_TO_ULONG(207, 207, 207), "grey81" },
1734 { RGB_TO_ULONG(209, 209, 209), "gray82" },
1735 { RGB_TO_ULONG(209, 209, 209), "grey82" },
1736 { RGB_TO_ULONG(212, 212, 212), "gray83" },
1737 { RGB_TO_ULONG(212, 212, 212), "grey83" },
1738 { RGB_TO_ULONG(214, 214, 214), "gray84" },
1739 { RGB_TO_ULONG(214, 214, 214), "grey84" },
1740 { RGB_TO_ULONG(217, 217, 217), "gray85" },
1741 { RGB_TO_ULONG(217, 217, 217), "grey85" },
1742 { RGB_TO_ULONG(219, 219, 219), "gray86" },
1743 { RGB_TO_ULONG(219, 219, 219), "grey86" },
1744 { RGB_TO_ULONG(222, 222, 222), "gray87" },
1745 { RGB_TO_ULONG(222, 222, 222), "grey87" },
1746 { RGB_TO_ULONG(224, 224, 224), "gray88" },
1747 { RGB_TO_ULONG(224, 224, 224), "grey88" },
1748 { RGB_TO_ULONG(227, 227, 227), "gray89" },
1749 { RGB_TO_ULONG(227, 227, 227), "grey89" },
1750 { RGB_TO_ULONG(229, 229, 229), "gray90" },
1751 { RGB_TO_ULONG(229, 229, 229), "grey90" },
1752 { RGB_TO_ULONG(232, 232, 232), "gray91" },
1753 { RGB_TO_ULONG(232, 232, 232), "grey91" },
1754 { RGB_TO_ULONG(235, 235, 235), "gray92" },
1755 { RGB_TO_ULONG(235, 235, 235), "grey92" },
1756 { RGB_TO_ULONG(237, 237, 237), "gray93" },
1757 { RGB_TO_ULONG(237, 237, 237), "grey93" },
1758 { RGB_TO_ULONG(240, 240, 240), "gray94" },
1759 { RGB_TO_ULONG(240, 240, 240), "grey94" },
1760 { RGB_TO_ULONG(242, 242, 242), "gray95" },
1761 { RGB_TO_ULONG(242, 242, 242), "grey95" },
1762 { RGB_TO_ULONG(245, 245, 245), "gray96" },
1763 { RGB_TO_ULONG(245, 245, 245), "grey96" },
1764 { RGB_TO_ULONG(247, 247, 247), "gray97" },
1765 { RGB_TO_ULONG(247, 247, 247), "grey97" },
1766 { RGB_TO_ULONG(250, 250, 250), "gray98" },
1767 { RGB_TO_ULONG(250, 250, 250), "grey98" },
1768 { RGB_TO_ULONG(252, 252, 252), "gray99" },
1769 { RGB_TO_ULONG(252, 252, 252), "grey99" },
1770 { RGB_TO_ULONG(255, 255, 255), "gray100" },
1771 { RGB_TO_ULONG(255, 255, 255), "grey100" },
1772 { RGB_TO_ULONG(169, 169, 169), "dark grey" },
1773 { RGB_TO_ULONG(169, 169, 169), "DarkGrey" },
1774 { RGB_TO_ULONG(169, 169, 169), "dark gray" },
1775 { RGB_TO_ULONG(169, 169, 169), "DarkGray" },
1776 { RGB_TO_ULONG(0 , 0 , 139), "dark blue" },
1777 { RGB_TO_ULONG(0 , 0 , 139), "DarkBlue" },
1778 { RGB_TO_ULONG(0 , 139, 139), "dark cyan" },
1779 { RGB_TO_ULONG(0 , 139, 139), "DarkCyan" },
1780 { RGB_TO_ULONG(139, 0 , 139), "dark magenta" },
1781 { RGB_TO_ULONG(139, 0 , 139), "DarkMagenta" },
1782 { RGB_TO_ULONG(139, 0 , 0 ), "dark red" },
1783 { RGB_TO_ULONG(139, 0 , 0 ), "DarkRed" },
1784 { RGB_TO_ULONG(144, 238, 144), "light green" },
1785 { RGB_TO_ULONG(144, 238, 144), "LightGreen" }
1786 };
1787
1788 unsigned long
1789 mac_color_map_lookup (colorname)
1790 char *colorname;
1791 {
1792 Lisp_Object ret = Qnil;
1793 int i;
1794
1795 BLOCK_INPUT;
1796
1797 for (i = 0; i < sizeof (mac_color_map) / sizeof (mac_color_map[0]); i++)
1798 if (stricmp (colorname, mac_color_map[i].name) == 0)
1799 {
1800 ret = mac_color_map[i].color;
1801 break;
1802 }
1803
1804 UNBLOCK_INPUT;
1805
1806 return ret;
1807 }
1808
1809 Lisp_Object
1810 x_to_mac_color (colorname)
1811 char * colorname;
1812 {
1813 register Lisp_Object tail, ret = Qnil;
1814
1815 BLOCK_INPUT;
1816
1817 if (colorname[0] == '#')
1818 {
1819 /* Could be an old-style RGB Device specification. */
1820 char *color;
1821 int size;
1822 color = colorname + 1;
1823
1824 size = strlen(color);
1825 if (size == 3 || size == 6 || size == 9 || size == 12)
1826 {
1827 unsigned long colorval;
1828 int i, pos;
1829 pos = 0;
1830 size /= 3;
1831 colorval = 0;
1832
1833 for (i = 0; i < 3; i++)
1834 {
1835 char *end;
1836 char t;
1837 unsigned long value;
1838
1839 /* The check for 'x' in the following conditional takes into
1840 account the fact that strtol allows a "0x" in front of
1841 our numbers, and we don't. */
1842 if (!isxdigit(color[0]) || color[1] == 'x')
1843 break;
1844 t = color[size];
1845 color[size] = '\0';
1846 value = strtoul(color, &end, 16);
1847 color[size] = t;
1848 if (errno == ERANGE || end - color != size)
1849 break;
1850 switch (size)
1851 {
1852 case 1:
1853 value = value * 0x10;
1854 break;
1855 case 2:
1856 break;
1857 case 3:
1858 value /= 0x10;
1859 break;
1860 case 4:
1861 value /= 0x100;
1862 break;
1863 }
1864 colorval |= (value << pos);
1865 pos += 0x8;
1866 if (i == 2)
1867 {
1868 UNBLOCK_INPUT;
1869 return (colorval);
1870 }
1871 color = end;
1872 }
1873 }
1874 }
1875 else if (strnicmp(colorname, "rgb:", 4) == 0)
1876 {
1877 char *color;
1878 unsigned long colorval;
1879 int i, pos;
1880 pos = 0;
1881
1882 colorval = 0;
1883 color = colorname + 4;
1884 for (i = 0; i < 3; i++)
1885 {
1886 char *end;
1887 unsigned long value;
1888
1889 /* The check for 'x' in the following conditional takes into
1890 account the fact that strtol allows a "0x" in front of
1891 our numbers, and we don't. */
1892 if (!isxdigit(color[0]) || color[1] == 'x')
1893 break;
1894 value = strtoul(color, &end, 16);
1895 if (errno == ERANGE)
1896 break;
1897 switch (end - color)
1898 {
1899 case 1:
1900 value = value * 0x10 + value;
1901 break;
1902 case 2:
1903 break;
1904 case 3:
1905 value /= 0x10;
1906 break;
1907 case 4:
1908 value /= 0x100;
1909 break;
1910 default:
1911 value = ULONG_MAX;
1912 }
1913 if (value == ULONG_MAX)
1914 break;
1915 colorval |= (value << pos);
1916 pos += 0x8;
1917 if (i == 2)
1918 {
1919 if (*end != '\0')
1920 break;
1921 UNBLOCK_INPUT;
1922 return (colorval);
1923 }
1924 if (*end != '/')
1925 break;
1926 color = end + 1;
1927 }
1928 }
1929 else if (strnicmp(colorname, "rgbi:", 5) == 0)
1930 {
1931 /* This is an RGB Intensity specification. */
1932 char *color;
1933 unsigned long colorval;
1934 int i, pos;
1935 pos = 0;
1936
1937 colorval = 0;
1938 color = colorname + 5;
1939 for (i = 0; i < 3; i++)
1940 {
1941 char *end;
1942 double value;
1943 unsigned long val;
1944
1945 value = strtod(color, &end);
1946 if (errno == ERANGE)
1947 break;
1948 if (value < 0.0 || value > 1.0)
1949 break;
1950 val = (unsigned long)(0x100 * value);
1951 /* We used 0x100 instead of 0xFF to give an continuous
1952 range between 0.0 and 1.0 inclusive. The next statement
1953 fixes the 1.0 case. */
1954 if (val == 0x100)
1955 val = 0xFF;
1956 colorval |= (val << pos);
1957 pos += 0x8;
1958 if (i == 2)
1959 {
1960 if (*end != '\0')
1961 break;
1962 UNBLOCK_INPUT;
1963 return (colorval);
1964 }
1965 if (*end != '/')
1966 break;
1967 color = end + 1;
1968 }
1969 }
1970
1971 ret = mac_color_map_lookup (colorname);
1972
1973 UNBLOCK_INPUT;
1974 return ret;
1975 }
1976
1977 /* Gamma-correct COLOR on frame F. */
1978
1979 void
1980 gamma_correct (f, color)
1981 struct frame *f;
1982 unsigned long *color;
1983 {
1984 if (f->gamma)
1985 {
1986 unsigned long red, green, blue;
1987
1988 red = pow (RED_FROM_ULONG (*color) / 255.0, f->gamma) * 255.0 + 0.5;
1989 green = pow (GREEN_FROM_ULONG (*color) / 255.0, f->gamma) * 255.0 + 0.5;
1990 blue = pow (BLUE_FROM_ULONG (*color) / 255.0, f->gamma) * 255.0 + 0.5;
1991 *color = RGB_TO_ULONG (red, green, blue);
1992 }
1993 }
1994
1995 /* Decide if color named COLOR is valid for the display associated
1996 with the selected frame; if so, return the rgb values in COLOR_DEF.
1997 If ALLOC is nonzero, allocate a new colormap cell. */
1998
1999 int
2000 mac_defined_color (f, color, color_def, alloc)
2001 FRAME_PTR f;
2002 char *color;
2003 XColor *color_def;
2004 int alloc;
2005 {
2006 register Lisp_Object tem;
2007 unsigned long mac_color_ref;
2008
2009 tem = x_to_mac_color (color);
2010
2011 if (!NILP (tem))
2012 {
2013 if (f)
2014 {
2015 /* Apply gamma correction. */
2016 mac_color_ref = XUINT (tem);
2017 gamma_correct (f, &mac_color_ref);
2018 XSETINT (tem, mac_color_ref);
2019 }
2020
2021 color_def->pixel = mac_color_ref;
2022 color_def->red = RED_FROM_ULONG (mac_color_ref);
2023 color_def->green = GREEN_FROM_ULONG (mac_color_ref);
2024 color_def->blue = BLUE_FROM_ULONG (mac_color_ref);
2025
2026 return 1;
2027 }
2028 else
2029 {
2030 return 0;
2031 }
2032 }
2033
2034 /* Given a string ARG naming a color, compute a pixel value from it
2035 suitable for screen F.
2036 If F is not a color screen, return DEF (default) regardless of what
2037 ARG says. */
2038
2039 int
2040 x_decode_color (f, arg, def)
2041 FRAME_PTR f;
2042 Lisp_Object arg;
2043 int def;
2044 {
2045 XColor cdef;
2046
2047 CHECK_STRING (arg, 0);
2048
2049 if (strcmp (XSTRING (arg)->data, "black") == 0)
2050 return BLACK_PIX_DEFAULT (f);
2051 else if (strcmp (XSTRING (arg)->data, "white") == 0)
2052 return WHITE_PIX_DEFAULT (f);
2053
2054 #if 0
2055 if ((FRAME_MAC_DISPLAY_INFO (f)->n_planes
2056 * FRAME_MAC_DISPLAY_INFO (f)->n_cbits) == 1)
2057 return def;
2058 #endif
2059
2060 if (mac_defined_color (f, XSTRING (arg)->data, &cdef, 1))
2061 return cdef.pixel;
2062
2063 /* defined_color failed; return an ultimate default. */
2064 return def;
2065 }
2066 \f
2067 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
2068 the previous value of that parameter, NEW_VALUE is the new value. */
2069
2070 static void
2071 x_set_line_spacing (f, new_value, old_value)
2072 struct frame *f;
2073 Lisp_Object new_value, old_value;
2074 {
2075 if (NILP (new_value))
2076 f->extra_line_spacing = 0;
2077 else if (NATNUMP (new_value))
2078 f->extra_line_spacing = XFASTINT (new_value);
2079 else
2080 Fsignal (Qerror, Fcons (build_string ("Illegal line-spacing"),
2081 Fcons (new_value, Qnil)));
2082 if (FRAME_VISIBLE_P (f))
2083 redraw_frame (f);
2084 }
2085
2086
2087 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
2088 the previous value of that parameter, NEW_VALUE is the new value. */
2089
2090 static void
2091 x_set_screen_gamma (f, new_value, old_value)
2092 struct frame *f;
2093 Lisp_Object new_value, old_value;
2094 {
2095 if (NILP (new_value))
2096 f->gamma = 0;
2097 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
2098 /* The value 0.4545 is the normal viewing gamma. */
2099 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
2100 else
2101 Fsignal (Qerror, Fcons (build_string ("Illegal screen-gamma"),
2102 Fcons (new_value, Qnil)));
2103
2104 clear_face_cache (0);
2105 }
2106
2107
2108 /* Functions called only from `x_set_frame_param'
2109 to set individual parameters.
2110
2111 If FRAME_MAC_WINDOW (f) is 0,
2112 the frame is being created and its window does not exist yet.
2113 In that case, just record the parameter's new value
2114 in the standard place; do not attempt to change the window. */
2115
2116 void
2117 x_set_foreground_color (f, arg, oldval)
2118 struct frame *f;
2119 Lisp_Object arg, oldval;
2120 {
2121 FRAME_FOREGROUND_PIXEL (f)
2122 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
2123
2124 if (FRAME_MAC_WINDOW (f) != 0)
2125 {
2126 update_face_from_frame_parameter (f, Qforeground_color, arg);
2127 if (FRAME_VISIBLE_P (f))
2128 redraw_frame (f);
2129 }
2130 }
2131
2132 void
2133 x_set_background_color (f, arg, oldval)
2134 struct frame *f;
2135 Lisp_Object arg, oldval;
2136 {
2137 FRAME_BACKGROUND_PIXEL (f)
2138 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
2139
2140 if (FRAME_MAC_WINDOW (f) != 0)
2141 {
2142 update_face_from_frame_parameter (f, Qbackground_color, arg);
2143
2144 if (FRAME_VISIBLE_P (f))
2145 redraw_frame (f);
2146 }
2147 }
2148
2149 void
2150 x_set_mouse_color (f, arg, oldval)
2151 struct frame *f;
2152 Lisp_Object arg, oldval;
2153 {
2154 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
2155 int count;
2156 int mask_color;
2157
2158 if (!EQ (Qnil, arg))
2159 f->output_data.mac->mouse_pixel
2160 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
2161 mask_color = FRAME_BACKGROUND_PIXEL (f);
2162
2163 /* Don't let pointers be invisible. */
2164 if (mask_color == f->output_data.mac->mouse_pixel
2165 && mask_color == FRAME_BACKGROUND_PIXEL (f))
2166 f->output_data.mac->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
2167
2168 #if 0 /* MAC_TODO : cursor changes */
2169 BLOCK_INPUT;
2170
2171 /* It's not okay to crash if the user selects a screwy cursor. */
2172 count = x_catch_errors (FRAME_W32_DISPLAY (f));
2173
2174 if (!EQ (Qnil, Vx_pointer_shape))
2175 {
2176 CHECK_NUMBER (Vx_pointer_shape, 0);
2177 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
2178 }
2179 else
2180 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2181 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
2182
2183 if (!EQ (Qnil, Vx_nontext_pointer_shape))
2184 {
2185 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
2186 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
2187 XINT (Vx_nontext_pointer_shape));
2188 }
2189 else
2190 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
2191 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
2192
2193 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
2194 {
2195 CHECK_NUMBER (Vx_hourglass_pointer_shape, 0);
2196 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
2197 XINT (Vx_hourglass_pointer_shape));
2198 }
2199 else
2200 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
2201 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
2202
2203 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
2204 if (!EQ (Qnil, Vx_mode_pointer_shape))
2205 {
2206 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
2207 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
2208 XINT (Vx_mode_pointer_shape));
2209 }
2210 else
2211 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2212 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
2213
2214 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
2215 {
2216 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
2217 cross_cursor
2218 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
2219 XINT (Vx_sensitive_text_pointer_shape));
2220 }
2221 else
2222 cross_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
2223
2224 if (!NILP (Vx_window_horizontal_drag_shape))
2225 {
2226 CHECK_NUMBER (Vx_window_horizontal_drag_shape, 0);
2227 horizontal_drag_cursor
2228 = XCreateFontCursor (FRAME_X_DISPLAY (f),
2229 XINT (Vx_window_horizontal_drag_shape));
2230 }
2231 else
2232 horizontal_drag_cursor
2233 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
2234
2235 /* Check and report errors with the above calls. */
2236 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
2237 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
2238
2239 {
2240 XColor fore_color, back_color;
2241
2242 fore_color.pixel = f->output_data.w32->mouse_pixel;
2243 back_color.pixel = mask_color;
2244 XQueryColor (FRAME_W32_DISPLAY (f),
2245 DefaultColormap (FRAME_W32_DISPLAY (f),
2246 DefaultScreen (FRAME_W32_DISPLAY (f))),
2247 &fore_color);
2248 XQueryColor (FRAME_W32_DISPLAY (f),
2249 DefaultColormap (FRAME_W32_DISPLAY (f),
2250 DefaultScreen (FRAME_W32_DISPLAY (f))),
2251 &back_color);
2252 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
2253 &fore_color, &back_color);
2254 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
2255 &fore_color, &back_color);
2256 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
2257 &fore_color, &back_color);
2258 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
2259 &fore_color, &back_color);
2260 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
2261 &fore_color, &back_color);
2262 }
2263
2264 if (FRAME_W32_WINDOW (f) != 0)
2265 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
2266
2267 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
2268 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
2269 f->output_data.w32->text_cursor = cursor;
2270
2271 if (nontext_cursor != f->output_data.w32->nontext_cursor
2272 && f->output_data.w32->nontext_cursor != 0)
2273 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
2274 f->output_data.w32->nontext_cursor = nontext_cursor;
2275
2276 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
2277 && f->output_data.w32->hourglass_cursor != 0)
2278 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
2279 f->output_data.w32->hourglass_cursor = hourglass_cursor;
2280
2281 if (mode_cursor != f->output_data.w32->modeline_cursor
2282 && f->output_data.w32->modeline_cursor != 0)
2283 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
2284 f->output_data.w32->modeline_cursor = mode_cursor;
2285
2286 if (cross_cursor != f->output_data.w32->cross_cursor
2287 && f->output_data.w32->cross_cursor != 0)
2288 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor);
2289 f->output_data.w32->cross_cursor = cross_cursor;
2290
2291 XFlush (FRAME_W32_DISPLAY (f));
2292 UNBLOCK_INPUT;
2293
2294 update_face_from_frame_parameter (f, Qmouse_color, arg);
2295 #endif /* MAC_TODO */
2296 }
2297
2298 void
2299 x_set_cursor_color (f, arg, oldval)
2300 struct frame *f;
2301 Lisp_Object arg, oldval;
2302 {
2303 unsigned long fore_pixel;
2304
2305 if (!NILP (Vx_cursor_fore_pixel))
2306 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
2307 WHITE_PIX_DEFAULT (f));
2308 else
2309 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
2310 f->output_data.mac->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
2311
2312 /* Make sure that the cursor color differs from the background color. */
2313 if (f->output_data.mac->cursor_pixel == FRAME_BACKGROUND_PIXEL (f))
2314 {
2315 f->output_data.mac->cursor_pixel = f->output_data.mac->mouse_pixel;
2316 if (f->output_data.mac->cursor_pixel == fore_pixel)
2317 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
2318 }
2319 FRAME_FOREGROUND_PIXEL (f) = fore_pixel;
2320
2321 #if 0 /* MAC_TODO: cannot figure out what to do (wrong number of params) */
2322 if (FRAME_MAC_WINDOW (f) != 0)
2323 {
2324 if (FRAME_VISIBLE_P (f))
2325 {
2326 x_display_cursor (f, 0);
2327 x_display_cursor (f, 1);
2328 }
2329 }
2330 #endif
2331
2332 update_face_from_frame_parameter (f, Qcursor_color, arg);
2333 }
2334
2335 /* Set the border-color of frame F to pixel value PIX.
2336 Note that this does not fully take effect if done before
2337 F has an window. */
2338 void
2339 x_set_border_pixel (f, pix)
2340 struct frame *f;
2341 int pix;
2342 {
2343 f->output_data.mac->border_pixel = pix;
2344
2345 if (FRAME_MAC_WINDOW (f) != 0 && f->output_data.mac->border_width > 0)
2346 {
2347 if (FRAME_VISIBLE_P (f))
2348 redraw_frame (f);
2349 }
2350 }
2351
2352 /* Set the border-color of frame F to value described by ARG.
2353 ARG can be a string naming a color.
2354 The border-color is used for the border that is drawn by the server.
2355 Note that this does not fully take effect if done before
2356 F has a window; it must be redone when the window is created. */
2357
2358 void
2359 x_set_border_color (f, arg, oldval)
2360 struct frame *f;
2361 Lisp_Object arg, oldval;
2362 {
2363 int pix;
2364
2365 CHECK_STRING (arg, 0);
2366 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
2367 x_set_border_pixel (f, pix);
2368 update_face_from_frame_parameter (f, Qborder_color, arg);
2369 }
2370
2371 /* Value is the internal representation of the specified cursor type
2372 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
2373 of the bar cursor. */
2374
2375 enum text_cursor_kinds
2376 x_specified_cursor_type (arg, width)
2377 Lisp_Object arg;
2378 int *width;
2379 {
2380 enum text_cursor_kinds type;
2381
2382 if (EQ (arg, Qbar))
2383 {
2384 type = BAR_CURSOR;
2385 *width = 2;
2386 }
2387 else if (CONSP (arg)
2388 && EQ (XCAR (arg), Qbar)
2389 && INTEGERP (XCDR (arg))
2390 && XINT (XCDR (arg)) >= 0)
2391 {
2392 type = BAR_CURSOR;
2393 *width = XINT (XCDR (arg));
2394 }
2395 else if (NILP (arg))
2396 type = NO_CURSOR;
2397 else
2398 /* Treat anything unknown as "box cursor".
2399 It was bad to signal an error; people have trouble fixing
2400 .Xdefaults with Emacs, when it has something bad in it. */
2401 type = FILLED_BOX_CURSOR;
2402
2403 return type;
2404 }
2405
2406 void
2407 x_set_cursor_type (f, arg, oldval)
2408 FRAME_PTR f;
2409 Lisp_Object arg, oldval;
2410 {
2411 int width;
2412
2413 FRAME_DESIRED_CURSOR (f) = x_specified_cursor_type (arg, &width);
2414 f->output_data.mac->cursor_width = width;
2415
2416 /* Make sure the cursor gets redrawn. This is overkill, but how
2417 often do people change cursor types? */
2418 update_mode_lines++;
2419 }
2420 \f
2421 #if 0 /* MAC_TODO: really no icon for Mac */
2422 void
2423 x_set_icon_type (f, arg, oldval)
2424 struct frame *f;
2425 Lisp_Object arg, oldval;
2426 {
2427 int result;
2428
2429 if (NILP (arg) && NILP (oldval))
2430 return;
2431
2432 if (STRINGP (arg) && STRINGP (oldval)
2433 && EQ (Fstring_equal (oldval, arg), Qt))
2434 return;
2435
2436 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
2437 return;
2438
2439 BLOCK_INPUT;
2440
2441 result = x_bitmap_icon (f, arg);
2442 if (result)
2443 {
2444 UNBLOCK_INPUT;
2445 error ("No icon window available");
2446 }
2447
2448 UNBLOCK_INPUT;
2449 }
2450 #endif
2451
2452 /* Return non-nil if frame F wants a bitmap icon. */
2453
2454 Lisp_Object
2455 x_icon_type (f)
2456 FRAME_PTR f;
2457 {
2458 Lisp_Object tem;
2459
2460 tem = assq_no_quit (Qicon_type, f->param_alist);
2461 if (CONSP (tem))
2462 return XCDR (tem);
2463 else
2464 return Qnil;
2465 }
2466
2467 void
2468 x_set_icon_name (f, arg, oldval)
2469 struct frame *f;
2470 Lisp_Object arg, oldval;
2471 {
2472 int result;
2473
2474 if (STRINGP (arg))
2475 {
2476 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
2477 return;
2478 }
2479 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
2480 return;
2481
2482 f->icon_name = arg;
2483
2484 #if 0
2485 if (f->output_data.w32->icon_bitmap != 0)
2486 return;
2487
2488 BLOCK_INPUT;
2489
2490 result = x_text_icon (f,
2491 (char *) XSTRING ((!NILP (f->icon_name)
2492 ? f->icon_name
2493 : !NILP (f->title)
2494 ? f->title
2495 : f->name))->data);
2496
2497 if (result)
2498 {
2499 UNBLOCK_INPUT;
2500 error ("No icon window available");
2501 }
2502
2503 /* If the window was unmapped (and its icon was mapped),
2504 the new icon is not mapped, so map the window in its stead. */
2505 if (FRAME_VISIBLE_P (f))
2506 {
2507 #ifdef USE_X_TOOLKIT
2508 XtPopup (f->output_data.w32->widget, XtGrabNone);
2509 #endif
2510 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
2511 }
2512
2513 XFlush (FRAME_W32_DISPLAY (f));
2514 UNBLOCK_INPUT;
2515 #endif
2516 }
2517
2518 extern Lisp_Object x_new_font ();
2519 extern Lisp_Object x_new_fontset();
2520
2521 void
2522 x_set_font (f, arg, oldval)
2523 struct frame *f;
2524 Lisp_Object arg, oldval;
2525 {
2526 Lisp_Object result;
2527 Lisp_Object fontset_name;
2528 Lisp_Object frame;
2529
2530 CHECK_STRING (arg, 1);
2531
2532 fontset_name = Fquery_fontset (arg, Qnil);
2533
2534 BLOCK_INPUT;
2535 result = (STRINGP (fontset_name)
2536 ? x_new_fontset (f, XSTRING (fontset_name)->data)
2537 : x_new_font (f, XSTRING (arg)->data));
2538 UNBLOCK_INPUT;
2539
2540 if (EQ (result, Qnil))
2541 error ("Font `%s' is not defined", XSTRING (arg)->data);
2542 else if (EQ (result, Qt))
2543 error ("The characters of the given font have varying widths");
2544 else if (STRINGP (result))
2545 {
2546 if (!NILP (Fequal (result, oldval)))
2547 return;
2548 store_frame_param (f, Qfont, result);
2549 recompute_basic_faces (f);
2550 }
2551 else
2552 abort ();
2553
2554 do_pending_window_change (0);
2555
2556 /* Don't call `face-set-after-frame-default' when faces haven't been
2557 initialized yet. This is the case when called from
2558 Fx_create_frame. In that case, the X widget or window doesn't
2559 exist either, and we can end up in x_report_frame_params with a
2560 null widget which gives a segfault. */
2561 if (FRAME_FACE_CACHE (f))
2562 {
2563 XSETFRAME (frame, f);
2564 call1 (Qface_set_after_frame_default, frame);
2565 }
2566 }
2567
2568 static void
2569 x_set_fringe_width (f, new_value, old_value)
2570 struct frame *f;
2571 Lisp_Object new_value, old_value;
2572 {
2573 x_compute_fringe_widths (f, 1);
2574 }
2575
2576 void
2577 x_set_border_width (f, arg, oldval)
2578 struct frame *f;
2579 Lisp_Object arg, oldval;
2580 {
2581 CHECK_NUMBER (arg, 0);
2582
2583 if (XINT (arg) == f->output_data.mac->border_width)
2584 return;
2585
2586 #if 0
2587 if (FRAME_MAC_WINDOW (f) != 0)
2588 error ("Cannot change the border width of a window");
2589 #endif
2590
2591 f->output_data.mac->border_width = XINT (arg);
2592 }
2593
2594 void
2595 x_set_internal_border_width (f, arg, oldval)
2596 struct frame *f;
2597 Lisp_Object arg, oldval;
2598 {
2599 int old = f->output_data.mac->internal_border_width;
2600
2601 CHECK_NUMBER (arg, 0);
2602 f->output_data.mac->internal_border_width = XINT (arg);
2603 if (f->output_data.mac->internal_border_width < 0)
2604 f->output_data.mac->internal_border_width = 0;
2605
2606 if (f->output_data.mac->internal_border_width == old)
2607 return;
2608
2609 if (FRAME_MAC_WINDOW (f) != 0)
2610 {
2611 x_set_window_size (f, 0, f->width, f->height);
2612 SET_FRAME_GARBAGED (f);
2613 do_pending_window_change (0);
2614 }
2615 }
2616
2617 void
2618 x_set_visibility (f, value, oldval)
2619 struct frame *f;
2620 Lisp_Object value, oldval;
2621 {
2622 Lisp_Object frame;
2623 XSETFRAME (frame, f);
2624
2625 if (NILP (value))
2626 Fmake_frame_invisible (frame, Qt);
2627 else if (EQ (value, Qicon))
2628 Ficonify_frame (frame);
2629 else
2630 Fmake_frame_visible (frame);
2631 }
2632
2633 \f
2634 /* Change window heights in windows rooted in WINDOW by N lines. */
2635
2636 static void
2637 x_change_window_heights (window, n)
2638 Lisp_Object window;
2639 int n;
2640 {
2641 struct window *w = XWINDOW (window);
2642
2643 XSETFASTINT (w->top, XFASTINT (w->top) + n);
2644 XSETFASTINT (w->height, XFASTINT (w->height) - n);
2645
2646 if (INTEGERP (w->orig_top))
2647 XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
2648 if (INTEGERP (w->orig_height))
2649 XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
2650
2651 /* Handle just the top child in a vertical split. */
2652 if (!NILP (w->vchild))
2653 x_change_window_heights (w->vchild, n);
2654
2655 /* Adjust all children in a horizontal split. */
2656 for (window = w->hchild; !NILP (window); window = w->next)
2657 {
2658 w = XWINDOW (window);
2659 x_change_window_heights (window, n);
2660 }
2661 }
2662
2663 void
2664 x_set_menu_bar_lines (f, value, oldval)
2665 struct frame *f;
2666 Lisp_Object value, oldval;
2667 {
2668 int nlines;
2669 int olines = FRAME_MENU_BAR_LINES (f);
2670
2671 /* Right now, menu bars don't work properly in minibuf-only frames;
2672 most of the commands try to apply themselves to the minibuffer
2673 frame itself, and get an error because you can't switch buffers
2674 in or split the minibuffer window. */
2675 if (FRAME_MINIBUF_ONLY_P (f))
2676 return;
2677
2678 if (INTEGERP (value))
2679 nlines = XINT (value);
2680 else
2681 nlines = 0;
2682
2683 FRAME_MENU_BAR_LINES (f) = 0;
2684 if (nlines)
2685 FRAME_EXTERNAL_MENU_BAR (f) = 1;
2686 else
2687 {
2688 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2689 free_frame_menubar (f);
2690 FRAME_EXTERNAL_MENU_BAR (f) = 0;
2691
2692 /* Adjust the frame size so that the client (text) dimensions
2693 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2694 set correctly. */
2695 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2696 do_pending_window_change (0);
2697 }
2698 adjust_glyphs (f);
2699 }
2700
2701 /* Set the number of lines used for the tool bar of frame F to VALUE.
2702 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2703 is the old number of tool bar lines. This function changes the
2704 height of all windows on frame F to match the new tool bar height.
2705 The frame's height doesn't change. */
2706
2707 void
2708 x_set_tool_bar_lines (f, value, oldval)
2709 struct frame *f;
2710 Lisp_Object value, oldval;
2711 {
2712 int delta, nlines, root_height;
2713 Lisp_Object root_window;
2714
2715 /* Treat tool bars like menu bars. */
2716 if (FRAME_MINIBUF_ONLY_P (f))
2717 return;
2718
2719 /* Use VALUE only if an integer >= 0. */
2720 if (INTEGERP (value) && XINT (value) >= 0)
2721 nlines = XFASTINT (value);
2722 else
2723 nlines = 0;
2724
2725 /* Make sure we redisplay all windows in this frame. */
2726 ++windows_or_buffers_changed;
2727
2728 delta = nlines - FRAME_TOOL_BAR_LINES (f);
2729
2730 /* Don't resize the tool-bar to more than we have room for. */
2731 root_window = FRAME_ROOT_WINDOW (f);
2732 root_height = XINT (XWINDOW (root_window)->height);
2733 if (root_height - delta < 1)
2734 {
2735 delta = root_height - 1;
2736 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
2737 }
2738
2739 FRAME_TOOL_BAR_LINES (f) = nlines;
2740 x_change_window_heights (root_window, delta);
2741 adjust_glyphs (f);
2742
2743 /* We also have to make sure that the internal border at the top of
2744 the frame, below the menu bar or tool bar, is redrawn when the
2745 tool bar disappears. This is so because the internal border is
2746 below the tool bar if one is displayed, but is below the menu bar
2747 if there isn't a tool bar. The tool bar draws into the area
2748 below the menu bar. */
2749 if (FRAME_MAC_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
2750 {
2751 updating_frame = f;
2752 clear_frame ();
2753 clear_current_matrices (f);
2754 updating_frame = NULL;
2755 }
2756
2757 /* If the tool bar gets smaller, the internal border below it
2758 has to be cleared. It was formerly part of the display
2759 of the larger tool bar, and updating windows won't clear it. */
2760 if (delta < 0)
2761 {
2762 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
2763 int width = PIXEL_WIDTH (f);
2764 int y = nlines * CANON_Y_UNIT (f);
2765
2766 BLOCK_INPUT;
2767 XClearArea (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f),
2768 0, y, width, height, 0);
2769 UNBLOCK_INPUT;
2770 }
2771 }
2772
2773
2774 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2775 w32_id_name.
2776
2777 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2778 name; if NAME is a string, set F's name to NAME and set
2779 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2780
2781 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2782 suggesting a new name, which lisp code should override; if
2783 F->explicit_name is set, ignore the new name; otherwise, set it. */
2784
2785 void
2786 x_set_name (f, name, explicit)
2787 struct frame *f;
2788 Lisp_Object name;
2789 int explicit;
2790 {
2791 /* Make sure that requests from lisp code override requests from
2792 Emacs redisplay code. */
2793 if (explicit)
2794 {
2795 /* If we're switching from explicit to implicit, we had better
2796 update the mode lines and thereby update the title. */
2797 if (f->explicit_name && NILP (name))
2798 update_mode_lines = 1;
2799
2800 f->explicit_name = ! NILP (name);
2801 }
2802 else if (f->explicit_name)
2803 return;
2804
2805 /* If NAME is nil, set the name to the w32_id_name. */
2806 if (NILP (name))
2807 {
2808 /* Check for no change needed in this very common case
2809 before we do any consing. */
2810 if (!strcmp (FRAME_MAC_DISPLAY_INFO (f)->mac_id_name,
2811 XSTRING (f->name)->data))
2812 return;
2813 name = build_string (FRAME_MAC_DISPLAY_INFO (f)->mac_id_name);
2814 }
2815 else
2816 CHECK_STRING (name, 0);
2817
2818 /* Don't change the name if it's already NAME. */
2819 if (! NILP (Fstring_equal (name, f->name)))
2820 return;
2821
2822 f->name = name;
2823
2824 /* For setting the frame title, the title parameter should override
2825 the name parameter. */
2826 if (! NILP (f->title))
2827 name = f->title;
2828
2829 if (FRAME_MAC_WINDOW (f))
2830 {
2831 if (STRING_MULTIBYTE (name))
2832 #if 0 /* MAC_TODO: encoding title string */
2833 name = ENCODE_SYSTEM (name);
2834 #else
2835 return;
2836 #endif
2837
2838 BLOCK_INPUT;
2839
2840 {
2841 Str255 windowTitle;
2842 if (strlen (XSTRING (name)->data) < 255)
2843 {
2844 strcpy (windowTitle, XSTRING (name)->data);
2845 c2pstr (windowTitle);
2846 SetWTitle (FRAME_MAC_WINDOW (f), windowTitle);
2847 }
2848 }
2849
2850 UNBLOCK_INPUT;
2851 }
2852 }
2853
2854 /* This function should be called when the user's lisp code has
2855 specified a name for the frame; the name will override any set by the
2856 redisplay code. */
2857 void
2858 x_explicitly_set_name (f, arg, oldval)
2859 FRAME_PTR f;
2860 Lisp_Object arg, oldval;
2861 {
2862 x_set_name (f, arg, 1);
2863 }
2864
2865 /* This function should be called by Emacs redisplay code to set the
2866 name; names set this way will never override names set by the user's
2867 lisp code. */
2868 void
2869 x_implicitly_set_name (f, arg, oldval)
2870 FRAME_PTR f;
2871 Lisp_Object arg, oldval;
2872 {
2873 x_set_name (f, arg, 0);
2874 }
2875 \f
2876 /* Change the title of frame F to NAME.
2877 If NAME is nil, use the frame name as the title.
2878
2879 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2880 name; if NAME is a string, set F's name to NAME and set
2881 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2882
2883 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2884 suggesting a new name, which lisp code should override; if
2885 F->explicit_name is set, ignore the new name; otherwise, set it. */
2886
2887 void
2888 x_set_title (f, name, old_name)
2889 struct frame *f;
2890 Lisp_Object name, old_name;
2891 {
2892 /* Don't change the title if it's already NAME. */
2893 if (EQ (name, f->title))
2894 return;
2895
2896 update_mode_lines = 1;
2897
2898 f->title = name;
2899
2900 if (NILP (name))
2901 name = f->name;
2902
2903 if (FRAME_MAC_WINDOW (f))
2904 {
2905 if (STRING_MULTIBYTE (name))
2906 #if 0 /* MAC_TODO: encoding title string */
2907 name = ENCODE_SYSTEM (name);
2908 #else
2909 return;
2910 #endif
2911
2912 BLOCK_INPUT;
2913
2914 {
2915 Str255 windowTitle;
2916 if (strlen (XSTRING (name)->data) < 255)
2917 {
2918 strcpy (windowTitle, XSTRING (name)->data);
2919 c2pstr (windowTitle);
2920 SetWTitle (FRAME_MAC_WINDOW (f), windowTitle);
2921 }
2922 }
2923
2924 UNBLOCK_INPUT;
2925 }
2926 }
2927 \f
2928 void
2929 x_set_autoraise (f, arg, oldval)
2930 struct frame *f;
2931 Lisp_Object arg, oldval;
2932 {
2933 f->auto_raise = !EQ (Qnil, arg);
2934 }
2935
2936 void
2937 x_set_autolower (f, arg, oldval)
2938 struct frame *f;
2939 Lisp_Object arg, oldval;
2940 {
2941 f->auto_lower = !EQ (Qnil, arg);
2942 }
2943
2944 void
2945 x_set_unsplittable (f, arg, oldval)
2946 struct frame *f;
2947 Lisp_Object arg, oldval;
2948 {
2949 f->no_split = !NILP (arg);
2950 }
2951
2952 void
2953 x_set_vertical_scroll_bars (f, arg, oldval)
2954 struct frame *f;
2955 Lisp_Object arg, oldval;
2956 {
2957 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2958 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2959 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2960 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
2961 {
2962 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
2963 = (NILP (arg)
2964 ? vertical_scroll_bar_none
2965 : EQ (Qright, arg)
2966 ? vertical_scroll_bar_right
2967 : vertical_scroll_bar_left);
2968
2969 /* We set this parameter before creating the window for the
2970 frame, so we can get the geometry right from the start.
2971 However, if the window hasn't been created yet, we shouldn't
2972 call x_set_window_size. */
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);
2976 }
2977 }
2978
2979 void
2980 x_set_scroll_bar_width (f, arg, oldval)
2981 struct frame *f;
2982 Lisp_Object arg, oldval;
2983 {
2984 /* Imitate X without X Toolkit */
2985
2986 int wid = FONT_WIDTH (f->output_data.mac->font);
2987
2988 if (NILP (arg))
2989 {
2990 /* Make the actual width at least 14 pixels and a multiple of a
2991 character width. */
2992 FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2993
2994 /* Use all of that space (aside from required margins) for the
2995 scroll bar. */
2996 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
2997
2998 if (FRAME_MAC_WINDOW (f))
2999 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
3000 do_pending_window_change (0);
3001 }
3002 else if (INTEGERP (arg) && XINT (arg) > 0
3003 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
3004 {
3005 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
3006 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
3007
3008 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
3009 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
3010 if (FRAME_MAC_WINDOW (f))
3011 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
3012 do_pending_window_change (0);
3013 }
3014 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
3015 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
3016 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
3017 }
3018 \f
3019 /* Subroutines of creating an frame. */
3020
3021 /* Make sure that Vx_resource_name is set to a reasonable value.
3022 Fix it up, or set it to `emacs' if it is too hopeless. */
3023
3024 static void
3025 validate_x_resource_name ()
3026 {
3027 int len = 0;
3028 /* Number of valid characters in the resource name. */
3029 int good_count = 0;
3030 /* Number of invalid characters in the resource name. */
3031 int bad_count = 0;
3032 Lisp_Object new;
3033 int i;
3034
3035 if (STRINGP (Vx_resource_name))
3036 {
3037 unsigned char *p = XSTRING (Vx_resource_name)->data;
3038 int i;
3039
3040 len = STRING_BYTES (XSTRING (Vx_resource_name));
3041
3042 /* Only letters, digits, - and _ are valid in resource names.
3043 Count the valid characters and count the invalid ones. */
3044 for (i = 0; i < len; i++)
3045 {
3046 int c = p[i];
3047 if (! ((c >= 'a' && c <= 'z')
3048 || (c >= 'A' && c <= 'Z')
3049 || (c >= '0' && c <= '9')
3050 || c == '-' || c == '_'))
3051 bad_count++;
3052 else
3053 good_count++;
3054 }
3055 }
3056 else
3057 /* Not a string => completely invalid. */
3058 bad_count = 5, good_count = 0;
3059
3060 /* If name is valid already, return. */
3061 if (bad_count == 0)
3062 return;
3063
3064 /* If name is entirely invalid, or nearly so, use `emacs'. */
3065 if (good_count == 0
3066 || (good_count == 1 && bad_count > 0))
3067 {
3068 Vx_resource_name = build_string ("emacs");
3069 return;
3070 }
3071
3072 /* Name is partly valid. Copy it and replace the invalid characters
3073 with underscores. */
3074
3075 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
3076
3077 for (i = 0; i < len; i++)
3078 {
3079 int c = XSTRING (new)->data[i];
3080 if (! ((c >= 'a' && c <= 'z')
3081 || (c >= 'A' && c <= 'Z')
3082 || (c >= '0' && c <= '9')
3083 || c == '-' || c == '_'))
3084 XSTRING (new)->data[i] = '_';
3085 }
3086 }
3087
3088
3089 #if 0 /* MAC_TODO: implement resource strings */
3090 extern char *x_get_string_resource ();
3091
3092 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
3093 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
3094 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
3095 class, where INSTANCE is the name under which Emacs was invoked, or\n\
3096 the name specified by the `-name' or `-rn' command-line arguments.\n\
3097 \n\
3098 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
3099 class, respectively. You must specify both of them or neither.\n\
3100 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
3101 and the class is `Emacs.CLASS.SUBCLASS'.")
3102 (attribute, class, component, subclass)
3103 Lisp_Object attribute, class, component, subclass;
3104 {
3105 register char *value;
3106 char *name_key;
3107 char *class_key;
3108
3109 CHECK_STRING (attribute, 0);
3110 CHECK_STRING (class, 0);
3111
3112 if (!NILP (component))
3113 CHECK_STRING (component, 1);
3114 if (!NILP (subclass))
3115 CHECK_STRING (subclass, 2);
3116 if (NILP (component) != NILP (subclass))
3117 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3118
3119 validate_x_resource_name ();
3120
3121 /* Allocate space for the components, the dots which separate them,
3122 and the final '\0'. Make them big enough for the worst case. */
3123 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
3124 + (STRINGP (component)
3125 ? STRING_BYTES (XSTRING (component)) : 0)
3126 + STRING_BYTES (XSTRING (attribute))
3127 + 3);
3128
3129 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3130 + STRING_BYTES (XSTRING (class))
3131 + (STRINGP (subclass)
3132 ? STRING_BYTES (XSTRING (subclass)) : 0)
3133 + 3);
3134
3135 /* Start with emacs.FRAMENAME for the name (the specific one)
3136 and with `Emacs' for the class key (the general one). */
3137 strcpy (name_key, XSTRING (Vx_resource_name)->data);
3138 strcpy (class_key, EMACS_CLASS);
3139
3140 strcat (class_key, ".");
3141 strcat (class_key, XSTRING (class)->data);
3142
3143 if (!NILP (component))
3144 {
3145 strcat (class_key, ".");
3146 strcat (class_key, XSTRING (subclass)->data);
3147
3148 strcat (name_key, ".");
3149 strcat (name_key, XSTRING (component)->data);
3150 }
3151
3152 strcat (name_key, ".");
3153 strcat (name_key, XSTRING (attribute)->data);
3154
3155 value = x_get_string_resource (Qnil,
3156 name_key, class_key);
3157
3158 if (value != (char *) 0)
3159 return build_string (value);
3160 else
3161 return Qnil;
3162 }
3163
3164 /* Used when C code wants a resource value. */
3165
3166 char *
3167 x_get_resource_string (attribute, class)
3168 char *attribute, *class;
3169 {
3170 char *name_key;
3171 char *class_key;
3172 struct frame *sf = SELECTED_FRAME ();
3173
3174 /* Allocate space for the components, the dots which separate them,
3175 and the final '\0'. */
3176 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
3177 + strlen (attribute) + 2);
3178 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3179 + strlen (class) + 2);
3180
3181 sprintf (name_key, "%s.%s",
3182 XSTRING (Vinvocation_name)->data,
3183 attribute);
3184 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3185
3186 return x_get_string_resource (sf, name_key, class_key);
3187 }
3188 #endif
3189
3190 /* Types we might convert a resource string into. */
3191 enum resource_types
3192 {
3193 RES_TYPE_NUMBER,
3194 RES_TYPE_FLOAT,
3195 RES_TYPE_BOOLEAN,
3196 RES_TYPE_STRING,
3197 RES_TYPE_SYMBOL
3198 };
3199
3200 /* Return the value of parameter PARAM.
3201
3202 First search ALIST, then Vdefault_frame_alist, then the X defaults
3203 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3204
3205 Convert the resource to the type specified by desired_type.
3206
3207 If no default is specified, return Qunbound. If you call
3208 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
3209 and don't let it get stored in any Lisp-visible variables! */
3210
3211 static Lisp_Object
3212 mac_get_arg (alist, param, attribute, class, type)
3213 Lisp_Object alist, param;
3214 char *attribute;
3215 char *class;
3216 enum resource_types type;
3217 {
3218 register Lisp_Object tem;
3219
3220 tem = Fassq (param, alist);
3221 if (EQ (tem, Qnil))
3222 tem = Fassq (param, Vdefault_frame_alist);
3223 if (EQ (tem, Qnil))
3224 {
3225
3226 #if 0 /* MAC_TODO: search resource also */
3227 if (attribute)
3228 {
3229 tem = Fx_get_resource (build_string (attribute),
3230 build_string (class),
3231 Qnil, Qnil);
3232
3233 if (NILP (tem))
3234 return Qunbound;
3235
3236 switch (type)
3237 {
3238 case RES_TYPE_NUMBER:
3239 return make_number (atoi (XSTRING (tem)->data));
3240
3241 case RES_TYPE_FLOAT:
3242 return make_float (atof (XSTRING (tem)->data));
3243
3244 case RES_TYPE_BOOLEAN:
3245 tem = Fdowncase (tem);
3246 if (!strcmp (XSTRING (tem)->data, "on")
3247 || !strcmp (XSTRING (tem)->data, "true"))
3248 return Qt;
3249 else
3250 return Qnil;
3251
3252 case RES_TYPE_STRING:
3253 return tem;
3254
3255 case RES_TYPE_SYMBOL:
3256 /* As a special case, we map the values `true' and `on'
3257 to Qt, and `false' and `off' to Qnil. */
3258 {
3259 Lisp_Object lower;
3260 lower = Fdowncase (tem);
3261 if (!strcmp (XSTRING (lower)->data, "on")
3262 || !strcmp (XSTRING (lower)->data, "true"))
3263 return Qt;
3264 else if (!strcmp (XSTRING (lower)->data, "off")
3265 || !strcmp (XSTRING (lower)->data, "false"))
3266 return Qnil;
3267 else
3268 return Fintern (tem, Qnil);
3269 }
3270
3271 default:
3272 abort ();
3273 }
3274 }
3275 else
3276 #endif
3277 return Qunbound;
3278 }
3279 return Fcdr (tem);
3280 }
3281
3282 /* Record in frame F the specified or default value according to ALIST
3283 of the parameter named PROP (a Lisp symbol).
3284 If no value is specified for PROP, look for an X default for XPROP
3285 on the frame named NAME.
3286 If that is not found either, use the value DEFLT. */
3287
3288 static Lisp_Object
3289 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
3290 struct frame *f;
3291 Lisp_Object alist;
3292 Lisp_Object prop;
3293 Lisp_Object deflt;
3294 char *xprop;
3295 char *xclass;
3296 enum resource_types type;
3297 {
3298 Lisp_Object tem;
3299
3300 tem = mac_get_arg (alist, prop, xprop, xclass, type);
3301 if (EQ (tem, Qunbound))
3302 tem = deflt;
3303 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3304 return tem;
3305 }
3306 \f
3307 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3308 "Parse an X-style geometry string STRING.\n\
3309 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
3310 The properties returned may include `top', `left', `height', and `width'.\n\
3311 The value of `left' or `top' may be an integer,\n\
3312 or a list (+ N) meaning N pixels relative to top/left corner,\n\
3313 or a list (- N) meaning -N pixels relative to bottom/right corner.")
3314 (string)
3315 Lisp_Object string;
3316 {
3317 int geometry, x, y;
3318 unsigned int width, height;
3319 Lisp_Object result;
3320
3321 CHECK_STRING (string, 0);
3322
3323 geometry = XParseGeometry ((char *) XSTRING (string)->data,
3324 &x, &y, &width, &height);
3325
3326 result = Qnil;
3327 if (geometry & XValue)
3328 {
3329 Lisp_Object element;
3330
3331 if (x >= 0 && (geometry & XNegative))
3332 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3333 else if (x < 0 && ! (geometry & XNegative))
3334 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3335 else
3336 element = Fcons (Qleft, make_number (x));
3337 result = Fcons (element, result);
3338 }
3339
3340 if (geometry & YValue)
3341 {
3342 Lisp_Object element;
3343
3344 if (y >= 0 && (geometry & YNegative))
3345 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3346 else if (y < 0 && ! (geometry & YNegative))
3347 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3348 else
3349 element = Fcons (Qtop, make_number (y));
3350 result = Fcons (element, result);
3351 }
3352
3353 if (geometry & WidthValue)
3354 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3355 if (geometry & HeightValue)
3356 result = Fcons (Fcons (Qheight, make_number (height)), result);
3357
3358 return result;
3359 }
3360
3361 /* Calculate the desired size and position of this window,
3362 and return the flags saying which aspects were specified.
3363
3364 This function does not make the coordinates positive. */
3365
3366 #define DEFAULT_ROWS 40
3367 #define DEFAULT_COLS 80
3368
3369 static int
3370 x_figure_window_size (f, parms)
3371 struct frame *f;
3372 Lisp_Object parms;
3373 {
3374 register Lisp_Object tem0, tem1, tem2;
3375 long window_prompting = 0;
3376
3377 /* Default values if we fall through.
3378 Actually, if that happens we should get
3379 window manager prompting. */
3380 SET_FRAME_WIDTH (f, DEFAULT_COLS);
3381 f->height = DEFAULT_ROWS;
3382 /* Window managers expect that if program-specified
3383 positions are not (0,0), they're intentional, not defaults. */
3384 f->output_data.mac->top_pos = 0;
3385 f->output_data.mac->left_pos = 0;
3386
3387 tem0 = mac_get_arg (parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3388 tem1 = mac_get_arg (parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3389 tem2 = mac_get_arg (parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
3390 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3391 {
3392 if (!EQ (tem0, Qunbound))
3393 {
3394 CHECK_NUMBER (tem0, 0);
3395 f->height = XINT (tem0);
3396 }
3397 if (!EQ (tem1, Qunbound))
3398 {
3399 CHECK_NUMBER (tem1, 0);
3400 SET_FRAME_WIDTH (f, XINT (tem1));
3401 }
3402 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3403 window_prompting |= USSize;
3404 else
3405 window_prompting |= PSize;
3406 }
3407
3408 f->output_data.mac->vertical_scroll_bar_extra
3409 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3410 ? 0
3411 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
3412 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
3413 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.mac->font)));
3414 x_compute_fringe_widths (f, 0);
3415 f->output_data.mac->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3416 f->output_data.mac->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
3417
3418 tem0 = mac_get_arg (parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3419 tem1 = mac_get_arg (parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3420 tem2 = mac_get_arg (parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
3421 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3422 {
3423 if (EQ (tem0, Qminus))
3424 {
3425 f->output_data.mac->top_pos = 0;
3426 window_prompting |= YNegative;
3427 }
3428 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3429 && CONSP (XCDR (tem0))
3430 && INTEGERP (XCAR (XCDR (tem0))))
3431 {
3432 f->output_data.mac->top_pos = - XINT (XCAR (XCDR (tem0)));
3433 window_prompting |= YNegative;
3434 }
3435 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3436 && CONSP (XCDR (tem0))
3437 && INTEGERP (XCAR (XCDR (tem0))))
3438 {
3439 f->output_data.mac->top_pos = XINT (XCAR (XCDR (tem0)));
3440 }
3441 else if (EQ (tem0, Qunbound))
3442 f->output_data.mac->top_pos = 0;
3443 else
3444 {
3445 CHECK_NUMBER (tem0, 0);
3446 f->output_data.mac->top_pos = XINT (tem0);
3447 if (f->output_data.mac->top_pos < 0)
3448 window_prompting |= YNegative;
3449 }
3450
3451 if (EQ (tem1, Qminus))
3452 {
3453 f->output_data.mac->left_pos = 0;
3454 window_prompting |= XNegative;
3455 }
3456 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3457 && CONSP (XCDR (tem1))
3458 && INTEGERP (XCAR (XCDR (tem1))))
3459 {
3460 f->output_data.mac->left_pos = - XINT (XCAR (XCDR (tem1)));
3461 window_prompting |= XNegative;
3462 }
3463 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3464 && CONSP (XCDR (tem1))
3465 && INTEGERP (XCAR (XCDR (tem1))))
3466 {
3467 f->output_data.mac->left_pos = XINT (XCAR (XCDR (tem1)));
3468 }
3469 else if (EQ (tem1, Qunbound))
3470 f->output_data.mac->left_pos = 0;
3471 else
3472 {
3473 CHECK_NUMBER (tem1, 0);
3474 f->output_data.mac->left_pos = XINT (tem1);
3475 if (f->output_data.mac->left_pos < 0)
3476 window_prompting |= XNegative;
3477 }
3478
3479 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
3480 window_prompting |= USPosition;
3481 else
3482 window_prompting |= PPosition;
3483 }
3484
3485 return window_prompting;
3486 }
3487
3488 \f
3489 #if 0
3490 /* Create and set up the Mac window for frame F. */
3491
3492 static void
3493 mac_window (f, window_prompting, minibuffer_only)
3494 struct frame *f;
3495 long window_prompting;
3496 int minibuffer_only;
3497 {
3498 Rect r;
3499
3500 BLOCK_INPUT;
3501
3502 /* Use the resource name as the top-level window name
3503 for looking up resources. Make a non-Lisp copy
3504 for the window manager, so GC relocation won't bother it.
3505
3506 Elsewhere we specify the window name for the window manager. */
3507
3508 {
3509 char *str = (char *) XSTRING (Vx_resource_name)->data;
3510 f->namebuf = (char *) xmalloc (strlen (str) + 1);
3511 strcpy (f->namebuf, str);
3512 }
3513
3514 SetRect (&r, f->output_data.mac->left_pos, f->output_data.mac->top_pos,
3515 f->output_data.mac->left_pos + PIXEL_WIDTH (f),
3516 f->output_data.mac->top_pos + PIXEL_HEIGHT (f));
3517 FRAME_MAC_WINDOW (f)
3518 = NewCWindow (NULL, &r, "\p", 1, zoomDocProc, (WindowPtr) -1, 1, (long) f->output_data.mac);
3519
3520 validate_x_resource_name ();
3521
3522 /* x_set_name normally ignores requests to set the name if the
3523 requested name is the same as the current name. This is the one
3524 place where that assumption isn't correct; f->name is set, but
3525 the server hasn't been told. */
3526 {
3527 Lisp_Object name;
3528 int explicit = f->explicit_name;
3529
3530 f->explicit_name = 0;
3531 name = f->name;
3532 f->name = Qnil;
3533 x_set_name (f, name, explicit);
3534 }
3535
3536 ShowWindow (FRAME_MAC_WINDOW (f));
3537
3538 UNBLOCK_INPUT;
3539
3540 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
3541 initialize_frame_menubar (f);
3542
3543 if (FRAME_MAC_WINDOW (f) == 0)
3544 error ("Unable to create window");
3545 }
3546 #endif
3547
3548 /* Handle the icon stuff for this window. Perhaps later we might
3549 want an x_set_icon_position which can be called interactively as
3550 well. */
3551
3552 static void
3553 x_icon (f, parms)
3554 struct frame *f;
3555 Lisp_Object parms;
3556 {
3557 Lisp_Object icon_x, icon_y;
3558
3559 /* Set the position of the icon. Note that Windows 95 groups all
3560 icons in the tray. */
3561 icon_x = mac_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
3562 icon_y = mac_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
3563 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
3564 {
3565 CHECK_NUMBER (icon_x, 0);
3566 CHECK_NUMBER (icon_y, 0);
3567 }
3568 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
3569 error ("Both left and top icon corners of icon must be specified");
3570
3571 BLOCK_INPUT;
3572
3573 if (! EQ (icon_x, Qunbound))
3574 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3575
3576 #if 0 /* TODO */
3577 /* Start up iconic or window? */
3578 x_wm_set_window_state
3579 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
3580 ? IconicState
3581 : NormalState));
3582
3583 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
3584 ? f->icon_name
3585 : f->name))->data);
3586 #endif
3587
3588 UNBLOCK_INPUT;
3589 }
3590
3591
3592 static void
3593 x_make_gc (f)
3594 struct frame *f;
3595 {
3596 XGCValues gc_values;
3597
3598 BLOCK_INPUT;
3599
3600 /* Create the GC's of this frame.
3601 Note that many default values are used. */
3602
3603 /* Normal video */
3604 gc_values.font = f->output_data.mac->font;
3605 gc_values.foreground = f->output_data.mac->foreground_pixel;
3606 gc_values.background = f->output_data.mac->background_pixel;
3607 f->output_data.mac->normal_gc = XCreateGC (FRAME_MAC_DISPLAY (f),
3608 FRAME_MAC_WINDOW (f),
3609 GCFont | GCForeground | GCBackground,
3610 &gc_values);
3611
3612 /* Reverse video style. */
3613 gc_values.foreground = f->output_data.mac->background_pixel;
3614 gc_values.background = f->output_data.mac->foreground_pixel;
3615 f->output_data.mac->reverse_gc = XCreateGC (FRAME_MAC_DISPLAY (f),
3616 FRAME_MAC_WINDOW (f),
3617 GCFont | GCForeground | GCBackground,
3618 &gc_values);
3619
3620 /* Cursor has cursor-color background, background-color foreground. */
3621 gc_values.foreground = f->output_data.mac->background_pixel;
3622 gc_values.background = f->output_data.mac->cursor_pixel;
3623 f->output_data.mac->cursor_gc = XCreateGC (FRAME_MAC_DISPLAY (f),
3624 FRAME_MAC_WINDOW (f),
3625 GCFont | GCForeground | GCBackground,
3626 &gc_values);
3627
3628 /* Reliefs. */
3629 f->output_data.mac->white_relief.gc = 0;
3630 f->output_data.mac->black_relief.gc = 0;
3631
3632 UNBLOCK_INPUT;
3633 }
3634
3635
3636 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3637 1, 1, 0,
3638 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
3639 Returns an Emacs frame object.\n\
3640 ALIST is an alist of frame parameters.\n\
3641 If the parameters specify that the frame should not have a minibuffer,\n\
3642 and do not specify a specific minibuffer window to use,\n\
3643 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3644 be shared by the new frame.\n\
3645 \n\
3646 This function is an internal primitive--use `make-frame' instead.")
3647 (parms)
3648 Lisp_Object parms;
3649 {
3650 struct frame *f;
3651 Lisp_Object frame, tem;
3652 Lisp_Object name;
3653 int minibuffer_only = 0;
3654 long window_prompting = 0;
3655 int width, height;
3656 int count = BINDING_STACK_SIZE ();
3657 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3658 Lisp_Object display;
3659 struct mac_display_info *dpyinfo = NULL;
3660 Lisp_Object parent;
3661 struct kboard *kb;
3662 char x_frame_name[10];
3663 static int x_frame_count = 2; /* starts from 2 because terminal frame is F1 */
3664
3665 check_mac ();
3666
3667 /* Use this general default value to start with
3668 until we know if this frame has a specified name. */
3669 Vx_resource_name = Vinvocation_name;
3670
3671 display = mac_get_arg (parms, Qdisplay, 0, 0, RES_TYPE_STRING);
3672 if (EQ (display, Qunbound))
3673 display = Qnil;
3674 dpyinfo = check_x_display_info (display);
3675 #ifdef MULTI_KBOARD
3676 kb = dpyinfo->kboard;
3677 #else
3678 kb = &the_only_kboard;
3679 #endif
3680
3681 name = mac_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
3682 if (!STRINGP (name)
3683 && ! EQ (name, Qunbound)
3684 && ! NILP (name))
3685 error ("Invalid frame name--not a string or nil");
3686
3687 if (STRINGP (name))
3688 Vx_resource_name = name;
3689
3690 /* See if parent window is specified. */
3691 parent = mac_get_arg (parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
3692 if (EQ (parent, Qunbound))
3693 parent = Qnil;
3694 if (! NILP (parent))
3695 CHECK_NUMBER (parent, 0);
3696
3697 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3698 /* No need to protect DISPLAY because that's not used after passing
3699 it to make_frame_without_minibuffer. */
3700 frame = Qnil;
3701 GCPRO4 (parms, parent, name, frame);
3702 tem = mac_get_arg (parms, Qminibuffer, 0, 0, RES_TYPE_SYMBOL);
3703 if (EQ (tem, Qnone) || NILP (tem))
3704 f = make_frame_without_minibuffer (Qnil, kb, display);
3705 else if (EQ (tem, Qonly))
3706 {
3707 f = make_minibuffer_frame ();
3708 minibuffer_only = 1;
3709 }
3710 else if (WINDOWP (tem))
3711 f = make_frame_without_minibuffer (tem, kb, display);
3712 else
3713 f = make_frame (1);
3714
3715 if (EQ (name, Qunbound) || NILP (name))
3716 {
3717 sprintf (x_frame_name, "F%d", x_frame_count++);
3718 f->name = build_string (x_frame_name);
3719 f->explicit_name = 0;
3720 }
3721 else
3722 {
3723 f->name = name;
3724 f->explicit_name = 1;
3725 }
3726
3727 XSETFRAME (frame, f);
3728
3729 /* Note that X Windows does support scroll bars. */
3730 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3731
3732 f->output_method = output_mac;
3733 f->output_data.mac = (struct mac_output *) xmalloc (sizeof (struct mac_output));
3734 bzero (f->output_data.mac, sizeof (struct mac_output));
3735 f->output_data.mac->fontset = -1;
3736 f->output_data.mac->scroll_bar_foreground_pixel = -1;
3737 f->output_data.mac->scroll_bar_background_pixel = -1;
3738
3739 #if 0
3740 FRAME_FONTSET (f) = -1;
3741 #endif
3742
3743 f->icon_name
3744 = mac_get_arg (parms, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
3745 if (! STRINGP (f->icon_name))
3746 f->icon_name = Qnil;
3747
3748 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
3749 #ifdef MULTI_KBOARD
3750 FRAME_KBOARD (f) = kb;
3751 #endif
3752
3753 /* Specify the parent under which to make this window. */
3754
3755 if (!NILP (parent))
3756 {
3757 f->output_data.mac->parent_desc = (Window) parent;
3758 f->output_data.mac->explicit_parent = 1;
3759 }
3760 else
3761 {
3762 f->output_data.mac->parent_desc = FRAME_MAC_DISPLAY_INFO (f)->root_window;
3763 f->output_data.mac->explicit_parent = 0;
3764 }
3765
3766 /* Set the name; the functions to which we pass f expect the name to
3767 be set. */
3768 if (EQ (name, Qunbound) || NILP (name))
3769 {
3770 f->name = build_string (dpyinfo->mac_id_name);
3771 f->explicit_name = 0;
3772 }
3773 else
3774 {
3775 f->name = name;
3776 f->explicit_name = 1;
3777 /* use the frame's title when getting resources for this frame. */
3778 specbind (Qx_resource_name, name);
3779 }
3780
3781 /* Extract the window parameters from the supplied values
3782 that are needed to determine window geometry. */
3783 {
3784 Lisp_Object font;
3785
3786 font = mac_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
3787
3788 BLOCK_INPUT;
3789 /* First, try whatever font the caller has specified. */
3790 if (STRINGP (font))
3791 {
3792 tem = Fquery_fontset (font, Qnil);
3793 if (STRINGP (tem))
3794 font = x_new_fontset (f, XSTRING (tem)->data);
3795 else
3796 font = x_new_font (f, XSTRING (font)->data);
3797 }
3798 /* Try out a font which we hope has bold and italic variations. */
3799 if (! STRINGP (font))
3800 font = x_new_font (f, "-ETL-fixed-medium-r-*--*-160-*-*-*-*-iso8859-1");
3801 /* If those didn't work, look for something which will at least work. */
3802 if (!STRINGP (font))
3803 font = x_new_font (f, "-*-monaco-*-12-*-mac-roman");
3804 if (! STRINGP (font))
3805 font = x_new_font (f, "-*-courier-*-10-*-mac-roman");
3806 if (! STRINGP (font))
3807 error ("Cannot find any usable font");
3808 UNBLOCK_INPUT;
3809
3810 x_default_parameter (f, parms, Qfont, font,
3811 "font", "Font", RES_TYPE_STRING);
3812 }
3813
3814 x_default_parameter (f, parms, Qborder_width, make_number (0),
3815 "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
3816 /* This defaults to 2 in order to match xterm. We recognize either
3817 internalBorderWidth or internalBorder (which is what xterm calls
3818 it). */
3819 if (NILP (Fassq (Qinternal_border_width, parms)))
3820 {
3821 Lisp_Object value;
3822
3823 value = mac_get_arg (parms, Qinternal_border_width,
3824 "internalBorder", "BorderWidth", RES_TYPE_NUMBER);
3825 if (! EQ (value, Qunbound))
3826 parms = Fcons (Fcons (Qinternal_border_width, value),
3827 parms);
3828 }
3829
3830 /* Default internalBorderWidth to 0 on Windows to match other programs. */
3831 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
3832 "internalBorderWidth", "BorderWidth", RES_TYPE_NUMBER);
3833
3834 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
3835 "verticalScrollBars", "ScrollBars", RES_TYPE_BOOLEAN);
3836
3837 /* Also do the stuff which must be set before the window exists. */
3838 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3839 "foreground", "Foreground", RES_TYPE_STRING);
3840 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3841 "background", "Background", RES_TYPE_STRING);
3842 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3843 "pointerColor", "Foreground", RES_TYPE_STRING);
3844 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3845 "cursorColor", "Foreground", RES_TYPE_STRING);
3846 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3847 "borderColor", "BorderColor", RES_TYPE_STRING);
3848 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
3849 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
3850 x_default_parameter (f, parms, Qline_spacing, Qnil,
3851 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
3852 x_default_parameter (f, parms, Qleft_fringe, Qnil,
3853 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
3854 x_default_parameter (f, parms, Qright_fringe, Qnil,
3855 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
3856
3857 /* Init faces before x_default_parameter is called for scroll-bar
3858 parameters because that function calls x_set_scroll_bar_width,
3859 which calls change_frame_size, which calls Fset_window_buffer,
3860 which runs hooks, which call Fvertical_motion. At the end, we
3861 end up in init_iterator with a null face cache, which should not
3862 happen. */
3863 init_frame_faces (f);
3864
3865 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3866 "menuBar", "MenuBar", RES_TYPE_NUMBER);
3867 x_default_parameter (f, parms, Qtool_bar_lines, make_number (0),
3868 "toolBar", "ToolBar", RES_TYPE_NUMBER);
3869 #if 0
3870 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3871 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
3872 #endif
3873 x_default_parameter (f, parms, Qtitle, Qnil,
3874 "title", "Title", RES_TYPE_STRING);
3875
3876 f->output_data.mac->parent_desc = FRAME_MAC_DISPLAY_INFO (f)->root_window;
3877 window_prompting = x_figure_window_size (f, parms);
3878
3879 if (window_prompting & XNegative)
3880 {
3881 if (window_prompting & YNegative)
3882 f->output_data.mac->win_gravity = SouthEastGravity;
3883 else
3884 f->output_data.mac->win_gravity = NorthEastGravity;
3885 }
3886 else
3887 {
3888 if (window_prompting & YNegative)
3889 f->output_data.mac->win_gravity = SouthWestGravity;
3890 else
3891 f->output_data.mac->win_gravity = NorthWestGravity;
3892 }
3893
3894 f->output_data.mac->size_hint_flags = window_prompting;
3895
3896 tem = mac_get_arg (parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
3897 f->no_split = minibuffer_only || EQ (tem, Qt);
3898
3899 /* Create the window. Add the tool-bar height to the initial frame
3900 height so that the user gets a text display area of the size he
3901 specified with -g or via the registry. Later changes of the
3902 tool-bar height don't change the frame size. This is done so that
3903 users can create tall Emacs frames without having to guess how
3904 tall the tool-bar will get. */
3905 f->height += FRAME_TOOL_BAR_LINES (f);
3906
3907 /* mac_window (f, window_prompting, minibuffer_only); */
3908 make_mac_frame (f);
3909
3910 x_icon (f, parms);
3911
3912 x_make_gc (f);
3913
3914 /* Now consider the frame official. */
3915 FRAME_MAC_DISPLAY_INFO (f)->reference_count++;
3916 Vframe_list = Fcons (frame, Vframe_list);
3917
3918 /* We need to do this after creating the window, so that the
3919 icon-creation functions can say whose icon they're describing. */
3920 x_default_parameter (f, parms, Qicon_type, Qnil,
3921 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
3922
3923 x_default_parameter (f, parms, Qauto_raise, Qnil,
3924 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3925 x_default_parameter (f, parms, Qauto_lower, Qnil,
3926 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3927 x_default_parameter (f, parms, Qcursor_type, Qbox,
3928 "cursorType", "CursorType", RES_TYPE_SYMBOL);
3929 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3930 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
3931
3932 /* Dimensions, especially f->height, must be done via change_frame_size.
3933 Change will not be effected unless different from the current
3934 f->height. */
3935
3936 width = f->width;
3937 height = f->height;
3938 f->height = 0;
3939 SET_FRAME_WIDTH (f, 0);
3940 change_frame_size (f, height, width, 1, 0, 0);
3941
3942 /* Set up faces after all frame parameters are known. */
3943 call1 (Qface_set_after_frame_default, frame);
3944
3945 #if 0 /* MAC_TODO: when we have window manager hints */
3946 /* Tell the server what size and position, etc, we want, and how
3947 badly we want them. This should be done after we have the menu
3948 bar so that its size can be taken into account. */
3949 BLOCK_INPUT;
3950 x_wm_set_size_hint (f, window_prompting, 0);
3951 UNBLOCK_INPUT;
3952 #endif
3953
3954 /* Make the window appear on the frame and enable display, unless
3955 the caller says not to. However, with explicit parent, Emacs
3956 cannot control visibility, so don't try. */
3957 if (! f->output_data.mac->explicit_parent)
3958 {
3959 Lisp_Object visibility;
3960
3961 visibility = mac_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
3962 if (EQ (visibility, Qunbound))
3963 visibility = Qt;
3964
3965 #if 0 /* MAC_TODO: really no iconify on Mac */
3966 if (EQ (visibility, Qicon))
3967 x_iconify_frame (f);
3968 else
3969 #endif
3970 if (! NILP (visibility))
3971 x_make_frame_visible (f);
3972 else
3973 /* Must have been Qnil. */
3974 ;
3975 }
3976
3977 UNGCPRO;
3978 return unbind_to (count, frame);
3979 }
3980
3981 /* FRAME is used only to get a handle on the X display. We don't pass the
3982 display info directly because we're called from frame.c, which doesn't
3983 know about that structure. */
3984 Lisp_Object
3985 x_get_focus_frame (frame)
3986 struct frame *frame;
3987 {
3988 struct mac_display_info *dpyinfo = FRAME_MAC_DISPLAY_INFO (frame);
3989 Lisp_Object xfocus;
3990 if (! dpyinfo->x_focus_frame)
3991 return Qnil;
3992
3993 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3994 return xfocus;
3995 }
3996 \f
3997 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
3998 "Internal function called by `color-defined-p', which see.")
3999 (color, frame)
4000 Lisp_Object color, frame;
4001 {
4002 XColor foo;
4003 FRAME_PTR f = check_x_frame (frame);
4004
4005 CHECK_STRING (color, 1);
4006
4007 if (mac_defined_color (f, XSTRING (color)->data, &foo, 0))
4008 return Qt;
4009 else
4010 return Qnil;
4011 }
4012
4013 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
4014 "Internal function called by `color-values', which see.")
4015 (color, frame)
4016 Lisp_Object color, frame;
4017 {
4018 XColor foo;
4019 FRAME_PTR f = check_x_frame (frame);
4020
4021 CHECK_STRING (color, 1);
4022
4023 if (mac_defined_color (f, XSTRING (color)->data, &foo, 0))
4024 {
4025 Lisp_Object rgb[3];
4026
4027 rgb[0] = make_number ((RED_FROM_ULONG (foo.pixel) << 8)
4028 | RED_FROM_ULONG (foo.pixel));
4029 rgb[1] = make_number ((GREEN_FROM_ULONG (foo.pixel) << 8)
4030 | GREEN_FROM_ULONG (foo.pixel));
4031 rgb[2] = make_number ((BLUE_FROM_ULONG (foo.pixel) << 8)
4032 | BLUE_FROM_ULONG (foo.pixel));
4033 return Flist (3, rgb);
4034 }
4035 else
4036 return Qnil;
4037 }
4038
4039 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
4040 "Internal function called by `display-color-p', which see.")
4041 (display)
4042 Lisp_Object display;
4043 {
4044 struct mac_display_info *dpyinfo = check_x_display_info (display);
4045
4046 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
4047 return Qnil;
4048
4049 return Qt;
4050 }
4051
4052 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
4053 0, 1, 0,
4054 "Return t if the X display supports shades of gray.\n\
4055 Note that color displays do support shades of gray.\n\
4056 The optional argument DISPLAY specifies which display to ask about.\n\
4057 DISPLAY should be either a frame or a display name (a string).\n\
4058 If omitted or nil, that stands for the selected frame's display.")
4059 (display)
4060 Lisp_Object display;
4061 {
4062 struct mac_display_info *dpyinfo = check_x_display_info (display);
4063
4064 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
4065 return Qnil;
4066
4067 return Qt;
4068 }
4069
4070 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
4071 0, 1, 0,
4072 "Returns the width in pixels of the X 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.")
4076 (display)
4077 Lisp_Object display;
4078 {
4079 struct mac_display_info *dpyinfo = check_x_display_info (display);
4080
4081 return make_number (dpyinfo->width);
4082 }
4083
4084 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
4085 Sx_display_pixel_height, 0, 1, 0,
4086 "Returns the height in pixels of the X 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.")
4090 (display)
4091 Lisp_Object display;
4092 {
4093 struct mac_display_info *dpyinfo = check_x_display_info (display);
4094
4095 return make_number (dpyinfo->height);
4096 }
4097
4098 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
4099 0, 1, 0,
4100 "Returns the number of bitplanes of the display DISPLAY.\n\
4101 The optional argument DISPLAY specifies which display to ask about.\n\
4102 DISPLAY should be either a frame or a display name (a string).\n\
4103 If omitted or nil, that stands for the selected frame's display.")
4104 (display)
4105 Lisp_Object display;
4106 {
4107 struct mac_display_info *dpyinfo = check_x_display_info (display);
4108
4109 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
4110 }
4111
4112 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
4113 0, 1, 0,
4114 "Returns the number of color cells of the display DISPLAY.\n\
4115 The optional argument DISPLAY specifies which display to ask about.\n\
4116 DISPLAY should be either a frame or a display name (a string).\n\
4117 If omitted or nil, that stands for the selected frame's display.")
4118 (display)
4119 Lisp_Object display;
4120 {
4121 struct mac_display_info *dpyinfo = check_x_display_info (display);
4122
4123 /* MAC_TODO: check whether this is right */
4124 return make_number ((unsigned long) (pow (2, dpyinfo->n_cbits)));
4125 }
4126
4127 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
4128 Sx_server_max_request_size,
4129 0, 1, 0,
4130 "Returns the maximum request size of the server of display DISPLAY.\n\
4131 The optional argument DISPLAY specifies which display to ask about.\n\
4132 DISPLAY should be either a frame or a display name (a string).\n\
4133 If omitted or nil, that stands for the selected frame's display.")
4134 (display)
4135 Lisp_Object display;
4136 {
4137 struct mac_display_info *dpyinfo = check_x_display_info (display);
4138
4139 return make_number (1);
4140 }
4141
4142 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
4143 "Returns the vendor ID string of the W32 system (Microsoft).\n\
4144 The optional argument DISPLAY specifies which display to ask about.\n\
4145 DISPLAY should be either a frame or a display name (a string).\n\
4146 If omitted or nil, that stands for the selected frame's display.")
4147 (display)
4148 Lisp_Object display;
4149 {
4150 return build_string ("Apple Computers");
4151 }
4152
4153 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
4154 "Returns the version numbers of the server of display DISPLAY.\n\
4155 The value is a list of three integers: the major and minor\n\
4156 version numbers, and the vendor-specific release\n\
4157 number. See also the function `x-server-vendor'.\n\n\
4158 The optional argument DISPLAY specifies which display to ask about.\n\
4159 DISPLAY should be either a frame or a display name (a string).\n\
4160 If omitted or nil, that stands for the selected frame's display.")
4161 (display)
4162 Lisp_Object display;
4163 {
4164 int mac_major_version, mac_minor_version;
4165 SInt32 response;
4166
4167 if (Gestalt (gestaltSystemVersion, &response) != noErr)
4168 error ("Cannot get Mac OS version");
4169
4170 mac_major_version = (response >> 8) & 0xf;
4171 mac_minor_version = (response >> 4) & 0xf;
4172
4173 return Fcons (make_number (mac_major_version),
4174 Fcons (make_number (mac_minor_version), Qnil));
4175 }
4176
4177 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
4178 "Returns the number of screens on the server of display DISPLAY.\n\
4179 The optional argument DISPLAY specifies which display to ask about.\n\
4180 DISPLAY should be either a frame or a display name (a string).\n\
4181 If omitted or nil, that stands for the selected frame's display.")
4182 (display)
4183 Lisp_Object display;
4184 {
4185 return make_number (1);
4186 }
4187
4188 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
4189 "Returns the height in millimeters of the X display DISPLAY.\n\
4190 The optional argument DISPLAY specifies which display to ask about.\n\
4191 DISPLAY should be either a frame or a display name (a string).\n\
4192 If omitted or nil, that stands for the selected frame's display.")
4193 (display)
4194 Lisp_Object display;
4195 {
4196 /* MAC_TODO: this is an approximation, and only of the main display */
4197
4198 struct mac_display_info *dpyinfo = check_x_display_info (display);
4199 short h, v;
4200
4201 ScreenRes (&h, &v);
4202
4203 return make_number ((int) (v / 72.0 * 25.4));
4204 }
4205
4206 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
4207 "Returns the width in millimeters of the X display DISPLAY.\n\
4208 The optional argument DISPLAY specifies which display to ask about.\n\
4209 DISPLAY should be either a frame or a display name (a string).\n\
4210 If omitted or nil, that stands for the selected frame's display.")
4211 (display)
4212 Lisp_Object display;
4213 {
4214 /* MAC_TODO: this is an approximation, and only of the main display */
4215
4216 struct mac_display_info *dpyinfo = check_x_display_info (display);
4217 short h, v;
4218
4219 ScreenRes (&h, &v);
4220
4221 return make_number ((int) (h / 72.0 * 25.4));
4222 }
4223
4224 DEFUN ("x-display-backing-store", Fx_display_backing_store,
4225 Sx_display_backing_store, 0, 1, 0,
4226 "Returns an indication of whether display DISPLAY does backing store.\n\
4227 The value may be `always', `when-mapped', or `not-useful'.\n\
4228 The optional argument DISPLAY specifies which display to ask about.\n\
4229 DISPLAY should be either a frame or a display name (a string).\n\
4230 If omitted or nil, that stands for the selected frame's display.")
4231 (display)
4232 Lisp_Object display;
4233 {
4234 return intern ("not-useful");
4235 }
4236
4237 DEFUN ("x-display-visual-class", Fx_display_visual_class,
4238 Sx_display_visual_class, 0, 1, 0,
4239 "Returns the visual class of the display DISPLAY.\n\
4240 The value is one of the symbols `static-gray', `gray-scale',\n\
4241 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\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.")
4245 (display)
4246 Lisp_Object display;
4247 {
4248 struct mac_display_info *dpyinfo = check_x_display_info (display);
4249
4250 #if 0
4251 switch (dpyinfo->visual->class)
4252 {
4253 case StaticGray: return (intern ("static-gray"));
4254 case GrayScale: return (intern ("gray-scale"));
4255 case StaticColor: return (intern ("static-color"));
4256 case PseudoColor: return (intern ("pseudo-color"));
4257 case TrueColor: return (intern ("true-color"));
4258 case DirectColor: return (intern ("direct-color"));
4259 default:
4260 error ("Display has an unknown visual class");
4261 }
4262 #endif
4263
4264 error ("Display has an unknown visual class");
4265 }
4266
4267 DEFUN ("x-display-save-under", Fx_display_save_under,
4268 Sx_display_save_under, 0, 1, 0,
4269 "Returns t if the display DISPLAY supports the save-under feature.\n\
4270 The optional argument DISPLAY specifies which display to ask about.\n\
4271 DISPLAY should be either a frame or a display name (a string).\n\
4272 If omitted or nil, that stands for the selected frame's display.")
4273 (display)
4274 Lisp_Object display;
4275 {
4276 return Qnil;
4277 }
4278 \f
4279 int
4280 x_pixel_width (f)
4281 register struct frame *f;
4282 {
4283 return PIXEL_WIDTH (f);
4284 }
4285
4286 int
4287 x_pixel_height (f)
4288 register struct frame *f;
4289 {
4290 return PIXEL_HEIGHT (f);
4291 }
4292
4293 int
4294 x_char_width (f)
4295 register struct frame *f;
4296 {
4297 return FONT_WIDTH (f->output_data.mac->font);
4298 }
4299
4300 int
4301 x_char_height (f)
4302 register struct frame *f;
4303 {
4304 return f->output_data.mac->line_height;
4305 }
4306
4307 int
4308 x_screen_planes (f)
4309 register struct frame *f;
4310 {
4311 return FRAME_MAC_DISPLAY_INFO (f)->n_planes;
4312 }
4313 \f
4314 /* Return the display structure for the display named NAME.
4315 Open a new connection if necessary. */
4316
4317 struct mac_display_info *
4318 x_display_info_for_name (name)
4319 Lisp_Object name;
4320 {
4321 Lisp_Object names;
4322 struct mac_display_info *dpyinfo;
4323
4324 CHECK_STRING (name, 0);
4325
4326 for (dpyinfo = &one_mac_display_info, names = x_display_name_list;
4327 dpyinfo;
4328 dpyinfo = dpyinfo->next, names = XCDR (names))
4329 {
4330 Lisp_Object tem;
4331 tem = Fstring_equal (XCAR (XCAR (names)), name);
4332 if (!NILP (tem))
4333 return dpyinfo;
4334 }
4335
4336 /* Use this general default value to start with. */
4337 Vx_resource_name = Vinvocation_name;
4338
4339 validate_x_resource_name ();
4340
4341 dpyinfo = x_term_init (name, (unsigned char *) 0,
4342 (char *) XSTRING (Vx_resource_name)->data);
4343
4344 if (dpyinfo == 0)
4345 error ("Cannot connect to server %s", XSTRING (name)->data);
4346
4347 mac_in_use = 1;
4348 XSETFASTINT (Vwindow_system_version, 3);
4349
4350 return dpyinfo;
4351 }
4352
4353 #if 0 /* MAC_TODO: implement network support */
4354 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4355 1, 3, 0, "Open a connection to a server.\n\
4356 DISPLAY is the name of the display to connect to.\n\
4357 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4358 If the optional third arg MUST-SUCCEED is non-nil,\n\
4359 terminate Emacs if we can't open the connection.")
4360 (display, xrm_string, must_succeed)
4361 Lisp_Object display, xrm_string, must_succeed;
4362 {
4363 unsigned char *xrm_option;
4364 struct mac_display_info *dpyinfo;
4365
4366 CHECK_STRING (display, 0);
4367 if (! NILP (xrm_string))
4368 CHECK_STRING (xrm_string, 1);
4369
4370 if (! EQ (Vwindow_system, intern ("mac")))
4371 error ("Not using Mac OS");
4372
4373 if (! NILP (xrm_string))
4374 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4375 else
4376 xrm_option = (unsigned char *) 0;
4377
4378 validate_x_resource_name ();
4379
4380 /* This is what opens the connection and sets x_current_display.
4381 This also initializes many symbols, such as those used for input. */
4382 dpyinfo = mac_term_init (display, xrm_option,
4383 (char *) XSTRING (Vx_resource_name)->data);
4384
4385 if (dpyinfo == 0)
4386 {
4387 if (!NILP (must_succeed))
4388 fatal ("Cannot connect to server %s.\n",
4389 XSTRING (display)->data);
4390 else
4391 error ("Cannot connect to server %s", XSTRING (display)->data);
4392 }
4393
4394 mac_in_use = 1;
4395
4396 XSETFASTINT (Vwindow_system_version, 3);
4397 return Qnil;
4398 }
4399
4400 DEFUN ("x-close-connection", Fx_close_connection,
4401 Sx_close_connection, 1, 1, 0,
4402 "Close the connection to DISPLAY's server.\n\
4403 For DISPLAY, specify either a frame or a display name (a string).\n\
4404 If DISPLAY is nil, that stands for the selected frame's display.")
4405 (display)
4406 Lisp_Object display;
4407 {
4408 struct mac_display_info *dpyinfo = check_x_display_info (display);
4409 int i;
4410
4411 if (dpyinfo->reference_count > 0)
4412 error ("Display still has frames on it");
4413
4414 BLOCK_INPUT;
4415 /* Free the fonts in the font table. */
4416 for (i = 0; i < dpyinfo->n_fonts; i++)
4417 if (dpyinfo->font_table[i].name)
4418 {
4419 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
4420 xfree (dpyinfo->font_table[i].full_name);
4421 xfree (dpyinfo->font_table[i].name);
4422 x_unload_font (dpyinfo, dpyinfo->font_table[i].font);
4423 }
4424 x_destroy_all_bitmaps (dpyinfo);
4425
4426 x_delete_display (dpyinfo);
4427 UNBLOCK_INPUT;
4428
4429 return Qnil;
4430 }
4431 #endif
4432
4433 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4434 "Return the list of display names that Emacs has connections to.")
4435 ()
4436 {
4437 Lisp_Object tail, result;
4438
4439 result = Qnil;
4440 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
4441 result = Fcons (XCAR (XCAR (tail)), result);
4442
4443 return result;
4444 }
4445
4446 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4447 "If ON is non-nil, report errors as soon as the erring request is made.\n\
4448 If ON is nil, allow buffering of requests.\n\
4449 This is a noop on W32 systems.\n\
4450 The optional second argument DISPLAY specifies which display to act on.\n\
4451 DISPLAY should be either a frame or a display name (a string).\n\
4452 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4453 (on, display)
4454 Lisp_Object display, on;
4455 {
4456 return Qnil;
4457 }
4458
4459 \f
4460 /***********************************************************************
4461 Image types
4462 ***********************************************************************/
4463
4464 /* Value is the number of elements of vector VECTOR. */
4465
4466 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4467
4468 /* List of supported image types. Use define_image_type to add new
4469 types. Use lookup_image_type to find a type for a given symbol. */
4470
4471 static struct image_type *image_types;
4472
4473 /* The symbol `image' which is the car of the lists used to represent
4474 images in Lisp. */
4475
4476 extern Lisp_Object Qimage;
4477
4478 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4479
4480 Lisp_Object Qxbm;
4481
4482 /* Keywords. */
4483
4484 extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
4485 extern Lisp_Object QCdata;
4486 Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
4487 Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
4488 Lisp_Object QCindex;
4489
4490 /* Other symbols. */
4491
4492 Lisp_Object Qlaplace;
4493
4494 /* Time in seconds after which images should be removed from the cache
4495 if not displayed. */
4496
4497 Lisp_Object Vimage_cache_eviction_delay;
4498
4499 /* Function prototypes. */
4500
4501 static void define_image_type P_ ((struct image_type *type));
4502 static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
4503 static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
4504 static void x_laplace P_ ((struct frame *, struct image *));
4505 static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
4506 Lisp_Object));
4507
4508
4509 /* Define a new image type from TYPE. This adds a copy of TYPE to
4510 image_types and adds the symbol *TYPE->type to Vimage_types. */
4511
4512 static void
4513 define_image_type (type)
4514 struct image_type *type;
4515 {
4516 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4517 The initialized data segment is read-only. */
4518 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
4519 bcopy (type, p, sizeof *p);
4520 p->next = image_types;
4521 image_types = p;
4522 Vimage_types = Fcons (*p->type, Vimage_types);
4523 }
4524
4525
4526 /* Look up image type SYMBOL, and return a pointer to its image_type
4527 structure. Value is null if SYMBOL is not a known image type. */
4528
4529 static INLINE struct image_type *
4530 lookup_image_type (symbol)
4531 Lisp_Object symbol;
4532 {
4533 struct image_type *type;
4534
4535 for (type = image_types; type; type = type->next)
4536 if (EQ (symbol, *type->type))
4537 break;
4538
4539 return type;
4540 }
4541
4542
4543 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4544 valid image specification is a list whose car is the symbol
4545 `image', and whose rest is a property list. The property list must
4546 contain a value for key `:type'. That value must be the name of a
4547 supported image type. The rest of the property list depends on the
4548 image type. */
4549
4550 int
4551 valid_image_p (object)
4552 Lisp_Object object;
4553 {
4554 int valid_p = 0;
4555
4556 if (CONSP (object) && EQ (XCAR (object), Qimage))
4557 {
4558 Lisp_Object symbol = Fplist_get (XCDR (object), QCtype);
4559 struct image_type *type = lookup_image_type (symbol);
4560
4561 if (type)
4562 valid_p = type->valid_p (object);
4563 }
4564
4565 return valid_p;
4566 }
4567
4568
4569 /* Log error message with format string FORMAT and argument ARG.
4570 Signaling an error, e.g. when an image cannot be loaded, is not a
4571 good idea because this would interrupt redisplay, and the error
4572 message display would lead to another redisplay. This function
4573 therefore simply displays a message. */
4574
4575 static void
4576 image_error (format, arg1, arg2)
4577 char *format;
4578 Lisp_Object arg1, arg2;
4579 {
4580 add_to_log (format, arg1, arg2);
4581 }
4582
4583
4584 \f
4585 /***********************************************************************
4586 Image specifications
4587 ***********************************************************************/
4588
4589 enum image_value_type
4590 {
4591 IMAGE_DONT_CHECK_VALUE_TYPE,
4592 IMAGE_STRING_VALUE,
4593 IMAGE_SYMBOL_VALUE,
4594 IMAGE_POSITIVE_INTEGER_VALUE,
4595 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
4596 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
4597 IMAGE_ASCENT_VALUE,
4598 IMAGE_INTEGER_VALUE,
4599 IMAGE_FUNCTION_VALUE,
4600 IMAGE_NUMBER_VALUE,
4601 IMAGE_BOOL_VALUE
4602 };
4603
4604 /* Structure used when parsing image specifications. */
4605
4606 struct image_keyword
4607 {
4608 /* Name of keyword. */
4609 char *name;
4610
4611 /* The type of value allowed. */
4612 enum image_value_type type;
4613
4614 /* Non-zero means key must be present. */
4615 int mandatory_p;
4616
4617 /* Used to recognize duplicate keywords in a property list. */
4618 int count;
4619
4620 /* The value that was found. */
4621 Lisp_Object value;
4622 };
4623
4624
4625 static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
4626 int, Lisp_Object));
4627 static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
4628
4629
4630 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
4631 has the format (image KEYWORD VALUE ...). One of the keyword/
4632 value pairs must be `:type TYPE'. KEYWORDS is a vector of
4633 image_keywords structures of size NKEYWORDS describing other
4634 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
4635
4636 static int
4637 parse_image_spec (spec, keywords, nkeywords, type)
4638 Lisp_Object spec;
4639 struct image_keyword *keywords;
4640 int nkeywords;
4641 Lisp_Object type;
4642 {
4643 int i;
4644 Lisp_Object plist;
4645
4646 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
4647 return 0;
4648
4649 plist = XCDR (spec);
4650 while (CONSP (plist))
4651 {
4652 Lisp_Object key, value;
4653
4654 /* First element of a pair must be a symbol. */
4655 key = XCAR (plist);
4656 plist = XCDR (plist);
4657 if (!SYMBOLP (key))
4658 return 0;
4659
4660 /* There must follow a value. */
4661 if (!CONSP (plist))
4662 return 0;
4663 value = XCAR (plist);
4664 plist = XCDR (plist);
4665
4666 /* Find key in KEYWORDS. Error if not found. */
4667 for (i = 0; i < nkeywords; ++i)
4668 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
4669 break;
4670
4671 if (i == nkeywords)
4672 continue;
4673
4674 /* Record that we recognized the keyword. If a keywords
4675 was found more than once, it's an error. */
4676 keywords[i].value = value;
4677 ++keywords[i].count;
4678
4679 if (keywords[i].count > 1)
4680 return 0;
4681
4682 /* Check type of value against allowed type. */
4683 switch (keywords[i].type)
4684 {
4685 case IMAGE_STRING_VALUE:
4686 if (!STRINGP (value))
4687 return 0;
4688 break;
4689
4690 case IMAGE_SYMBOL_VALUE:
4691 if (!SYMBOLP (value))
4692 return 0;
4693 break;
4694
4695 case IMAGE_POSITIVE_INTEGER_VALUE:
4696 if (!INTEGERP (value) || XINT (value) <= 0)
4697 return 0;
4698 break;
4699
4700 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
4701 if (INTEGERP (value) && XINT (value) >= 0)
4702 break;
4703 if (CONSP (value)
4704 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
4705 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
4706 break;
4707 return 0;
4708
4709 case IMAGE_ASCENT_VALUE:
4710 if (SYMBOLP (value) && EQ (value, Qcenter))
4711 break;
4712 else if (INTEGERP (value)
4713 && XINT (value) >= 0
4714 && XINT (value) <= 100)
4715 break;
4716 return 0;
4717
4718 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
4719 if (!INTEGERP (value) || XINT (value) < 0)
4720 return 0;
4721 break;
4722
4723 case IMAGE_DONT_CHECK_VALUE_TYPE:
4724 break;
4725
4726 case IMAGE_FUNCTION_VALUE:
4727 value = indirect_function (value);
4728 if (SUBRP (value)
4729 || COMPILEDP (value)
4730 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
4731 break;
4732 return 0;
4733
4734 case IMAGE_NUMBER_VALUE:
4735 if (!INTEGERP (value) && !FLOATP (value))
4736 return 0;
4737 break;
4738
4739 case IMAGE_INTEGER_VALUE:
4740 if (!INTEGERP (value))
4741 return 0;
4742 break;
4743
4744 case IMAGE_BOOL_VALUE:
4745 if (!NILP (value) && !EQ (value, Qt))
4746 return 0;
4747 break;
4748
4749 default:
4750 abort ();
4751 break;
4752 }
4753
4754 if (EQ (key, QCtype) && !EQ (type, value))
4755 return 0;
4756 }
4757
4758 /* Check that all mandatory fields are present. */
4759 for (i = 0; i < nkeywords; ++i)
4760 if (keywords[i].mandatory_p && keywords[i].count == 0)
4761 return 0;
4762
4763 return NILP (plist);
4764 }
4765
4766
4767 /* Return the value of KEY in image specification SPEC. Value is nil
4768 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
4769 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
4770
4771 static Lisp_Object
4772 image_spec_value (spec, key, found)
4773 Lisp_Object spec, key;
4774 int *found;
4775 {
4776 Lisp_Object tail;
4777
4778 xassert (valid_image_p (spec));
4779
4780 for (tail = XCDR (spec);
4781 CONSP (tail) && CONSP (XCDR (tail));
4782 tail = XCDR (XCDR (tail)))
4783 {
4784 if (EQ (XCAR (tail), key))
4785 {
4786 if (found)
4787 *found = 1;
4788 return XCAR (XCDR (tail));
4789 }
4790 }
4791
4792 if (found)
4793 *found = 0;
4794 return Qnil;
4795 }
4796
4797
4798
4799 \f
4800 /***********************************************************************
4801 Image type independent image structures
4802 ***********************************************************************/
4803
4804 static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
4805 static void free_image P_ ((struct frame *f, struct image *img));
4806
4807
4808 /* Allocate and return a new image structure for image specification
4809 SPEC. SPEC has a hash value of HASH. */
4810
4811 static struct image *
4812 make_image (spec, hash)
4813 Lisp_Object spec;
4814 unsigned hash;
4815 {
4816 struct image *img = (struct image *) xmalloc (sizeof *img);
4817
4818 xassert (valid_image_p (spec));
4819 bzero (img, sizeof *img);
4820 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
4821 xassert (img->type != NULL);
4822 img->spec = spec;
4823 img->data.lisp_val = Qnil;
4824 img->ascent = DEFAULT_IMAGE_ASCENT;
4825 img->hash = hash;
4826 return img;
4827 }
4828
4829
4830 /* Free image IMG which was used on frame F, including its resources. */
4831
4832 static void
4833 free_image (f, img)
4834 struct frame *f;
4835 struct image *img;
4836 {
4837 if (img)
4838 {
4839 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
4840
4841 /* Remove IMG from the hash table of its cache. */
4842 if (img->prev)
4843 img->prev->next = img->next;
4844 else
4845 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
4846
4847 if (img->next)
4848 img->next->prev = img->prev;
4849
4850 c->images[img->id] = NULL;
4851
4852 /* Free resources, then free IMG. */
4853 img->type->free (f, img);
4854 xfree (img);
4855 }
4856 }
4857
4858
4859 /* Prepare image IMG for display on frame F. Must be called before
4860 drawing an image. */
4861
4862 void
4863 prepare_image_for_display (f, img)
4864 struct frame *f;
4865 struct image *img;
4866 {
4867 EMACS_TIME t;
4868
4869 /* We're about to display IMG, so set its timestamp to `now'. */
4870 EMACS_GET_TIME (t);
4871 img->timestamp = EMACS_SECS (t);
4872
4873 /* If IMG doesn't have a pixmap yet, load it now, using the image
4874 type dependent loader function. */
4875 if (img->pixmap == 0 && !img->load_failed_p)
4876 img->load_failed_p = img->type->load (f, img) == 0;
4877 }
4878
4879
4880 /* Value is the number of pixels for the ascent of image IMG when
4881 drawn in face FACE. */
4882
4883 int
4884 image_ascent (img, face)
4885 struct image *img;
4886 struct face *face;
4887 {
4888 int height = img->height + img->vmargin;
4889 int ascent;
4890
4891 if (img->ascent == CENTERED_IMAGE_ASCENT)
4892 {
4893 if (face->font)
4894 ascent = height / 2 - (FONT_DESCENT(face->font)
4895 - FONT_BASE(face->font)) / 2;
4896 else
4897 ascent = height / 2;
4898 }
4899 else
4900 ascent = height * img->ascent / 100.0;
4901
4902 return ascent;
4903 }
4904
4905
4906 \f
4907 /***********************************************************************
4908 Helper functions for X image types
4909 ***********************************************************************/
4910
4911 static void x_clear_image P_ ((struct frame *f, struct image *img));
4912 static unsigned long x_alloc_image_color P_ ((struct frame *f,
4913 struct image *img,
4914 Lisp_Object color_name,
4915 unsigned long dflt));
4916
4917 /* Free X resources of image IMG which is used on frame F. */
4918
4919 static void
4920 x_clear_image (f, img)
4921 struct frame *f;
4922 struct image *img;
4923 {
4924 #if 0 /* MAC_TODO: W32 image support */
4925
4926 if (img->pixmap)
4927 {
4928 BLOCK_INPUT;
4929 XFreePixmap (NULL, img->pixmap);
4930 img->pixmap = 0;
4931 UNBLOCK_INPUT;
4932 }
4933
4934 if (img->ncolors)
4935 {
4936 int class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
4937
4938 /* If display has an immutable color map, freeing colors is not
4939 necessary and some servers don't allow it. So don't do it. */
4940 if (class != StaticColor
4941 && class != StaticGray
4942 && class != TrueColor)
4943 {
4944 Colormap cmap;
4945 BLOCK_INPUT;
4946 cmap = DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f)->screen);
4947 XFreeColors (FRAME_W32_DISPLAY (f), cmap, img->colors,
4948 img->ncolors, 0);
4949 UNBLOCK_INPUT;
4950 }
4951
4952 xfree (img->colors);
4953 img->colors = NULL;
4954 img->ncolors = 0;
4955 }
4956 #endif
4957 }
4958
4959
4960 /* Allocate color COLOR_NAME for image IMG on frame F. If color
4961 cannot be allocated, use DFLT. Add a newly allocated color to
4962 IMG->colors, so that it can be freed again. Value is the pixel
4963 color. */
4964
4965 static unsigned long
4966 x_alloc_image_color (f, img, color_name, dflt)
4967 struct frame *f;
4968 struct image *img;
4969 Lisp_Object color_name;
4970 unsigned long dflt;
4971 {
4972 #if 0 /* MAC_TODO: allocing colors. */
4973 XColor color;
4974 unsigned long result;
4975
4976 xassert (STRINGP (color_name));
4977
4978 if (w32_defined_color (f, XSTRING (color_name)->data, &color, 1))
4979 {
4980 /* This isn't called frequently so we get away with simply
4981 reallocating the color vector to the needed size, here. */
4982 ++img->ncolors;
4983 img->colors =
4984 (unsigned long *) xrealloc (img->colors,
4985 img->ncolors * sizeof *img->colors);
4986 img->colors[img->ncolors - 1] = color.pixel;
4987 result = color.pixel;
4988 }
4989 else
4990 result = dflt;
4991 return result;
4992 #endif
4993 return 0;
4994 }
4995
4996
4997 \f
4998 /***********************************************************************
4999 Image Cache
5000 ***********************************************************************/
5001
5002 static void cache_image P_ ((struct frame *f, struct image *img));
5003
5004
5005 /* Return a new, initialized image cache that is allocated from the
5006 heap. Call free_image_cache to free an image cache. */
5007
5008 struct image_cache *
5009 make_image_cache ()
5010 {
5011 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
5012 int size;
5013
5014 bzero (c, sizeof *c);
5015 c->size = 50;
5016 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
5017 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5018 c->buckets = (struct image **) xmalloc (size);
5019 bzero (c->buckets, size);
5020 return c;
5021 }
5022
5023
5024 /* Free image cache of frame F. Be aware that X frames share images
5025 caches. */
5026
5027 void
5028 free_image_cache (f)
5029 struct frame *f;
5030 {
5031 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5032 if (c)
5033 {
5034 int i;
5035
5036 /* Cache should not be referenced by any frame when freed. */
5037 xassert (c->refcount == 0);
5038
5039 for (i = 0; i < c->used; ++i)
5040 free_image (f, c->images[i]);
5041 xfree (c->images);
5042 xfree (c);
5043 xfree (c->buckets);
5044 FRAME_X_IMAGE_CACHE (f) = NULL;
5045 }
5046 }
5047
5048
5049 /* Clear image cache of frame F. FORCE_P non-zero means free all
5050 images. FORCE_P zero means clear only images that haven't been
5051 displayed for some time. Should be called from time to time to
5052 reduce the number of loaded images. If image-eviction-seconds is
5053 non-nil, this frees images in the cache which weren't displayed for
5054 at least that many seconds. */
5055
5056 void
5057 clear_image_cache (f, force_p)
5058 struct frame *f;
5059 int force_p;
5060 {
5061 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5062
5063 if (c && INTEGERP (Vimage_cache_eviction_delay))
5064 {
5065 EMACS_TIME t;
5066 unsigned long old;
5067 int i, any_freed_p = 0;
5068
5069 EMACS_GET_TIME (t);
5070 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
5071
5072 for (i = 0; i < c->used; ++i)
5073 {
5074 struct image *img = c->images[i];
5075 if (img != NULL
5076 && (force_p
5077 || (img->timestamp > old)))
5078 {
5079 free_image (f, img);
5080 any_freed_p = 1;
5081 }
5082 }
5083
5084 /* We may be clearing the image cache because, for example,
5085 Emacs was iconified for a longer period of time. In that
5086 case, current matrices may still contain references to
5087 images freed above. So, clear these matrices. */
5088 if (any_freed_p)
5089 {
5090 clear_current_matrices (f);
5091 ++windows_or_buffers_changed;
5092 }
5093 }
5094 }
5095
5096
5097 DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
5098 0, 1, 0,
5099 "Clear the image cache of FRAME.\n\
5100 FRAME nil or omitted means use the selected frame.\n\
5101 FRAME t means clear the image caches of all frames.")
5102 (frame)
5103 Lisp_Object frame;
5104 {
5105 if (EQ (frame, Qt))
5106 {
5107 Lisp_Object tail;
5108
5109 FOR_EACH_FRAME (tail, frame)
5110 if (FRAME_MAC_P (XFRAME (frame)))
5111 clear_image_cache (XFRAME (frame), 1);
5112 }
5113 else
5114 clear_image_cache (check_x_frame (frame), 1);
5115
5116 return Qnil;
5117 }
5118
5119
5120 /* Return the id of image with Lisp specification SPEC on frame F.
5121 SPEC must be a valid Lisp image specification (see valid_image_p). */
5122
5123 int
5124 lookup_image (f, spec)
5125 struct frame *f;
5126 Lisp_Object spec;
5127 {
5128 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5129 struct image *img;
5130 int i;
5131 unsigned hash;
5132 struct gcpro gcpro1;
5133 EMACS_TIME now;
5134
5135 /* F must be a window-system frame, and SPEC must be a valid image
5136 specification. */
5137 xassert (FRAME_WINDOW_P (f));
5138 xassert (valid_image_p (spec));
5139
5140 GCPRO1 (spec);
5141
5142 /* Look up SPEC in the hash table of the image cache. */
5143 hash = sxhash (spec, 0);
5144 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
5145
5146 for (img = c->buckets[i]; img; img = img->next)
5147 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
5148 break;
5149
5150 /* If not found, create a new image and cache it. */
5151 if (img == NULL)
5152 {
5153 BLOCK_INPUT;
5154 img = make_image (spec, hash);
5155 cache_image (f, img);
5156 img->load_failed_p = img->type->load (f, img) == 0;
5157
5158 /* If we can't load the image, and we don't have a width and
5159 height, use some arbitrary width and height so that we can
5160 draw a rectangle for it. */
5161 if (img->load_failed_p)
5162 {
5163 Lisp_Object value;
5164
5165 value = image_spec_value (spec, QCwidth, NULL);
5166 img->width = (INTEGERP (value)
5167 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
5168 value = image_spec_value (spec, QCheight, NULL);
5169 img->height = (INTEGERP (value)
5170 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
5171 }
5172 else
5173 {
5174 /* Handle image type independent image attributes
5175 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
5176 Lisp_Object ascent, margin, relief;
5177
5178 ascent = image_spec_value (spec, QCascent, NULL);
5179 if (INTEGERP (ascent))
5180 img->ascent = XFASTINT (ascent);
5181 else if (EQ (ascent, Qcenter))
5182 img->ascent = CENTERED_IMAGE_ASCENT;
5183
5184 margin = image_spec_value (spec, QCmargin, NULL);
5185 if (INTEGERP (margin) && XINT (margin) >= 0)
5186 img->vmargin = img->hmargin = XFASTINT (margin);
5187 else if (CONSP (margin) && INTEGERP (XCAR (margin))
5188 && INTEGERP (XCDR (margin)))
5189 {
5190 if (XINT (XCAR (margin)) > 0)
5191 img->hmargin = XFASTINT (XCAR (margin));
5192 if (XINT (XCDR (margin)) > 0)
5193 img->vmargin = XFASTINT (XCDR (margin));
5194 }
5195
5196 relief = image_spec_value (spec, QCrelief, NULL);
5197 if (INTEGERP (relief))
5198 {
5199 img->relief = XINT (relief);
5200 img->hmargin += abs (img->relief);
5201 img->vmargin += abs (img->relief);
5202 }
5203 }
5204 }
5205
5206 /* We're using IMG, so set its timestamp to `now'. */
5207 EMACS_GET_TIME (now);
5208 img->timestamp = EMACS_SECS (now);
5209
5210 UNGCPRO;
5211
5212 /* Value is the image id. */
5213 return img->id;
5214 }
5215
5216
5217 /* Cache image IMG in the image cache of frame F. */
5218
5219 static void
5220 cache_image (f, img)
5221 struct frame *f;
5222 struct image *img;
5223 {
5224 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5225 int i;
5226
5227 /* Find a free slot in c->images. */
5228 for (i = 0; i < c->used; ++i)
5229 if (c->images[i] == NULL)
5230 break;
5231
5232 /* If no free slot found, maybe enlarge c->images. */
5233 if (i == c->used && c->used == c->size)
5234 {
5235 c->size *= 2;
5236 c->images = (struct image **) xrealloc (c->images,
5237 c->size * sizeof *c->images);
5238 }
5239
5240 /* Add IMG to c->images, and assign IMG an id. */
5241 c->images[i] = img;
5242 img->id = i;
5243 if (i == c->used)
5244 ++c->used;
5245
5246 /* Add IMG to the cache's hash table. */
5247 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
5248 img->next = c->buckets[i];
5249 if (img->next)
5250 img->next->prev = img;
5251 img->prev = NULL;
5252 c->buckets[i] = img;
5253 }
5254
5255
5256 /* Call FN on every image in the image cache of frame F. Used to mark
5257 Lisp Objects in the image cache. */
5258
5259 void
5260 forall_images_in_image_cache (f, fn)
5261 struct frame *f;
5262 void (*fn) P_ ((struct image *img));
5263 {
5264 if (FRAME_LIVE_P (f) && FRAME_MAC_P (f))
5265 {
5266 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5267 if (c)
5268 {
5269 int i;
5270 for (i = 0; i < c->used; ++i)
5271 if (c->images[i])
5272 fn (c->images[i]);
5273 }
5274 }
5275 }
5276
5277
5278 \f
5279 /***********************************************************************
5280 Mac support code
5281 ***********************************************************************/
5282
5283 #if 0 /* MAC_TODO: Mac specific image code. */
5284
5285 static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
5286 XImage **, Pixmap *));
5287 static void x_destroy_x_image P_ ((XImage *));
5288 static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
5289
5290
5291 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5292 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5293 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5294 via xmalloc. Print error messages via image_error if an error
5295 occurs. Value is non-zero if successful. */
5296
5297 static int
5298 x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
5299 struct frame *f;
5300 int width, height, depth;
5301 XImage **ximg;
5302 Pixmap *pixmap;
5303 {
5304 #if 0 /* MAC_TODO: Image support for Mac */
5305 Display *display = FRAME_W32_DISPLAY (f);
5306 Screen *screen = FRAME_X_SCREEN (f);
5307 Window window = FRAME_W32_WINDOW (f);
5308
5309 xassert (interrupt_input_blocked);
5310
5311 if (depth <= 0)
5312 depth = DefaultDepthOfScreen (screen);
5313 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
5314 depth, ZPixmap, 0, NULL, width, height,
5315 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
5316 if (*ximg == NULL)
5317 {
5318 image_error ("Unable to allocate X image", Qnil, Qnil);
5319 return 0;
5320 }
5321
5322 /* Allocate image raster. */
5323 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
5324
5325 /* Allocate a pixmap of the same size. */
5326 *pixmap = XCreatePixmap (display, window, width, height, depth);
5327 if (*pixmap == 0)
5328 {
5329 x_destroy_x_image (*ximg);
5330 *ximg = NULL;
5331 image_error ("Unable to create X pixmap", Qnil, Qnil);
5332 return 0;
5333 }
5334 #endif
5335 return 1;
5336 }
5337
5338
5339 /* Destroy XImage XIMG. Free XIMG->data. */
5340
5341 static void
5342 x_destroy_x_image (ximg)
5343 XImage *ximg;
5344 {
5345 xassert (interrupt_input_blocked);
5346 if (ximg)
5347 {
5348 xfree (ximg->data);
5349 ximg->data = NULL;
5350 XDestroyImage (ximg);
5351 }
5352 }
5353
5354
5355 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5356 are width and height of both the image and pixmap. */
5357
5358 static void
5359 x_put_x_image (f, ximg, pixmap, width, height)
5360 struct frame *f;
5361 XImage *ximg;
5362 Pixmap pixmap;
5363 {
5364 GC gc;
5365
5366 xassert (interrupt_input_blocked);
5367 gc = XCreateGC (NULL, pixmap, 0, NULL);
5368 XPutImage (NULL, pixmap, gc, ximg, 0, 0, 0, 0, width, height);
5369 XFreeGC (NULL, gc);
5370 }
5371
5372 #endif
5373
5374 \f
5375 /***********************************************************************
5376 Searching files
5377 ***********************************************************************/
5378
5379 static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5380
5381 /* Find image file FILE. Look in data-directory, then
5382 x-bitmap-file-path. Value is the full name of the file found, or
5383 nil if not found. */
5384
5385 static Lisp_Object
5386 x_find_image_file (file)
5387 Lisp_Object file;
5388 {
5389 Lisp_Object file_found, search_path;
5390 struct gcpro gcpro1, gcpro2;
5391 int fd;
5392
5393 file_found = Qnil;
5394 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
5395 GCPRO2 (file_found, search_path);
5396
5397 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5398 fd = openp (search_path, file, Qnil, &file_found, 0);
5399
5400 if (fd < 0)
5401 file_found = Qnil;
5402 else
5403 close (fd);
5404
5405 UNGCPRO;
5406 return file_found;
5407 }
5408
5409 \f
5410 /***********************************************************************
5411 XBM images
5412 ***********************************************************************/
5413
5414 static int xbm_load P_ ((struct frame *f, struct image *img));
5415 static int xbm_load_image_from_file P_ ((struct frame *f, struct image *img,
5416 Lisp_Object file));
5417 static int xbm_image_p P_ ((Lisp_Object object));
5418 static int xbm_read_bitmap_file_data P_ ((char *, int *, int *,
5419 unsigned char **));
5420
5421
5422 /* Indices of image specification fields in xbm_format, below. */
5423
5424 enum xbm_keyword_index
5425 {
5426 XBM_TYPE,
5427 XBM_FILE,
5428 XBM_WIDTH,
5429 XBM_HEIGHT,
5430 XBM_DATA,
5431 XBM_FOREGROUND,
5432 XBM_BACKGROUND,
5433 XBM_ASCENT,
5434 XBM_MARGIN,
5435 XBM_RELIEF,
5436 XBM_ALGORITHM,
5437 XBM_HEURISTIC_MASK,
5438 XBM_LAST
5439 };
5440
5441 /* Vector of image_keyword structures describing the format
5442 of valid XBM image specifications. */
5443
5444 static struct image_keyword xbm_format[XBM_LAST] =
5445 {
5446 {":type", IMAGE_SYMBOL_VALUE, 1},
5447 {":file", IMAGE_STRING_VALUE, 0},
5448 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5449 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5450 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5451 {":foreground", IMAGE_STRING_VALUE, 0},
5452 {":background", IMAGE_STRING_VALUE, 0},
5453 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
5454 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
5455 {":relief", IMAGE_INTEGER_VALUE, 0},
5456 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5457 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
5458 };
5459
5460 /* Structure describing the image type XBM. */
5461
5462 static struct image_type xbm_type =
5463 {
5464 &Qxbm,
5465 xbm_image_p,
5466 xbm_load,
5467 x_clear_image,
5468 NULL
5469 };
5470
5471 /* Tokens returned from xbm_scan. */
5472
5473 enum xbm_token
5474 {
5475 XBM_TK_IDENT = 256,
5476 XBM_TK_NUMBER
5477 };
5478
5479
5480 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5481 A valid specification is a list starting with the symbol `image'
5482 The rest of the list is a property list which must contain an
5483 entry `:type xbm..
5484
5485 If the specification specifies a file to load, it must contain
5486 an entry `:file FILENAME' where FILENAME is a string.
5487
5488 If the specification is for a bitmap loaded from memory it must
5489 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5490 WIDTH and HEIGHT are integers > 0. DATA may be:
5491
5492 1. a string large enough to hold the bitmap data, i.e. it must
5493 have a size >= (WIDTH + 7) / 8 * HEIGHT
5494
5495 2. a bool-vector of size >= WIDTH * HEIGHT
5496
5497 3. a vector of strings or bool-vectors, one for each line of the
5498 bitmap.
5499
5500 Both the file and data forms may contain the additional entries
5501 `:background COLOR' and `:foreground COLOR'. If not present,
5502 foreground and background of the frame on which the image is
5503 displayed, is used. */
5504
5505 static int
5506 xbm_image_p (object)
5507 Lisp_Object object;
5508 {
5509 struct image_keyword kw[XBM_LAST];
5510
5511 bcopy (xbm_format, kw, sizeof kw);
5512 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
5513 return 0;
5514
5515 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
5516
5517 if (kw[XBM_FILE].count)
5518 {
5519 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
5520 return 0;
5521 }
5522 else
5523 {
5524 Lisp_Object data;
5525 int width, height;
5526
5527 /* Entries for `:width', `:height' and `:data' must be present. */
5528 if (!kw[XBM_WIDTH].count
5529 || !kw[XBM_HEIGHT].count
5530 || !kw[XBM_DATA].count)
5531 return 0;
5532
5533 data = kw[XBM_DATA].value;
5534 width = XFASTINT (kw[XBM_WIDTH].value);
5535 height = XFASTINT (kw[XBM_HEIGHT].value);
5536
5537 /* Check type of data, and width and height against contents of
5538 data. */
5539 if (VECTORP (data))
5540 {
5541 int i;
5542
5543 /* Number of elements of the vector must be >= height. */
5544 if (XVECTOR (data)->size < height)
5545 return 0;
5546
5547 /* Each string or bool-vector in data must be large enough
5548 for one line of the image. */
5549 for (i = 0; i < height; ++i)
5550 {
5551 Lisp_Object elt = XVECTOR (data)->contents[i];
5552
5553 if (STRINGP (elt))
5554 {
5555 if (XSTRING (elt)->size
5556 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
5557 return 0;
5558 }
5559 else if (BOOL_VECTOR_P (elt))
5560 {
5561 if (XBOOL_VECTOR (elt)->size < width)
5562 return 0;
5563 }
5564 else
5565 return 0;
5566 }
5567 }
5568 else if (STRINGP (data))
5569 {
5570 if (XSTRING (data)->size
5571 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
5572 return 0;
5573 }
5574 else if (BOOL_VECTOR_P (data))
5575 {
5576 if (XBOOL_VECTOR (data)->size < width * height)
5577 return 0;
5578 }
5579 else
5580 return 0;
5581 }
5582
5583 /* Baseline must be a value between 0 and 100 (a percentage). */
5584 if (kw[XBM_ASCENT].count
5585 && XFASTINT (kw[XBM_ASCENT].value) > 100)
5586 return 0;
5587
5588 return 1;
5589 }
5590
5591
5592 /* Scan a bitmap file. FP is the stream to read from. Value is
5593 either an enumerator from enum xbm_token, or a character for a
5594 single-character token, or 0 at end of file. If scanning an
5595 identifier, store the lexeme of the identifier in SVAL. If
5596 scanning a number, store its value in *IVAL. */
5597
5598 static int
5599 xbm_scan (fp, sval, ival)
5600 FILE *fp;
5601 char *sval;
5602 int *ival;
5603 {
5604 int c;
5605
5606 /* Skip white space. */
5607 while ((c = fgetc (fp)) != EOF && isspace (c))
5608 ;
5609
5610 if (c == EOF)
5611 c = 0;
5612 else if (isdigit (c))
5613 {
5614 int value = 0, digit;
5615
5616 if (c == '0')
5617 {
5618 c = fgetc (fp);
5619 if (c == 'x' || c == 'X')
5620 {
5621 while ((c = fgetc (fp)) != EOF)
5622 {
5623 if (isdigit (c))
5624 digit = c - '0';
5625 else if (c >= 'a' && c <= 'f')
5626 digit = c - 'a' + 10;
5627 else if (c >= 'A' && c <= 'F')
5628 digit = c - 'A' + 10;
5629 else
5630 break;
5631 value = 16 * value + digit;
5632 }
5633 }
5634 else if (isdigit (c))
5635 {
5636 value = c - '0';
5637 while ((c = fgetc (fp)) != EOF
5638 && isdigit (c))
5639 value = 8 * value + c - '0';
5640 }
5641 }
5642 else
5643 {
5644 value = c - '0';
5645 while ((c = fgetc (fp)) != EOF
5646 && isdigit (c))
5647 value = 10 * value + c - '0';
5648 }
5649
5650 if (c != EOF)
5651 ungetc (c, fp);
5652 *ival = value;
5653 c = XBM_TK_NUMBER;
5654 }
5655 else if (isalpha (c) || c == '_')
5656 {
5657 *sval++ = c;
5658 while ((c = fgetc (fp)) != EOF
5659 && (isalnum (c) || c == '_'))
5660 *sval++ = c;
5661 *sval = 0;
5662 if (c != EOF)
5663 ungetc (c, fp);
5664 c = XBM_TK_IDENT;
5665 }
5666
5667 return c;
5668 }
5669
5670
5671 /* Replacement for XReadBitmapFileData which isn't available under old
5672 X versions. FILE is the name of the bitmap file to read. Set
5673 *WIDTH and *HEIGHT to the width and height of the image. Return in
5674 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
5675 successful. */
5676
5677 static int
5678 xbm_read_bitmap_file_data (file, width, height, data)
5679 char *file;
5680 int *width, *height;
5681 unsigned char **data;
5682 {
5683 FILE *fp;
5684 char buffer[BUFSIZ];
5685 int padding_p = 0;
5686 int v10 = 0;
5687 int bytes_per_line, i, nbytes;
5688 unsigned char *p;
5689 int value;
5690 int LA1;
5691
5692 #define match() \
5693 LA1 = xbm_scan (fp, buffer, &value)
5694
5695 #define expect(TOKEN) \
5696 if (LA1 != (TOKEN)) \
5697 goto failure; \
5698 else \
5699 match ()
5700
5701 #define expect_ident(IDENT) \
5702 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
5703 match (); \
5704 else \
5705 goto failure
5706
5707 fp = fopen (file, "r");
5708 if (fp == NULL)
5709 return 0;
5710
5711 *width = *height = -1;
5712 *data = NULL;
5713 LA1 = xbm_scan (fp, buffer, &value);
5714
5715 /* Parse defines for width, height and hot-spots. */
5716 while (LA1 == '#')
5717 {
5718 match ();
5719 expect_ident ("define");
5720 expect (XBM_TK_IDENT);
5721
5722 if (LA1 == XBM_TK_NUMBER);
5723 {
5724 char *p = strrchr (buffer, '_');
5725 p = p ? p + 1 : buffer;
5726 if (strcmp (p, "width") == 0)
5727 *width = value;
5728 else if (strcmp (p, "height") == 0)
5729 *height = value;
5730 }
5731 expect (XBM_TK_NUMBER);
5732 }
5733
5734 if (*width < 0 || *height < 0)
5735 goto failure;
5736
5737 /* Parse bits. Must start with `static'. */
5738 expect_ident ("static");
5739 if (LA1 == XBM_TK_IDENT)
5740 {
5741 if (strcmp (buffer, "unsigned") == 0)
5742 {
5743 match ();
5744 expect_ident ("char");
5745 }
5746 else if (strcmp (buffer, "short") == 0)
5747 {
5748 match ();
5749 v10 = 1;
5750 if (*width % 16 && *width % 16 < 9)
5751 padding_p = 1;
5752 }
5753 else if (strcmp (buffer, "char") == 0)
5754 match ();
5755 else
5756 goto failure;
5757 }
5758 else
5759 goto failure;
5760
5761 expect (XBM_TK_IDENT);
5762 expect ('[');
5763 expect (']');
5764 expect ('=');
5765 expect ('{');
5766
5767 bytes_per_line = (*width + 7) / 8 + padding_p;
5768 nbytes = bytes_per_line * *height;
5769 p = *data = (char *) xmalloc (nbytes);
5770
5771 if (v10)
5772 {
5773
5774 for (i = 0; i < nbytes; i += 2)
5775 {
5776 int val = value;
5777 expect (XBM_TK_NUMBER);
5778
5779 *p++ = val;
5780 if (!padding_p || ((i + 2) % bytes_per_line))
5781 *p++ = value >> 8;
5782
5783 if (LA1 == ',' || LA1 == '}')
5784 match ();
5785 else
5786 goto failure;
5787 }
5788 }
5789 else
5790 {
5791 for (i = 0; i < nbytes; ++i)
5792 {
5793 int val = value;
5794 expect (XBM_TK_NUMBER);
5795
5796 *p++ = val;
5797
5798 if (LA1 == ',' || LA1 == '}')
5799 match ();
5800 else
5801 goto failure;
5802 }
5803 }
5804
5805 fclose (fp);
5806 return 1;
5807
5808 failure:
5809
5810 fclose (fp);
5811 if (*data)
5812 {
5813 xfree (*data);
5814 *data = NULL;
5815 }
5816 return 0;
5817
5818 #undef match
5819 #undef expect
5820 #undef expect_ident
5821 }
5822
5823
5824 /* Load XBM image IMG which will be displayed on frame F from file
5825 SPECIFIED_FILE. Value is non-zero if successful. */
5826
5827 static int
5828 xbm_load_image_from_file (f, img, specified_file)
5829 struct frame *f;
5830 struct image *img;
5831 Lisp_Object specified_file;
5832 {
5833 int rc;
5834 unsigned char *data;
5835 int success_p = 0;
5836 Lisp_Object file;
5837 struct gcpro gcpro1;
5838
5839 xassert (STRINGP (specified_file));
5840 file = Qnil;
5841 GCPRO1 (file);
5842
5843 file = x_find_image_file (specified_file);
5844 if (!STRINGP (file))
5845 {
5846 image_error ("Cannot find image file `%s'", specified_file, Qnil);
5847 UNGCPRO;
5848 return 0;
5849 }
5850
5851 rc = xbm_read_bitmap_file_data (XSTRING (file)->data, &img->width,
5852 &img->height, &data);
5853 if (rc)
5854 {
5855 int depth = one_mac_display_info.n_cbits;
5856 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
5857 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
5858 Lisp_Object value;
5859
5860 xassert (img->width > 0 && img->height > 0);
5861
5862 /* Get foreground and background colors, maybe allocate colors. */
5863 value = image_spec_value (img->spec, QCforeground, NULL);
5864 if (!NILP (value))
5865 foreground = x_alloc_image_color (f, img, value, foreground);
5866
5867 value = image_spec_value (img->spec, QCbackground, NULL);
5868 if (!NILP (value))
5869 background = x_alloc_image_color (f, img, value, background);
5870
5871 #if 0 /* MAC_TODO : Port image display to Mac */
5872 BLOCK_INPUT;
5873 img->pixmap
5874 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f),
5875 FRAME_W32_WINDOW (f),
5876 data,
5877 img->width, img->height,
5878 foreground, background,
5879 depth);
5880 xfree (data);
5881
5882 if (img->pixmap == 0)
5883 {
5884 x_clear_image (f, img);
5885 image_error ("Unable to create X pixmap for `%s'", file, Qnil);
5886 }
5887 else
5888 success_p = 1;
5889
5890 UNBLOCK_INPUT;
5891 #endif
5892 }
5893 else
5894 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
5895
5896 UNGCPRO;
5897 return success_p;
5898 }
5899
5900
5901 /* Fill image IMG which is used on frame F with pixmap data. Value is
5902 non-zero if successful. */
5903
5904 static int
5905 xbm_load (f, img)
5906 struct frame *f;
5907 struct image *img;
5908 {
5909 int success_p = 0;
5910 Lisp_Object file_name;
5911
5912 xassert (xbm_image_p (img->spec));
5913
5914 /* If IMG->spec specifies a file name, create a non-file spec from it. */
5915 file_name = image_spec_value (img->spec, QCfile, NULL);
5916 if (STRINGP (file_name))
5917 success_p = xbm_load_image_from_file (f, img, file_name);
5918 else
5919 {
5920 struct image_keyword fmt[XBM_LAST];
5921 Lisp_Object data;
5922 int depth;
5923 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
5924 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
5925 char *bits;
5926 int parsed_p;
5927
5928 /* Parse the list specification. */
5929 bcopy (xbm_format, fmt, sizeof fmt);
5930 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
5931 xassert (parsed_p);
5932
5933 /* Get specified width, and height. */
5934 img->width = XFASTINT (fmt[XBM_WIDTH].value);
5935 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
5936 xassert (img->width > 0 && img->height > 0);
5937
5938 BLOCK_INPUT;
5939
5940 if (fmt[XBM_ASCENT].count)
5941 img->ascent = XFASTINT (fmt[XBM_ASCENT].value);
5942
5943 /* Get foreground and background colors, maybe allocate colors. */
5944 if (fmt[XBM_FOREGROUND].count)
5945 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
5946 foreground);
5947 if (fmt[XBM_BACKGROUND].count)
5948 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
5949 background);
5950
5951 /* Set bits to the bitmap image data. */
5952 data = fmt[XBM_DATA].value;
5953 if (VECTORP (data))
5954 {
5955 int i;
5956 char *p;
5957 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
5958
5959 p = bits = (char *) alloca (nbytes * img->height);
5960 for (i = 0; i < img->height; ++i, p += nbytes)
5961 {
5962 Lisp_Object line = XVECTOR (data)->contents[i];
5963 if (STRINGP (line))
5964 bcopy (XSTRING (line)->data, p, nbytes);
5965 else
5966 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
5967 }
5968 }
5969 else if (STRINGP (data))
5970 bits = XSTRING (data)->data;
5971 else
5972 bits = XBOOL_VECTOR (data)->data;
5973
5974 #if 0 /* MAC_TODO : port Mac display code */
5975 /* Create the pixmap. */
5976 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
5977 img->pixmap
5978 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f),
5979 FRAME_W32_WINDOW (f),
5980 bits,
5981 img->width, img->height,
5982 foreground, background,
5983 depth);
5984 #endif /* MAC_TODO */
5985
5986 if (img->pixmap)
5987 success_p = 1;
5988 else
5989 {
5990 image_error ("Unable to create pixmap for XBM image `%s'",
5991 img->spec, Qnil);
5992 x_clear_image (f, img);
5993 }
5994
5995 UNBLOCK_INPUT;
5996 }
5997
5998 return success_p;
5999 }
6000
6001
6002 \f
6003 /***********************************************************************
6004 XPM images
6005 ***********************************************************************/
6006
6007 #if HAVE_XPM
6008
6009 static int xpm_image_p P_ ((Lisp_Object object));
6010 static int xpm_load P_ ((struct frame *f, struct image *img));
6011 static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
6012
6013 #include "X11/xpm.h"
6014
6015 /* The symbol `xpm' identifying XPM-format images. */
6016
6017 Lisp_Object Qxpm;
6018
6019 /* Indices of image specification fields in xpm_format, below. */
6020
6021 enum xpm_keyword_index
6022 {
6023 XPM_TYPE,
6024 XPM_FILE,
6025 XPM_DATA,
6026 XPM_ASCENT,
6027 XPM_MARGIN,
6028 XPM_RELIEF,
6029 XPM_ALGORITHM,
6030 XPM_HEURISTIC_MASK,
6031 XPM_COLOR_SYMBOLS,
6032 XPM_LAST
6033 };
6034
6035 /* Vector of image_keyword structures describing the format
6036 of valid XPM image specifications. */
6037
6038 static struct image_keyword xpm_format[XPM_LAST] =
6039 {
6040 {":type", IMAGE_SYMBOL_VALUE, 1},
6041 {":file", IMAGE_STRING_VALUE, 0},
6042 {":data", IMAGE_STRING_VALUE, 0},
6043 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
6044 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6045 {":relief", IMAGE_INTEGER_VALUE, 0},
6046 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6047 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6048 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
6049 };
6050
6051 /* Structure describing the image type XBM. */
6052
6053 static struct image_type xpm_type =
6054 {
6055 &Qxpm,
6056 xpm_image_p,
6057 xpm_load,
6058 x_clear_image,
6059 NULL
6060 };
6061
6062
6063 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6064 for XPM images. Such a list must consist of conses whose car and
6065 cdr are strings. */
6066
6067 static int
6068 xpm_valid_color_symbols_p (color_symbols)
6069 Lisp_Object color_symbols;
6070 {
6071 while (CONSP (color_symbols))
6072 {
6073 Lisp_Object sym = XCAR (color_symbols);
6074 if (!CONSP (sym)
6075 || !STRINGP (XCAR (sym))
6076 || !STRINGP (XCDR (sym)))
6077 break;
6078 color_symbols = XCDR (color_symbols);
6079 }
6080
6081 return NILP (color_symbols);
6082 }
6083
6084
6085 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6086
6087 static int
6088 xpm_image_p (object)
6089 Lisp_Object object;
6090 {
6091 struct image_keyword fmt[XPM_LAST];
6092 bcopy (xpm_format, fmt, sizeof fmt);
6093 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
6094 /* Either `:file' or `:data' must be present. */
6095 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
6096 /* Either no `:color-symbols' or it's a list of conses
6097 whose car and cdr are strings. */
6098 && (fmt[XPM_COLOR_SYMBOLS].count == 0
6099 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))
6100 && (fmt[XPM_ASCENT].count == 0
6101 || XFASTINT (fmt[XPM_ASCENT].value) < 100));
6102 }
6103
6104
6105 /* Load image IMG which will be displayed on frame F. Value is
6106 non-zero if successful. */
6107
6108 static int
6109 xpm_load (f, img)
6110 struct frame *f;
6111 struct image *img;
6112 {
6113 int rc, i;
6114 XpmAttributes attrs;
6115 Lisp_Object specified_file, color_symbols;
6116
6117 /* Configure the XPM lib. Use the visual of frame F. Allocate
6118 close colors. Return colors allocated. */
6119 bzero (&attrs, sizeof attrs);
6120 attrs.visual = FRAME_X_VISUAL (f);
6121 attrs.colormap = FRAME_X_COLORMAP (f);
6122 attrs.valuemask |= XpmVisual;
6123 attrs.valuemask |= XpmColormap;
6124 attrs.valuemask |= XpmReturnAllocPixels;
6125 #ifdef XpmAllocCloseColors
6126 attrs.alloc_close_colors = 1;
6127 attrs.valuemask |= XpmAllocCloseColors;
6128 #else
6129 attrs.closeness = 600;
6130 attrs.valuemask |= XpmCloseness;
6131 #endif
6132
6133 /* If image specification contains symbolic color definitions, add
6134 these to `attrs'. */
6135 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
6136 if (CONSP (color_symbols))
6137 {
6138 Lisp_Object tail;
6139 XpmColorSymbol *xpm_syms;
6140 int i, size;
6141
6142 attrs.valuemask |= XpmColorSymbols;
6143
6144 /* Count number of symbols. */
6145 attrs.numsymbols = 0;
6146 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
6147 ++attrs.numsymbols;
6148
6149 /* Allocate an XpmColorSymbol array. */
6150 size = attrs.numsymbols * sizeof *xpm_syms;
6151 xpm_syms = (XpmColorSymbol *) alloca (size);
6152 bzero (xpm_syms, size);
6153 attrs.colorsymbols = xpm_syms;
6154
6155 /* Fill the color symbol array. */
6156 for (tail = color_symbols, i = 0;
6157 CONSP (tail);
6158 ++i, tail = XCDR (tail))
6159 {
6160 Lisp_Object name = XCAR (XCAR (tail));
6161 Lisp_Object color = XCDR (XCAR (tail));
6162 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
6163 strcpy (xpm_syms[i].name, XSTRING (name)->data);
6164 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
6165 strcpy (xpm_syms[i].value, XSTRING (color)->data);
6166 }
6167 }
6168
6169 /* Create a pixmap for the image, either from a file, or from a
6170 string buffer containing data in the same format as an XPM file. */
6171 BLOCK_INPUT;
6172 specified_file = image_spec_value (img->spec, QCfile, NULL);
6173 if (STRINGP (specified_file))
6174 {
6175 Lisp_Object file = x_find_image_file (specified_file);
6176 if (!STRINGP (file))
6177 {
6178 image_error ("Cannot find image file `%s'", specified_file, Qnil);
6179 UNBLOCK_INPUT;
6180 return 0;
6181 }
6182
6183 rc = XpmReadFileToPixmap (NULL, FRAME_W32_WINDOW (f),
6184 XSTRING (file)->data, &img->pixmap, &img->mask,
6185 &attrs);
6186 }
6187 else
6188 {
6189 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
6190 rc = XpmCreatePixmapFromBuffer (NULL, FRAME_W32_WINDOW (f),
6191 XSTRING (buffer)->data,
6192 &img->pixmap, &img->mask,
6193 &attrs);
6194 }
6195 UNBLOCK_INPUT;
6196
6197 if (rc == XpmSuccess)
6198 {
6199 /* Remember allocated colors. */
6200 img->ncolors = attrs.nalloc_pixels;
6201 img->colors = (unsigned long *) xmalloc (img->ncolors
6202 * sizeof *img->colors);
6203 for (i = 0; i < attrs.nalloc_pixels; ++i)
6204 img->colors[i] = attrs.alloc_pixels[i];
6205
6206 img->width = attrs.width;
6207 img->height = attrs.height;
6208 xassert (img->width > 0 && img->height > 0);
6209
6210 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6211 BLOCK_INPUT;
6212 XpmFreeAttributes (&attrs);
6213 UNBLOCK_INPUT;
6214 }
6215 else
6216 {
6217 switch (rc)
6218 {
6219 case XpmOpenFailed:
6220 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
6221 break;
6222
6223 case XpmFileInvalid:
6224 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
6225 break;
6226
6227 case XpmNoMemory:
6228 image_error ("Out of memory (%s)", img->spec, Qnil);
6229 break;
6230
6231 case XpmColorFailed:
6232 image_error ("Color allocation error (%s)", img->spec, Qnil);
6233 break;
6234
6235 default:
6236 image_error ("Unknown error (%s)", img->spec, Qnil);
6237 break;
6238 }
6239 }
6240
6241 return rc == XpmSuccess;
6242 }
6243
6244 #endif /* HAVE_XPM != 0 */
6245
6246 \f
6247 #if 0 /* MAC_TODO : Color tables on Mac. */
6248 /***********************************************************************
6249 Color table
6250 ***********************************************************************/
6251
6252 /* An entry in the color table mapping an RGB color to a pixel color. */
6253
6254 struct ct_color
6255 {
6256 int r, g, b;
6257 unsigned long pixel;
6258
6259 /* Next in color table collision list. */
6260 struct ct_color *next;
6261 };
6262
6263 /* The bucket vector size to use. Must be prime. */
6264
6265 #define CT_SIZE 101
6266
6267 /* Value is a hash of the RGB color given by R, G, and B. */
6268
6269 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6270
6271 /* The color hash table. */
6272
6273 struct ct_color **ct_table;
6274
6275 /* Number of entries in the color table. */
6276
6277 int ct_colors_allocated;
6278
6279 /* Function prototypes. */
6280
6281 static void init_color_table P_ ((void));
6282 static void free_color_table P_ ((void));
6283 static unsigned long *colors_in_color_table P_ ((int *n));
6284 static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
6285 static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
6286
6287
6288 /* Initialize the color table. */
6289
6290 static void
6291 init_color_table ()
6292 {
6293 int size = CT_SIZE * sizeof (*ct_table);
6294 ct_table = (struct ct_color **) xmalloc (size);
6295 bzero (ct_table, size);
6296 ct_colors_allocated = 0;
6297 }
6298
6299
6300 /* Free memory associated with the color table. */
6301
6302 static void
6303 free_color_table ()
6304 {
6305 int i;
6306 struct ct_color *p, *next;
6307
6308 for (i = 0; i < CT_SIZE; ++i)
6309 for (p = ct_table[i]; p; p = next)
6310 {
6311 next = p->next;
6312 xfree (p);
6313 }
6314
6315 xfree (ct_table);
6316 ct_table = NULL;
6317 }
6318
6319
6320 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6321 entry for that color already is in the color table, return the
6322 pixel color of that entry. Otherwise, allocate a new color for R,
6323 G, B, and make an entry in the color table. */
6324
6325 static unsigned long
6326 lookup_rgb_color (f, r, g, b)
6327 struct frame *f;
6328 int r, g, b;
6329 {
6330 unsigned hash = CT_HASH_RGB (r, g, b);
6331 int i = hash % CT_SIZE;
6332 struct ct_color *p;
6333
6334 for (p = ct_table[i]; p; p = p->next)
6335 if (p->r == r && p->g == g && p->b == b)
6336 break;
6337
6338 if (p == NULL)
6339 {
6340 COLORREF color;
6341 Colormap cmap;
6342 int rc;
6343
6344 color = RGB_TO_ULONG (r, g, b);
6345
6346 ++ct_colors_allocated;
6347
6348 p = (struct ct_color *) xmalloc (sizeof *p);
6349 p->r = r;
6350 p->g = g;
6351 p->b = b;
6352 p->pixel = color;
6353 p->next = ct_table[i];
6354 ct_table[i] = p;
6355 }
6356
6357 return p->pixel;
6358 }
6359
6360
6361 /* Look up pixel color PIXEL which is used on frame F in the color
6362 table. If not already present, allocate it. Value is PIXEL. */
6363
6364 static unsigned long
6365 lookup_pixel_color (f, pixel)
6366 struct frame *f;
6367 unsigned long pixel;
6368 {
6369 int i = pixel % CT_SIZE;
6370 struct ct_color *p;
6371
6372 for (p = ct_table[i]; p; p = p->next)
6373 if (p->pixel == pixel)
6374 break;
6375
6376 if (p == NULL)
6377 {
6378 XColor color;
6379 Colormap cmap;
6380 int rc;
6381
6382 BLOCK_INPUT;
6383
6384 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
6385 color.pixel = pixel;
6386 XQueryColor (NULL, cmap, &color);
6387 rc = x_alloc_nearest_color (f, cmap, &color);
6388 UNBLOCK_INPUT;
6389
6390 if (rc)
6391 {
6392 ++ct_colors_allocated;
6393
6394 p = (struct ct_color *) xmalloc (sizeof *p);
6395 p->r = color.red;
6396 p->g = color.green;
6397 p->b = color.blue;
6398 p->pixel = pixel;
6399 p->next = ct_table[i];
6400 ct_table[i] = p;
6401 }
6402 else
6403 return FRAME_FOREGROUND_PIXEL (f);
6404 }
6405 return p->pixel;
6406 }
6407
6408
6409 /* Value is a vector of all pixel colors contained in the color table,
6410 allocated via xmalloc. Set *N to the number of colors. */
6411
6412 static unsigned long *
6413 colors_in_color_table (n)
6414 int *n;
6415 {
6416 int i, j;
6417 struct ct_color *p;
6418 unsigned long *colors;
6419
6420 if (ct_colors_allocated == 0)
6421 {
6422 *n = 0;
6423 colors = NULL;
6424 }
6425 else
6426 {
6427 colors = (unsigned long *) xmalloc (ct_colors_allocated
6428 * sizeof *colors);
6429 *n = ct_colors_allocated;
6430
6431 for (i = j = 0; i < CT_SIZE; ++i)
6432 for (p = ct_table[i]; p; p = p->next)
6433 colors[j++] = p->pixel;
6434 }
6435
6436 return colors;
6437 }
6438
6439 #endif /* MAC_TODO */
6440
6441 \f
6442 /***********************************************************************
6443 Algorithms
6444 ***********************************************************************/
6445
6446 #if 0 /* MAC_TODO : Mac versions of low level algorithms */
6447 static void x_laplace_write_row P_ ((struct frame *, long *,
6448 int, XImage *, int));
6449 static void x_laplace_read_row P_ ((struct frame *, Colormap,
6450 XColor *, int, XImage *, int));
6451
6452
6453 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
6454 frame we operate on, CMAP is the color-map in effect, and WIDTH is
6455 the width of one row in the image. */
6456
6457 static void
6458 x_laplace_read_row (f, cmap, colors, width, ximg, y)
6459 struct frame *f;
6460 Colormap cmap;
6461 XColor *colors;
6462 int width;
6463 XImage *ximg;
6464 int y;
6465 {
6466 int x;
6467
6468 for (x = 0; x < width; ++x)
6469 colors[x].pixel = XGetPixel (ximg, x, y);
6470
6471 XQueryColors (NULL, cmap, colors, width);
6472 }
6473
6474
6475 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
6476 containing the pixel colors to write. F is the frame we are
6477 working on. */
6478
6479 static void
6480 x_laplace_write_row (f, pixels, width, ximg, y)
6481 struct frame *f;
6482 long *pixels;
6483 int width;
6484 XImage *ximg;
6485 int y;
6486 {
6487 int x;
6488
6489 for (x = 0; x < width; ++x)
6490 XPutPixel (ximg, x, y, pixels[x]);
6491 }
6492 #endif
6493
6494 /* Transform image IMG which is used on frame F with a Laplace
6495 edge-detection algorithm. The result is an image that can be used
6496 to draw disabled buttons, for example. */
6497
6498 static void
6499 x_laplace (f, img)
6500 struct frame *f;
6501 struct image *img;
6502 {
6503 #if 0 /* MAC_TODO : Mac version */
6504 Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
6505 XImage *ximg, *oimg;
6506 XColor *in[3];
6507 long *out;
6508 Pixmap pixmap;
6509 int x, y, i;
6510 long pixel;
6511 int in_y, out_y, rc;
6512 int mv2 = 45000;
6513
6514 BLOCK_INPUT;
6515
6516 /* Get the X image IMG->pixmap. */
6517 ximg = XGetImage (NULL, img->pixmap,
6518 0, 0, img->width, img->height, ~0, ZPixmap);
6519
6520 /* Allocate 3 input rows, and one output row of colors. */
6521 for (i = 0; i < 3; ++i)
6522 in[i] = (XColor *) alloca (img->width * sizeof (XColor));
6523 out = (long *) alloca (img->width * sizeof (long));
6524
6525 /* Create an X image for output. */
6526 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 0,
6527 &oimg, &pixmap);
6528
6529 /* Fill first two rows. */
6530 x_laplace_read_row (f, cmap, in[0], img->width, ximg, 0);
6531 x_laplace_read_row (f, cmap, in[1], img->width, ximg, 1);
6532 in_y = 2;
6533
6534 /* Write first row, all zeros. */
6535 init_color_table ();
6536 pixel = lookup_rgb_color (f, 0, 0, 0);
6537 for (x = 0; x < img->width; ++x)
6538 out[x] = pixel;
6539 x_laplace_write_row (f, out, img->width, oimg, 0);
6540 out_y = 1;
6541
6542 for (y = 2; y < img->height; ++y)
6543 {
6544 int rowa = y % 3;
6545 int rowb = (y + 2) % 3;
6546
6547 x_laplace_read_row (f, cmap, in[rowa], img->width, ximg, in_y++);
6548
6549 for (x = 0; x < img->width - 2; ++x)
6550 {
6551 int r = in[rowa][x].red + mv2 - in[rowb][x + 2].red;
6552 int g = in[rowa][x].green + mv2 - in[rowb][x + 2].green;
6553 int b = in[rowa][x].blue + mv2 - in[rowb][x + 2].blue;
6554
6555 out[x + 1] = lookup_rgb_color (f, r & 0xffff, g & 0xffff,
6556 b & 0xffff);
6557 }
6558
6559 x_laplace_write_row (f, out, img->width, oimg, out_y++);
6560 }
6561
6562 /* Write last line, all zeros. */
6563 for (x = 0; x < img->width; ++x)
6564 out[x] = pixel;
6565 x_laplace_write_row (f, out, img->width, oimg, out_y);
6566
6567 /* Free the input image, and free resources of IMG. */
6568 XDestroyImage (ximg);
6569 x_clear_image (f, img);
6570
6571 /* Put the output image into pixmap, and destroy it. */
6572 x_put_x_image (f, oimg, pixmap, img->width, img->height);
6573 x_destroy_x_image (oimg);
6574
6575 /* Remember new pixmap and colors in IMG. */
6576 img->pixmap = pixmap;
6577 img->colors = colors_in_color_table (&img->ncolors);
6578 free_color_table ();
6579
6580 UNBLOCK_INPUT;
6581 #endif /* MAC_TODO */
6582 }
6583
6584
6585 /* Build a mask for image IMG which is used on frame F. FILE is the
6586 name of an image file, for error messages. HOW determines how to
6587 determine the background color of IMG. If it is a list '(R G B)',
6588 with R, G, and B being integers >= 0, take that as the color of the
6589 background. Otherwise, determine the background color of IMG
6590 heuristically. Value is non-zero if successful. */
6591
6592 static int
6593 x_build_heuristic_mask (f, img, how)
6594 struct frame *f;
6595 struct image *img;
6596 Lisp_Object how;
6597 {
6598 #if 0 /* MAC_TODO : Mac version */
6599 Display *dpy = FRAME_W32_DISPLAY (f);
6600 XImage *ximg, *mask_img;
6601 int x, y, rc, look_at_corners_p;
6602 unsigned long bg;
6603
6604 BLOCK_INPUT;
6605
6606 /* Create an image and pixmap serving as mask. */
6607 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
6608 &mask_img, &img->mask);
6609 if (!rc)
6610 {
6611 UNBLOCK_INPUT;
6612 return 0;
6613 }
6614
6615 /* Get the X image of IMG->pixmap. */
6616 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
6617 ~0, ZPixmap);
6618
6619 /* Determine the background color of ximg. If HOW is `(R G B)'
6620 take that as color. Otherwise, try to determine the color
6621 heuristically. */
6622 look_at_corners_p = 1;
6623
6624 if (CONSP (how))
6625 {
6626 int rgb[3], i = 0;
6627
6628 while (i < 3
6629 && CONSP (how)
6630 && NATNUMP (XCAR (how)))
6631 {
6632 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
6633 how = XCDR (how);
6634 }
6635
6636 if (i == 3 && NILP (how))
6637 {
6638 char color_name[30];
6639 XColor exact, color;
6640 Colormap cmap;
6641
6642 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
6643
6644 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
6645 if (XLookupColor (dpy, cmap, color_name, &exact, &color))
6646 {
6647 bg = color.pixel;
6648 look_at_corners_p = 0;
6649 }
6650 }
6651 }
6652
6653 if (look_at_corners_p)
6654 {
6655 unsigned long corners[4];
6656 int i, best_count;
6657
6658 /* Get the colors at the corners of ximg. */
6659 corners[0] = XGetPixel (ximg, 0, 0);
6660 corners[1] = XGetPixel (ximg, img->width - 1, 0);
6661 corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
6662 corners[3] = XGetPixel (ximg, 0, img->height - 1);
6663
6664 /* Choose the most frequently found color as background. */
6665 for (i = best_count = 0; i < 4; ++i)
6666 {
6667 int j, n;
6668
6669 for (j = n = 0; j < 4; ++j)
6670 if (corners[i] == corners[j])
6671 ++n;
6672
6673 if (n > best_count)
6674 bg = corners[i], best_count = n;
6675 }
6676 }
6677
6678 /* Set all bits in mask_img to 1 whose color in ximg is different
6679 from the background color bg. */
6680 for (y = 0; y < img->height; ++y)
6681 for (x = 0; x < img->width; ++x)
6682 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
6683
6684 /* Put mask_img into img->mask. */
6685 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
6686 x_destroy_x_image (mask_img);
6687 XDestroyImage (ximg);
6688
6689 UNBLOCK_INPUT;
6690 #endif /* MAC_TODO */
6691
6692 return 1;
6693 }
6694
6695
6696 \f
6697 /***********************************************************************
6698 PBM (mono, gray, color)
6699 ***********************************************************************/
6700 #ifdef HAVE_PBM
6701
6702 static int pbm_image_p P_ ((Lisp_Object object));
6703 static int pbm_load P_ ((struct frame *f, struct image *img));
6704 static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
6705
6706 /* The symbol `pbm' identifying images of this type. */
6707
6708 Lisp_Object Qpbm;
6709
6710 /* Indices of image specification fields in gs_format, below. */
6711
6712 enum pbm_keyword_index
6713 {
6714 PBM_TYPE,
6715 PBM_FILE,
6716 PBM_DATA,
6717 PBM_ASCENT,
6718 PBM_MARGIN,
6719 PBM_RELIEF,
6720 PBM_ALGORITHM,
6721 PBM_HEURISTIC_MASK,
6722 PBM_LAST
6723 };
6724
6725 /* Vector of image_keyword structures describing the format
6726 of valid user-defined image specifications. */
6727
6728 static struct image_keyword pbm_format[PBM_LAST] =
6729 {
6730 {":type", IMAGE_SYMBOL_VALUE, 1},
6731 {":file", IMAGE_STRING_VALUE, 0},
6732 {":data", IMAGE_STRING_VALUE, 0},
6733 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
6734 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6735 {":relief", IMAGE_INTEGER_VALUE, 0},
6736 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6737 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
6738 };
6739
6740 /* Structure describing the image type `pbm'. */
6741
6742 static struct image_type pbm_type =
6743 {
6744 &Qpbm,
6745 pbm_image_p,
6746 pbm_load,
6747 x_clear_image,
6748 NULL
6749 };
6750
6751
6752 /* Return non-zero if OBJECT is a valid PBM image specification. */
6753
6754 static int
6755 pbm_image_p (object)
6756 Lisp_Object object;
6757 {
6758 struct image_keyword fmt[PBM_LAST];
6759
6760 bcopy (pbm_format, fmt, sizeof fmt);
6761
6762 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm)
6763 || (fmt[PBM_ASCENT].count
6764 && XFASTINT (fmt[PBM_ASCENT].value) > 100))
6765 return 0;
6766
6767 /* Must specify either :data or :file. */
6768 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
6769 }
6770
6771
6772 /* Scan a decimal number from *S and return it. Advance *S while
6773 reading the number. END is the end of the string. Value is -1 at
6774 end of input. */
6775
6776 static int
6777 pbm_scan_number (s, end)
6778 unsigned char **s, *end;
6779 {
6780 int c, val = -1;
6781
6782 while (*s < end)
6783 {
6784 /* Skip white-space. */
6785 while (*s < end && (c = *(*s)++, isspace (c)))
6786 ;
6787
6788 if (c == '#')
6789 {
6790 /* Skip comment to end of line. */
6791 while (*s < end && (c = *(*s)++, c != '\n'))
6792 ;
6793 }
6794 else if (isdigit (c))
6795 {
6796 /* Read decimal number. */
6797 val = c - '0';
6798 while (*s < end && (c = *(*s)++, isdigit (c)))
6799 val = 10 * val + c - '0';
6800 break;
6801 }
6802 else
6803 break;
6804 }
6805
6806 return val;
6807 }
6808
6809
6810 /* Read FILE into memory. Value is a pointer to a buffer allocated
6811 with xmalloc holding FILE's contents. Value is null if an error
6812 occured. *SIZE is set to the size of the file. */
6813
6814 static char *
6815 pbm_read_file (file, size)
6816 Lisp_Object file;
6817 int *size;
6818 {
6819 FILE *fp = NULL;
6820 char *buf = NULL;
6821 struct stat st;
6822
6823 if (stat (XSTRING (file)->data, &st) == 0
6824 && (fp = fopen (XSTRING (file)->data, "r")) != NULL
6825 && (buf = (char *) xmalloc (st.st_size),
6826 fread (buf, 1, st.st_size, fp) == st.st_size))
6827 {
6828 *size = st.st_size;
6829 fclose (fp);
6830 }
6831 else
6832 {
6833 if (fp)
6834 fclose (fp);
6835 if (buf)
6836 {
6837 xfree (buf);
6838 buf = NULL;
6839 }
6840 }
6841
6842 return buf;
6843 }
6844
6845
6846 /* Load PBM image IMG for use on frame F. */
6847
6848 static int
6849 pbm_load (f, img)
6850 struct frame *f;
6851 struct image *img;
6852 {
6853 int raw_p, x, y;
6854 int width, height, max_color_idx = 0;
6855 XImage *ximg;
6856 Lisp_Object file, specified_file;
6857 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
6858 struct gcpro gcpro1;
6859 unsigned char *contents = NULL;
6860 unsigned char *end, *p;
6861 int size;
6862
6863 specified_file = image_spec_value (img->spec, QCfile, NULL);
6864 file = Qnil;
6865 GCPRO1 (file);
6866
6867 if (STRINGP (specified_file))
6868 {
6869 file = x_find_image_file (specified_file);
6870 if (!STRINGP (file))
6871 {
6872 image_error ("Cannot find image file `%s'", specified_file, Qnil);
6873 UNGCPRO;
6874 return 0;
6875 }
6876
6877 contents = pbm_read_file (file, &size);
6878 if (contents == NULL)
6879 {
6880 image_error ("Error reading `%s'", file, Qnil);
6881 UNGCPRO;
6882 return 0;
6883 }
6884
6885 p = contents;
6886 end = contents + size;
6887 }
6888 else
6889 {
6890 Lisp_Object data;
6891 data = image_spec_value (img->spec, QCdata, NULL);
6892 p = XSTRING (data)->data;
6893 end = p + STRING_BYTES (XSTRING (data));
6894 }
6895
6896 /* Check magic number. */
6897 if (end - p < 2 || *p++ != 'P')
6898 {
6899 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
6900 error:
6901 xfree (contents);
6902 UNGCPRO;
6903 return 0;
6904 }
6905
6906 switch (*p++)
6907 {
6908 case '1':
6909 raw_p = 0, type = PBM_MONO;
6910 break;
6911
6912 case '2':
6913 raw_p = 0, type = PBM_GRAY;
6914 break;
6915
6916 case '3':
6917 raw_p = 0, type = PBM_COLOR;
6918 break;
6919
6920 case '4':
6921 raw_p = 1, type = PBM_MONO;
6922 break;
6923
6924 case '5':
6925 raw_p = 1, type = PBM_GRAY;
6926 break;
6927
6928 case '6':
6929 raw_p = 1, type = PBM_COLOR;
6930 break;
6931
6932 default:
6933 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
6934 goto error;
6935 }
6936
6937 /* Read width, height, maximum color-component. Characters
6938 starting with `#' up to the end of a line are ignored. */
6939 width = pbm_scan_number (&p, end);
6940 height = pbm_scan_number (&p, end);
6941
6942 if (type != PBM_MONO)
6943 {
6944 max_color_idx = pbm_scan_number (&p, end);
6945 if (raw_p && max_color_idx > 255)
6946 max_color_idx = 255;
6947 }
6948
6949 if (width < 0
6950 || height < 0
6951 || (type != PBM_MONO && max_color_idx < 0))
6952 goto error;
6953
6954 BLOCK_INPUT;
6955 if (!x_create_x_image_and_pixmap (f, width, height, 0,
6956 &ximg, &img->pixmap))
6957 {
6958 UNBLOCK_INPUT;
6959 goto error;
6960 }
6961
6962 /* Initialize the color hash table. */
6963 init_color_table ();
6964
6965 if (type == PBM_MONO)
6966 {
6967 int c = 0, g;
6968
6969 for (y = 0; y < height; ++y)
6970 for (x = 0; x < width; ++x)
6971 {
6972 if (raw_p)
6973 {
6974 if ((x & 7) == 0)
6975 c = *p++;
6976 g = c & 0x80;
6977 c <<= 1;
6978 }
6979 else
6980 g = pbm_scan_number (&p, end);
6981
6982 XPutPixel (ximg, x, y, (g
6983 ? FRAME_FOREGROUND_PIXEL (f)
6984 : FRAME_BACKGROUND_PIXEL (f)));
6985 }
6986 }
6987 else
6988 {
6989 for (y = 0; y < height; ++y)
6990 for (x = 0; x < width; ++x)
6991 {
6992 int r, g, b;
6993
6994 if (type == PBM_GRAY)
6995 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
6996 else if (raw_p)
6997 {
6998 r = *p++;
6999 g = *p++;
7000 b = *p++;
7001 }
7002 else
7003 {
7004 r = pbm_scan_number (&p, end);
7005 g = pbm_scan_number (&p, end);
7006 b = pbm_scan_number (&p, end);
7007 }
7008
7009 if (r < 0 || g < 0 || b < 0)
7010 {
7011 xfree (ximg->data);
7012 ximg->data = NULL;
7013 XDestroyImage (ximg);
7014 UNBLOCK_INPUT;
7015 image_error ("Invalid pixel value in image `%s'",
7016 img->spec, Qnil);
7017 goto error;
7018 }
7019
7020 /* RGB values are now in the range 0..max_color_idx.
7021 Scale this to the range 0..0xffff supported by X. */
7022 r = (double) r * 65535 / max_color_idx;
7023 g = (double) g * 65535 / max_color_idx;
7024 b = (double) b * 65535 / max_color_idx;
7025 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
7026 }
7027 }
7028
7029 /* Store in IMG->colors the colors allocated for the image, and
7030 free the color table. */
7031 img->colors = colors_in_color_table (&img->ncolors);
7032 free_color_table ();
7033
7034 /* Put the image into a pixmap. */
7035 x_put_x_image (f, ximg, img->pixmap, width, height);
7036 x_destroy_x_image (ximg);
7037 UNBLOCK_INPUT;
7038
7039 img->width = width;
7040 img->height = height;
7041
7042 UNGCPRO;
7043 xfree (contents);
7044 return 1;
7045 }
7046 #endif /* HAVE_PBM */
7047
7048 \f
7049 /***********************************************************************
7050 PNG
7051 ***********************************************************************/
7052
7053 #if HAVE_PNG
7054
7055 #include <png.h>
7056
7057 /* Function prototypes. */
7058
7059 static int png_image_p P_ ((Lisp_Object object));
7060 static int png_load P_ ((struct frame *f, struct image *img));
7061
7062 /* The symbol `png' identifying images of this type. */
7063
7064 Lisp_Object Qpng;
7065
7066 /* Indices of image specification fields in png_format, below. */
7067
7068 enum png_keyword_index
7069 {
7070 PNG_TYPE,
7071 PNG_DATA,
7072 PNG_FILE,
7073 PNG_ASCENT,
7074 PNG_MARGIN,
7075 PNG_RELIEF,
7076 PNG_ALGORITHM,
7077 PNG_HEURISTIC_MASK,
7078 PNG_LAST
7079 };
7080
7081 /* Vector of image_keyword structures describing the format
7082 of valid user-defined image specifications. */
7083
7084 static struct image_keyword png_format[PNG_LAST] =
7085 {
7086 {":type", IMAGE_SYMBOL_VALUE, 1},
7087 {":data", IMAGE_STRING_VALUE, 0},
7088 {":file", IMAGE_STRING_VALUE, 0},
7089 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
7090 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7091 {":relief", IMAGE_INTEGER_VALUE, 0},
7092 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7093 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7094 };
7095
7096 /* Structure describing the image type `png'. */
7097
7098 static struct image_type png_type =
7099 {
7100 &Qpng,
7101 png_image_p,
7102 png_load,
7103 x_clear_image,
7104 NULL
7105 };
7106
7107
7108 /* Return non-zero if OBJECT is a valid PNG image specification. */
7109
7110 static int
7111 png_image_p (object)
7112 Lisp_Object object;
7113 {
7114 struct image_keyword fmt[PNG_LAST];
7115 bcopy (png_format, fmt, sizeof fmt);
7116
7117 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng)
7118 || (fmt[PNG_ASCENT].count
7119 && XFASTINT (fmt[PNG_ASCENT].value) > 100))
7120 return 0;
7121
7122 /* Must specify either the :data or :file keyword. */
7123 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
7124 }
7125
7126
7127 /* Error and warning handlers installed when the PNG library
7128 is initialized. */
7129
7130 static void
7131 my_png_error (png_ptr, msg)
7132 png_struct *png_ptr;
7133 char *msg;
7134 {
7135 xassert (png_ptr != NULL);
7136 image_error ("PNG error: %s", build_string (msg), Qnil);
7137 longjmp (png_ptr->jmpbuf, 1);
7138 }
7139
7140
7141 static void
7142 my_png_warning (png_ptr, msg)
7143 png_struct *png_ptr;
7144 char *msg;
7145 {
7146 xassert (png_ptr != NULL);
7147 image_error ("PNG warning: %s", build_string (msg), Qnil);
7148 }
7149
7150 /* Memory source for PNG decoding. */
7151
7152 struct png_memory_storage
7153 {
7154 unsigned char *bytes; /* The data */
7155 size_t len; /* How big is it? */
7156 int index; /* Where are we? */
7157 };
7158
7159
7160 /* Function set as reader function when reading PNG image from memory.
7161 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7162 bytes from the input to DATA. */
7163
7164 static void
7165 png_read_from_memory (png_ptr, data, length)
7166 png_structp png_ptr;
7167 png_bytep data;
7168 png_size_t length;
7169 {
7170 struct png_memory_storage *tbr
7171 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
7172
7173 if (length > tbr->len - tbr->index)
7174 png_error (png_ptr, "Read error");
7175
7176 bcopy (tbr->bytes + tbr->index, data, length);
7177 tbr->index = tbr->index + length;
7178 }
7179
7180 /* Load PNG image IMG for use on frame F. Value is non-zero if
7181 successful. */
7182
7183 static int
7184 png_load (f, img)
7185 struct frame *f;
7186 struct image *img;
7187 {
7188 Lisp_Object file, specified_file;
7189 Lisp_Object specified_data;
7190 int x, y, i;
7191 XImage *ximg, *mask_img = NULL;
7192 struct gcpro gcpro1;
7193 png_struct *png_ptr = NULL;
7194 png_info *info_ptr = NULL, *end_info = NULL;
7195 FILE *fp = NULL;
7196 png_byte sig[8];
7197 png_byte *pixels = NULL;
7198 png_byte **rows = NULL;
7199 png_uint_32 width, height;
7200 int bit_depth, color_type, interlace_type;
7201 png_byte channels;
7202 png_uint_32 row_bytes;
7203 int transparent_p;
7204 char *gamma_str;
7205 double screen_gamma, image_gamma;
7206 int intent;
7207 struct png_memory_storage tbr; /* Data to be read */
7208
7209 /* Find out what file to load. */
7210 specified_file = image_spec_value (img->spec, QCfile, NULL);
7211 specified_data = image_spec_value (img->spec, QCdata, NULL);
7212 file = Qnil;
7213 GCPRO1 (file);
7214
7215 if (NILP (specified_data))
7216 {
7217 file = x_find_image_file (specified_file);
7218 if (!STRINGP (file))
7219 {
7220 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7221 UNGCPRO;
7222 return 0;
7223 }
7224
7225 /* Open the image file. */
7226 fp = fopen (XSTRING (file)->data, "rb");
7227 if (!fp)
7228 {
7229 image_error ("Cannot open image file `%s'", file, Qnil);
7230 UNGCPRO;
7231 fclose (fp);
7232 return 0;
7233 }
7234
7235 /* Check PNG signature. */
7236 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
7237 || !png_check_sig (sig, sizeof sig))
7238 {
7239 image_error ("Not a PNG file:` %s'", file, Qnil);
7240 UNGCPRO;
7241 fclose (fp);
7242 return 0;
7243 }
7244 }
7245 else
7246 {
7247 /* Read from memory. */
7248 tbr.bytes = XSTRING (specified_data)->data;
7249 tbr.len = STRING_BYTES (XSTRING (specified_data));
7250 tbr.index = 0;
7251
7252 /* Check PNG signature. */
7253 if (tbr.len < sizeof sig
7254 || !png_check_sig (tbr.bytes, sizeof sig))
7255 {
7256 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
7257 UNGCPRO;
7258 return 0;
7259 }
7260
7261 /* Need to skip past the signature. */
7262 tbr.bytes += sizeof (sig);
7263 }
7264
7265 /* Initialize read and info structs for PNG lib. */
7266 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
7267 my_png_error, my_png_warning);
7268 if (!png_ptr)
7269 {
7270 if (fp) fclose (fp);
7271 UNGCPRO;
7272 return 0;
7273 }
7274
7275 info_ptr = png_create_info_struct (png_ptr);
7276 if (!info_ptr)
7277 {
7278 png_destroy_read_struct (&png_ptr, NULL, NULL);
7279 if (fp) fclose (fp);
7280 UNGCPRO;
7281 return 0;
7282 }
7283
7284 end_info = png_create_info_struct (png_ptr);
7285 if (!end_info)
7286 {
7287 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
7288 if (fp) fclose (fp);
7289 UNGCPRO;
7290 return 0;
7291 }
7292
7293 /* Set error jump-back. We come back here when the PNG library
7294 detects an error. */
7295 if (setjmp (png_ptr->jmpbuf))
7296 {
7297 error:
7298 if (png_ptr)
7299 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
7300 xfree (pixels);
7301 xfree (rows);
7302 if (fp) fclose (fp);
7303 UNGCPRO;
7304 return 0;
7305 }
7306
7307 /* Read image info. */
7308 if (!NILP (specified_data))
7309 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
7310 else
7311 png_init_io (png_ptr, fp);
7312
7313 png_set_sig_bytes (png_ptr, sizeof sig);
7314 png_read_info (png_ptr, info_ptr);
7315 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
7316 &interlace_type, NULL, NULL);
7317
7318 /* If image contains simply transparency data, we prefer to
7319 construct a clipping mask. */
7320 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
7321 transparent_p = 1;
7322 else
7323 transparent_p = 0;
7324
7325 /* This function is easier to write if we only have to handle
7326 one data format: RGB or RGBA with 8 bits per channel. Let's
7327 transform other formats into that format. */
7328
7329 /* Strip more than 8 bits per channel. */
7330 if (bit_depth == 16)
7331 png_set_strip_16 (png_ptr);
7332
7333 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
7334 if available. */
7335 png_set_expand (png_ptr);
7336
7337 /* Convert grayscale images to RGB. */
7338 if (color_type == PNG_COLOR_TYPE_GRAY
7339 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
7340 png_set_gray_to_rgb (png_ptr);
7341
7342 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
7343 gamma_str = getenv ("SCREEN_GAMMA");
7344 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
7345
7346 /* Tell the PNG lib to handle gamma correction for us. */
7347
7348 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
7349 if (png_get_sRGB (png_ptr, info_ptr, &intent))
7350 /* There is a special chunk in the image specifying the gamma. */
7351 png_set_sRGB (png_ptr, info_ptr, intent);
7352 else
7353 #endif
7354 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
7355 /* Image contains gamma information. */
7356 png_set_gamma (png_ptr, screen_gamma, image_gamma);
7357 else
7358 /* Use a default of 0.5 for the image gamma. */
7359 png_set_gamma (png_ptr, screen_gamma, 0.5);
7360
7361 /* Handle alpha channel by combining the image with a background
7362 color. Do this only if a real alpha channel is supplied. For
7363 simple transparency, we prefer a clipping mask. */
7364 if (!transparent_p)
7365 {
7366 png_color_16 *image_background;
7367
7368 if (png_get_bKGD (png_ptr, info_ptr, &image_background))
7369 /* Image contains a background color with which to
7370 combine the image. */
7371 png_set_background (png_ptr, image_background,
7372 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
7373 else
7374 {
7375 /* Image does not contain a background color with which
7376 to combine the image data via an alpha channel. Use
7377 the frame's background instead. */
7378 XColor color;
7379 Colormap cmap;
7380 png_color_16 frame_background;
7381
7382 BLOCK_INPUT;
7383 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
7384 color.pixel = FRAME_BACKGROUND_PIXEL (f);
7385 XQueryColor (FRAME_W32_DISPLAY (f), cmap, &color);
7386 UNBLOCK_INPUT;
7387
7388 bzero (&frame_background, sizeof frame_background);
7389 frame_background.red = color.red;
7390 frame_background.green = color.green;
7391 frame_background.blue = color.blue;
7392
7393 png_set_background (png_ptr, &frame_background,
7394 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
7395 }
7396 }
7397
7398 /* Update info structure. */
7399 png_read_update_info (png_ptr, info_ptr);
7400
7401 /* Get number of channels. Valid values are 1 for grayscale images
7402 and images with a palette, 2 for grayscale images with transparency
7403 information (alpha channel), 3 for RGB images, and 4 for RGB
7404 images with alpha channel, i.e. RGBA. If conversions above were
7405 sufficient we should only have 3 or 4 channels here. */
7406 channels = png_get_channels (png_ptr, info_ptr);
7407 xassert (channels == 3 || channels == 4);
7408
7409 /* Number of bytes needed for one row of the image. */
7410 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
7411
7412 /* Allocate memory for the image. */
7413 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
7414 rows = (png_byte **) xmalloc (height * sizeof *rows);
7415 for (i = 0; i < height; ++i)
7416 rows[i] = pixels + i * row_bytes;
7417
7418 /* Read the entire image. */
7419 png_read_image (png_ptr, rows);
7420 png_read_end (png_ptr, info_ptr);
7421 if (fp)
7422 {
7423 fclose (fp);
7424 fp = NULL;
7425 }
7426
7427 BLOCK_INPUT;
7428
7429 /* Create the X image and pixmap. */
7430 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
7431 &img->pixmap))
7432 {
7433 UNBLOCK_INPUT;
7434 goto error;
7435 }
7436
7437 /* Create an image and pixmap serving as mask if the PNG image
7438 contains an alpha channel. */
7439 if (channels == 4
7440 && !transparent_p
7441 && !x_create_x_image_and_pixmap (f, width, height, 1,
7442 &mask_img, &img->mask))
7443 {
7444 x_destroy_x_image (ximg);
7445 XFreePixmap (FRAME_W32_DISPLAY (f), img->pixmap);
7446 img->pixmap = 0;
7447 UNBLOCK_INPUT;
7448 goto error;
7449 }
7450
7451 /* Fill the X image and mask from PNG data. */
7452 init_color_table ();
7453
7454 for (y = 0; y < height; ++y)
7455 {
7456 png_byte *p = rows[y];
7457
7458 for (x = 0; x < width; ++x)
7459 {
7460 unsigned r, g, b;
7461
7462 r = *p++ << 8;
7463 g = *p++ << 8;
7464 b = *p++ << 8;
7465 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
7466
7467 /* An alpha channel, aka mask channel, associates variable
7468 transparency with an image. Where other image formats
7469 support binary transparency---fully transparent or fully
7470 opaque---PNG allows up to 254 levels of partial transparency.
7471 The PNG library implements partial transparency by combining
7472 the image with a specified background color.
7473
7474 I'm not sure how to handle this here nicely: because the
7475 background on which the image is displayed may change, for
7476 real alpha channel support, it would be necessary to create
7477 a new image for each possible background.
7478
7479 What I'm doing now is that a mask is created if we have
7480 boolean transparency information. Otherwise I'm using
7481 the frame's background color to combine the image with. */
7482
7483 if (channels == 4)
7484 {
7485 if (mask_img)
7486 XPutPixel (mask_img, x, y, *p > 0);
7487 ++p;
7488 }
7489 }
7490 }
7491
7492 /* Remember colors allocated for this image. */
7493 img->colors = colors_in_color_table (&img->ncolors);
7494 free_color_table ();
7495
7496 /* Clean up. */
7497 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
7498 xfree (rows);
7499 xfree (pixels);
7500
7501 img->width = width;
7502 img->height = height;
7503
7504 /* Put the image into the pixmap, then free the X image and its buffer. */
7505 x_put_x_image (f, ximg, img->pixmap, width, height);
7506 x_destroy_x_image (ximg);
7507
7508 /* Same for the mask. */
7509 if (mask_img)
7510 {
7511 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
7512 x_destroy_x_image (mask_img);
7513 }
7514
7515 UNBLOCK_INPUT;
7516 UNGCPRO;
7517 return 1;
7518 }
7519
7520 #endif /* HAVE_PNG != 0 */
7521
7522
7523 \f
7524 /***********************************************************************
7525 JPEG
7526 ***********************************************************************/
7527
7528 #if HAVE_JPEG
7529
7530 /* Work around a warning about HAVE_STDLIB_H being redefined in
7531 jconfig.h. */
7532 #ifdef HAVE_STDLIB_H
7533 #define HAVE_STDLIB_H_1
7534 #undef HAVE_STDLIB_H
7535 #endif /* HAVE_STLIB_H */
7536
7537 #include <jpeglib.h>
7538 #include <jerror.h>
7539 #include <setjmp.h>
7540
7541 #ifdef HAVE_STLIB_H_1
7542 #define HAVE_STDLIB_H 1
7543 #endif
7544
7545 static int jpeg_image_p P_ ((Lisp_Object object));
7546 static int jpeg_load P_ ((struct frame *f, struct image *img));
7547
7548 /* The symbol `jpeg' identifying images of this type. */
7549
7550 Lisp_Object Qjpeg;
7551
7552 /* Indices of image specification fields in gs_format, below. */
7553
7554 enum jpeg_keyword_index
7555 {
7556 JPEG_TYPE,
7557 JPEG_DATA,
7558 JPEG_FILE,
7559 JPEG_ASCENT,
7560 JPEG_MARGIN,
7561 JPEG_RELIEF,
7562 JPEG_ALGORITHM,
7563 JPEG_HEURISTIC_MASK,
7564 JPEG_LAST
7565 };
7566
7567 /* Vector of image_keyword structures describing the format
7568 of valid user-defined image specifications. */
7569
7570 static struct image_keyword jpeg_format[JPEG_LAST] =
7571 {
7572 {":type", IMAGE_SYMBOL_VALUE, 1},
7573 {":data", IMAGE_STRING_VALUE, 0},
7574 {":file", IMAGE_STRING_VALUE, 0},
7575 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
7576 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7577 {":relief", IMAGE_INTEGER_VALUE, 0},
7578 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7579 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7580 };
7581
7582 /* Structure describing the image type `jpeg'. */
7583
7584 static struct image_type jpeg_type =
7585 {
7586 &Qjpeg,
7587 jpeg_image_p,
7588 jpeg_load,
7589 x_clear_image,
7590 NULL
7591 };
7592
7593
7594 /* Return non-zero if OBJECT is a valid JPEG image specification. */
7595
7596 static int
7597 jpeg_image_p (object)
7598 Lisp_Object object;
7599 {
7600 struct image_keyword fmt[JPEG_LAST];
7601
7602 bcopy (jpeg_format, fmt, sizeof fmt);
7603
7604 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg)
7605 || (fmt[JPEG_ASCENT].count
7606 && XFASTINT (fmt[JPEG_ASCENT].value) > 100))
7607 return 0;
7608
7609 /* Must specify either the :data or :file keyword. */
7610 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
7611 }
7612
7613
7614 struct my_jpeg_error_mgr
7615 {
7616 struct jpeg_error_mgr pub;
7617 jmp_buf setjmp_buffer;
7618 };
7619
7620 static void
7621 my_error_exit (cinfo)
7622 j_common_ptr cinfo;
7623 {
7624 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
7625 longjmp (mgr->setjmp_buffer, 1);
7626 }
7627
7628 /* Init source method for JPEG data source manager. Called by
7629 jpeg_read_header() before any data is actually read. See
7630 libjpeg.doc from the JPEG lib distribution. */
7631
7632 static void
7633 our_init_source (cinfo)
7634 j_decompress_ptr cinfo;
7635 {
7636 }
7637
7638
7639 /* Fill input buffer method for JPEG data source manager. Called
7640 whenever more data is needed. We read the whole image in one step,
7641 so this only adds a fake end of input marker at the end. */
7642
7643 static boolean
7644 our_fill_input_buffer (cinfo)
7645 j_decompress_ptr cinfo;
7646 {
7647 /* Insert a fake EOI marker. */
7648 struct jpeg_source_mgr *src = cinfo->src;
7649 static JOCTET buffer[2];
7650
7651 buffer[0] = (JOCTET) 0xFF;
7652 buffer[1] = (JOCTET) JPEG_EOI;
7653
7654 src->next_input_byte = buffer;
7655 src->bytes_in_buffer = 2;
7656 return TRUE;
7657 }
7658
7659
7660 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
7661 is the JPEG data source manager. */
7662
7663 static void
7664 our_skip_input_data (cinfo, num_bytes)
7665 j_decompress_ptr cinfo;
7666 long num_bytes;
7667 {
7668 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
7669
7670 if (src)
7671 {
7672 if (num_bytes > src->bytes_in_buffer)
7673 ERREXIT (cinfo, JERR_INPUT_EOF);
7674
7675 src->bytes_in_buffer -= num_bytes;
7676 src->next_input_byte += num_bytes;
7677 }
7678 }
7679
7680
7681 /* Method to terminate data source. Called by
7682 jpeg_finish_decompress() after all data has been processed. */
7683
7684 static void
7685 our_term_source (cinfo)
7686 j_decompress_ptr cinfo;
7687 {
7688 }
7689
7690
7691 /* Set up the JPEG lib for reading an image from DATA which contains
7692 LEN bytes. CINFO is the decompression info structure created for
7693 reading the image. */
7694
7695 static void
7696 jpeg_memory_src (cinfo, data, len)
7697 j_decompress_ptr cinfo;
7698 JOCTET *data;
7699 unsigned int len;
7700 {
7701 struct jpeg_source_mgr *src;
7702
7703 if (cinfo->src == NULL)
7704 {
7705 /* First time for this JPEG object? */
7706 cinfo->src = (struct jpeg_source_mgr *)
7707 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
7708 sizeof (struct jpeg_source_mgr));
7709 src = (struct jpeg_source_mgr *) cinfo->src;
7710 src->next_input_byte = data;
7711 }
7712
7713 src = (struct jpeg_source_mgr *) cinfo->src;
7714 src->init_source = our_init_source;
7715 src->fill_input_buffer = our_fill_input_buffer;
7716 src->skip_input_data = our_skip_input_data;
7717 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
7718 src->term_source = our_term_source;
7719 src->bytes_in_buffer = len;
7720 src->next_input_byte = data;
7721 }
7722
7723
7724 /* Load image IMG for use on frame F. Patterned after example.c
7725 from the JPEG lib. */
7726
7727 static int
7728 jpeg_load (f, img)
7729 struct frame *f;
7730 struct image *img;
7731 {
7732 struct jpeg_decompress_struct cinfo;
7733 struct my_jpeg_error_mgr mgr;
7734 Lisp_Object file, specified_file;
7735 Lisp_Object specified_data;
7736 FILE *fp = NULL;
7737 JSAMPARRAY buffer;
7738 int row_stride, x, y;
7739 XImage *ximg = NULL;
7740 int rc;
7741 unsigned long *colors;
7742 int width, height;
7743 struct gcpro gcpro1;
7744
7745 /* Open the JPEG file. */
7746 specified_file = image_spec_value (img->spec, QCfile, NULL);
7747 specified_data = image_spec_value (img->spec, QCdata, NULL);
7748 file = Qnil;
7749 GCPRO1 (file);
7750
7751 if (NILP (specified_data))
7752 {
7753 file = x_find_image_file (specified_file);
7754 if (!STRINGP (file))
7755 {
7756 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7757 UNGCPRO;
7758 return 0;
7759 }
7760
7761 fp = fopen (XSTRING (file)->data, "r");
7762 if (fp == NULL)
7763 {
7764 image_error ("Cannot open `%s'", file, Qnil);
7765 UNGCPRO;
7766 return 0;
7767 }
7768 }
7769
7770 /* Customize libjpeg's error handling to call my_error_exit when an
7771 error is detected. This function will perform a longjmp. */
7772 mgr.pub.error_exit = my_error_exit;
7773 cinfo.err = jpeg_std_error (&mgr.pub);
7774
7775 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
7776 {
7777 if (rc == 1)
7778 {
7779 /* Called from my_error_exit. Display a JPEG error. */
7780 char buffer[JMSG_LENGTH_MAX];
7781 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
7782 image_error ("Error reading JPEG image `%s': %s", img->spec,
7783 build_string (buffer));
7784 }
7785
7786 /* Close the input file and destroy the JPEG object. */
7787 if (fp)
7788 fclose (fp);
7789 jpeg_destroy_decompress (&cinfo);
7790
7791 BLOCK_INPUT;
7792
7793 /* If we already have an XImage, free that. */
7794 x_destroy_x_image (ximg);
7795
7796 /* Free pixmap and colors. */
7797 x_clear_image (f, img);
7798
7799 UNBLOCK_INPUT;
7800 UNGCPRO;
7801 return 0;
7802 }
7803
7804 /* Create the JPEG decompression object. Let it read from fp.
7805 Read the JPEG image header. */
7806 jpeg_create_decompress (&cinfo);
7807
7808 if (NILP (specified_data))
7809 jpeg_stdio_src (&cinfo, fp);
7810 else
7811 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
7812 STRING_BYTES (XSTRING (specified_data)));
7813
7814 jpeg_read_header (&cinfo, TRUE);
7815
7816 /* Customize decompression so that color quantization will be used.
7817 Start decompression. */
7818 cinfo.quantize_colors = TRUE;
7819 jpeg_start_decompress (&cinfo);
7820 width = img->width = cinfo.output_width;
7821 height = img->height = cinfo.output_height;
7822
7823 BLOCK_INPUT;
7824
7825 /* Create X image and pixmap. */
7826 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
7827 &img->pixmap))
7828 {
7829 UNBLOCK_INPUT;
7830 longjmp (mgr.setjmp_buffer, 2);
7831 }
7832
7833 /* Allocate colors. When color quantization is used,
7834 cinfo.actual_number_of_colors has been set with the number of
7835 colors generated, and cinfo.colormap is a two-dimensional array
7836 of color indices in the range 0..cinfo.actual_number_of_colors.
7837 No more than 255 colors will be generated. */
7838 {
7839 int i, ir, ig, ib;
7840
7841 if (cinfo.out_color_components > 2)
7842 ir = 0, ig = 1, ib = 2;
7843 else if (cinfo.out_color_components > 1)
7844 ir = 0, ig = 1, ib = 0;
7845 else
7846 ir = 0, ig = 0, ib = 0;
7847
7848 /* Use the color table mechanism because it handles colors that
7849 cannot be allocated nicely. Such colors will be replaced with
7850 a default color, and we don't have to care about which colors
7851 can be freed safely, and which can't. */
7852 init_color_table ();
7853 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
7854 * sizeof *colors);
7855
7856 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
7857 {
7858 /* Multiply RGB values with 255 because X expects RGB values
7859 in the range 0..0xffff. */
7860 int r = cinfo.colormap[ir][i] << 8;
7861 int g = cinfo.colormap[ig][i] << 8;
7862 int b = cinfo.colormap[ib][i] << 8;
7863 colors[i] = lookup_rgb_color (f, r, g, b);
7864 }
7865
7866 /* Remember those colors actually allocated. */
7867 img->colors = colors_in_color_table (&img->ncolors);
7868 free_color_table ();
7869 }
7870
7871 /* Read pixels. */
7872 row_stride = width * cinfo.output_components;
7873 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
7874 row_stride, 1);
7875 for (y = 0; y < height; ++y)
7876 {
7877 jpeg_read_scanlines (&cinfo, buffer, 1);
7878 for (x = 0; x < cinfo.output_width; ++x)
7879 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
7880 }
7881
7882 /* Clean up. */
7883 jpeg_finish_decompress (&cinfo);
7884 jpeg_destroy_decompress (&cinfo);
7885 if (fp)
7886 fclose (fp);
7887
7888 /* Put the image into the pixmap. */
7889 x_put_x_image (f, ximg, img->pixmap, width, height);
7890 x_destroy_x_image (ximg);
7891 UNBLOCK_INPUT;
7892 UNGCPRO;
7893 return 1;
7894 }
7895
7896 #endif /* HAVE_JPEG */
7897
7898
7899 \f
7900 /***********************************************************************
7901 TIFF
7902 ***********************************************************************/
7903
7904 #if HAVE_TIFF
7905
7906 #include <tiffio.h>
7907
7908 static int tiff_image_p P_ ((Lisp_Object object));
7909 static int tiff_load P_ ((struct frame *f, struct image *img));
7910
7911 /* The symbol `tiff' identifying images of this type. */
7912
7913 Lisp_Object Qtiff;
7914
7915 /* Indices of image specification fields in tiff_format, below. */
7916
7917 enum tiff_keyword_index
7918 {
7919 TIFF_TYPE,
7920 TIFF_DATA,
7921 TIFF_FILE,
7922 TIFF_ASCENT,
7923 TIFF_MARGIN,
7924 TIFF_RELIEF,
7925 TIFF_ALGORITHM,
7926 TIFF_HEURISTIC_MASK,
7927 TIFF_LAST
7928 };
7929
7930 /* Vector of image_keyword structures describing the format
7931 of valid user-defined image specifications. */
7932
7933 static struct image_keyword tiff_format[TIFF_LAST] =
7934 {
7935 {":type", IMAGE_SYMBOL_VALUE, 1},
7936 {":data", IMAGE_STRING_VALUE, 0},
7937 {":file", IMAGE_STRING_VALUE, 0},
7938 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
7939 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7940 {":relief", IMAGE_INTEGER_VALUE, 0},
7941 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7942 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7943 };
7944
7945 /* Structure describing the image type `tiff'. */
7946
7947 static struct image_type tiff_type =
7948 {
7949 &Qtiff,
7950 tiff_image_p,
7951 tiff_load,
7952 x_clear_image,
7953 NULL
7954 };
7955
7956
7957 /* Return non-zero if OBJECT is a valid TIFF image specification. */
7958
7959 static int
7960 tiff_image_p (object)
7961 Lisp_Object object;
7962 {
7963 struct image_keyword fmt[TIFF_LAST];
7964 bcopy (tiff_format, fmt, sizeof fmt);
7965
7966 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff)
7967 || (fmt[TIFF_ASCENT].count
7968 && XFASTINT (fmt[TIFF_ASCENT].value) > 100))
7969 return 0;
7970
7971 /* Must specify either the :data or :file keyword. */
7972 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
7973 }
7974
7975
7976 /* Reading from a memory buffer for TIFF images Based on the PNG
7977 memory source, but we have to provide a lot of extra functions.
7978 Blah.
7979
7980 We really only need to implement read and seek, but I am not
7981 convinced that the TIFF library is smart enough not to destroy
7982 itself if we only hand it the function pointers we need to
7983 override. */
7984
7985 typedef struct
7986 {
7987 unsigned char *bytes;
7988 size_t len;
7989 int index;
7990 }
7991 tiff_memory_source;
7992
7993 static size_t
7994 tiff_read_from_memory (data, buf, size)
7995 thandle_t data;
7996 tdata_t buf;
7997 tsize_t size;
7998 {
7999 tiff_memory_source *src = (tiff_memory_source *) data;
8000
8001 if (size > src->len - src->index)
8002 return (size_t) -1;
8003 bcopy (src->bytes + src->index, buf, size);
8004 src->index += size;
8005 return size;
8006 }
8007
8008 static size_t
8009 tiff_write_from_memory (data, buf, size)
8010 thandle_t data;
8011 tdata_t buf;
8012 tsize_t size;
8013 {
8014 return (size_t) -1;
8015 }
8016
8017 static toff_t
8018 tiff_seek_in_memory (data, off, whence)
8019 thandle_t data;
8020 toff_t off;
8021 int whence;
8022 {
8023 tiff_memory_source *src = (tiff_memory_source *) data;
8024 int idx;
8025
8026 switch (whence)
8027 {
8028 case SEEK_SET: /* Go from beginning of source. */
8029 idx = off;
8030 break;
8031
8032 case SEEK_END: /* Go from end of source. */
8033 idx = src->len + off;
8034 break;
8035
8036 case SEEK_CUR: /* Go from current position. */
8037 idx = src->index + off;
8038 break;
8039
8040 default: /* Invalid `whence'. */
8041 return -1;
8042 }
8043
8044 if (idx > src->len || idx < 0)
8045 return -1;
8046
8047 src->index = idx;
8048 return src->index;
8049 }
8050
8051 static int
8052 tiff_close_memory (data)
8053 thandle_t data;
8054 {
8055 /* NOOP */
8056 return 0;
8057 }
8058
8059 static int
8060 tiff_mmap_memory (data, pbase, psize)
8061 thandle_t data;
8062 tdata_t *pbase;
8063 toff_t *psize;
8064 {
8065 /* It is already _IN_ memory. */
8066 return 0;
8067 }
8068
8069 static void
8070 tiff_unmap_memory (data, base, size)
8071 thandle_t data;
8072 tdata_t base;
8073 toff_t size;
8074 {
8075 /* We don't need to do this. */
8076 }
8077
8078 static toff_t
8079 tiff_size_of_memory (data)
8080 thandle_t data;
8081 {
8082 return ((tiff_memory_source *) data)->len;
8083 }
8084
8085 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8086 successful. */
8087
8088 static int
8089 tiff_load (f, img)
8090 struct frame *f;
8091 struct image *img;
8092 {
8093 Lisp_Object file, specified_file;
8094 Lisp_Object specified_data;
8095 TIFF *tiff;
8096 int width, height, x, y;
8097 uint32 *buf;
8098 int rc;
8099 XImage *ximg;
8100 struct gcpro gcpro1;
8101 tiff_memory_source memsrc;
8102
8103 specified_file = image_spec_value (img->spec, QCfile, NULL);
8104 specified_data = image_spec_value (img->spec, QCdata, NULL);
8105 file = Qnil;
8106 GCPRO1 (file);
8107
8108 if (NILP (specified_data))
8109 {
8110 /* Read from a file */
8111 file = x_find_image_file (specified_file);
8112 if (!STRINGP (file))
8113 {
8114 image_error ("Cannot find image file `%s'", file, Qnil);
8115 UNGCPRO;
8116 return 0;
8117 }
8118
8119 /* Try to open the image file. */
8120 tiff = TIFFOpen (XSTRING (file)->data, "r");
8121 if (tiff == NULL)
8122 {
8123 image_error ("Cannot open `%s'", file, Qnil);
8124 UNGCPRO;
8125 return 0;
8126 }
8127 }
8128 else
8129 {
8130 /* Memory source! */
8131 memsrc.bytes = XSTRING (specified_data)->data;
8132 memsrc.len = STRING_BYTES (XSTRING (specified_data));
8133 memsrc.index = 0;
8134
8135 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
8136 (TIFFReadWriteProc) tiff_read_from_memory,
8137 (TIFFReadWriteProc) tiff_write_from_memory,
8138 tiff_seek_in_memory,
8139 tiff_close_memory,
8140 tiff_size_of_memory,
8141 tiff_mmap_memory,
8142 tiff_unmap_memory);
8143
8144 if (!tiff)
8145 {
8146 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
8147 UNGCPRO;
8148 return 0;
8149 }
8150 }
8151
8152 /* Get width and height of the image, and allocate a raster buffer
8153 of width x height 32-bit values. */
8154 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
8155 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
8156 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
8157
8158 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
8159 TIFFClose (tiff);
8160 if (!rc)
8161 {
8162 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
8163 xfree (buf);
8164 UNGCPRO;
8165 return 0;
8166 }
8167
8168 BLOCK_INPUT;
8169
8170 /* Create the X image and pixmap. */
8171 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8172 {
8173 UNBLOCK_INPUT;
8174 xfree (buf);
8175 UNGCPRO;
8176 return 0;
8177 }
8178
8179 /* Initialize the color table. */
8180 init_color_table ();
8181
8182 /* Process the pixel raster. Origin is in the lower-left corner. */
8183 for (y = 0; y < height; ++y)
8184 {
8185 uint32 *row = buf + y * width;
8186
8187 for (x = 0; x < width; ++x)
8188 {
8189 uint32 abgr = row[x];
8190 int r = TIFFGetR (abgr) << 8;
8191 int g = TIFFGetG (abgr) << 8;
8192 int b = TIFFGetB (abgr) << 8;
8193 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
8194 }
8195 }
8196
8197 /* Remember the colors allocated for the image. Free the color table. */
8198 img->colors = colors_in_color_table (&img->ncolors);
8199 free_color_table ();
8200
8201 /* Put the image into the pixmap, then free the X image and its buffer. */
8202 x_put_x_image (f, ximg, img->pixmap, width, height);
8203 x_destroy_x_image (ximg);
8204 xfree (buf);
8205 UNBLOCK_INPUT;
8206
8207 img->width = width;
8208 img->height = height;
8209
8210 UNGCPRO;
8211 return 1;
8212 }
8213
8214 #endif /* HAVE_TIFF != 0 */
8215
8216
8217 \f
8218 /***********************************************************************
8219 GIF
8220 ***********************************************************************/
8221
8222 #if HAVE_GIF
8223
8224 #include <gif_lib.h>
8225
8226 static int gif_image_p P_ ((Lisp_Object object));
8227 static int gif_load P_ ((struct frame *f, struct image *img));
8228
8229 /* The symbol `gif' identifying images of this type. */
8230
8231 Lisp_Object Qgif;
8232
8233 /* Indices of image specification fields in gif_format, below. */
8234
8235 enum gif_keyword_index
8236 {
8237 GIF_TYPE,
8238 GIF_DATA,
8239 GIF_FILE,
8240 GIF_ASCENT,
8241 GIF_MARGIN,
8242 GIF_RELIEF,
8243 GIF_ALGORITHM,
8244 GIF_HEURISTIC_MASK,
8245 GIF_IMAGE,
8246 GIF_LAST
8247 };
8248
8249 /* Vector of image_keyword structures describing the format
8250 of valid user-defined image specifications. */
8251
8252 static struct image_keyword gif_format[GIF_LAST] =
8253 {
8254 {":type", IMAGE_SYMBOL_VALUE, 1},
8255 {":data", IMAGE_STRING_VALUE, 0},
8256 {":file", IMAGE_STRING_VALUE, 0},
8257 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8258 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8259 {":relief", IMAGE_INTEGER_VALUE, 0},
8260 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8261 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8262 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
8263 };
8264
8265 /* Structure describing the image type `gif'. */
8266
8267 static struct image_type gif_type =
8268 {
8269 &Qgif,
8270 gif_image_p,
8271 gif_load,
8272 x_clear_image,
8273 NULL
8274 };
8275
8276 /* Return non-zero if OBJECT is a valid GIF image specification. */
8277
8278 static int
8279 gif_image_p (object)
8280 Lisp_Object object;
8281 {
8282 struct image_keyword fmt[GIF_LAST];
8283 bcopy (gif_format, fmt, sizeof fmt);
8284
8285 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif)
8286 || (fmt[GIF_ASCENT].count
8287 && XFASTINT (fmt[GIF_ASCENT].value) > 100))
8288 return 0;
8289
8290 /* Must specify either the :data or :file keyword. */
8291 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
8292 }
8293
8294 /* Reading a GIF image from memory
8295 Based on the PNG memory stuff to a certain extent. */
8296
8297 typedef struct
8298 {
8299 unsigned char *bytes;
8300 size_t len;
8301 int index;
8302 }
8303 gif_memory_source;
8304
8305 /* Make the current memory source available to gif_read_from_memory.
8306 It's done this way because not all versions of libungif support
8307 a UserData field in the GifFileType structure. */
8308 static gif_memory_source *current_gif_memory_src;
8309
8310 static int
8311 gif_read_from_memory (file, buf, len)
8312 GifFileType *file;
8313 GifByteType *buf;
8314 int len;
8315 {
8316 gif_memory_source *src = current_gif_memory_src;
8317
8318 if (len > src->len - src->index)
8319 return -1;
8320
8321 bcopy (src->bytes + src->index, buf, len);
8322 src->index += len;
8323 return len;
8324 }
8325
8326
8327 /* Load GIF image IMG for use on frame F. Value is non-zero if
8328 successful. */
8329
8330 static int
8331 gif_load (f, img)
8332 struct frame *f;
8333 struct image *img;
8334 {
8335 Lisp_Object file, specified_file;
8336 Lisp_Object specified_data;
8337 int rc, width, height, x, y, i;
8338 XImage *ximg;
8339 ColorMapObject *gif_color_map;
8340 unsigned long pixel_colors[256];
8341 GifFileType *gif;
8342 struct gcpro gcpro1;
8343 Lisp_Object image;
8344 int ino, image_left, image_top, image_width, image_height;
8345 gif_memory_source memsrc;
8346 unsigned char *raster;
8347
8348 specified_file = image_spec_value (img->spec, QCfile, NULL);
8349 specified_data = image_spec_value (img->spec, QCdata, NULL);
8350 file = Qnil;
8351 GCPRO1 (file);
8352
8353 if (NILP (specified_data))
8354 {
8355 file = x_find_image_file (specified_file);
8356 if (!STRINGP (file))
8357 {
8358 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8359 UNGCPRO;
8360 return 0;
8361 }
8362
8363 /* Open the GIF file. */
8364 gif = DGifOpenFileName (XSTRING (file)->data);
8365 if (gif == NULL)
8366 {
8367 image_error ("Cannot open `%s'", file, Qnil);
8368 UNGCPRO;
8369 return 0;
8370 }
8371 }
8372 else
8373 {
8374 /* Read from memory! */
8375 current_gif_memory_src = &memsrc;
8376 memsrc.bytes = XSTRING (specified_data)->data;
8377 memsrc.len = STRING_BYTES (XSTRING (specified_data));
8378 memsrc.index = 0;
8379
8380 gif = DGifOpen(&memsrc, gif_read_from_memory);
8381 if (!gif)
8382 {
8383 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
8384 UNGCPRO;
8385 return 0;
8386 }
8387 }
8388
8389 /* Read entire contents. */
8390 rc = DGifSlurp (gif);
8391 if (rc == GIF_ERROR)
8392 {
8393 image_error ("Error reading `%s'", img->spec, Qnil);
8394 DGifCloseFile (gif);
8395 UNGCPRO;
8396 return 0;
8397 }
8398
8399 image = image_spec_value (img->spec, QCindex, NULL);
8400 ino = INTEGERP (image) ? XFASTINT (image) : 0;
8401 if (ino >= gif->ImageCount)
8402 {
8403 image_error ("Invalid image number `%s' in image `%s'",
8404 image, img->spec);
8405 DGifCloseFile (gif);
8406 UNGCPRO;
8407 return 0;
8408 }
8409
8410 width = img->width = gif->SWidth;
8411 height = img->height = gif->SHeight;
8412
8413 BLOCK_INPUT;
8414
8415 /* Create the X image and pixmap. */
8416 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8417 {
8418 UNBLOCK_INPUT;
8419 DGifCloseFile (gif);
8420 UNGCPRO;
8421 return 0;
8422 }
8423
8424 /* Allocate colors. */
8425 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
8426 if (!gif_color_map)
8427 gif_color_map = gif->SColorMap;
8428 init_color_table ();
8429 bzero (pixel_colors, sizeof pixel_colors);
8430
8431 for (i = 0; i < gif_color_map->ColorCount; ++i)
8432 {
8433 int r = gif_color_map->Colors[i].Red << 8;
8434 int g = gif_color_map->Colors[i].Green << 8;
8435 int b = gif_color_map->Colors[i].Blue << 8;
8436 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
8437 }
8438
8439 img->colors = colors_in_color_table (&img->ncolors);
8440 free_color_table ();
8441
8442 /* Clear the part of the screen image that are not covered by
8443 the image from the GIF file. Full animated GIF support
8444 requires more than can be done here (see the gif89 spec,
8445 disposal methods). Let's simply assume that the part
8446 not covered by a sub-image is in the frame's background color. */
8447 image_top = gif->SavedImages[ino].ImageDesc.Top;
8448 image_left = gif->SavedImages[ino].ImageDesc.Left;
8449 image_width = gif->SavedImages[ino].ImageDesc.Width;
8450 image_height = gif->SavedImages[ino].ImageDesc.Height;
8451
8452 for (y = 0; y < image_top; ++y)
8453 for (x = 0; x < width; ++x)
8454 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8455
8456 for (y = image_top + image_height; y < height; ++y)
8457 for (x = 0; x < width; ++x)
8458 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8459
8460 for (y = image_top; y < image_top + image_height; ++y)
8461 {
8462 for (x = 0; x < image_left; ++x)
8463 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8464 for (x = image_left + image_width; x < width; ++x)
8465 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8466 }
8467
8468 /* Read the GIF image into the X image. We use a local variable
8469 `raster' here because RasterBits below is a char *, and invites
8470 problems with bytes >= 0x80. */
8471 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
8472
8473 if (gif->SavedImages[ino].ImageDesc.Interlace)
8474 {
8475 static int interlace_start[] = {0, 4, 2, 1};
8476 static int interlace_increment[] = {8, 8, 4, 2};
8477 int pass, inc;
8478 int row = interlace_start[0];
8479
8480 pass = 0;
8481
8482 for (y = 0; y < image_height; y++)
8483 {
8484 if (row >= image_height)
8485 {
8486 row = interlace_start[++pass];
8487 while (row >= image_height)
8488 row = interlace_start[++pass];
8489 }
8490
8491 for (x = 0; x < image_width; x++)
8492 {
8493 int i = raster[(y * image_width) + x];
8494 XPutPixel (ximg, x + image_left, row + image_top,
8495 pixel_colors[i]);
8496 }
8497
8498 row += interlace_increment[pass];
8499 }
8500 }
8501 else
8502 {
8503 for (y = 0; y < image_height; ++y)
8504 for (x = 0; x < image_width; ++x)
8505 {
8506 int i = raster[y* image_width + x];
8507 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
8508 }
8509 }
8510
8511 DGifCloseFile (gif);
8512
8513 /* Put the image into the pixmap, then free the X image and its buffer. */
8514 x_put_x_image (f, ximg, img->pixmap, width, height);
8515 x_destroy_x_image (ximg);
8516 UNBLOCK_INPUT;
8517
8518 UNGCPRO;
8519 return 1;
8520 }
8521
8522 #endif /* HAVE_GIF != 0 */
8523
8524
8525 \f
8526 /***********************************************************************
8527 Ghostscript
8528 ***********************************************************************/
8529
8530 #ifdef HAVE_GHOSTSCRIPT
8531 static int gs_image_p P_ ((Lisp_Object object));
8532 static int gs_load P_ ((struct frame *f, struct image *img));
8533 static void gs_clear_image P_ ((struct frame *f, struct image *img));
8534
8535 /* The symbol `postscript' identifying images of this type. */
8536
8537 Lisp_Object Qpostscript;
8538
8539 /* Keyword symbols. */
8540
8541 Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
8542
8543 /* Indices of image specification fields in gs_format, below. */
8544
8545 enum gs_keyword_index
8546 {
8547 GS_TYPE,
8548 GS_PT_WIDTH,
8549 GS_PT_HEIGHT,
8550 GS_FILE,
8551 GS_LOADER,
8552 GS_BOUNDING_BOX,
8553 GS_ASCENT,
8554 GS_MARGIN,
8555 GS_RELIEF,
8556 GS_ALGORITHM,
8557 GS_HEURISTIC_MASK,
8558 GS_LAST
8559 };
8560
8561 /* Vector of image_keyword structures describing the format
8562 of valid user-defined image specifications. */
8563
8564 static struct image_keyword gs_format[GS_LAST] =
8565 {
8566 {":type", IMAGE_SYMBOL_VALUE, 1},
8567 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
8568 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
8569 {":file", IMAGE_STRING_VALUE, 1},
8570 {":loader", IMAGE_FUNCTION_VALUE, 0},
8571 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
8572 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8573 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8574 {":relief", IMAGE_INTEGER_VALUE, 0},
8575 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8576 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8577 };
8578
8579 /* Structure describing the image type `ghostscript'. */
8580
8581 static struct image_type gs_type =
8582 {
8583 &Qpostscript,
8584 gs_image_p,
8585 gs_load,
8586 gs_clear_image,
8587 NULL
8588 };
8589
8590
8591 /* Free X resources of Ghostscript image IMG which is used on frame F. */
8592
8593 static void
8594 gs_clear_image (f, img)
8595 struct frame *f;
8596 struct image *img;
8597 {
8598 /* IMG->data.ptr_val may contain a recorded colormap. */
8599 xfree (img->data.ptr_val);
8600 x_clear_image (f, img);
8601 }
8602
8603
8604 /* Return non-zero if OBJECT is a valid Ghostscript image
8605 specification. */
8606
8607 static int
8608 gs_image_p (object)
8609 Lisp_Object object;
8610 {
8611 struct image_keyword fmt[GS_LAST];
8612 Lisp_Object tem;
8613 int i;
8614
8615 bcopy (gs_format, fmt, sizeof fmt);
8616
8617 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript)
8618 || (fmt[GS_ASCENT].count
8619 && XFASTINT (fmt[GS_ASCENT].value) > 100))
8620 return 0;
8621
8622 /* Bounding box must be a list or vector containing 4 integers. */
8623 tem = fmt[GS_BOUNDING_BOX].value;
8624 if (CONSP (tem))
8625 {
8626 for (i = 0; i < 4; ++i, tem = XCDR (tem))
8627 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
8628 return 0;
8629 if (!NILP (tem))
8630 return 0;
8631 }
8632 else if (VECTORP (tem))
8633 {
8634 if (XVECTOR (tem)->size != 4)
8635 return 0;
8636 for (i = 0; i < 4; ++i)
8637 if (!INTEGERP (XVECTOR (tem)->contents[i]))
8638 return 0;
8639 }
8640 else
8641 return 0;
8642
8643 return 1;
8644 }
8645
8646
8647 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
8648 if successful. */
8649
8650 static int
8651 gs_load (f, img)
8652 struct frame *f;
8653 struct image *img;
8654 {
8655 char buffer[100];
8656 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
8657 struct gcpro gcpro1, gcpro2;
8658 Lisp_Object frame;
8659 double in_width, in_height;
8660 Lisp_Object pixel_colors = Qnil;
8661
8662 /* Compute pixel size of pixmap needed from the given size in the
8663 image specification. Sizes in the specification are in pt. 1 pt
8664 = 1/72 in, xdpi and ydpi are stored in the frame's X display
8665 info. */
8666 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
8667 in_width = XFASTINT (pt_width) / 72.0;
8668 img->width = in_width * FRAME_W32_DISPLAY_INFO (f)->resx;
8669 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
8670 in_height = XFASTINT (pt_height) / 72.0;
8671 img->height = in_height * FRAME_W32_DISPLAY_INFO (f)->resy;
8672
8673 /* Create the pixmap. */
8674 BLOCK_INPUT;
8675 xassert (img->pixmap == 0);
8676 img->pixmap = XCreatePixmap (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
8677 img->width, img->height,
8678 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
8679 UNBLOCK_INPUT;
8680
8681 if (!img->pixmap)
8682 {
8683 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
8684 return 0;
8685 }
8686
8687 /* Call the loader to fill the pixmap. It returns a process object
8688 if successful. We do not record_unwind_protect here because
8689 other places in redisplay like calling window scroll functions
8690 don't either. Let the Lisp loader use `unwind-protect' instead. */
8691 GCPRO2 (window_and_pixmap_id, pixel_colors);
8692
8693 sprintf (buffer, "%lu %lu",
8694 (unsigned long) FRAME_W32_WINDOW (f),
8695 (unsigned long) img->pixmap);
8696 window_and_pixmap_id = build_string (buffer);
8697
8698 sprintf (buffer, "%lu %lu",
8699 FRAME_FOREGROUND_PIXEL (f),
8700 FRAME_BACKGROUND_PIXEL (f));
8701 pixel_colors = build_string (buffer);
8702
8703 XSETFRAME (frame, f);
8704 loader = image_spec_value (img->spec, QCloader, NULL);
8705 if (NILP (loader))
8706 loader = intern ("gs-load-image");
8707
8708 img->data.lisp_val = call6 (loader, frame, img->spec,
8709 make_number (img->width),
8710 make_number (img->height),
8711 window_and_pixmap_id,
8712 pixel_colors);
8713 UNGCPRO;
8714 return PROCESSP (img->data.lisp_val);
8715 }
8716
8717
8718 /* Kill the Ghostscript process that was started to fill PIXMAP on
8719 frame F. Called from XTread_socket when receiving an event
8720 telling Emacs that Ghostscript has finished drawing. */
8721
8722 void
8723 x_kill_gs_process (pixmap, f)
8724 Pixmap pixmap;
8725 struct frame *f;
8726 {
8727 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8728 int class, i;
8729 struct image *img;
8730
8731 /* Find the image containing PIXMAP. */
8732 for (i = 0; i < c->used; ++i)
8733 if (c->images[i]->pixmap == pixmap)
8734 break;
8735
8736 /* Kill the GS process. We should have found PIXMAP in the image
8737 cache and its image should contain a process object. */
8738 xassert (i < c->used);
8739 img = c->images[i];
8740 xassert (PROCESSP (img->data.lisp_val));
8741 Fkill_process (img->data.lisp_val, Qnil);
8742 img->data.lisp_val = Qnil;
8743
8744 /* On displays with a mutable colormap, figure out the colors
8745 allocated for the image by looking at the pixels of an XImage for
8746 img->pixmap. */
8747 class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
8748 if (class != StaticColor && class != StaticGray && class != TrueColor)
8749 {
8750 XImage *ximg;
8751
8752 BLOCK_INPUT;
8753
8754 /* Try to get an XImage for img->pixmep. */
8755 ximg = XGetImage (FRAME_W32_DISPLAY (f), img->pixmap,
8756 0, 0, img->width, img->height, ~0, ZPixmap);
8757 if (ximg)
8758 {
8759 int x, y;
8760
8761 /* Initialize the color table. */
8762 init_color_table ();
8763
8764 /* For each pixel of the image, look its color up in the
8765 color table. After having done so, the color table will
8766 contain an entry for each color used by the image. */
8767 for (y = 0; y < img->height; ++y)
8768 for (x = 0; x < img->width; ++x)
8769 {
8770 unsigned long pixel = XGetPixel (ximg, x, y);
8771 lookup_pixel_color (f, pixel);
8772 }
8773
8774 /* Record colors in the image. Free color table and XImage. */
8775 img->colors = colors_in_color_table (&img->ncolors);
8776 free_color_table ();
8777 XDestroyImage (ximg);
8778
8779 #if 0 /* This doesn't seem to be the case. If we free the colors
8780 here, we get a BadAccess later in x_clear_image when
8781 freeing the colors. */
8782 /* We have allocated colors once, but Ghostscript has also
8783 allocated colors on behalf of us. So, to get the
8784 reference counts right, free them once. */
8785 if (img->ncolors)
8786 {
8787 Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
8788 XFreeColors (FRAME_W32_DISPLAY (f), cmap,
8789 img->colors, img->ncolors, 0);
8790 }
8791 #endif
8792 }
8793 else
8794 image_error ("Cannot get X image of `%s'; colors will not be freed",
8795 img->spec, Qnil);
8796
8797 UNBLOCK_INPUT;
8798 }
8799 }
8800
8801 #endif /* HAVE_GHOSTSCRIPT */
8802
8803 \f
8804 /***********************************************************************
8805 Window properties
8806 ***********************************************************************/
8807
8808 DEFUN ("x-change-window-property", Fx_change_window_property,
8809 Sx_change_window_property, 2, 3, 0,
8810 "Change window property PROP to VALUE on the X window of FRAME.\n\
8811 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
8812 selected frame. Value is VALUE.")
8813 (prop, value, frame)
8814 Lisp_Object frame, prop, value;
8815 {
8816 #if 0 /* MAC_TODO : port window properties to Mac */
8817 struct frame *f = check_x_frame (frame);
8818 Atom prop_atom;
8819
8820 CHECK_STRING (prop, 1);
8821 CHECK_STRING (value, 2);
8822
8823 BLOCK_INPUT;
8824 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
8825 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
8826 prop_atom, XA_STRING, 8, PropModeReplace,
8827 XSTRING (value)->data, XSTRING (value)->size);
8828
8829 /* Make sure the property is set when we return. */
8830 XFlush (FRAME_W32_DISPLAY (f));
8831 UNBLOCK_INPUT;
8832
8833 #endif /* MAC_TODO */
8834
8835 return value;
8836 }
8837
8838
8839 DEFUN ("x-delete-window-property", Fx_delete_window_property,
8840 Sx_delete_window_property, 1, 2, 0,
8841 "Remove window property PROP from X window of FRAME.\n\
8842 FRAME nil or omitted means use the selected frame. Value is PROP.")
8843 (prop, frame)
8844 Lisp_Object prop, frame;
8845 {
8846 #if 0 /* MAC_TODO : port window properties to Mac */
8847
8848 struct frame *f = check_x_frame (frame);
8849 Atom prop_atom;
8850
8851 CHECK_STRING (prop, 1);
8852 BLOCK_INPUT;
8853 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
8854 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
8855
8856 /* Make sure the property is removed when we return. */
8857 XFlush (FRAME_W32_DISPLAY (f));
8858 UNBLOCK_INPUT;
8859 #endif /* MAC_TODO */
8860
8861 return prop;
8862 }
8863
8864
8865 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
8866 1, 2, 0,
8867 "Value is the value of window property PROP on FRAME.\n\
8868 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
8869 if FRAME hasn't a property with name PROP or if PROP has no string\n\
8870 value.")
8871 (prop, frame)
8872 Lisp_Object prop, frame;
8873 {
8874 #if 0 /* MAC_TODO : port window properties to Mac */
8875
8876 struct frame *f = check_x_frame (frame);
8877 Atom prop_atom;
8878 int rc;
8879 Lisp_Object prop_value = Qnil;
8880 char *tmp_data = NULL;
8881 Atom actual_type;
8882 int actual_format;
8883 unsigned long actual_size, bytes_remaining;
8884
8885 CHECK_STRING (prop, 1);
8886 BLOCK_INPUT;
8887 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
8888 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
8889 prop_atom, 0, 0, False, XA_STRING,
8890 &actual_type, &actual_format, &actual_size,
8891 &bytes_remaining, (unsigned char **) &tmp_data);
8892 if (rc == Success)
8893 {
8894 int size = bytes_remaining;
8895
8896 XFree (tmp_data);
8897 tmp_data = NULL;
8898
8899 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
8900 prop_atom, 0, bytes_remaining,
8901 False, XA_STRING,
8902 &actual_type, &actual_format,
8903 &actual_size, &bytes_remaining,
8904 (unsigned char **) &tmp_data);
8905 if (rc == Success)
8906 prop_value = make_string (tmp_data, size);
8907
8908 XFree (tmp_data);
8909 }
8910
8911 UNBLOCK_INPUT;
8912
8913 return prop_value;
8914
8915 #endif /* MAC_TODO */
8916 return Qnil;
8917 }
8918
8919
8920 \f
8921 /***********************************************************************
8922 Busy cursor
8923 ***********************************************************************/
8924
8925 /* If non-null, an asynchronous timer that, when it expires, displays
8926 an hourglass cursor on all frames. */
8927
8928 static struct atimer *hourglass_atimer;
8929
8930 /* Non-zero means an hourglass cursor is currently shown. */
8931
8932 static int hourglass_shown_p;
8933
8934 /* Number of seconds to wait before displaying an hourglass cursor. */
8935
8936 static Lisp_Object Vhourglass_delay;
8937
8938 /* Default number of seconds to wait before displaying an hourglass
8939 cursor. */
8940
8941 #define DEFAULT_HOURGLASS_DELAY 1
8942
8943 /* Function prototypes. */
8944
8945 static void show_hourglass P_ ((struct atimer *));
8946 static void hide_hourglass P_ ((void));
8947
8948
8949 /* Cancel a currently active hourglass timer, and start a new one. */
8950
8951 void
8952 start_hourglass ()
8953 {
8954 #if 0 /* TODO: cursor shape changes. */
8955 EMACS_TIME delay;
8956 int secs, usecs = 0;
8957
8958 cancel_hourglass ();
8959
8960 if (INTEGERP (Vhourglass_delay)
8961 && XINT (Vhourglass_delay) > 0)
8962 secs = XFASTINT (Vhourglass_delay);
8963 else if (FLOATP (Vhourglass_delay)
8964 && XFLOAT_DATA (Vhourglass_delay) > 0)
8965 {
8966 Lisp_Object tem;
8967 tem = Ftruncate (Vhourglass_delay, Qnil);
8968 secs = XFASTINT (tem);
8969 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
8970 }
8971 else
8972 secs = DEFAULT_HOURGLASS_DELAY;
8973
8974 EMACS_SET_SECS_USECS (delay, secs, usecs);
8975 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
8976 show_hourglass, NULL);
8977 #endif
8978 }
8979
8980
8981 /* Cancel the hourglass cursor timer if active, hide an hourglass
8982 cursor if shown. */
8983
8984 void
8985 cancel_hourglass ()
8986 {
8987 if (hourglass_atimer)
8988 {
8989 cancel_atimer (hourglass_atimer);
8990 hourglass_atimer = NULL;
8991 }
8992
8993 if (hourglass_shown_p)
8994 hide_hourglass ();
8995 }
8996
8997
8998 /* Timer function of hourglass_atimer. TIMER is equal to
8999 hourglass_atimer.
9000
9001 Display an hourglass cursor on all frames by mapping the frames'
9002 hourglass_window. Set the hourglass_p flag in the frames'
9003 output_data.x structure to indicate that an hourglass cursor is
9004 shown on the frames. */
9005
9006 static void
9007 show_hourglass (timer)
9008 struct atimer *timer;
9009 {
9010 #if 0 /* MAC_TODO: cursor shape changes. */
9011 /* The timer implementation will cancel this timer automatically
9012 after this function has run. Set hourglass_atimer to null
9013 so that we know the timer doesn't have to be canceled. */
9014 hourglass_atimer = NULL;
9015
9016 if (!hourglass_shown_p)
9017 {
9018 Lisp_Object rest, frame;
9019
9020 BLOCK_INPUT;
9021
9022 FOR_EACH_FRAME (rest, frame)
9023 if (FRAME_W32_P (XFRAME (frame)))
9024 {
9025 struct frame *f = XFRAME (frame);
9026
9027 f->output_data.w32->hourglass_p = 1;
9028
9029 if (!f->output_data.w32->hourglass_window)
9030 {
9031 unsigned long mask = CWCursor;
9032 XSetWindowAttributes attrs;
9033
9034 attrs.cursor = f->output_data.w32->hourglass_cursor;
9035
9036 f->output_data.w32->hourglass_window
9037 = XCreateWindow (FRAME_X_DISPLAY (f),
9038 FRAME_OUTER_WINDOW (f),
9039 0, 0, 32000, 32000, 0, 0,
9040 InputOnly,
9041 CopyFromParent,
9042 mask, &attrs);
9043 }
9044
9045 XMapRaised (FRAME_X_DISPLAY (f),
9046 f->output_data.w32->hourglass_window);
9047 XFlush (FRAME_X_DISPLAY (f));
9048 }
9049
9050 hourglass_shown_p = 1;
9051 UNBLOCK_INPUT;
9052 }
9053 #endif
9054 }
9055
9056
9057 /* Hide the hourglass cursor on all frames, if it is currently shown. */
9058
9059 static void
9060 hide_hourglass ()
9061 {
9062 #if 0 /* TODO: cursor shape changes. */
9063 if (hourglass_shown_p)
9064 {
9065 Lisp_Object rest, frame;
9066
9067 BLOCK_INPUT;
9068 FOR_EACH_FRAME (rest, frame)
9069 {
9070 struct frame *f = XFRAME (frame);
9071
9072 if (FRAME_W32_P (f)
9073 /* Watch out for newly created frames. */
9074 && f->output_data.x->hourglass_window)
9075 {
9076 XUnmapWindow (FRAME_X_DISPLAY (f),
9077 f->output_data.x->hourglass_window);
9078 /* Sync here because XTread_socket looks at the
9079 hourglass_p flag that is reset to zero below. */
9080 XSync (FRAME_X_DISPLAY (f), False);
9081 f->output_data.x->hourglass_p = 0;
9082 }
9083 }
9084
9085 hourglass_shown_p = 0;
9086 UNBLOCK_INPUT;
9087 }
9088 #endif
9089 }
9090
9091
9092 \f
9093 /***********************************************************************
9094 Tool tips
9095 ***********************************************************************/
9096
9097 static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
9098 Lisp_Object));
9099
9100 /* The frame of a currently visible tooltip, or null. */
9101
9102 Lisp_Object tip_frame;
9103
9104 /* If non-nil, a timer started that hides the last tooltip when it
9105 fires. */
9106
9107 Lisp_Object tip_timer;
9108 Window tip_window;
9109
9110 /* Create a frame for a tooltip on the display described by DPYINFO.
9111 PARMS is a list of frame parameters. Value is the frame. */
9112
9113 static Lisp_Object
9114 x_create_tip_frame (dpyinfo, parms)
9115 struct w32_display_info *dpyinfo;
9116 Lisp_Object parms;
9117 {
9118 #if 0 /* MAC_TODO : Mac version */
9119 struct frame *f;
9120 Lisp_Object frame, tem;
9121 Lisp_Object name;
9122 long window_prompting = 0;
9123 int width, height;
9124 int count = specpdl_ptr - specpdl;
9125 struct gcpro gcpro1, gcpro2, gcpro3;
9126 struct kboard *kb;
9127
9128 check_x ();
9129
9130 /* Use this general default value to start with until we know if
9131 this frame has a specified name. */
9132 Vx_resource_name = Vinvocation_name;
9133
9134 #ifdef MULTI_KBOARD
9135 kb = dpyinfo->kboard;
9136 #else
9137 kb = &the_only_kboard;
9138 #endif
9139
9140 /* Get the name of the frame to use for resource lookup. */
9141 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
9142 if (!STRINGP (name)
9143 && !EQ (name, Qunbound)
9144 && !NILP (name))
9145 error ("Invalid frame name--not a string or nil");
9146 Vx_resource_name = name;
9147
9148 frame = Qnil;
9149 GCPRO3 (parms, name, frame);
9150 tip_frame = f = make_frame (1);
9151 XSETFRAME (frame, f);
9152 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
9153
9154 f->output_method = output_w32;
9155 f->output_data.w32 =
9156 (struct w32_output *) xmalloc (sizeof (struct w32_output));
9157 bzero (f->output_data.w32, sizeof (struct w32_output));
9158 #if 0
9159 f->output_data.w32->icon_bitmap = -1;
9160 #endif
9161 f->output_data.w32->fontset = -1;
9162 f->icon_name = Qnil;
9163
9164 #ifdef MULTI_KBOARD
9165 FRAME_KBOARD (f) = kb;
9166 #endif
9167 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
9168 f->output_data.w32->explicit_parent = 0;
9169
9170 /* Set the name; the functions to which we pass f expect the name to
9171 be set. */
9172 if (EQ (name, Qunbound) || NILP (name))
9173 {
9174 f->name = build_string (dpyinfo->x_id_name);
9175 f->explicit_name = 0;
9176 }
9177 else
9178 {
9179 f->name = name;
9180 f->explicit_name = 1;
9181 /* use the frame's title when getting resources for this frame. */
9182 specbind (Qx_resource_name, name);
9183 }
9184
9185 /* Extract the window parameters from the supplied values
9186 that are needed to determine window geometry. */
9187 {
9188 Lisp_Object font;
9189
9190 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
9191
9192 BLOCK_INPUT;
9193 /* First, try whatever font the caller has specified. */
9194 if (STRINGP (font))
9195 {
9196 tem = Fquery_fontset (font, Qnil);
9197 if (STRINGP (tem))
9198 font = x_new_fontset (f, XSTRING (tem)->data);
9199 else
9200 font = x_new_font (f, XSTRING (font)->data);
9201 }
9202
9203 /* Try out a font which we hope has bold and italic variations. */
9204 if (!STRINGP (font))
9205 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9206 if (!STRINGP (font))
9207 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9208 if (! STRINGP (font))
9209 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9210 if (! STRINGP (font))
9211 /* This was formerly the first thing tried, but it finds too many fonts
9212 and takes too long. */
9213 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9214 /* If those didn't work, look for something which will at least work. */
9215 if (! STRINGP (font))
9216 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9217 UNBLOCK_INPUT;
9218 if (! STRINGP (font))
9219 font = build_string ("fixed");
9220
9221 x_default_parameter (f, parms, Qfont, font,
9222 "font", "Font", RES_TYPE_STRING);
9223 }
9224
9225 x_default_parameter (f, parms, Qborder_width, make_number (2),
9226 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
9227
9228 /* This defaults to 2 in order to match xterm. We recognize either
9229 internalBorderWidth or internalBorder (which is what xterm calls
9230 it). */
9231 if (NILP (Fassq (Qinternal_border_width, parms)))
9232 {
9233 Lisp_Object value;
9234
9235 value = w32_get_arg (parms, Qinternal_border_width,
9236 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
9237 if (! EQ (value, Qunbound))
9238 parms = Fcons (Fcons (Qinternal_border_width, value),
9239 parms);
9240 }
9241
9242 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
9243 "internalBorderWidth", "internalBorderWidth",
9244 RES_TYPE_NUMBER);
9245
9246 /* Also do the stuff which must be set before the window exists. */
9247 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
9248 "foreground", "Foreground", RES_TYPE_STRING);
9249 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
9250 "background", "Background", RES_TYPE_STRING);
9251 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
9252 "pointerColor", "Foreground", RES_TYPE_STRING);
9253 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
9254 "cursorColor", "Foreground", RES_TYPE_STRING);
9255 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
9256 "borderColor", "BorderColor", RES_TYPE_STRING);
9257
9258 /* Init faces before x_default_parameter is called for scroll-bar
9259 parameters because that function calls x_set_scroll_bar_width,
9260 which calls change_frame_size, which calls Fset_window_buffer,
9261 which runs hooks, which call Fvertical_motion. At the end, we
9262 end up in init_iterator with a null face cache, which should not
9263 happen. */
9264 init_frame_faces (f);
9265
9266 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
9267 window_prompting = x_figure_window_size (f, parms);
9268
9269 if (window_prompting & XNegative)
9270 {
9271 if (window_prompting & YNegative)
9272 f->output_data.w32->win_gravity = SouthEastGravity;
9273 else
9274 f->output_data.w32->win_gravity = NorthEastGravity;
9275 }
9276 else
9277 {
9278 if (window_prompting & YNegative)
9279 f->output_data.w32->win_gravity = SouthWestGravity;
9280 else
9281 f->output_data.w32->win_gravity = NorthWestGravity;
9282 }
9283
9284 f->output_data.w32->size_hint_flags = window_prompting;
9285 {
9286 XSetWindowAttributes attrs;
9287 unsigned long mask;
9288
9289 BLOCK_INPUT;
9290 mask = CWBackPixel | CWOverrideRedirect | CWSaveUnder | CWEventMask;
9291 /* Window managers looks at the override-redirect flag to
9292 determine whether or net to give windows a decoration (Xlib
9293 3.2.8). */
9294 attrs.override_redirect = True;
9295 attrs.save_under = True;
9296 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
9297 /* Arrange for getting MapNotify and UnmapNotify events. */
9298 attrs.event_mask = StructureNotifyMask;
9299 tip_window
9300 = FRAME_W32_WINDOW (f)
9301 = XCreateWindow (FRAME_W32_DISPLAY (f),
9302 FRAME_W32_DISPLAY_INFO (f)->root_window,
9303 /* x, y, width, height */
9304 0, 0, 1, 1,
9305 /* Border. */
9306 1,
9307 CopyFromParent, InputOutput, CopyFromParent,
9308 mask, &attrs);
9309 UNBLOCK_INPUT;
9310 }
9311
9312 x_make_gc (f);
9313
9314 x_default_parameter (f, parms, Qauto_raise, Qnil,
9315 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
9316 x_default_parameter (f, parms, Qauto_lower, Qnil,
9317 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
9318 x_default_parameter (f, parms, Qcursor_type, Qbox,
9319 "cursorType", "CursorType", RES_TYPE_SYMBOL);
9320
9321 /* Dimensions, especially f->height, must be done via change_frame_size.
9322 Change will not be effected unless different from the current
9323 f->height. */
9324 width = f->width;
9325 height = f->height;
9326 f->height = 0;
9327 SET_FRAME_WIDTH (f, 0);
9328 change_frame_size (f, height, width, 1, 0, 0);
9329
9330 f->no_split = 1;
9331
9332 UNGCPRO;
9333
9334 /* It is now ok to make the frame official even if we get an error
9335 below. And the frame needs to be on Vframe_list or making it
9336 visible won't work. */
9337 Vframe_list = Fcons (frame, Vframe_list);
9338
9339 /* Now that the frame is official, it counts as a reference to
9340 its display. */
9341 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
9342
9343 return unbind_to (count, frame);
9344 #endif /* MAC_TODO */
9345 return Qnil;
9346 }
9347
9348 #ifdef TODO /* Tooltip support not complete. */
9349 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
9350 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9351 A tooltip window is a small window displaying a string.\n\
9352 \n\
9353 FRAME nil or omitted means use the selected frame.\n\
9354 \n\
9355 PARMS is an optional list of frame parameters which can be\n\
9356 used to change the tooltip's appearance.\n\
9357 \n\
9358 Automatically hide the tooltip after TIMEOUT seconds.\n\
9359 TIMEOUT nil means use the default timeout of 5 seconds.\n\
9360 \n\
9361 If the list of frame parameters PARAMS contains a `left' parameters,\n\
9362 the tooltip is displayed at that x-position. Otherwise it is\n\
9363 displayed at the mouse position, with offset DX added (default is 5 if\n\
9364 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
9365 parameter is specified, it determines the y-position of the tooltip\n\
9366 window, otherwise it is displayed at the mouse position, with offset\n\
9367 DY added (default is 10).")
9368 (string, frame, parms, timeout, dx, dy)
9369 Lisp_Object string, frame, parms, timeout, dx, dy;
9370 {
9371 struct frame *f;
9372 struct window *w;
9373 Window root, child;
9374 Lisp_Object buffer, top, left;
9375 struct buffer *old_buffer;
9376 struct text_pos pos;
9377 int i, width, height;
9378 int root_x, root_y, win_x, win_y;
9379 unsigned pmask;
9380 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9381 int old_windows_or_buffers_changed = windows_or_buffers_changed;
9382 int count = specpdl_ptr - specpdl;
9383
9384 specbind (Qinhibit_redisplay, Qt);
9385
9386 GCPRO4 (string, parms, frame, timeout);
9387
9388 CHECK_STRING (string, 0);
9389 f = check_x_frame (frame);
9390 if (NILP (timeout))
9391 timeout = make_number (5);
9392 else
9393 CHECK_NATNUM (timeout, 2);
9394
9395 if (NILP (dx))
9396 dx = make_number (5);
9397 else
9398 CHECK_NUMBER (dx, 5);
9399
9400 if (NILP (dy))
9401 dy = make_number (-10);
9402 else
9403 CHECK_NUMBER (dy, 6);
9404
9405 if (NILP (last_show_tip_args))
9406 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
9407
9408 if (!NILP (tip_frame))
9409 {
9410 Lisp_Object last_string = AREF (last_show_tip_args, 0);
9411 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
9412 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
9413
9414 if (EQ (frame, last_frame)
9415 && !NILP (Fequal (last_string, string))
9416 && !NILP (Fequal (last_parms, parms)))
9417 {
9418 struct frame *f = XFRAME (tip_frame);
9419
9420 /* Only DX and DY have changed. */
9421 if (!NILP (tip_timer))
9422 {
9423 Lisp_Object timer = tip_timer;
9424 tip_timer = Qnil;
9425 call1 (Qcancel_timer, timer);
9426 }
9427
9428 BLOCK_INPUT;
9429 compute_tip_xy (f, parms, dx, dy, &root_x, &root_y);
9430 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9431 root_x, root_y - PIXEL_HEIGHT (f));
9432 UNBLOCK_INPUT;
9433 goto start_timer;
9434 }
9435 }
9436
9437 /* Hide a previous tip, if any. */
9438 Fx_hide_tip ();
9439
9440 ASET (last_show_tip_args, 0, string);
9441 ASET (last_show_tip_args, 1, frame);
9442 ASET (last_show_tip_args, 2, parms);
9443
9444 /* Add default values to frame parameters. */
9445 if (NILP (Fassq (Qname, parms)))
9446 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
9447 if (NILP (Fassq (Qinternal_border_width, parms)))
9448 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
9449 if (NILP (Fassq (Qborder_width, parms)))
9450 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
9451 if (NILP (Fassq (Qborder_color, parms)))
9452 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
9453 if (NILP (Fassq (Qbackground_color, parms)))
9454 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
9455 parms);
9456
9457 /* Create a frame for the tooltip, and record it in the global
9458 variable tip_frame. */
9459 frame = x_create_tip_frame (FRAME_MAC_DISPLAY_INFO (f), parms);
9460 f = XFRAME (frame);
9461
9462 /* Set up the frame's root window. Currently we use a size of 80
9463 columns x 40 lines. If someone wants to show a larger tip, he
9464 will loose. I don't think this is a realistic case. */
9465 w = XWINDOW (FRAME_ROOT_WINDOW (f));
9466 w->left = w->top = make_number (0);
9467 w->width = make_number (80);
9468 w->height = make_number (40);
9469 adjust_glyphs (f);
9470 w->pseudo_window_p = 1;
9471
9472 /* Display the tooltip text in a temporary buffer. */
9473 buffer = Fget_buffer_create (build_string (" *tip*"));
9474 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
9475 old_buffer = current_buffer;
9476 set_buffer_internal_1 (XBUFFER (buffer));
9477 Ferase_buffer ();
9478 Finsert (1, &string);
9479 clear_glyph_matrix (w->desired_matrix);
9480 clear_glyph_matrix (w->current_matrix);
9481 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
9482 try_window (FRAME_ROOT_WINDOW (f), pos);
9483
9484 /* Compute width and height of the tooltip. */
9485 width = height = 0;
9486 for (i = 0; i < w->desired_matrix->nrows; ++i)
9487 {
9488 struct glyph_row *row = &w->desired_matrix->rows[i];
9489 struct glyph *last;
9490 int row_width;
9491
9492 /* Stop at the first empty row at the end. */
9493 if (!row->enabled_p || !row->displays_text_p)
9494 break;
9495
9496 /* Let the row go over the full width of the frame. */
9497 row->full_width_p = 1;
9498
9499 /* There's a glyph at the end of rows that is use to place
9500 the cursor there. Don't include the width of this glyph. */
9501 if (row->used[TEXT_AREA])
9502 {
9503 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
9504 row_width = row->pixel_width - last->pixel_width;
9505 }
9506 else
9507 row_width = row->pixel_width;
9508
9509 height += row->height;
9510 width = max (width, row_width);
9511 }
9512
9513 /* Add the frame's internal border to the width and height the X
9514 window should have. */
9515 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
9516 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
9517
9518 /* Move the tooltip window where the mouse pointer is. Resize and
9519 show it. */
9520 compute_tip_xy (f, parms, dx, dy, &root_x, &root_y);
9521
9522 #if 0 /* TODO : Mac specifics */
9523 BLOCK_INPUT;
9524 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9525 root_x, root_y - height, width, height);
9526 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
9527 UNBLOCK_INPUT;
9528 #endif /* TODO */
9529
9530 /* Draw into the window. */
9531 w->must_be_updated_p = 1;
9532 update_single_window (w, 1);
9533
9534 /* Restore original current buffer. */
9535 set_buffer_internal_1 (old_buffer);
9536 windows_or_buffers_changed = old_windows_or_buffers_changed;
9537
9538 start_timer:
9539 /* Let the tip disappear after timeout seconds. */
9540 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
9541 intern ("x-hide-tip"));
9542
9543 UNGCPRO;
9544 return unbind_to (count, Qnil);
9545 }
9546
9547
9548 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
9549 "Hide the current tooltip window, if there is any.\n\
9550 Value is t is tooltip was open, nil otherwise.")
9551 ()
9552 {
9553 int count;
9554 Lisp_Object deleted, frame, timer;
9555 struct gcpro gcpro1, gcpro2;
9556
9557 /* Return quickly if nothing to do. */
9558 if (NILP (tip_timer) && NILP (tip_frame))
9559 return Qnil;
9560
9561 frame = tip_frame;
9562 timer = tip_timer;
9563 GCPRO2 (frame, timer);
9564 tip_frame = tip_timer = deleted = Qnil;
9565
9566 count = BINDING_STACK_SIZE ();
9567 specbind (Qinhibit_redisplay, Qt);
9568 specbind (Qinhibit_quit, Qt);
9569
9570 if (!NILP (timer))
9571 call1 (Qcancel_timer, timer);
9572
9573 if (FRAMEP (frame))
9574 {
9575 Fdelete_frame (frame, Qnil);
9576 deleted = Qt;
9577 }
9578
9579 UNGCPRO;
9580 return unbind_to (count, deleted);
9581 }
9582 #endif
9583
9584
9585 \f
9586 /***********************************************************************
9587 File selection dialog
9588 ***********************************************************************/
9589
9590 #if 0 /* MAC_TODO: can standard file dialog */
9591 extern Lisp_Object Qfile_name_history;
9592
9593 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
9594 "Read file name, prompting with PROMPT in directory DIR.\n\
9595 Use a file selection dialog.\n\
9596 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9597 specified. Don't let the user enter a file name in the file\n\
9598 selection dialog's entry field, if MUSTMATCH is non-nil.")
9599 (prompt, dir, default_filename, mustmatch)
9600 Lisp_Object prompt, dir, default_filename, mustmatch;
9601 {
9602 struct frame *f = SELECTED_FRAME ();
9603 Lisp_Object file = Qnil;
9604 int count = specpdl_ptr - specpdl;
9605 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
9606 char filename[MAX_PATH + 1];
9607 char init_dir[MAX_PATH + 1];
9608 int use_dialog_p = 1;
9609
9610 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
9611 CHECK_STRING (prompt, 0);
9612 CHECK_STRING (dir, 1);
9613
9614 /* Create the dialog with PROMPT as title, using DIR as initial
9615 directory and using "*" as pattern. */
9616 dir = Fexpand_file_name (dir, Qnil);
9617 strncpy (init_dir, XSTRING (dir)->data, MAX_PATH);
9618 init_dir[MAX_PATH] = '\0';
9619 unixtodos_filename (init_dir);
9620
9621 if (STRINGP (default_filename))
9622 {
9623 char *file_name_only;
9624 char *full_path_name = XSTRING (default_filename)->data;
9625
9626 unixtodos_filename (full_path_name);
9627
9628 file_name_only = strrchr (full_path_name, '\\');
9629 if (!file_name_only)
9630 file_name_only = full_path_name;
9631 else
9632 {
9633 file_name_only++;
9634
9635 /* If default_file_name is a directory, don't use the open
9636 file dialog, as it does not support selecting
9637 directories. */
9638 if (!(*file_name_only))
9639 use_dialog_p = 0;
9640 }
9641
9642 strncpy (filename, file_name_only, MAX_PATH);
9643 filename[MAX_PATH] = '\0';
9644 }
9645 else
9646 filename[0] = '\0';
9647
9648 if (use_dialog_p)
9649 {
9650 OPENFILENAME file_details;
9651 char *filename_file;
9652
9653 /* Prevent redisplay. */
9654 specbind (Qinhibit_redisplay, Qt);
9655 BLOCK_INPUT;
9656
9657 bzero (&file_details, sizeof (file_details));
9658 file_details.lStructSize = sizeof (file_details);
9659 file_details.hwndOwner = FRAME_W32_WINDOW (f);
9660 file_details.lpstrFile = filename;
9661 file_details.nMaxFile = sizeof (filename);
9662 file_details.lpstrInitialDir = init_dir;
9663 file_details.lpstrTitle = XSTRING (prompt)->data;
9664 file_details.Flags = OFN_HIDEREADONLY | OFN_NOCHANGEDIR;
9665
9666 if (!NILP (mustmatch))
9667 file_details.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
9668
9669 if (GetOpenFileName (&file_details))
9670 {
9671 dostounix_filename (filename);
9672 file = build_string (filename);
9673 }
9674 else
9675 file = Qnil;
9676
9677 UNBLOCK_INPUT;
9678 file = unbind_to (count, file);
9679 }
9680 /* Open File dialog will not allow folders to be selected, so resort
9681 to minibuffer completing reads for directories. */
9682 else
9683 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
9684 dir, mustmatch, dir, Qfile_name_history,
9685 default_filename, Qnil);
9686
9687 UNGCPRO;
9688
9689 /* Make "Cancel" equivalent to C-g. */
9690 if (NILP (file))
9691 Fsignal (Qquit, Qnil);
9692
9693 return unbind_to (count, file);
9694 }
9695 #endif
9696
9697
9698 \f
9699 /***********************************************************************
9700 Tests
9701 ***********************************************************************/
9702
9703 #if GLYPH_DEBUG
9704
9705 DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
9706 "Value is non-nil if SPEC is a valid image specification.")
9707 (spec)
9708 Lisp_Object spec;
9709 {
9710 return valid_image_p (spec) ? Qt : Qnil;
9711 }
9712
9713
9714 DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, "")
9715 (spec)
9716 Lisp_Object spec;
9717 {
9718 int id = -1;
9719
9720 if (valid_image_p (spec))
9721 id = lookup_image (SELECTED_FRAME (), spec);
9722
9723 debug_print (spec);
9724 return make_number (id);
9725 }
9726
9727 #endif /* GLYPH_DEBUG != 0 */
9728
9729
9730 \f
9731 void
9732 syms_of_macfns ()
9733 {
9734 /* Certainly running on Mac. */
9735 mac_in_use = 1;
9736
9737 /* The section below is built by the lisp expression at the top of the file,
9738 just above where these variables are declared. */
9739 /*&&& init symbols here &&&*/
9740 Qauto_raise = intern ("auto-raise");
9741 staticpro (&Qauto_raise);
9742 Qauto_lower = intern ("auto-lower");
9743 staticpro (&Qauto_lower);
9744 Qbar = intern ("bar");
9745 staticpro (&Qbar);
9746 Qborder_color = intern ("border-color");
9747 staticpro (&Qborder_color);
9748 Qborder_width = intern ("border-width");
9749 staticpro (&Qborder_width);
9750 Qbox = intern ("box");
9751 staticpro (&Qbox);
9752 Qcursor_color = intern ("cursor-color");
9753 staticpro (&Qcursor_color);
9754 Qcursor_type = intern ("cursor-type");
9755 staticpro (&Qcursor_type);
9756 Qgeometry = intern ("geometry");
9757 staticpro (&Qgeometry);
9758 Qicon_left = intern ("icon-left");
9759 staticpro (&Qicon_left);
9760 Qicon_top = intern ("icon-top");
9761 staticpro (&Qicon_top);
9762 Qicon_type = intern ("icon-type");
9763 staticpro (&Qicon_type);
9764 Qicon_name = intern ("icon-name");
9765 staticpro (&Qicon_name);
9766 Qinternal_border_width = intern ("internal-border-width");
9767 staticpro (&Qinternal_border_width);
9768 Qleft = intern ("left");
9769 staticpro (&Qleft);
9770 Qright = intern ("right");
9771 staticpro (&Qright);
9772 Qmouse_color = intern ("mouse-color");
9773 staticpro (&Qmouse_color);
9774 Qnone = intern ("none");
9775 staticpro (&Qnone);
9776 Qparent_id = intern ("parent-id");
9777 staticpro (&Qparent_id);
9778 Qscroll_bar_width = intern ("scroll-bar-width");
9779 staticpro (&Qscroll_bar_width);
9780 Qsuppress_icon = intern ("suppress-icon");
9781 staticpro (&Qsuppress_icon);
9782 Qundefined_color = intern ("undefined-color");
9783 staticpro (&Qundefined_color);
9784 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
9785 staticpro (&Qvertical_scroll_bars);
9786 Qvisibility = intern ("visibility");
9787 staticpro (&Qvisibility);
9788 Qwindow_id = intern ("window-id");
9789 staticpro (&Qwindow_id);
9790 Qx_frame_parameter = intern ("x-frame-parameter");
9791 staticpro (&Qx_frame_parameter);
9792 Qx_resource_name = intern ("x-resource-name");
9793 staticpro (&Qx_resource_name);
9794 Quser_position = intern ("user-position");
9795 staticpro (&Quser_position);
9796 Quser_size = intern ("user-size");
9797 staticpro (&Quser_size);
9798 Qscreen_gamma = intern ("screen-gamma");
9799 staticpro (&Qscreen_gamma);
9800 Qline_spacing = intern ("line-spacing");
9801 staticpro (&Qline_spacing);
9802 Qcenter = intern ("center");
9803 staticpro (&Qcenter);
9804 Qcancel_timer = intern ("cancel-timer");
9805 staticpro (&Qcancel_timer);
9806 /* This is the end of symbol initialization. */
9807
9808 Qhyper = intern ("hyper");
9809 staticpro (&Qhyper);
9810 Qsuper = intern ("super");
9811 staticpro (&Qsuper);
9812 Qmeta = intern ("meta");
9813 staticpro (&Qmeta);
9814 Qalt = intern ("alt");
9815 staticpro (&Qalt);
9816 Qctrl = intern ("ctrl");
9817 staticpro (&Qctrl);
9818 Qcontrol = intern ("control");
9819 staticpro (&Qcontrol);
9820 Qshift = intern ("shift");
9821 staticpro (&Qshift);
9822
9823 /* Text property `display' should be nonsticky by default. */
9824 Vtext_property_default_nonsticky
9825 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
9826
9827
9828 Qlaplace = intern ("laplace");
9829 staticpro (&Qlaplace);
9830
9831 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
9832 staticpro (&Qface_set_after_frame_default);
9833
9834 Fput (Qundefined_color, Qerror_conditions,
9835 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
9836 Fput (Qundefined_color, Qerror_message,
9837 build_string ("Undefined color"));
9838
9839 init_x_parm_symbols ();
9840
9841 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
9842 "List of directories to search for bitmap files for w32.");
9843 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
9844
9845 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
9846 "The shape of the pointer when over text.\n\
9847 Changing the value does not affect existing frames\n\
9848 unless you set the mouse color.");
9849 Vx_pointer_shape = Qnil;
9850
9851 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
9852 "The name Emacs uses to look up resources; for internal use only.\n\
9853 `x-get-resource' uses this as the first component of the instance name\n\
9854 when requesting resource values.\n\
9855 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
9856 was invoked, or to the value specified with the `-name' or `-rn'\n\
9857 switches, if present.");
9858 Vx_resource_name = Qnil;
9859
9860 Vx_nontext_pointer_shape = Qnil;
9861
9862 Vx_mode_pointer_shape = Qnil;
9863
9864 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
9865 "The shape of the pointer when Emacs is busy.\n\
9866 This variable takes effect when you create a new frame\n\
9867 or when you set the mouse color.");
9868 Vx_hourglass_pointer_shape = Qnil;
9869
9870 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
9871 "Non-zero means Emacs displays an hourglass pointer on window systems.");
9872 display_hourglass_p = 1;
9873
9874 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
9875 "*Seconds to wait before displaying an hourglass pointer.\n\
9876 Value must be an integer or float.");
9877 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
9878
9879 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
9880 &Vx_sensitive_text_pointer_shape,
9881 "The shape of the pointer when over mouse-sensitive text.\n\
9882 This variable takes effect when you create a new frame\n\
9883 or when you set the mouse color.");
9884 Vx_sensitive_text_pointer_shape = Qnil;
9885
9886 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
9887 "A string indicating the foreground color of the cursor box.");
9888 Vx_cursor_fore_pixel = Qnil;
9889
9890 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
9891 "Non-nil if no window manager is in use.\n\
9892 Emacs doesn't try to figure this out; this is always nil\n\
9893 unless you set it to something else.");
9894 /* We don't have any way to find this out, so set it to nil
9895 and maybe the user would like to set it to t. */
9896 Vx_no_window_manager = Qnil;
9897
9898 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9899 &Vx_pixel_size_width_font_regexp,
9900 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
9901 \n\
9902 Since Emacs gets width of a font matching with this regexp from\n\
9903 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
9904 such a font. This is especially effective for such large fonts as\n\
9905 Chinese, Japanese, and Korean.");
9906 Vx_pixel_size_width_font_regexp = Qnil;
9907
9908 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
9909 "Time after which cached images are removed from the cache.\n\
9910 When an image has not been displayed this many seconds, remove it\n\
9911 from the image cache. Value must be an integer or nil with nil\n\
9912 meaning don't clear the cache.");
9913 Vimage_cache_eviction_delay = make_number (30 * 60);
9914
9915 #if 0 /* MAC_TODO: implement get X resource */
9916 defsubr (&Sx_get_resource);
9917 #endif
9918 defsubr (&Sx_change_window_property);
9919 defsubr (&Sx_delete_window_property);
9920 defsubr (&Sx_window_property);
9921 defsubr (&Sxw_display_color_p);
9922 defsubr (&Sx_display_grayscale_p);
9923 defsubr (&Sxw_color_defined_p);
9924 defsubr (&Sxw_color_values);
9925 defsubr (&Sx_server_max_request_size);
9926 defsubr (&Sx_server_vendor);
9927 defsubr (&Sx_server_version);
9928 defsubr (&Sx_display_pixel_width);
9929 defsubr (&Sx_display_pixel_height);
9930 defsubr (&Sx_display_mm_width);
9931 defsubr (&Sx_display_mm_height);
9932 defsubr (&Sx_display_screens);
9933 defsubr (&Sx_display_planes);
9934 defsubr (&Sx_display_color_cells);
9935 defsubr (&Sx_display_visual_class);
9936 defsubr (&Sx_display_backing_store);
9937 defsubr (&Sx_display_save_under);
9938 #if 0 /* MAC_TODO: implement XParseGeometry */
9939 defsubr (&Sx_parse_geometry);
9940 #endif
9941 defsubr (&Sx_create_frame);
9942 #if 0 /* MAC_TODO: implement network support */
9943 defsubr (&Sx_open_connection);
9944 defsubr (&Sx_close_connection);
9945 #endif
9946 defsubr (&Sx_display_list);
9947 defsubr (&Sx_synchronize);
9948
9949 /* Setting callback functions for fontset handler. */
9950 get_font_info_func = x_get_font_info;
9951
9952 #if 0 /* This function pointer doesn't seem to be used anywhere.
9953 And the pointer assigned has the wrong type, anyway. */
9954 list_fonts_func = x_list_fonts;
9955 #endif
9956
9957 load_font_func = x_load_font;
9958 find_ccl_program_func = x_find_ccl_program;
9959 query_font_func = x_query_font;
9960
9961 set_frame_fontset_func = x_set_font;
9962 check_window_system_func = check_mac;
9963
9964 #if 0 /* MAC_TODO: Image support for Mac Images. */
9965 Qxbm = intern ("xbm");
9966 staticpro (&Qxbm);
9967 QCtype = intern (":type");
9968 staticpro (&QCtype);
9969 QCconversion = intern (":conversion");
9970 staticpro (&QCconversion);
9971 QCheuristic_mask = intern (":heuristic-mask");
9972 staticpro (&QCheuristic_mask);
9973 QCcolor_symbols = intern (":color-symbols");
9974 staticpro (&QCcolor_symbols);
9975 QCascent = intern (":ascent");
9976 staticpro (&QCascent);
9977 QCmargin = intern (":margin");
9978 staticpro (&QCmargin);
9979 QCrelief = intern (":relief");
9980 staticpro (&QCrelief);
9981 Qpostscript = intern ("postscript");
9982 staticpro (&Qpostscript);
9983 QCloader = intern (":loader");
9984 staticpro (&QCloader);
9985 QCbounding_box = intern (":bounding-box");
9986 staticpro (&QCbounding_box);
9987 QCpt_width = intern (":pt-width");
9988 staticpro (&QCpt_width);
9989 QCpt_height = intern (":pt-height");
9990 staticpro (&QCpt_height);
9991 QCindex = intern (":index");
9992 staticpro (&QCindex);
9993 Qpbm = intern ("pbm");
9994 staticpro (&Qpbm);
9995
9996 #if HAVE_XPM
9997 Qxpm = intern ("xpm");
9998 staticpro (&Qxpm);
9999 #endif
10000
10001 #if HAVE_JPEG
10002 Qjpeg = intern ("jpeg");
10003 staticpro (&Qjpeg);
10004 #endif
10005
10006 #if HAVE_TIFF
10007 Qtiff = intern ("tiff");
10008 staticpro (&Qtiff);
10009 #endif
10010
10011 #if HAVE_GIF
10012 Qgif = intern ("gif");
10013 staticpro (&Qgif);
10014 #endif
10015
10016 #if HAVE_PNG
10017 Qpng = intern ("png");
10018 staticpro (&Qpng);
10019 #endif
10020
10021 defsubr (&Sclear_image_cache);
10022
10023 #if GLYPH_DEBUG
10024 defsubr (&Simagep);
10025 defsubr (&Slookup_image);
10026 #endif
10027 #endif /* TODO */
10028
10029 hourglass_atimer = NULL;
10030 hourglass_shown_p = 0;
10031 #ifdef TODO /* Tooltip support not complete. */
10032 defsubr (&Sx_show_tip);
10033 defsubr (&Sx_hide_tip);
10034 #endif
10035 tip_timer = Qnil;
10036 staticpro (&tip_timer);
10037 tip_frame = Qnil;
10038 staticpro (&tip_frame);
10039
10040 #if 0 /* MAC_TODO */
10041 defsubr (&Sx_file_dialog);
10042 #endif
10043 }
10044
10045
10046 void
10047 init_xfns ()
10048 {
10049 image_types = NULL;
10050 Vimage_types = Qnil;
10051
10052 #if 0 /* TODO : Image support for W32 */
10053 define_image_type (&xbm_type);
10054 define_image_type (&gs_type);
10055 define_image_type (&pbm_type);
10056
10057 #if HAVE_XPM
10058 define_image_type (&xpm_type);
10059 #endif
10060
10061 #if HAVE_JPEG
10062 define_image_type (&jpeg_type);
10063 #endif
10064
10065 #if HAVE_TIFF
10066 define_image_type (&tiff_type);
10067 #endif
10068
10069 #if HAVE_GIF
10070 define_image_type (&gif_type);
10071 #endif
10072
10073 #if HAVE_PNG
10074 define_image_type (&png_type);
10075 #endif
10076 #endif /* NTEMACS_TODO */
10077 }
10078
10079 #undef abort
10080
10081 #if 0
10082 void
10083 w32_abort()
10084 {
10085 int button;
10086 button = MessageBox (NULL,
10087 "A fatal error has occurred!\n\n"
10088 "Select Abort to exit, Retry to debug, Ignore to continue",
10089 "Emacs Abort Dialog",
10090 MB_ICONEXCLAMATION | MB_TASKMODAL
10091 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
10092 switch (button)
10093 {
10094 case IDRETRY:
10095 DebugBreak ();
10096 break;
10097 case IDIGNORE:
10098 break;
10099 case IDABORT:
10100 default:
10101 abort ();
10102 break;
10103 }
10104 }
10105
10106 /* For convenience when debugging. */
10107 int
10108 w32_last_error()
10109 {
10110 return GetLastError ();
10111 }
10112 #endif