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