Fixed X support, preliminary support for X-tty combo sessions.
[bpt/emacs.git] / src / xfns.c
1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 01, 02, 03
3 Free Software Foundation.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 #include <config.h>
23 #include <signal.h>
24 #include <stdio.h>
25 #include <math.h>
26
27 #ifdef HAVE_UNISTD_H
28 #include <unistd.h>
29 #endif
30
31 /* This makes the fields of a Display accessible, in Xlib header files. */
32
33 #define XLIB_ILLEGAL_ACCESS
34
35 #include "lisp.h"
36 #include "xterm.h"
37 #include "frame.h"
38 #include "window.h"
39 #include "buffer.h"
40 #include "intervals.h"
41 #include "dispextern.h"
42 #include "keyboard.h"
43 #include "blockinput.h"
44 #include <epaths.h>
45 #include "charset.h"
46 #include "coding.h"
47 #include "fontset.h"
48 #include "systime.h"
49 #include "termhooks.h"
50 #include "atimer.h"
51 #include "systty.h"
52 #include "termchar.h"
53
54 #ifdef HAVE_X_WINDOWS
55
56 #include <ctype.h>
57 #include <sys/types.h>
58 #include <sys/stat.h>
59
60 #ifndef VMS
61 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
62 #include "bitmaps/gray.xbm"
63 #else
64 #include <X11/bitmaps/gray>
65 #endif
66 #else
67 #include "[.bitmaps]gray.xbm"
68 #endif
69
70 #ifdef USE_GTK
71 #include "gtkutil.h"
72 #endif
73
74 #ifdef USE_X_TOOLKIT
75 #include <X11/Shell.h>
76
77 #ifndef USE_MOTIF
78 #include <X11/Xaw/Paned.h>
79 #include <X11/Xaw/Label.h>
80 #endif /* USE_MOTIF */
81
82 #ifdef USG
83 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
84 #include <X11/Xos.h>
85 #define USG
86 #else
87 #include <X11/Xos.h>
88 #endif
89
90 #include "widget.h"
91
92 #include "../lwlib/lwlib.h"
93
94 #ifdef USE_MOTIF
95 #include <Xm/Xm.h>
96 #include <Xm/DialogS.h>
97 #include <Xm/FileSB.h>
98 #endif
99
100 /* Do the EDITRES protocol if running X11R5
101 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
102
103 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
104 #define HACK_EDITRES
105 extern void _XEditResCheckMessages ();
106 #endif /* R5 + Athena */
107
108 /* Unique id counter for widgets created by the Lucid Widget Library. */
109
110 extern LWLIB_ID widget_id_tick;
111
112 #ifdef USE_LUCID
113 /* This is part of a kludge--see lwlib/xlwmenu.c. */
114 extern XFontStruct *xlwmenu_default_font;
115 #endif
116
117 extern void free_frame_menubar ();
118 extern double atof ();
119
120 #ifdef USE_MOTIF
121
122 /* LessTif/Motif version info. */
123
124 static Lisp_Object Vmotif_version_string;
125
126 #endif /* USE_MOTIF */
127
128 #endif /* USE_X_TOOLKIT */
129
130 #ifdef USE_GTK
131
132 /* GTK+ version info */
133
134 static Lisp_Object Vgtk_version_string;
135
136 #endif /* USE_GTK */
137
138 #ifdef HAVE_X11R4
139 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
140 #else
141 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
142 #endif
143
144 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
145 it, and including `bitmaps/gray' more than once is a problem when
146 config.h defines `static' as an empty replacement string. */
147
148 int gray_bitmap_width = gray_width;
149 int gray_bitmap_height = gray_height;
150 char *gray_bitmap_bits = gray_bits;
151
152 /* Non-zero means we're allowed to display an hourglass cursor. */
153
154 int display_hourglass_p;
155
156 /* The background and shape of the mouse pointer, and shape when not
157 over text or in the modeline. */
158
159 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
160 Lisp_Object Vx_hourglass_pointer_shape;
161
162 /* The shape when over mouse-sensitive text. */
163
164 Lisp_Object Vx_sensitive_text_pointer_shape;
165
166 /* If non-nil, the pointer shape to indicate that windows can be
167 dragged horizontally. */
168
169 Lisp_Object Vx_window_horizontal_drag_shape;
170
171 /* Color of chars displayed in cursor box. */
172
173 Lisp_Object Vx_cursor_fore_pixel;
174
175 /* Nonzero if using X. */
176
177 static int x_in_use;
178
179 /* Non nil if no window manager is in use. */
180
181 Lisp_Object Vx_no_window_manager;
182
183 /* Search path for bitmap files. */
184
185 Lisp_Object Vx_bitmap_file_path;
186
187 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
188
189 Lisp_Object Vx_pixel_size_width_font_regexp;
190
191 Lisp_Object Qnone;
192 Lisp_Object Qsuppress_icon;
193 Lisp_Object Qundefined_color;
194 Lisp_Object Qcenter;
195 Lisp_Object Qcompound_text, Qcancel_timer;
196
197 /* In dispnew.c */
198
199 extern Lisp_Object Vwindow_system_version;
200
201 /* The below are defined in frame.c. */
202
203 #if GLYPH_DEBUG
204 int image_cache_refcount, dpyinfo_refcount;
205 #endif
206
207
208 \f
209 /* Error if we are not connected to X. */
210
211 void
212 check_x ()
213 {
214 if (! x_in_use)
215 error ("X windows are not in use or not initialized");
216 }
217
218 /* Nonzero if we can use mouse menus.
219 You should not call this unless HAVE_MENUS is defined. */
220
221 int
222 have_menus_p ()
223 {
224 return x_in_use;
225 }
226
227 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
228 and checking validity for X. */
229
230 FRAME_PTR
231 check_x_frame (frame)
232 Lisp_Object frame;
233 {
234 FRAME_PTR f;
235
236 if (NILP (frame))
237 frame = selected_frame;
238 CHECK_LIVE_FRAME (frame);
239 f = XFRAME (frame);
240 if (! FRAME_X_P (f))
241 error ("Non-X frame used");
242 return f;
243 }
244
245 /* Let the user specify an X display with a frame.
246 nil stands for the selected frame--or, if that is not an X frame,
247 the first X display on the list. */
248
249 struct x_display_info *
250 check_x_display_info (frame)
251 Lisp_Object frame;
252 {
253 struct x_display_info *dpyinfo = NULL;
254
255 if (NILP (frame))
256 {
257 struct frame *sf = XFRAME (selected_frame);
258
259 if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
260 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
261 else if (x_display_list != 0)
262 dpyinfo = x_display_list;
263 else
264 error ("X windows are not in use or not initialized");
265 }
266 else if (STRINGP (frame))
267 dpyinfo = x_display_info_for_name (frame);
268 else
269 {
270 FRAME_PTR f = check_x_frame (frame);
271 dpyinfo = FRAME_X_DISPLAY_INFO (f);
272 }
273
274 return dpyinfo;
275 }
276
277 \f
278 /* Return the Emacs frame-object corresponding to an X window.
279 It could be the frame's main window or an icon window. */
280
281 /* This function can be called during GC, so use GC_xxx type test macros. */
282
283 struct frame *
284 x_window_to_frame (dpyinfo, wdesc)
285 struct x_display_info *dpyinfo;
286 int wdesc;
287 {
288 Lisp_Object tail, frame;
289 struct frame *f;
290
291 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
292 {
293 frame = XCAR (tail);
294 if (!GC_FRAMEP (frame))
295 continue;
296 f = XFRAME (frame);
297 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
298 continue;
299 if (f->output_data.x->hourglass_window == wdesc)
300 return f;
301 #ifdef USE_X_TOOLKIT
302 if ((f->output_data.x->edit_widget
303 && XtWindow (f->output_data.x->edit_widget) == wdesc)
304 /* A tooltip frame? */
305 || (!f->output_data.x->edit_widget
306 && FRAME_X_WINDOW (f) == wdesc)
307 || f->output_data.x->icon_desc == wdesc)
308 return f;
309 #else /* not USE_X_TOOLKIT */
310 #ifdef USE_GTK
311 if (f->output_data.x->edit_widget)
312 {
313 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
314 struct x_output *x = f->output_data.x;
315 if (gwdesc != 0 && gwdesc == x->edit_widget)
316 return f;
317 }
318 #endif /* USE_GTK */
319 if (FRAME_X_WINDOW (f) == wdesc
320 || f->output_data.x->icon_desc == wdesc)
321 return f;
322 #endif /* not USE_X_TOOLKIT */
323 }
324 return 0;
325 }
326
327 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
328 /* Like x_window_to_frame but also compares the window with the widget's
329 windows. */
330
331 struct frame *
332 x_any_window_to_frame (dpyinfo, wdesc)
333 struct x_display_info *dpyinfo;
334 int wdesc;
335 {
336 Lisp_Object tail, frame;
337 struct frame *f, *found;
338 struct x_output *x;
339
340 found = NULL;
341 for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
342 {
343 frame = XCAR (tail);
344 if (!GC_FRAMEP (frame))
345 continue;
346
347 f = XFRAME (frame);
348 if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
349 {
350 /* This frame matches if the window is any of its widgets. */
351 x = f->output_data.x;
352 if (x->hourglass_window == wdesc)
353 found = f;
354 else if (x->widget)
355 {
356 #ifdef USE_GTK
357 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
358 if (gwdesc != 0
359 && (gwdesc == x->widget
360 || gwdesc == x->edit_widget
361 || gwdesc == x->vbox_widget
362 || gwdesc == x->menubar_widget))
363 found = f;
364 #else
365 if (wdesc == XtWindow (x->widget)
366 || wdesc == XtWindow (x->column_widget)
367 || wdesc == XtWindow (x->edit_widget))
368 found = f;
369 /* Match if the window is this frame's menubar. */
370 else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
371 found = f;
372 #endif
373 }
374 else if (FRAME_X_WINDOW (f) == wdesc)
375 /* A tooltip frame. */
376 found = f;
377 }
378 }
379
380 return found;
381 }
382
383 /* Likewise, but exclude the menu bar widget. */
384
385 struct frame *
386 x_non_menubar_window_to_frame (dpyinfo, wdesc)
387 struct x_display_info *dpyinfo;
388 int wdesc;
389 {
390 Lisp_Object tail, frame;
391 struct frame *f;
392 struct x_output *x;
393
394 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
395 {
396 frame = XCAR (tail);
397 if (!GC_FRAMEP (frame))
398 continue;
399 f = XFRAME (frame);
400 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
401 continue;
402 x = f->output_data.x;
403 /* This frame matches if the window is any of its widgets. */
404 if (x->hourglass_window == wdesc)
405 return f;
406 else if (x->widget)
407 {
408 #ifdef USE_GTK
409 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
410 if (gwdesc != 0
411 && (gwdesc == x->widget
412 || gwdesc == x->edit_widget
413 || gwdesc == x->vbox_widget))
414 return f;
415 #else
416 if (wdesc == XtWindow (x->widget)
417 || wdesc == XtWindow (x->column_widget)
418 || wdesc == XtWindow (x->edit_widget))
419 return f;
420 #endif
421 }
422 else if (FRAME_X_WINDOW (f) == wdesc)
423 /* A tooltip frame. */
424 return f;
425 }
426 return 0;
427 }
428
429 /* Likewise, but consider only the menu bar widget. */
430
431 struct frame *
432 x_menubar_window_to_frame (dpyinfo, wdesc)
433 struct x_display_info *dpyinfo;
434 int wdesc;
435 {
436 Lisp_Object tail, frame;
437 struct frame *f;
438 struct x_output *x;
439
440 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
441 {
442 frame = XCAR (tail);
443 if (!GC_FRAMEP (frame))
444 continue;
445 f = XFRAME (frame);
446 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
447 continue;
448 x = f->output_data.x;
449 /* Match if the window is this frame's menubar. */
450 #ifdef USE_GTK
451 if (x->menubar_widget)
452 {
453 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
454 int found = 0;
455
456 BLOCK_INPUT;
457 if (gwdesc != 0
458 && (gwdesc == x->menubar_widget
459 || gtk_widget_get_parent (gwdesc) == x->menubar_widget))
460 found = 1;
461 UNBLOCK_INPUT;
462 if (found) return f;
463 }
464 #else
465 if (x->menubar_widget
466 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
467 return f;
468 #endif
469 }
470 return 0;
471 }
472
473 /* Return the frame whose principal (outermost) window is WDESC.
474 If WDESC is some other (smaller) window, we return 0. */
475
476 struct frame *
477 x_top_window_to_frame (dpyinfo, wdesc)
478 struct x_display_info *dpyinfo;
479 int wdesc;
480 {
481 Lisp_Object tail, frame;
482 struct frame *f;
483 struct x_output *x;
484
485 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
486 {
487 frame = XCAR (tail);
488 if (!GC_FRAMEP (frame))
489 continue;
490 f = XFRAME (frame);
491 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
492 continue;
493 x = f->output_data.x;
494
495 if (x->widget)
496 {
497 /* This frame matches if the window is its topmost widget. */
498 #ifdef USE_GTK
499 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
500 if (gwdesc == x->widget)
501 return f;
502 #else
503 if (wdesc == XtWindow (x->widget))
504 return f;
505 #if 0 /* I don't know why it did this,
506 but it seems logically wrong,
507 and it causes trouble for MapNotify events. */
508 /* Match if the window is this frame's menubar. */
509 if (x->menubar_widget
510 && wdesc == XtWindow (x->menubar_widget))
511 return f;
512 #endif
513 #endif
514 }
515 else if (FRAME_X_WINDOW (f) == wdesc)
516 /* Tooltip frame. */
517 return f;
518 }
519 return 0;
520 }
521 #endif /* USE_X_TOOLKIT || USE_GTK */
522
523 \f
524
525 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
526 id, which is just an int that this section returns. Bitmaps are
527 reference counted so they can be shared among frames.
528
529 Bitmap indices are guaranteed to be > 0, so a negative number can
530 be used to indicate no bitmap.
531
532 If you use x_create_bitmap_from_data, then you must keep track of
533 the bitmaps yourself. That is, creating a bitmap from the same
534 data more than once will not be caught. */
535
536
537 /* Functions to access the contents of a bitmap, given an id. */
538
539 int
540 x_bitmap_height (f, id)
541 FRAME_PTR f;
542 int id;
543 {
544 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
545 }
546
547 int
548 x_bitmap_width (f, id)
549 FRAME_PTR f;
550 int id;
551 {
552 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
553 }
554
555 int
556 x_bitmap_pixmap (f, id)
557 FRAME_PTR f;
558 int id;
559 {
560 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
561 }
562
563 int
564 x_bitmap_mask (f, id)
565 FRAME_PTR f;
566 int id;
567 {
568 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].mask;
569 }
570
571
572 /* Allocate a new bitmap record. Returns index of new record. */
573
574 static int
575 x_allocate_bitmap_record (f)
576 FRAME_PTR f;
577 {
578 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
579 int i;
580
581 if (dpyinfo->bitmaps == NULL)
582 {
583 dpyinfo->bitmaps_size = 10;
584 dpyinfo->bitmaps
585 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
586 dpyinfo->bitmaps_last = 1;
587 return 1;
588 }
589
590 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
591 return ++dpyinfo->bitmaps_last;
592
593 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
594 if (dpyinfo->bitmaps[i].refcount == 0)
595 return i + 1;
596
597 dpyinfo->bitmaps_size *= 2;
598 dpyinfo->bitmaps
599 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
600 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
601 return ++dpyinfo->bitmaps_last;
602 }
603
604 /* Add one reference to the reference count of the bitmap with id ID. */
605
606 void
607 x_reference_bitmap (f, id)
608 FRAME_PTR f;
609 int id;
610 {
611 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
612 }
613
614 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
615
616 int
617 x_create_bitmap_from_data (f, bits, width, height)
618 struct frame *f;
619 char *bits;
620 unsigned int width, height;
621 {
622 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
623 Pixmap bitmap;
624 int id;
625
626 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
627 bits, width, height);
628
629
630
631 if (! bitmap)
632 return -1;
633
634 id = x_allocate_bitmap_record (f);
635 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
636 dpyinfo->bitmaps[id - 1].have_mask = 0;
637 dpyinfo->bitmaps[id - 1].file = NULL;
638 dpyinfo->bitmaps[id - 1].refcount = 1;
639 dpyinfo->bitmaps[id - 1].depth = 1;
640 dpyinfo->bitmaps[id - 1].height = height;
641 dpyinfo->bitmaps[id - 1].width = width;
642
643 return id;
644 }
645
646 /* Create bitmap from file FILE for frame F. */
647
648 int
649 x_create_bitmap_from_file (f, file)
650 struct frame *f;
651 Lisp_Object file;
652 {
653 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
654 unsigned int width, height;
655 Pixmap bitmap;
656 int xhot, yhot, result, id;
657 Lisp_Object found;
658 int fd;
659 char *filename;
660
661 /* Look for an existing bitmap with the same name. */
662 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
663 {
664 if (dpyinfo->bitmaps[id].refcount
665 && dpyinfo->bitmaps[id].file
666 && !strcmp (dpyinfo->bitmaps[id].file, (char *) SDATA (file)))
667 {
668 ++dpyinfo->bitmaps[id].refcount;
669 return id + 1;
670 }
671 }
672
673 /* Search bitmap-file-path for the file, if appropriate. */
674 fd = openp (Vx_bitmap_file_path, file, Qnil, &found, Qnil);
675 if (fd < 0)
676 return -1;
677 emacs_close (fd);
678
679 filename = (char *) SDATA (found);
680
681 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
682 filename, &width, &height, &bitmap, &xhot, &yhot);
683 if (result != BitmapSuccess)
684 return -1;
685
686 id = x_allocate_bitmap_record (f);
687 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
688 dpyinfo->bitmaps[id - 1].have_mask = 0;
689 dpyinfo->bitmaps[id - 1].refcount = 1;
690 dpyinfo->bitmaps[id - 1].file
691 = (char *) xmalloc (SBYTES (file) + 1);
692 dpyinfo->bitmaps[id - 1].depth = 1;
693 dpyinfo->bitmaps[id - 1].height = height;
694 dpyinfo->bitmaps[id - 1].width = width;
695 strcpy (dpyinfo->bitmaps[id - 1].file, SDATA (file));
696
697 return id;
698 }
699
700 /* Remove reference to bitmap with id number ID. */
701
702 void
703 x_destroy_bitmap (f, id)
704 FRAME_PTR f;
705 int id;
706 {
707 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
708
709 if (id > 0)
710 {
711 --dpyinfo->bitmaps[id - 1].refcount;
712 if (dpyinfo->bitmaps[id - 1].refcount == 0)
713 {
714 BLOCK_INPUT;
715 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
716 if (dpyinfo->bitmaps[id - 1].have_mask)
717 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].mask);
718 if (dpyinfo->bitmaps[id - 1].file)
719 {
720 xfree (dpyinfo->bitmaps[id - 1].file);
721 dpyinfo->bitmaps[id - 1].file = NULL;
722 }
723 UNBLOCK_INPUT;
724 }
725 }
726 }
727
728 /* Free all the bitmaps for the display specified by DPYINFO. */
729
730 static void
731 x_destroy_all_bitmaps (dpyinfo)
732 struct x_display_info *dpyinfo;
733 {
734 int i;
735 for (i = 0; i < dpyinfo->bitmaps_last; i++)
736 if (dpyinfo->bitmaps[i].refcount > 0)
737 {
738 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
739 if (dpyinfo->bitmaps[i].have_mask)
740 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].mask);
741 if (dpyinfo->bitmaps[i].file)
742 xfree (dpyinfo->bitmaps[i].file);
743 }
744 dpyinfo->bitmaps_last = 0;
745 }
746 \f
747
748
749
750 /* Useful functions defined in the section
751 `Image type independent image structures' below. */
752
753 static unsigned long four_corners_best P_ ((XImage *ximg, unsigned long width,
754 unsigned long height));
755
756 static int x_create_x_image_and_pixmap P_ ((struct frame *f, int width, int height,
757 int depth, XImage **ximg,
758 Pixmap *pixmap));
759
760 static void x_destroy_x_image P_ ((XImage *ximg));
761
762
763 /* Create a mask of a bitmap. Note is this not a perfect mask.
764 It's nicer with some borders in this context */
765
766 int
767 x_create_bitmap_mask (f, id)
768 struct frame *f;
769 int id;
770 {
771 Pixmap pixmap, mask;
772 XImage *ximg, *mask_img;
773 unsigned long width, height;
774 int result;
775 unsigned long bg;
776 unsigned long x, y, xp, xm, yp, ym;
777 GC gc;
778
779 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
780 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
781
782 if (!(id > 0))
783 return -1;
784
785 pixmap = x_bitmap_pixmap (f, id);
786 width = x_bitmap_width (f, id);
787 height = x_bitmap_height (f, id);
788
789 BLOCK_INPUT;
790 ximg = XGetImage (FRAME_X_DISPLAY (f), pixmap, 0, 0, width, height,
791 ~0, ZPixmap);
792
793 if (!ximg)
794 {
795 UNBLOCK_INPUT;
796 return -1;
797 }
798
799 result = x_create_x_image_and_pixmap (f, width, height, 1, &mask_img, &mask);
800
801 UNBLOCK_INPUT;
802 if (!result)
803 {
804 XDestroyImage (ximg);
805 return -1;
806 }
807
808 bg = four_corners_best (ximg, width, height);
809
810 for (y = 0; y < ximg->height; ++y)
811 {
812 for (x = 0; x < ximg->width; ++x)
813 {
814 xp = x != ximg->width - 1 ? x + 1 : 0;
815 xm = x != 0 ? x - 1 : ximg->width - 1;
816 yp = y != ximg->height - 1 ? y + 1 : 0;
817 ym = y != 0 ? y - 1 : ximg->height - 1;
818 if (XGetPixel (ximg, x, y) == bg
819 && XGetPixel (ximg, x, yp) == bg
820 && XGetPixel (ximg, x, ym) == bg
821 && XGetPixel (ximg, xp, y) == bg
822 && XGetPixel (ximg, xp, yp) == bg
823 && XGetPixel (ximg, xp, ym) == bg
824 && XGetPixel (ximg, xm, y) == bg
825 && XGetPixel (ximg, xm, yp) == bg
826 && XGetPixel (ximg, xm, ym) == bg)
827 XPutPixel (mask_img, x, y, 0);
828 else
829 XPutPixel (mask_img, x, y, 1);
830 }
831 }
832
833 xassert (interrupt_input_blocked);
834 gc = XCreateGC (FRAME_X_DISPLAY (f), mask, 0, NULL);
835 XPutImage (FRAME_X_DISPLAY (f), mask, gc, mask_img, 0, 0, 0, 0,
836 width, height);
837 XFreeGC (FRAME_X_DISPLAY (f), gc);
838
839 dpyinfo->bitmaps[id - 1].have_mask = 1;
840 dpyinfo->bitmaps[id - 1].mask = mask;
841
842 XDestroyImage (ximg);
843 x_destroy_x_image (mask_img);
844
845 return 0;
846 }
847
848 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
849 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
850 static void x_disable_image P_ ((struct frame *, struct image *));
851
852 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
853 static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
854 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
855 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
856 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
857 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
858 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
859 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
860 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
861 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
862 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
863 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
864 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
865 void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
866 Lisp_Object));
867 void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
868 Lisp_Object));
869 static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
870 Lisp_Object,
871 Lisp_Object,
872 char *, char *,
873 int));
874 static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
875 Lisp_Object));
876 static void init_color_table P_ ((void));
877 static void free_color_table P_ ((void));
878 static unsigned long *colors_in_color_table P_ ((int *n));
879 static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
880 static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
881
882
883
884 \f
885
886 /* Store the screen positions of frame F into XPTR and YPTR.
887 These are the positions of the containing window manager window,
888 not Emacs's own window. */
889
890 void
891 x_real_positions (f, xptr, yptr)
892 FRAME_PTR f;
893 int *xptr, *yptr;
894 {
895 int win_x, win_y, outer_x, outer_y;
896 int real_x = 0, real_y = 0;
897 int had_errors = 0;
898 Window win = f->output_data.x->parent_desc;
899
900 int count;
901
902 BLOCK_INPUT;
903
904 count = x_catch_errors (FRAME_X_DISPLAY (f));
905
906 if (win == FRAME_X_DISPLAY_INFO (f)->root_window)
907 win = FRAME_OUTER_WINDOW (f);
908
909 /* This loop traverses up the containment tree until we hit the root
910 window. Window managers may intersect many windows between our window
911 and the root window. The window we find just before the root window
912 should be the outer WM window. */
913 for (;;)
914 {
915 Window wm_window, rootw;
916 Window *tmp_children;
917 unsigned int tmp_nchildren;
918 int success;
919
920 success = XQueryTree (FRAME_X_DISPLAY (f), win, &rootw,
921 &wm_window, &tmp_children, &tmp_nchildren);
922
923 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
924
925 /* Don't free tmp_children if XQueryTree failed. */
926 if (! success)
927 break;
928
929 XFree ((char *) tmp_children);
930
931 if (wm_window == rootw || had_errors)
932 break;
933
934 win = wm_window;
935 }
936
937 if (! had_errors)
938 {
939 int ign;
940 Window child, rootw;
941
942 /* Get the real coordinates for the WM window upper left corner */
943 XGetGeometry (FRAME_X_DISPLAY (f), win,
944 &rootw, &real_x, &real_y, &ign, &ign, &ign, &ign);
945
946 /* Translate real coordinates to coordinates relative to our
947 window. For our window, the upper left corner is 0, 0.
948 Since the upper left corner of the WM window is outside
949 our window, win_x and win_y will be negative:
950
951 ------------------ ---> x
952 | title |
953 | ----------------- v y
954 | | our window
955 */
956 XTranslateCoordinates (FRAME_X_DISPLAY (f),
957
958 /* From-window, to-window. */
959 FRAME_X_DISPLAY_INFO (f)->root_window,
960 FRAME_X_WINDOW (f),
961
962 /* From-position, to-position. */
963 real_x, real_y, &win_x, &win_y,
964
965 /* Child of win. */
966 &child);
967
968 if (FRAME_X_WINDOW (f) == FRAME_OUTER_WINDOW (f))
969 {
970 outer_x = win_x;
971 outer_y = win_y;
972 }
973 else
974 {
975 XTranslateCoordinates (FRAME_X_DISPLAY (f),
976
977 /* From-window, to-window. */
978 FRAME_X_DISPLAY_INFO (f)->root_window,
979 FRAME_OUTER_WINDOW (f),
980
981 /* From-position, to-position. */
982 real_x, real_y, &outer_x, &outer_y,
983
984 /* Child of win. */
985 &child);
986 }
987
988 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
989 }
990
991 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
992
993 UNBLOCK_INPUT;
994
995 if (had_errors) return;
996
997 f->x_pixels_diff = -win_x;
998 f->y_pixels_diff = -win_y;
999
1000 FRAME_X_OUTPUT (f)->x_pixels_outer_diff = -outer_x;
1001 FRAME_X_OUTPUT (f)->y_pixels_outer_diff = -outer_y;
1002
1003 *xptr = real_x;
1004 *yptr = real_y;
1005 }
1006
1007 \f
1008
1009
1010 /* Gamma-correct COLOR on frame F. */
1011
1012 void
1013 gamma_correct (f, color)
1014 struct frame *f;
1015 XColor *color;
1016 {
1017 if (f->gamma)
1018 {
1019 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
1020 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
1021 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
1022 }
1023 }
1024
1025
1026 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1027 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1028 allocate the color. Value is zero if COLOR_NAME is invalid, or
1029 no color could be allocated. */
1030
1031 int
1032 x_defined_color (f, color_name, color, alloc_p)
1033 struct frame *f;
1034 char *color_name;
1035 XColor *color;
1036 int alloc_p;
1037 {
1038 int success_p;
1039 Display *dpy = FRAME_X_DISPLAY (f);
1040 Colormap cmap = FRAME_X_COLORMAP (f);
1041
1042 BLOCK_INPUT;
1043 success_p = XParseColor (dpy, cmap, color_name, color);
1044 if (success_p && alloc_p)
1045 success_p = x_alloc_nearest_color (f, cmap, color);
1046 UNBLOCK_INPUT;
1047
1048 return success_p;
1049 }
1050
1051
1052 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1053 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1054 Signal an error if color can't be allocated. */
1055
1056 int
1057 x_decode_color (f, color_name, mono_color)
1058 FRAME_PTR f;
1059 Lisp_Object color_name;
1060 int mono_color;
1061 {
1062 XColor cdef;
1063
1064 CHECK_STRING (color_name);
1065
1066 #if 0 /* Don't do this. It's wrong when we're not using the default
1067 colormap, it makes freeing difficult, and it's probably not
1068 an important optimization. */
1069 if (strcmp (SDATA (color_name), "black") == 0)
1070 return BLACK_PIX_DEFAULT (f);
1071 else if (strcmp (SDATA (color_name), "white") == 0)
1072 return WHITE_PIX_DEFAULT (f);
1073 #endif
1074
1075 /* Return MONO_COLOR for monochrome frames. */
1076 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1077 return mono_color;
1078
1079 /* x_defined_color is responsible for coping with failures
1080 by looking for a near-miss. */
1081 if (x_defined_color (f, SDATA (color_name), &cdef, 1))
1082 return cdef.pixel;
1083
1084 Fsignal (Qerror, Fcons (build_string ("Undefined color"),
1085 Fcons (color_name, Qnil)));
1086 return 0;
1087 }
1088
1089
1090 \f
1091 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1092 the previous value of that parameter, NEW_VALUE is the new value.
1093 See also the comment of wait_for_wm in struct x_output. */
1094
1095 static void
1096 x_set_wait_for_wm (f, new_value, old_value)
1097 struct frame *f;
1098 Lisp_Object new_value, old_value;
1099 {
1100 f->output_data.x->wait_for_wm = !NILP (new_value);
1101 }
1102
1103 #ifdef USE_GTK
1104
1105 static Lisp_Object x_find_image_file P_ ((Lisp_Object file));
1106
1107 /* Set icon from FILE for frame F. By using GTK functions the icon
1108 may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */
1109
1110 int
1111 xg_set_icon (f, file)
1112 FRAME_PTR f;
1113 Lisp_Object file;
1114 {
1115 struct gcpro gcpro1;
1116 int result = 0;
1117 Lisp_Object found;
1118
1119 GCPRO1 (found);
1120
1121 found = x_find_image_file (file);
1122
1123 if (! NILP (found))
1124 {
1125 GdkPixbuf *pixbuf;
1126 GError *err = NULL;
1127 char *filename;
1128
1129 filename = SDATA (found);
1130 BLOCK_INPUT;
1131
1132 pixbuf = gdk_pixbuf_new_from_file (filename, &err);
1133
1134 if (pixbuf)
1135 {
1136 gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1137 pixbuf);
1138 g_object_unref (pixbuf);
1139
1140 result = 1;
1141 }
1142 else
1143 g_error_free (err);
1144
1145 UNBLOCK_INPUT;
1146 }
1147
1148 UNGCPRO;
1149 return result;
1150 }
1151 #endif /* USE_GTK */
1152
1153
1154 /* Functions called only from `x_set_frame_param'
1155 to set individual parameters.
1156
1157 If FRAME_X_WINDOW (f) is 0,
1158 the frame is being created and its X-window does not exist yet.
1159 In that case, just record the parameter's new value
1160 in the standard place; do not attempt to change the window. */
1161
1162 void
1163 x_set_foreground_color (f, arg, oldval)
1164 struct frame *f;
1165 Lisp_Object arg, oldval;
1166 {
1167 struct x_output *x = f->output_data.x;
1168 unsigned long fg, old_fg;
1169
1170 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1171 old_fg = x->foreground_pixel;
1172 x->foreground_pixel = fg;
1173
1174 if (FRAME_X_WINDOW (f) != 0)
1175 {
1176 Display *dpy = FRAME_X_DISPLAY (f);
1177
1178 BLOCK_INPUT;
1179 XSetForeground (dpy, x->normal_gc, fg);
1180 XSetBackground (dpy, x->reverse_gc, fg);
1181
1182 if (x->cursor_pixel == old_fg)
1183 {
1184 unload_color (f, x->cursor_pixel);
1185 x->cursor_pixel = x_copy_color (f, fg);
1186 XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
1187 }
1188
1189 UNBLOCK_INPUT;
1190
1191 update_face_from_frame_parameter (f, Qforeground_color, arg);
1192
1193 if (FRAME_VISIBLE_P (f))
1194 redraw_frame (f);
1195 }
1196
1197 unload_color (f, old_fg);
1198 }
1199
1200 void
1201 x_set_background_color (f, arg, oldval)
1202 struct frame *f;
1203 Lisp_Object arg, oldval;
1204 {
1205 struct x_output *x = f->output_data.x;
1206 unsigned long bg;
1207
1208 bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1209 unload_color (f, x->background_pixel);
1210 x->background_pixel = bg;
1211
1212 if (FRAME_X_WINDOW (f) != 0)
1213 {
1214 Display *dpy = FRAME_X_DISPLAY (f);
1215
1216 BLOCK_INPUT;
1217 XSetBackground (dpy, x->normal_gc, bg);
1218 XSetForeground (dpy, x->reverse_gc, bg);
1219 XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
1220 XSetForeground (dpy, x->cursor_gc, bg);
1221
1222 #ifdef USE_GTK
1223 xg_set_background_color (f, bg);
1224 #endif
1225
1226 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1227 toolkit scroll bars. */
1228 {
1229 Lisp_Object bar;
1230 for (bar = FRAME_SCROLL_BARS (f);
1231 !NILP (bar);
1232 bar = XSCROLL_BAR (bar)->next)
1233 {
1234 Window window = SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar));
1235 XSetWindowBackground (dpy, window, bg);
1236 }
1237 }
1238 #endif /* USE_TOOLKIT_SCROLL_BARS */
1239
1240 UNBLOCK_INPUT;
1241 update_face_from_frame_parameter (f, Qbackground_color, arg);
1242
1243 if (FRAME_VISIBLE_P (f))
1244 redraw_frame (f);
1245 }
1246 }
1247
1248 void
1249 x_set_mouse_color (f, arg, oldval)
1250 struct frame *f;
1251 Lisp_Object arg, oldval;
1252 {
1253 struct x_output *x = f->output_data.x;
1254 Display *dpy = FRAME_X_DISPLAY (f);
1255 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1256 Cursor hourglass_cursor, horizontal_drag_cursor;
1257 int count;
1258 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1259 unsigned long mask_color = x->background_pixel;
1260
1261 /* Don't let pointers be invisible. */
1262 if (mask_color == pixel)
1263 {
1264 x_free_colors (f, &pixel, 1);
1265 pixel = x_copy_color (f, x->foreground_pixel);
1266 }
1267
1268 unload_color (f, x->mouse_pixel);
1269 x->mouse_pixel = pixel;
1270
1271 BLOCK_INPUT;
1272
1273 /* It's not okay to crash if the user selects a screwy cursor. */
1274 count = x_catch_errors (dpy);
1275
1276 if (!NILP (Vx_pointer_shape))
1277 {
1278 CHECK_NUMBER (Vx_pointer_shape);
1279 cursor = XCreateFontCursor (dpy, XINT (Vx_pointer_shape));
1280 }
1281 else
1282 cursor = XCreateFontCursor (dpy, XC_xterm);
1283 x_check_errors (dpy, "bad text pointer cursor: %s");
1284
1285 if (!NILP (Vx_nontext_pointer_shape))
1286 {
1287 CHECK_NUMBER (Vx_nontext_pointer_shape);
1288 nontext_cursor
1289 = XCreateFontCursor (dpy, XINT (Vx_nontext_pointer_shape));
1290 }
1291 else
1292 nontext_cursor = XCreateFontCursor (dpy, XC_left_ptr);
1293 x_check_errors (dpy, "bad nontext pointer cursor: %s");
1294
1295 if (!NILP (Vx_hourglass_pointer_shape))
1296 {
1297 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1298 hourglass_cursor
1299 = XCreateFontCursor (dpy, XINT (Vx_hourglass_pointer_shape));
1300 }
1301 else
1302 hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
1303 x_check_errors (dpy, "bad hourglass pointer cursor: %s");
1304
1305 if (!NILP (Vx_mode_pointer_shape))
1306 {
1307 CHECK_NUMBER (Vx_mode_pointer_shape);
1308 mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
1309 }
1310 else
1311 mode_cursor = XCreateFontCursor (dpy, XC_xterm);
1312 x_check_errors (dpy, "bad modeline pointer cursor: %s");
1313
1314 if (!NILP (Vx_sensitive_text_pointer_shape))
1315 {
1316 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1317 hand_cursor
1318 = XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
1319 }
1320 else
1321 hand_cursor = XCreateFontCursor (dpy, XC_hand2);
1322
1323 if (!NILP (Vx_window_horizontal_drag_shape))
1324 {
1325 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1326 horizontal_drag_cursor
1327 = XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
1328 }
1329 else
1330 horizontal_drag_cursor
1331 = XCreateFontCursor (dpy, XC_sb_h_double_arrow);
1332
1333 /* Check and report errors with the above calls. */
1334 x_check_errors (dpy, "can't set cursor shape: %s");
1335 x_uncatch_errors (dpy, count);
1336
1337 {
1338 XColor fore_color, back_color;
1339
1340 fore_color.pixel = x->mouse_pixel;
1341 x_query_color (f, &fore_color);
1342 back_color.pixel = mask_color;
1343 x_query_color (f, &back_color);
1344
1345 XRecolorCursor (dpy, cursor, &fore_color, &back_color);
1346 XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
1347 XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
1348 XRecolorCursor (dpy, hand_cursor, &fore_color, &back_color);
1349 XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
1350 XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
1351 }
1352
1353 if (FRAME_X_WINDOW (f) != 0)
1354 XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
1355
1356 if (cursor != x->text_cursor
1357 && x->text_cursor != 0)
1358 XFreeCursor (dpy, x->text_cursor);
1359 x->text_cursor = cursor;
1360
1361 if (nontext_cursor != x->nontext_cursor
1362 && x->nontext_cursor != 0)
1363 XFreeCursor (dpy, x->nontext_cursor);
1364 x->nontext_cursor = nontext_cursor;
1365
1366 if (hourglass_cursor != x->hourglass_cursor
1367 && x->hourglass_cursor != 0)
1368 XFreeCursor (dpy, x->hourglass_cursor);
1369 x->hourglass_cursor = hourglass_cursor;
1370
1371 if (mode_cursor != x->modeline_cursor
1372 && x->modeline_cursor != 0)
1373 XFreeCursor (dpy, f->output_data.x->modeline_cursor);
1374 x->modeline_cursor = mode_cursor;
1375
1376 if (hand_cursor != x->hand_cursor
1377 && x->hand_cursor != 0)
1378 XFreeCursor (dpy, x->hand_cursor);
1379 x->hand_cursor = hand_cursor;
1380
1381 if (horizontal_drag_cursor != x->horizontal_drag_cursor
1382 && x->horizontal_drag_cursor != 0)
1383 XFreeCursor (dpy, x->horizontal_drag_cursor);
1384 x->horizontal_drag_cursor = horizontal_drag_cursor;
1385
1386 XFlush (dpy);
1387 UNBLOCK_INPUT;
1388
1389 update_face_from_frame_parameter (f, Qmouse_color, arg);
1390 }
1391
1392 void
1393 x_set_cursor_color (f, arg, oldval)
1394 struct frame *f;
1395 Lisp_Object arg, oldval;
1396 {
1397 unsigned long fore_pixel, pixel;
1398 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
1399 struct x_output *x = f->output_data.x;
1400
1401 if (!NILP (Vx_cursor_fore_pixel))
1402 {
1403 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1404 WHITE_PIX_DEFAULT (f));
1405 fore_pixel_allocated_p = 1;
1406 }
1407 else
1408 fore_pixel = x->background_pixel;
1409
1410 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1411 pixel_allocated_p = 1;
1412
1413 /* Make sure that the cursor color differs from the background color. */
1414 if (pixel == x->background_pixel)
1415 {
1416 if (pixel_allocated_p)
1417 {
1418 x_free_colors (f, &pixel, 1);
1419 pixel_allocated_p = 0;
1420 }
1421
1422 pixel = x->mouse_pixel;
1423 if (pixel == fore_pixel)
1424 {
1425 if (fore_pixel_allocated_p)
1426 {
1427 x_free_colors (f, &fore_pixel, 1);
1428 fore_pixel_allocated_p = 0;
1429 }
1430 fore_pixel = x->background_pixel;
1431 }
1432 }
1433
1434 unload_color (f, x->cursor_foreground_pixel);
1435 if (!fore_pixel_allocated_p)
1436 fore_pixel = x_copy_color (f, fore_pixel);
1437 x->cursor_foreground_pixel = fore_pixel;
1438
1439 unload_color (f, x->cursor_pixel);
1440 if (!pixel_allocated_p)
1441 pixel = x_copy_color (f, pixel);
1442 x->cursor_pixel = pixel;
1443
1444 if (FRAME_X_WINDOW (f) != 0)
1445 {
1446 BLOCK_INPUT;
1447 XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
1448 XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
1449 UNBLOCK_INPUT;
1450
1451 if (FRAME_VISIBLE_P (f))
1452 {
1453 x_update_cursor (f, 0);
1454 x_update_cursor (f, 1);
1455 }
1456 }
1457
1458 update_face_from_frame_parameter (f, Qcursor_color, arg);
1459 }
1460 \f
1461 /* Set the border-color of frame F to pixel value PIX.
1462 Note that this does not fully take effect if done before
1463 F has an x-window. */
1464
1465 void
1466 x_set_border_pixel (f, pix)
1467 struct frame *f;
1468 int pix;
1469 {
1470 unload_color (f, f->output_data.x->border_pixel);
1471 f->output_data.x->border_pixel = pix;
1472
1473 if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
1474 {
1475 BLOCK_INPUT;
1476 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1477 (unsigned long)pix);
1478 UNBLOCK_INPUT;
1479
1480 if (FRAME_VISIBLE_P (f))
1481 redraw_frame (f);
1482 }
1483 }
1484
1485 /* Set the border-color of frame F to value described by ARG.
1486 ARG can be a string naming a color.
1487 The border-color is used for the border that is drawn by the X server.
1488 Note that this does not fully take effect if done before
1489 F has an x-window; it must be redone when the window is created.
1490
1491 Note: this is done in two routines because of the way X10 works.
1492
1493 Note: under X11, this is normally the province of the window manager,
1494 and so emacs' border colors may be overridden. */
1495
1496 void
1497 x_set_border_color (f, arg, oldval)
1498 struct frame *f;
1499 Lisp_Object arg, oldval;
1500 {
1501 int pix;
1502
1503 CHECK_STRING (arg);
1504 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1505 x_set_border_pixel (f, pix);
1506 update_face_from_frame_parameter (f, Qborder_color, arg);
1507 }
1508
1509
1510 void
1511 x_set_cursor_type (f, arg, oldval)
1512 FRAME_PTR f;
1513 Lisp_Object arg, oldval;
1514 {
1515 set_frame_cursor_types (f, arg);
1516
1517 /* Make sure the cursor gets redrawn. */
1518 cursor_type_changed = 1;
1519 }
1520 \f
1521 void
1522 x_set_icon_type (f, arg, oldval)
1523 struct frame *f;
1524 Lisp_Object arg, oldval;
1525 {
1526 int result;
1527
1528 if (STRINGP (arg))
1529 {
1530 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1531 return;
1532 }
1533 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1534 return;
1535
1536 BLOCK_INPUT;
1537 if (NILP (arg))
1538 result = x_text_icon (f,
1539 (char *) SDATA ((!NILP (f->icon_name)
1540 ? f->icon_name
1541 : f->name)));
1542 else
1543 result = x_bitmap_icon (f, arg);
1544
1545 if (result)
1546 {
1547 UNBLOCK_INPUT;
1548 error ("No icon window available");
1549 }
1550
1551 XFlush (FRAME_X_DISPLAY (f));
1552 UNBLOCK_INPUT;
1553 }
1554
1555 void
1556 x_set_icon_name (f, arg, oldval)
1557 struct frame *f;
1558 Lisp_Object arg, oldval;
1559 {
1560 int result;
1561
1562 if (STRINGP (arg))
1563 {
1564 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1565 return;
1566 }
1567 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1568 return;
1569
1570 f->icon_name = arg;
1571
1572 if (f->output_data.x->icon_bitmap != 0)
1573 return;
1574
1575 BLOCK_INPUT;
1576
1577 result = x_text_icon (f,
1578 (char *) SDATA ((!NILP (f->icon_name)
1579 ? f->icon_name
1580 : !NILP (f->title)
1581 ? f->title
1582 : f->name)));
1583
1584 if (result)
1585 {
1586 UNBLOCK_INPUT;
1587 error ("No icon window available");
1588 }
1589
1590 XFlush (FRAME_X_DISPLAY (f));
1591 UNBLOCK_INPUT;
1592 }
1593
1594 \f
1595 void
1596 x_set_menu_bar_lines (f, value, oldval)
1597 struct frame *f;
1598 Lisp_Object value, oldval;
1599 {
1600 int nlines;
1601 #ifndef USE_X_TOOLKIT
1602 int olines = FRAME_MENU_BAR_LINES (f);
1603 #endif
1604
1605 /* Right now, menu bars don't work properly in minibuf-only frames;
1606 most of the commands try to apply themselves to the minibuffer
1607 frame itself, and get an error because you can't switch buffers
1608 in or split the minibuffer window. */
1609 if (FRAME_MINIBUF_ONLY_P (f))
1610 return;
1611
1612 if (INTEGERP (value))
1613 nlines = XINT (value);
1614 else
1615 nlines = 0;
1616
1617 /* Make sure we redisplay all windows in this frame. */
1618 windows_or_buffers_changed++;
1619
1620 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1621 FRAME_MENU_BAR_LINES (f) = 0;
1622 if (nlines)
1623 {
1624 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1625 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1626 /* Make sure next redisplay shows the menu bar. */
1627 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1628 }
1629 else
1630 {
1631 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1632 free_frame_menubar (f);
1633 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1634 if (FRAME_X_P (f))
1635 f->output_data.x->menubar_widget = 0;
1636 }
1637 #else /* not USE_X_TOOLKIT && not USE_GTK */
1638 FRAME_MENU_BAR_LINES (f) = nlines;
1639 change_window_heights (f->root_window, nlines - olines);
1640 #endif /* not USE_X_TOOLKIT */
1641 adjust_glyphs (f);
1642 }
1643
1644
1645 /* Set the number of lines used for the tool bar of frame F to VALUE.
1646 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1647 is the old number of tool bar lines. This function changes the
1648 height of all windows on frame F to match the new tool bar height.
1649 The frame's height doesn't change. */
1650
1651 void
1652 x_set_tool_bar_lines (f, value, oldval)
1653 struct frame *f;
1654 Lisp_Object value, oldval;
1655 {
1656 int delta, nlines, root_height;
1657 Lisp_Object root_window;
1658
1659 /* Treat tool bars like menu bars. */
1660 if (FRAME_MINIBUF_ONLY_P (f))
1661 return;
1662
1663 /* Use VALUE only if an integer >= 0. */
1664 if (INTEGERP (value) && XINT (value) >= 0)
1665 nlines = XFASTINT (value);
1666 else
1667 nlines = 0;
1668
1669 #ifdef USE_GTK
1670 FRAME_TOOL_BAR_LINES (f) = 0;
1671 if (nlines)
1672 {
1673 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
1674 if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
1675 /* Make sure next redisplay shows the tool bar. */
1676 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1677 update_frame_tool_bar (f);
1678 }
1679 else
1680 {
1681 if (FRAME_EXTERNAL_TOOL_BAR (f))
1682 free_frame_tool_bar (f);
1683 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
1684 }
1685
1686 return;
1687 #endif
1688
1689 /* Make sure we redisplay all windows in this frame. */
1690 ++windows_or_buffers_changed;
1691
1692 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1693
1694 /* Don't resize the tool-bar to more than we have room for. */
1695 root_window = FRAME_ROOT_WINDOW (f);
1696 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1697 if (root_height - delta < 1)
1698 {
1699 delta = root_height - 1;
1700 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1701 }
1702
1703 FRAME_TOOL_BAR_LINES (f) = nlines;
1704 change_window_heights (root_window, delta);
1705 adjust_glyphs (f);
1706
1707 /* We also have to make sure that the internal border at the top of
1708 the frame, below the menu bar or tool bar, is redrawn when the
1709 tool bar disappears. This is so because the internal border is
1710 below the tool bar if one is displayed, but is below the menu bar
1711 if there isn't a tool bar. The tool bar draws into the area
1712 below the menu bar. */
1713 if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1714 {
1715 updating_frame = f;
1716 clear_frame ();
1717 clear_current_matrices (f);
1718 updating_frame = NULL;
1719 }
1720
1721 /* If the tool bar gets smaller, the internal border below it
1722 has to be cleared. It was formerly part of the display
1723 of the larger tool bar, and updating windows won't clear it. */
1724 if (delta < 0)
1725 {
1726 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1727 int width = FRAME_PIXEL_WIDTH (f);
1728 int y = nlines * FRAME_LINE_HEIGHT (f);
1729
1730 BLOCK_INPUT;
1731 x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1732 0, y, width, height, False);
1733 UNBLOCK_INPUT;
1734
1735 if (WINDOWP (f->tool_bar_window))
1736 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1737 }
1738 }
1739
1740
1741 /* Set the foreground color for scroll bars on frame F to VALUE.
1742 VALUE should be a string, a color name. If it isn't a string or
1743 isn't a valid color name, do nothing. OLDVAL is the old value of
1744 the frame parameter. */
1745
1746 void
1747 x_set_scroll_bar_foreground (f, value, oldval)
1748 struct frame *f;
1749 Lisp_Object value, oldval;
1750 {
1751 unsigned long pixel;
1752
1753 if (STRINGP (value))
1754 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
1755 else
1756 pixel = -1;
1757
1758 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
1759 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
1760
1761 f->output_data.x->scroll_bar_foreground_pixel = pixel;
1762 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1763 {
1764 /* Remove all scroll bars because they have wrong colors. */
1765 if (condemn_scroll_bars_hook)
1766 (*condemn_scroll_bars_hook) (f);
1767 if (judge_scroll_bars_hook)
1768 (*judge_scroll_bars_hook) (f);
1769
1770 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
1771 redraw_frame (f);
1772 }
1773 }
1774
1775
1776 /* Set the background color for scroll bars on frame F to VALUE VALUE
1777 should be a string, a color name. If it isn't a string or isn't a
1778 valid color name, do nothing. OLDVAL is the old value of the frame
1779 parameter. */
1780
1781 void
1782 x_set_scroll_bar_background (f, value, oldval)
1783 struct frame *f;
1784 Lisp_Object value, oldval;
1785 {
1786 unsigned long pixel;
1787
1788 if (STRINGP (value))
1789 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
1790 else
1791 pixel = -1;
1792
1793 if (f->output_data.x->scroll_bar_background_pixel != -1)
1794 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
1795
1796 #ifdef USE_TOOLKIT_SCROLL_BARS
1797 /* Scrollbar shadow colors. */
1798 if (f->output_data.x->scroll_bar_top_shadow_pixel != -1)
1799 {
1800 unload_color (f, f->output_data.x->scroll_bar_top_shadow_pixel);
1801 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
1802 }
1803 if (f->output_data.x->scroll_bar_bottom_shadow_pixel != -1)
1804 {
1805 unload_color (f, f->output_data.x->scroll_bar_bottom_shadow_pixel);
1806 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
1807 }
1808 #endif /* USE_TOOLKIT_SCROLL_BARS */
1809
1810 f->output_data.x->scroll_bar_background_pixel = pixel;
1811 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1812 {
1813 /* Remove all scroll bars because they have wrong colors. */
1814 if (condemn_scroll_bars_hook)
1815 (*condemn_scroll_bars_hook) (f);
1816 if (judge_scroll_bars_hook)
1817 (*judge_scroll_bars_hook) (f);
1818
1819 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
1820 redraw_frame (f);
1821 }
1822 }
1823
1824 \f
1825 /* Encode Lisp string STRING as a text in a format appropriate for
1826 XICCC (X Inter Client Communication Conventions).
1827
1828 If STRING contains only ASCII characters, do no conversion and
1829 return the string data of STRING. Otherwise, encode the text by
1830 CODING_SYSTEM, and return a newly allocated memory area which
1831 should be freed by `xfree' by a caller.
1832
1833 SELECTIONP non-zero means the string is being encoded for an X
1834 selection, so it is safe to run pre-write conversions (which
1835 may run Lisp code).
1836
1837 Store the byte length of resulting text in *TEXT_BYTES.
1838
1839 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
1840 which means that the `encoding' of the result can be `STRING'.
1841 Otherwise store 0 in *STRINGP, which means that the `encoding' of
1842 the result should be `COMPOUND_TEXT'. */
1843
1844 unsigned char *
1845 x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
1846 Lisp_Object string, coding_system;
1847 int *text_bytes, *stringp;
1848 int selectionp;
1849 {
1850 unsigned char *str = SDATA (string);
1851 int chars = SCHARS (string);
1852 int bytes = SBYTES (string);
1853 int charset_info;
1854 int bufsize;
1855 unsigned char *buf;
1856 struct coding_system coding;
1857 extern Lisp_Object Qcompound_text_with_extensions;
1858
1859 charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
1860 if (charset_info == 0)
1861 {
1862 /* No multibyte character in OBJ. We need not encode it. */
1863 *text_bytes = bytes;
1864 *stringp = 1;
1865 return str;
1866 }
1867
1868 setup_coding_system (coding_system, &coding);
1869 if (selectionp
1870 && SYMBOLP (coding.pre_write_conversion)
1871 && !NILP (Ffboundp (coding.pre_write_conversion)))
1872 {
1873 string = run_pre_post_conversion_on_str (string, &coding, 1);
1874 str = SDATA (string);
1875 chars = SCHARS (string);
1876 bytes = SBYTES (string);
1877 }
1878 coding.src_multibyte = 1;
1879 coding.dst_multibyte = 0;
1880 coding.mode |= CODING_MODE_LAST_BLOCK;
1881 if (coding.type == coding_type_iso2022)
1882 coding.flags |= CODING_FLAG_ISO_SAFE;
1883 /* We suppress producing escape sequences for composition. */
1884 coding.composing = COMPOSITION_DISABLED;
1885 bufsize = encoding_buffer_size (&coding, bytes);
1886 buf = (unsigned char *) xmalloc (bufsize);
1887 encode_coding (&coding, str, buf, bytes, bufsize);
1888 *text_bytes = coding.produced;
1889 *stringp = (charset_info == 1
1890 || (!EQ (coding_system, Qcompound_text)
1891 && !EQ (coding_system, Qcompound_text_with_extensions)));
1892 return buf;
1893 }
1894
1895 \f
1896 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1897 x_id_name.
1898
1899 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1900 name; if NAME is a string, set F's name to NAME and set
1901 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1902
1903 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1904 suggesting a new name, which lisp code should override; if
1905 F->explicit_name is set, ignore the new name; otherwise, set it. */
1906
1907 void
1908 x_set_name (f, name, explicit)
1909 struct frame *f;
1910 Lisp_Object name;
1911 int explicit;
1912 {
1913 /* Make sure that requests from lisp code override requests from
1914 Emacs redisplay code. */
1915 if (explicit)
1916 {
1917 /* If we're switching from explicit to implicit, we had better
1918 update the mode lines and thereby update the title. */
1919 if (f->explicit_name && NILP (name))
1920 update_mode_lines = 1;
1921
1922 f->explicit_name = ! NILP (name);
1923 }
1924 else if (f->explicit_name)
1925 return;
1926
1927 /* If NAME is nil, set the name to the x_id_name. */
1928 if (NILP (name))
1929 {
1930 /* Check for no change needed in this very common case
1931 before we do any consing. */
1932 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1933 SDATA (f->name)))
1934 return;
1935 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1936 }
1937 else
1938 CHECK_STRING (name);
1939
1940 /* Don't change the name if it's already NAME. */
1941 if (! NILP (Fstring_equal (name, f->name)))
1942 return;
1943
1944 f->name = name;
1945
1946 /* For setting the frame title, the title parameter should override
1947 the name parameter. */
1948 if (! NILP (f->title))
1949 name = f->title;
1950
1951 if (FRAME_X_WINDOW (f))
1952 {
1953 BLOCK_INPUT;
1954 #ifdef HAVE_X11R4
1955 {
1956 XTextProperty text, icon;
1957 int bytes, stringp;
1958 Lisp_Object coding_system;
1959
1960 /* Note: Encoding strategy
1961
1962 We encode NAME by compound-text and use "COMPOUND-TEXT" in
1963 text.encoding. But, there are non-internationalized window
1964 managers which don't support that encoding. So, if NAME
1965 contains only ASCII and 8859-1 characters, encode it by
1966 iso-latin-1, and use "STRING" in text.encoding hoping that
1967 such window managers at least analyze this format correctly,
1968 i.e. treat 8-bit bytes as 8859-1 characters.
1969
1970 We may also be able to use "UTF8_STRING" in text.encoding
1971 in the future which can encode all Unicode characters.
1972 But, for the moment, there's no way to know that the
1973 current window manager supports it or not. */
1974 coding_system = Qcompound_text;
1975 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
1976 text.encoding = (stringp ? XA_STRING
1977 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1978 text.format = 8;
1979 text.nitems = bytes;
1980
1981 if (NILP (f->icon_name))
1982 {
1983 icon = text;
1984 }
1985 else
1986 {
1987 /* See the above comment "Note: Encoding strategy". */
1988 icon.value = x_encode_text (f->icon_name, coding_system, 0,
1989 &bytes, &stringp);
1990 icon.encoding = (stringp ? XA_STRING
1991 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1992 icon.format = 8;
1993 icon.nitems = bytes;
1994 }
1995 #ifdef USE_GTK
1996 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1997 SDATA (name));
1998 #else /* not USE_GTK */
1999 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
2000 #endif /* not USE_GTK */
2001
2002 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &icon);
2003
2004 if (!NILP (f->icon_name)
2005 && icon.value != (unsigned char *) SDATA (f->icon_name))
2006 xfree (icon.value);
2007 if (text.value != (unsigned char *) SDATA (name))
2008 xfree (text.value);
2009 }
2010 #else /* not HAVE_X11R4 */
2011 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2012 SDATA (name));
2013 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2014 SDATA (name));
2015 #endif /* not HAVE_X11R4 */
2016 UNBLOCK_INPUT;
2017 }
2018 }
2019
2020 /* This function should be called when the user's lisp code has
2021 specified a name for the frame; the name will override any set by the
2022 redisplay code. */
2023 void
2024 x_explicitly_set_name (f, arg, oldval)
2025 FRAME_PTR f;
2026 Lisp_Object arg, oldval;
2027 {
2028 x_set_name (f, arg, 1);
2029 }
2030
2031 /* This function should be called by Emacs redisplay code to set the
2032 name; names set this way will never override names set by the user's
2033 lisp code. */
2034 void
2035 x_implicitly_set_name (f, arg, oldval)
2036 FRAME_PTR f;
2037 Lisp_Object arg, oldval;
2038 {
2039 x_set_name (f, arg, 0);
2040 }
2041 \f
2042 /* Change the title of frame F to NAME.
2043 If NAME is nil, use the frame name as the title.
2044
2045 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2046 name; if NAME is a string, set F's name to NAME and set
2047 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2048
2049 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2050 suggesting a new name, which lisp code should override; if
2051 F->explicit_name is set, ignore the new name; otherwise, set it. */
2052
2053 void
2054 x_set_title (f, name, old_name)
2055 struct frame *f;
2056 Lisp_Object name, old_name;
2057 {
2058 /* Don't change the title if it's already NAME. */
2059 if (EQ (name, f->title))
2060 return;
2061
2062 update_mode_lines = 1;
2063
2064 f->title = name;
2065
2066 if (NILP (name))
2067 name = f->name;
2068 else
2069 CHECK_STRING (name);
2070
2071 if (FRAME_X_WINDOW (f))
2072 {
2073 BLOCK_INPUT;
2074 #ifdef HAVE_X11R4
2075 {
2076 XTextProperty text, icon;
2077 int bytes, stringp;
2078 Lisp_Object coding_system;
2079
2080 coding_system = Qcompound_text;
2081 /* See the comment "Note: Encoding strategy" in x_set_name. */
2082 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
2083 text.encoding = (stringp ? XA_STRING
2084 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2085 text.format = 8;
2086 text.nitems = bytes;
2087
2088 if (NILP (f->icon_name))
2089 {
2090 icon = text;
2091 }
2092 else
2093 {
2094 /* See the comment "Note: Encoding strategy" in x_set_name. */
2095 icon.value = x_encode_text (f->icon_name, coding_system, 0,
2096 &bytes, &stringp);
2097 icon.encoding = (stringp ? XA_STRING
2098 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2099 icon.format = 8;
2100 icon.nitems = bytes;
2101 }
2102
2103 #ifdef USE_GTK
2104 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
2105 SDATA (name));
2106 #else /* not USE_GTK */
2107 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
2108 #endif /* not USE_GTK */
2109
2110 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
2111 &icon);
2112
2113 if (!NILP (f->icon_name)
2114 && icon.value != (unsigned char *) SDATA (f->icon_name))
2115 xfree (icon.value);
2116 if (text.value != (unsigned char *) SDATA (name))
2117 xfree (text.value);
2118 }
2119 #else /* not HAVE_X11R4 */
2120 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2121 SDATA (name));
2122 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2123 SDATA (name));
2124 #endif /* not HAVE_X11R4 */
2125 UNBLOCK_INPUT;
2126 }
2127 }
2128
2129 void
2130 x_set_scroll_bar_default_width (f)
2131 struct frame *f;
2132 {
2133 int wid = FRAME_COLUMN_WIDTH (f);
2134
2135 #ifdef USE_TOOLKIT_SCROLL_BARS
2136 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2137 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2138 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2139 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = width;
2140 #else
2141 /* Make the actual width at least 14 pixels and a multiple of a
2142 character width. */
2143 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2144
2145 /* Use all of that space (aside from required margins) for the
2146 scroll bar. */
2147 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = 0;
2148 #endif
2149 }
2150
2151 \f
2152 /* Record in frame F the specified or default value according to ALIST
2153 of the parameter named PROP (a Lisp symbol). If no value is
2154 specified for PROP, look for an X default for XPROP on the frame
2155 named NAME. If that is not found either, use the value DEFLT. */
2156
2157 static Lisp_Object
2158 x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
2159 foreground_p)
2160 struct frame *f;
2161 Lisp_Object alist;
2162 Lisp_Object prop;
2163 char *xprop;
2164 char *xclass;
2165 int foreground_p;
2166 {
2167 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2168 Lisp_Object tem;
2169
2170 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
2171 if (EQ (tem, Qunbound))
2172 {
2173 #ifdef USE_TOOLKIT_SCROLL_BARS
2174
2175 /* See if an X resource for the scroll bar color has been
2176 specified. */
2177 tem = display_x_get_resource (dpyinfo,
2178 build_string (foreground_p
2179 ? "foreground"
2180 : "background"),
2181 empty_string,
2182 build_string ("verticalScrollBar"),
2183 empty_string);
2184 if (!STRINGP (tem))
2185 {
2186 /* If nothing has been specified, scroll bars will use a
2187 toolkit-dependent default. Because these defaults are
2188 difficult to get at without actually creating a scroll
2189 bar, use nil to indicate that no color has been
2190 specified. */
2191 tem = Qnil;
2192 }
2193
2194 #else /* not USE_TOOLKIT_SCROLL_BARS */
2195
2196 tem = Qnil;
2197
2198 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2199 }
2200
2201 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2202 return tem;
2203 }
2204
2205
2206
2207 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2208
2209 Status
2210 XSetWMProtocols (dpy, w, protocols, count)
2211 Display *dpy;
2212 Window w;
2213 Atom *protocols;
2214 int count;
2215 {
2216 Atom prop;
2217 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2218 if (prop == None) return False;
2219 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2220 (unsigned char *) protocols, count);
2221 return True;
2222 }
2223 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2224 \f
2225 #ifdef USE_X_TOOLKIT
2226
2227 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2228 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2229 already be present because of the toolkit (Motif adds some of them,
2230 for example, but Xt doesn't). */
2231
2232 static void
2233 hack_wm_protocols (f, widget)
2234 FRAME_PTR f;
2235 Widget widget;
2236 {
2237 Display *dpy = XtDisplay (widget);
2238 Window w = XtWindow (widget);
2239 int need_delete = 1;
2240 int need_focus = 1;
2241 int need_save = 1;
2242
2243 BLOCK_INPUT;
2244 {
2245 Atom type, *atoms = 0;
2246 int format = 0;
2247 unsigned long nitems = 0;
2248 unsigned long bytes_after;
2249
2250 if ((XGetWindowProperty (dpy, w,
2251 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2252 (long)0, (long)100, False, XA_ATOM,
2253 &type, &format, &nitems, &bytes_after,
2254 (unsigned char **) &atoms)
2255 == Success)
2256 && format == 32 && type == XA_ATOM)
2257 while (nitems > 0)
2258 {
2259 nitems--;
2260 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2261 need_delete = 0;
2262 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2263 need_focus = 0;
2264 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2265 need_save = 0;
2266 }
2267 if (atoms) XFree ((char *) atoms);
2268 }
2269 {
2270 Atom props [10];
2271 int count = 0;
2272 if (need_delete)
2273 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2274 if (need_focus)
2275 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2276 if (need_save)
2277 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2278 if (count)
2279 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2280 XA_ATOM, 32, PropModeAppend,
2281 (unsigned char *) props, count);
2282 }
2283 UNBLOCK_INPUT;
2284 }
2285 #endif
2286
2287
2288 \f
2289 /* Support routines for XIC (X Input Context). */
2290
2291 #ifdef HAVE_X_I18N
2292
2293 static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
2294 static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
2295
2296
2297 /* Supported XIM styles, ordered by preference. */
2298
2299 static XIMStyle supported_xim_styles[] =
2300 {
2301 XIMPreeditPosition | XIMStatusArea,
2302 XIMPreeditPosition | XIMStatusNothing,
2303 XIMPreeditPosition | XIMStatusNone,
2304 XIMPreeditNothing | XIMStatusArea,
2305 XIMPreeditNothing | XIMStatusNothing,
2306 XIMPreeditNothing | XIMStatusNone,
2307 XIMPreeditNone | XIMStatusArea,
2308 XIMPreeditNone | XIMStatusNothing,
2309 XIMPreeditNone | XIMStatusNone,
2310 0,
2311 };
2312
2313
2314 /* Create an X fontset on frame F with base font name
2315 BASE_FONTNAME.. */
2316
2317 static XFontSet
2318 xic_create_xfontset (f, base_fontname)
2319 struct frame *f;
2320 char *base_fontname;
2321 {
2322 XFontSet xfs;
2323 char **missing_list;
2324 int missing_count;
2325 char *def_string;
2326
2327 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
2328 base_fontname, &missing_list,
2329 &missing_count, &def_string);
2330 if (missing_list)
2331 XFreeStringList (missing_list);
2332
2333 /* No need to free def_string. */
2334 return xfs;
2335 }
2336
2337
2338 /* Value is the best input style, given user preferences USER (already
2339 checked to be supported by Emacs), and styles supported by the
2340 input method XIM. */
2341
2342 static XIMStyle
2343 best_xim_style (user, xim)
2344 XIMStyles *user;
2345 XIMStyles *xim;
2346 {
2347 int i, j;
2348
2349 for (i = 0; i < user->count_styles; ++i)
2350 for (j = 0; j < xim->count_styles; ++j)
2351 if (user->supported_styles[i] == xim->supported_styles[j])
2352 return user->supported_styles[i];
2353
2354 /* Return the default style. */
2355 return XIMPreeditNothing | XIMStatusNothing;
2356 }
2357
2358 /* Create XIC for frame F. */
2359
2360 static XIMStyle xic_style;
2361
2362 void
2363 create_frame_xic (f)
2364 struct frame *f;
2365 {
2366 XIM xim;
2367 XIC xic = NULL;
2368 XFontSet xfs = NULL;
2369
2370 if (FRAME_XIC (f))
2371 return;
2372
2373 xim = FRAME_X_XIM (f);
2374 if (xim)
2375 {
2376 XRectangle s_area;
2377 XPoint spot;
2378 XVaNestedList preedit_attr;
2379 XVaNestedList status_attr;
2380 char *base_fontname;
2381 int fontset;
2382
2383 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
2384 spot.x = 0; spot.y = 1;
2385 /* Create X fontset. */
2386 fontset = FRAME_FONTSET (f);
2387 if (fontset < 0)
2388 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2389 else
2390 {
2391 /* Determine the base fontname from the ASCII font name of
2392 FONTSET. */
2393 char *ascii_font = (char *) SDATA (fontset_ascii (fontset));
2394 char *p = ascii_font;
2395 int i;
2396
2397 for (i = 0; *p; p++)
2398 if (*p == '-') i++;
2399 if (i != 14)
2400 /* As the font name doesn't conform to XLFD, we can't
2401 modify it to get a suitable base fontname for the
2402 frame. */
2403 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2404 else
2405 {
2406 int len = strlen (ascii_font) + 1;
2407 char *p1 = NULL;
2408
2409 for (i = 0, p = ascii_font; i < 8; p++)
2410 {
2411 if (*p == '-')
2412 {
2413 i++;
2414 if (i == 3)
2415 p1 = p + 1;
2416 }
2417 }
2418 base_fontname = (char *) alloca (len);
2419 bzero (base_fontname, len);
2420 strcpy (base_fontname, "-*-*-");
2421 bcopy (p1, base_fontname + 5, p - p1);
2422 strcat (base_fontname, "*-*-*-*-*-*-*");
2423 }
2424 }
2425 xfs = xic_create_xfontset (f, base_fontname);
2426
2427 /* Determine XIC style. */
2428 if (xic_style == 0)
2429 {
2430 XIMStyles supported_list;
2431 supported_list.count_styles = (sizeof supported_xim_styles
2432 / sizeof supported_xim_styles[0]);
2433 supported_list.supported_styles = supported_xim_styles;
2434 xic_style = best_xim_style (&supported_list,
2435 FRAME_X_XIM_STYLES (f));
2436 }
2437
2438 preedit_attr = XVaCreateNestedList (0,
2439 XNFontSet, xfs,
2440 XNForeground,
2441 FRAME_FOREGROUND_PIXEL (f),
2442 XNBackground,
2443 FRAME_BACKGROUND_PIXEL (f),
2444 (xic_style & XIMPreeditPosition
2445 ? XNSpotLocation
2446 : NULL),
2447 &spot,
2448 NULL);
2449 status_attr = XVaCreateNestedList (0,
2450 XNArea,
2451 &s_area,
2452 XNFontSet,
2453 xfs,
2454 XNForeground,
2455 FRAME_FOREGROUND_PIXEL (f),
2456 XNBackground,
2457 FRAME_BACKGROUND_PIXEL (f),
2458 NULL);
2459
2460 xic = XCreateIC (xim,
2461 XNInputStyle, xic_style,
2462 XNClientWindow, FRAME_X_WINDOW (f),
2463 XNFocusWindow, FRAME_X_WINDOW (f),
2464 XNStatusAttributes, status_attr,
2465 XNPreeditAttributes, preedit_attr,
2466 NULL);
2467 XFree (preedit_attr);
2468 XFree (status_attr);
2469 }
2470
2471 FRAME_XIC (f) = xic;
2472 FRAME_XIC_STYLE (f) = xic_style;
2473 FRAME_XIC_FONTSET (f) = xfs;
2474 }
2475
2476
2477 /* Destroy XIC and free XIC fontset of frame F, if any. */
2478
2479 void
2480 free_frame_xic (f)
2481 struct frame *f;
2482 {
2483 if (FRAME_XIC (f) == NULL)
2484 return;
2485
2486 XDestroyIC (FRAME_XIC (f));
2487 if (FRAME_XIC_FONTSET (f))
2488 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2489
2490 FRAME_XIC (f) = NULL;
2491 FRAME_XIC_FONTSET (f) = NULL;
2492 }
2493
2494
2495 /* Place preedit area for XIC of window W's frame to specified
2496 pixel position X/Y. X and Y are relative to window W. */
2497
2498 void
2499 xic_set_preeditarea (w, x, y)
2500 struct window *w;
2501 int x, y;
2502 {
2503 struct frame *f = XFRAME (w->frame);
2504 XVaNestedList attr;
2505 XPoint spot;
2506
2507 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
2508 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
2509 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
2510 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2511 XFree (attr);
2512 }
2513
2514
2515 /* Place status area for XIC in bottom right corner of frame F.. */
2516
2517 void
2518 xic_set_statusarea (f)
2519 struct frame *f;
2520 {
2521 XIC xic = FRAME_XIC (f);
2522 XVaNestedList attr;
2523 XRectangle area;
2524 XRectangle *needed;
2525
2526 /* Negotiate geometry of status area. If input method has existing
2527 status area, use its current size. */
2528 area.x = area.y = area.width = area.height = 0;
2529 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
2530 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2531 XFree (attr);
2532
2533 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
2534 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2535 XFree (attr);
2536
2537 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
2538 {
2539 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
2540 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2541 XFree (attr);
2542 }
2543
2544 area.width = needed->width;
2545 area.height = needed->height;
2546 area.x = FRAME_PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
2547 area.y = (FRAME_PIXEL_HEIGHT (f) - area.height
2548 - FRAME_MENUBAR_HEIGHT (f)
2549 - FRAME_TOOLBAR_HEIGHT (f)
2550 - FRAME_INTERNAL_BORDER_WIDTH (f));
2551 XFree (needed);
2552
2553 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
2554 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2555 XFree (attr);
2556 }
2557
2558
2559 /* Set X fontset for XIC of frame F, using base font name
2560 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
2561
2562 void
2563 xic_set_xfontset (f, base_fontname)
2564 struct frame *f;
2565 char *base_fontname;
2566 {
2567 XVaNestedList attr;
2568 XFontSet xfs;
2569
2570 xfs = xic_create_xfontset (f, base_fontname);
2571
2572 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
2573 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
2574 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2575 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
2576 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
2577 XFree (attr);
2578
2579 if (FRAME_XIC_FONTSET (f))
2580 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2581 FRAME_XIC_FONTSET (f) = xfs;
2582 }
2583
2584 #endif /* HAVE_X_I18N */
2585
2586
2587 \f
2588 #ifdef USE_X_TOOLKIT
2589
2590 /* Create and set up the X widget for frame F. */
2591
2592 static void
2593 x_window (f, window_prompting, minibuffer_only)
2594 struct frame *f;
2595 long window_prompting;
2596 int minibuffer_only;
2597 {
2598 XClassHint class_hints;
2599 XSetWindowAttributes attributes;
2600 unsigned long attribute_mask;
2601 Widget shell_widget;
2602 Widget pane_widget;
2603 Widget frame_widget;
2604 Arg al [25];
2605 int ac;
2606
2607 BLOCK_INPUT;
2608
2609 /* Use the resource name as the top-level widget name
2610 for looking up resources. Make a non-Lisp copy
2611 for the window manager, so GC relocation won't bother it.
2612
2613 Elsewhere we specify the window name for the window manager. */
2614
2615 {
2616 char *str = (char *) SDATA (Vx_resource_name);
2617 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2618 strcpy (f->namebuf, str);
2619 }
2620
2621 ac = 0;
2622 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2623 XtSetArg (al[ac], XtNinput, 1); ac++;
2624 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2625 XtSetArg (al[ac], XtNborderWidth, f->border_width); ac++;
2626 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2627 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2628 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2629 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2630 applicationShellWidgetClass,
2631 FRAME_X_DISPLAY (f), al, ac);
2632
2633 f->output_data.x->widget = shell_widget;
2634 /* maybe_set_screen_title_format (shell_widget); */
2635
2636 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2637 (widget_value *) NULL,
2638 shell_widget, False,
2639 (lw_callback) NULL,
2640 (lw_callback) NULL,
2641 (lw_callback) NULL,
2642 (lw_callback) NULL);
2643
2644 ac = 0;
2645 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2646 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2647 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2648 XtSetValues (pane_widget, al, ac);
2649 f->output_data.x->column_widget = pane_widget;
2650
2651 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2652 the emacs screen when changing menubar. This reduces flickering. */
2653
2654 ac = 0;
2655 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2656 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2657 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2658 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2659 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2660 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2661 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2662 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2663 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
2664 al, ac);
2665
2666 f->output_data.x->edit_widget = frame_widget;
2667
2668 XtManageChild (frame_widget);
2669
2670 /* Do some needed geometry management. */
2671 {
2672 int len;
2673 char *tem, shell_position[32];
2674 Arg al[10];
2675 int ac = 0;
2676 int extra_borders = 0;
2677 int menubar_size
2678 = (f->output_data.x->menubar_widget
2679 ? (f->output_data.x->menubar_widget->core.height
2680 + f->output_data.x->menubar_widget->core.border_width)
2681 : 0);
2682
2683 #if 0 /* Experimentally, we now get the right results
2684 for -geometry -0-0 without this. 24 Aug 96, rms. */
2685 if (FRAME_EXTERNAL_MENU_BAR (f))
2686 {
2687 Dimension ibw = 0;
2688 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2689 menubar_size += ibw;
2690 }
2691 #endif
2692
2693 f->output_data.x->menubar_height = menubar_size;
2694
2695 #ifndef USE_LUCID
2696 /* Motif seems to need this amount added to the sizes
2697 specified for the shell widget. The Athena/Lucid widgets don't.
2698 Both conclusions reached experimentally. -- rms. */
2699 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2700 &extra_borders, NULL);
2701 extra_borders *= 2;
2702 #endif
2703
2704 /* Convert our geometry parameters into a geometry string
2705 and specify it.
2706 Note that we do not specify here whether the position
2707 is a user-specified or program-specified one.
2708 We pass that information later, in x_wm_set_size_hints. */
2709 {
2710 int left = f->left_pos;
2711 int xneg = window_prompting & XNegative;
2712 int top = f->top_pos;
2713 int yneg = window_prompting & YNegative;
2714 if (xneg)
2715 left = -left;
2716 if (yneg)
2717 top = -top;
2718
2719 if (window_prompting & USPosition)
2720 sprintf (shell_position, "=%dx%d%c%d%c%d",
2721 FRAME_PIXEL_WIDTH (f) + extra_borders,
2722 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2723 (xneg ? '-' : '+'), left,
2724 (yneg ? '-' : '+'), top);
2725 else
2726 {
2727 sprintf (shell_position, "=%dx%d",
2728 FRAME_PIXEL_WIDTH (f) + extra_borders,
2729 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2730
2731 /* Setting x and y when the position is not specified in
2732 the geometry string will set program position in the WM hints.
2733 If Emacs had just one program position, we could set it in
2734 fallback resources, but since each make-frame call can specify
2735 different program positions, this is easier. */
2736 XtSetArg (al[ac], XtNx, left); ac++;
2737 XtSetArg (al[ac], XtNy, top); ac++;
2738 }
2739 }
2740
2741 len = strlen (shell_position) + 1;
2742 /* We don't free this because we don't know whether
2743 it is safe to free it while the frame exists.
2744 It isn't worth the trouble of arranging to free it
2745 when the frame is deleted. */
2746 tem = (char *) xmalloc (len);
2747 strncpy (tem, shell_position, len);
2748 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2749 XtSetValues (shell_widget, al, ac);
2750 }
2751
2752 XtManageChild (pane_widget);
2753 XtRealizeWidget (shell_widget);
2754
2755 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2756
2757 validate_x_resource_name ();
2758
2759 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2760 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2761 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2762
2763 #ifdef HAVE_X_I18N
2764 FRAME_XIC (f) = NULL;
2765 if (use_xim)
2766 create_frame_xic (f);
2767 #endif
2768
2769 f->output_data.x->wm_hints.input = True;
2770 f->output_data.x->wm_hints.flags |= InputHint;
2771 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2772 &f->output_data.x->wm_hints);
2773
2774 hack_wm_protocols (f, shell_widget);
2775
2776 #ifdef HACK_EDITRES
2777 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2778 #endif
2779
2780 /* Do a stupid property change to force the server to generate a
2781 PropertyNotify event so that the event_stream server timestamp will
2782 be initialized to something relevant to the time we created the window.
2783 */
2784 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2785 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2786 XA_ATOM, 32, PropModeAppend,
2787 (unsigned char*) NULL, 0);
2788
2789 /* Make all the standard events reach the Emacs frame. */
2790 attributes.event_mask = STANDARD_EVENT_SET;
2791
2792 #ifdef HAVE_X_I18N
2793 if (FRAME_XIC (f))
2794 {
2795 /* XIM server might require some X events. */
2796 unsigned long fevent = NoEventMask;
2797 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2798 attributes.event_mask |= fevent;
2799 }
2800 #endif /* HAVE_X_I18N */
2801
2802 attribute_mask = CWEventMask;
2803 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2804 attribute_mask, &attributes);
2805
2806 XtMapWidget (frame_widget);
2807
2808 /* x_set_name normally ignores requests to set the name if the
2809 requested name is the same as the current name. This is the one
2810 place where that assumption isn't correct; f->name is set, but
2811 the X server hasn't been told. */
2812 {
2813 Lisp_Object name;
2814 int explicit = f->explicit_name;
2815
2816 f->explicit_name = 0;
2817 name = f->name;
2818 f->name = Qnil;
2819 x_set_name (f, name, explicit);
2820 }
2821
2822 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2823 f->output_data.x->text_cursor);
2824
2825 UNBLOCK_INPUT;
2826
2827 /* This is a no-op, except under Motif. Make sure main areas are
2828 set to something reasonable, in case we get an error later. */
2829 lw_set_main_areas (pane_widget, 0, frame_widget);
2830 }
2831
2832 #else /* not USE_X_TOOLKIT */
2833 #ifdef USE_GTK
2834 void
2835 x_window (f)
2836 FRAME_PTR f;
2837 {
2838 if (! xg_create_frame_widgets (f))
2839 error ("Unable to create window");
2840
2841 #ifdef HAVE_X_I18N
2842 FRAME_XIC (f) = NULL;
2843 if (use_xim)
2844 {
2845 BLOCK_INPUT;
2846 create_frame_xic (f);
2847 if (FRAME_XIC (f))
2848 {
2849 /* XIM server might require some X events. */
2850 unsigned long fevent = NoEventMask;
2851 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2852
2853 if (fevent != NoEventMask)
2854 {
2855 XSetWindowAttributes attributes;
2856 XWindowAttributes wattr;
2857 unsigned long attribute_mask;
2858
2859 XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2860 &wattr);
2861 attributes.event_mask = wattr.your_event_mask | fevent;
2862 attribute_mask = CWEventMask;
2863 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2864 attribute_mask, &attributes);
2865 }
2866 }
2867 UNBLOCK_INPUT;
2868 }
2869 #endif
2870 }
2871
2872 #else /*! USE_GTK */
2873 /* Create and set up the X window for frame F. */
2874
2875 void
2876 x_window (f)
2877 struct frame *f;
2878
2879 {
2880 XClassHint class_hints;
2881 XSetWindowAttributes attributes;
2882 unsigned long attribute_mask;
2883
2884 attributes.background_pixel = f->output_data.x->background_pixel;
2885 attributes.border_pixel = f->output_data.x->border_pixel;
2886 attributes.bit_gravity = StaticGravity;
2887 attributes.backing_store = NotUseful;
2888 attributes.save_under = True;
2889 attributes.event_mask = STANDARD_EVENT_SET;
2890 attributes.colormap = FRAME_X_COLORMAP (f);
2891 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
2892 | CWColormap);
2893
2894 BLOCK_INPUT;
2895 FRAME_X_WINDOW (f)
2896 = XCreateWindow (FRAME_X_DISPLAY (f),
2897 f->output_data.x->parent_desc,
2898 f->left_pos,
2899 f->top_pos,
2900 FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
2901 f->border_width,
2902 CopyFromParent, /* depth */
2903 InputOutput, /* class */
2904 FRAME_X_VISUAL (f),
2905 attribute_mask, &attributes);
2906
2907 #ifdef HAVE_X_I18N
2908 if (use_xim)
2909 {
2910 create_frame_xic (f);
2911 if (FRAME_XIC (f))
2912 {
2913 /* XIM server might require some X events. */
2914 unsigned long fevent = NoEventMask;
2915 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2916 attributes.event_mask |= fevent;
2917 attribute_mask = CWEventMask;
2918 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2919 attribute_mask, &attributes);
2920 }
2921 }
2922 #endif /* HAVE_X_I18N */
2923
2924 validate_x_resource_name ();
2925
2926 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2927 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2928 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2929
2930 /* The menubar is part of the ordinary display;
2931 it does not count in addition to the height of the window. */
2932 f->output_data.x->menubar_height = 0;
2933
2934 /* This indicates that we use the "Passive Input" input model.
2935 Unless we do this, we don't get the Focus{In,Out} events that we
2936 need to draw the cursor correctly. Accursed bureaucrats.
2937 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2938
2939 f->output_data.x->wm_hints.input = True;
2940 f->output_data.x->wm_hints.flags |= InputHint;
2941 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2942 &f->output_data.x->wm_hints);
2943 f->output_data.x->wm_hints.icon_pixmap = None;
2944
2945 /* Request "save yourself" and "delete window" commands from wm. */
2946 {
2947 Atom protocols[2];
2948 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2949 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2950 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2951 }
2952
2953 /* x_set_name normally ignores requests to set the name if the
2954 requested name is the same as the current name. This is the one
2955 place where that assumption isn't correct; f->name is set, but
2956 the X server hasn't been told. */
2957 {
2958 Lisp_Object name;
2959 int explicit = f->explicit_name;
2960
2961 f->explicit_name = 0;
2962 name = f->name;
2963 f->name = Qnil;
2964 x_set_name (f, name, explicit);
2965 }
2966
2967 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2968 f->output_data.x->text_cursor);
2969
2970 UNBLOCK_INPUT;
2971
2972 if (FRAME_X_WINDOW (f) == 0)
2973 error ("Unable to create window");
2974 }
2975
2976 #endif /* not USE_GTK */
2977 #endif /* not USE_X_TOOLKIT */
2978
2979 /* Handle the icon stuff for this window. Perhaps later we might
2980 want an x_set_icon_position which can be called interactively as
2981 well. */
2982
2983 static void
2984 x_icon (f, parms)
2985 struct frame *f;
2986 Lisp_Object parms;
2987 {
2988 Lisp_Object icon_x, icon_y;
2989 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2990
2991 /* Set the position of the icon. Note that twm groups all
2992 icons in an icon window. */
2993 icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
2994 icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
2995 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2996 {
2997 CHECK_NUMBER (icon_x);
2998 CHECK_NUMBER (icon_y);
2999 }
3000 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
3001 error ("Both left and top icon corners of icon must be specified");
3002
3003 BLOCK_INPUT;
3004
3005 if (! EQ (icon_x, Qunbound))
3006 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3007
3008 /* Start up iconic or window? */
3009 x_wm_set_window_state
3010 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
3011 Qicon)
3012 ? IconicState
3013 : NormalState));
3014
3015 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
3016 ? f->icon_name
3017 : f->name)));
3018
3019 UNBLOCK_INPUT;
3020 }
3021
3022 /* Make the GCs needed for this window, setting the
3023 background, border and mouse colors; also create the
3024 mouse cursor and the gray border tile. */
3025
3026 static char cursor_bits[] =
3027 {
3028 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3029 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3030 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3031 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3032 };
3033
3034 static void
3035 x_make_gc (f)
3036 struct frame *f;
3037 {
3038 XGCValues gc_values;
3039
3040 BLOCK_INPUT;
3041
3042 /* Create the GCs of this frame.
3043 Note that many default values are used. */
3044
3045 /* Normal video */
3046 gc_values.font = FRAME_FONT (f)->fid;
3047 gc_values.foreground = f->output_data.x->foreground_pixel;
3048 gc_values.background = f->output_data.x->background_pixel;
3049 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3050 f->output_data.x->normal_gc
3051 = XCreateGC (FRAME_X_DISPLAY (f),
3052 FRAME_X_WINDOW (f),
3053 GCLineWidth | GCFont | GCForeground | GCBackground,
3054 &gc_values);
3055
3056 /* Reverse video style. */
3057 gc_values.foreground = f->output_data.x->background_pixel;
3058 gc_values.background = f->output_data.x->foreground_pixel;
3059 f->output_data.x->reverse_gc
3060 = XCreateGC (FRAME_X_DISPLAY (f),
3061 FRAME_X_WINDOW (f),
3062 GCFont | GCForeground | GCBackground | GCLineWidth,
3063 &gc_values);
3064
3065 /* Cursor has cursor-color background, background-color foreground. */
3066 gc_values.foreground = f->output_data.x->background_pixel;
3067 gc_values.background = f->output_data.x->cursor_pixel;
3068 gc_values.fill_style = FillOpaqueStippled;
3069 gc_values.stipple
3070 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3071 FRAME_X_DISPLAY_INFO (f)->root_window,
3072 cursor_bits, 16, 16);
3073 f->output_data.x->cursor_gc
3074 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3075 (GCFont | GCForeground | GCBackground
3076 | GCFillStyle /* | GCStipple */ | GCLineWidth),
3077 &gc_values);
3078
3079 /* Reliefs. */
3080 f->output_data.x->white_relief.gc = 0;
3081 f->output_data.x->black_relief.gc = 0;
3082
3083 /* Create the gray border tile used when the pointer is not in
3084 the frame. Since this depends on the frame's pixel values,
3085 this must be done on a per-frame basis. */
3086 f->output_data.x->border_tile
3087 = (XCreatePixmapFromBitmapData
3088 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3089 gray_bits, gray_width, gray_height,
3090 f->output_data.x->foreground_pixel,
3091 f->output_data.x->background_pixel,
3092 DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
3093
3094 UNBLOCK_INPUT;
3095 }
3096
3097
3098 /* Free what was was allocated in x_make_gc. */
3099
3100 void
3101 x_free_gcs (f)
3102 struct frame *f;
3103 {
3104 Display *dpy = FRAME_X_DISPLAY (f);
3105
3106 BLOCK_INPUT;
3107
3108 if (f->output_data.x->normal_gc)
3109 {
3110 XFreeGC (dpy, f->output_data.x->normal_gc);
3111 f->output_data.x->normal_gc = 0;
3112 }
3113
3114 if (f->output_data.x->reverse_gc)
3115 {
3116 XFreeGC (dpy, f->output_data.x->reverse_gc);
3117 f->output_data.x->reverse_gc = 0;
3118 }
3119
3120 if (f->output_data.x->cursor_gc)
3121 {
3122 XFreeGC (dpy, f->output_data.x->cursor_gc);
3123 f->output_data.x->cursor_gc = 0;
3124 }
3125
3126 if (f->output_data.x->border_tile)
3127 {
3128 XFreePixmap (dpy, f->output_data.x->border_tile);
3129 f->output_data.x->border_tile = 0;
3130 }
3131
3132 UNBLOCK_INPUT;
3133 }
3134
3135
3136 /* Handler for signals raised during x_create_frame and
3137 x_create_top_frame. FRAME is the frame which is partially
3138 constructed. */
3139
3140 static Lisp_Object
3141 unwind_create_frame (frame)
3142 Lisp_Object frame;
3143 {
3144 struct frame *f = XFRAME (frame);
3145
3146 /* If frame is ``official'', nothing to do. */
3147 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
3148 {
3149 #if GLYPH_DEBUG
3150 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3151 #endif
3152
3153 x_free_frame_resources (f);
3154
3155 /* Check that reference counts are indeed correct. */
3156 xassert (dpyinfo->reference_count == dpyinfo_refcount);
3157 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
3158 return Qt;
3159 }
3160
3161 return Qnil;
3162 }
3163
3164
3165 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3166 1, 1, 0,
3167 doc: /* Make a new X window, which is called a "frame" in Emacs terms.
3168 Returns an Emacs frame object.
3169 ALIST is an alist of frame parameters.
3170 If the parameters specify that the frame should not have a minibuffer,
3171 and do not specify a specific minibuffer window to use,
3172 then `default-minibuffer-frame' must be a frame whose minibuffer can
3173 be shared by the new frame.
3174
3175 This function is an internal primitive--use `make-frame' instead. */)
3176 (parms)
3177 Lisp_Object parms;
3178 {
3179 struct frame *f;
3180 Lisp_Object frame, tem;
3181 Lisp_Object name;
3182 int minibuffer_only = 0;
3183 long window_prompting = 0;
3184 int width, height;
3185 int count = SPECPDL_INDEX ();
3186 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3187 Lisp_Object display;
3188 struct x_display_info *dpyinfo = NULL;
3189 Lisp_Object parent;
3190 struct kboard *kb;
3191
3192 check_x ();
3193
3194 /* XXX rif hack:Make sure rif is set to the right value. */
3195 rif = x_display_method.rif;
3196
3197 /* Use this general default value to start with
3198 until we know if this frame has a specified name. */
3199 Vx_resource_name = Vinvocation_name;
3200
3201 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
3202 if (EQ (display, Qunbound))
3203 display = Qnil;
3204 dpyinfo = check_x_display_info (display);
3205 #ifdef MULTI_KBOARD
3206 kb = dpyinfo->kboard;
3207 #else
3208 kb = &the_only_kboard;
3209 #endif
3210
3211 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
3212 if (!STRINGP (name)
3213 && ! EQ (name, Qunbound)
3214 && ! NILP (name))
3215 error ("Invalid frame name--not a string or nil");
3216
3217 if (STRINGP (name))
3218 Vx_resource_name = name;
3219
3220 /* See if parent window is specified. */
3221 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
3222 if (EQ (parent, Qunbound))
3223 parent = Qnil;
3224 if (! NILP (parent))
3225 CHECK_NUMBER (parent);
3226
3227 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3228 /* No need to protect DISPLAY because that's not used after passing
3229 it to make_frame_without_minibuffer. */
3230 frame = Qnil;
3231 GCPRO4 (parms, parent, name, frame);
3232 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
3233 RES_TYPE_SYMBOL);
3234 if (EQ (tem, Qnone) || NILP (tem))
3235 f = make_frame_without_minibuffer (Qnil, kb, display);
3236 else if (EQ (tem, Qonly))
3237 {
3238 f = make_minibuffer_frame ();
3239 minibuffer_only = 1;
3240 }
3241 else if (WINDOWP (tem))
3242 f = make_frame_without_minibuffer (tem, kb, display);
3243 else
3244 f = make_frame (1);
3245
3246 XSETFRAME (frame, f);
3247
3248 /* Note that X Windows does support scroll bars. */
3249 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3250
3251 f->display_method = &x_display_method;
3252 f->output_method = output_x_window;
3253 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3254 bzero (f->output_data.x, sizeof (struct x_output));
3255 f->output_data.x->icon_bitmap = -1;
3256 FRAME_FONTSET (f) = -1;
3257 f->output_data.x->scroll_bar_foreground_pixel = -1;
3258 f->output_data.x->scroll_bar_background_pixel = -1;
3259 #ifdef USE_TOOLKIT_SCROLL_BARS
3260 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
3261 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
3262 #endif /* USE_TOOLKIT_SCROLL_BARS */
3263 record_unwind_protect (unwind_create_frame, frame);
3264
3265 f->icon_name
3266 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
3267 RES_TYPE_STRING);
3268 if (! STRINGP (f->icon_name))
3269 f->icon_name = Qnil;
3270
3271 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3272 #if GLYPH_DEBUG
3273 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
3274 dpyinfo_refcount = dpyinfo->reference_count;
3275 #endif /* GLYPH_DEBUG */
3276 #ifdef MULTI_KBOARD
3277 FRAME_KBOARD (f) = kb;
3278 #endif
3279
3280 /* These colors will be set anyway later, but it's important
3281 to get the color reference counts right, so initialize them! */
3282 {
3283 Lisp_Object black;
3284 struct gcpro gcpro1;
3285
3286 /* Function x_decode_color can signal an error. Make
3287 sure to initialize color slots so that we won't try
3288 to free colors we haven't allocated. */
3289 f->output_data.x->foreground_pixel = -1;
3290 f->output_data.x->background_pixel = -1;
3291 f->output_data.x->cursor_pixel = -1;
3292 f->output_data.x->cursor_foreground_pixel = -1;
3293 f->output_data.x->border_pixel = -1;
3294 f->output_data.x->mouse_pixel = -1;
3295
3296 black = build_string ("black");
3297 GCPRO1 (black);
3298 f->output_data.x->foreground_pixel
3299 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3300 f->output_data.x->background_pixel
3301 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3302 f->output_data.x->cursor_pixel
3303 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3304 f->output_data.x->cursor_foreground_pixel
3305 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3306 f->output_data.x->border_pixel
3307 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3308 f->output_data.x->mouse_pixel
3309 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3310 UNGCPRO;
3311 }
3312
3313 /* Specify the parent under which to make this X window. */
3314
3315 if (!NILP (parent))
3316 {
3317 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3318 f->output_data.x->explicit_parent = 1;
3319 }
3320 else
3321 {
3322 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3323 f->output_data.x->explicit_parent = 0;
3324 }
3325
3326 /* Set the name; the functions to which we pass f expect the name to
3327 be set. */
3328 if (EQ (name, Qunbound) || NILP (name))
3329 {
3330 f->name = build_string (dpyinfo->x_id_name);
3331 f->explicit_name = 0;
3332 }
3333 else
3334 {
3335 f->name = name;
3336 f->explicit_name = 1;
3337 /* use the frame's title when getting resources for this frame. */
3338 specbind (Qx_resource_name, name);
3339 }
3340
3341 /* Extract the window parameters from the supplied values
3342 that are needed to determine window geometry. */
3343 {
3344 Lisp_Object font;
3345
3346 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
3347
3348 BLOCK_INPUT;
3349 /* First, try whatever font the caller has specified. */
3350 if (STRINGP (font))
3351 {
3352 tem = Fquery_fontset (font, Qnil);
3353 if (STRINGP (tem))
3354 font = x_new_fontset (f, SDATA (tem));
3355 else
3356 font = x_new_font (f, SDATA (font));
3357 }
3358
3359 /* Try out a font which we hope has bold and italic variations. */
3360 if (!STRINGP (font))
3361 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3362 if (!STRINGP (font))
3363 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3364 if (! STRINGP (font))
3365 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3366 if (! STRINGP (font))
3367 /* This was formerly the first thing tried, but it finds too many fonts
3368 and takes too long. */
3369 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3370 /* If those didn't work, look for something which will at least work. */
3371 if (! STRINGP (font))
3372 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3373 UNBLOCK_INPUT;
3374 if (! STRINGP (font))
3375 font = build_string ("fixed");
3376
3377 x_default_parameter (f, parms, Qfont, font,
3378 "font", "Font", RES_TYPE_STRING);
3379 }
3380
3381 #ifdef USE_LUCID
3382 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3383 whereby it fails to get any font. */
3384 xlwmenu_default_font = FRAME_FONT (f);
3385 #endif
3386
3387 x_default_parameter (f, parms, Qborder_width, make_number (2),
3388 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
3389
3390 /* This defaults to 1 in order to match xterm. We recognize either
3391 internalBorderWidth or internalBorder (which is what xterm calls
3392 it). */
3393 if (NILP (Fassq (Qinternal_border_width, parms)))
3394 {
3395 Lisp_Object value;
3396
3397 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3398 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
3399 if (! EQ (value, Qunbound))
3400 parms = Fcons (Fcons (Qinternal_border_width, value),
3401 parms);
3402 }
3403 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3404 "internalBorderWidth", "internalBorderWidth",
3405 RES_TYPE_NUMBER);
3406 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3407 "verticalScrollBars", "ScrollBars",
3408 RES_TYPE_SYMBOL);
3409
3410 /* Also do the stuff which must be set before the window exists. */
3411 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3412 "foreground", "Foreground", RES_TYPE_STRING);
3413 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3414 "background", "Background", RES_TYPE_STRING);
3415 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3416 "pointerColor", "Foreground", RES_TYPE_STRING);
3417 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3418 "cursorColor", "Foreground", RES_TYPE_STRING);
3419 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3420 "borderColor", "BorderColor", RES_TYPE_STRING);
3421 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
3422 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
3423 x_default_parameter (f, parms, Qline_spacing, Qnil,
3424 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
3425 x_default_parameter (f, parms, Qleft_fringe, Qnil,
3426 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
3427 x_default_parameter (f, parms, Qright_fringe, Qnil,
3428 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
3429
3430 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
3431 "scrollBarForeground",
3432 "ScrollBarForeground", 1);
3433 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
3434 "scrollBarBackground",
3435 "ScrollBarBackground", 0);
3436
3437 /* Init faces before x_default_parameter is called for scroll-bar
3438 parameters because that function calls x_set_scroll_bar_width,
3439 which calls change_frame_size, which calls Fset_window_buffer,
3440 which runs hooks, which call Fvertical_motion. At the end, we
3441 end up in init_iterator with a null face cache, which should not
3442 happen. */
3443 init_frame_faces (f);
3444
3445 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3446 "menuBar", "MenuBar", RES_TYPE_NUMBER);
3447 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
3448 "toolBar", "ToolBar", RES_TYPE_NUMBER);
3449 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3450 "bufferPredicate", "BufferPredicate",
3451 RES_TYPE_SYMBOL);
3452 x_default_parameter (f, parms, Qtitle, Qnil,
3453 "title", "Title", RES_TYPE_STRING);
3454 x_default_parameter (f, parms, Qwait_for_wm, Qt,
3455 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
3456 x_default_parameter (f, parms, Qfullscreen, Qnil,
3457 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
3458
3459 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3460
3461 /* Compute the size of the X window. */
3462 window_prompting = x_figure_window_size (f, parms, 1);
3463
3464 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
3465 f->no_split = minibuffer_only || EQ (tem, Qt);
3466
3467 /* Create the X widget or window. */
3468 #ifdef USE_X_TOOLKIT
3469 x_window (f, window_prompting, minibuffer_only);
3470 #else
3471 x_window (f);
3472 #endif
3473
3474 x_icon (f, parms);
3475 x_make_gc (f);
3476
3477 /* Now consider the frame official. */
3478 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3479 Vframe_list = Fcons (frame, Vframe_list);
3480
3481 /* We need to do this after creating the X window, so that the
3482 icon-creation functions can say whose icon they're describing. */
3483 x_default_parameter (f, parms, Qicon_type, Qnil,
3484 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
3485
3486 x_default_parameter (f, parms, Qauto_raise, Qnil,
3487 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3488 x_default_parameter (f, parms, Qauto_lower, Qnil,
3489 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3490 x_default_parameter (f, parms, Qcursor_type, Qbox,
3491 "cursorType", "CursorType", RES_TYPE_SYMBOL);
3492 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3493 "scrollBarWidth", "ScrollBarWidth",
3494 RES_TYPE_NUMBER);
3495
3496 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
3497 Change will not be effected unless different from the current
3498 FRAME_LINES (f). */
3499 width = FRAME_COLS (f);
3500 height = FRAME_LINES (f);
3501
3502 SET_FRAME_COLS (f, 0);
3503 FRAME_LINES (f) = 0;
3504 change_frame_size (f, height, width, 1, 0, 0);
3505
3506 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
3507 /* Create the menu bar. */
3508 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
3509 {
3510 /* If this signals an error, we haven't set size hints for the
3511 frame and we didn't make it visible. */
3512 initialize_frame_menubar (f);
3513
3514 #ifndef USE_GTK
3515 /* This is a no-op, except under Motif where it arranges the
3516 main window for the widgets on it. */
3517 lw_set_main_areas (f->output_data.x->column_widget,
3518 f->output_data.x->menubar_widget,
3519 f->output_data.x->edit_widget);
3520 #endif /* not USE_GTK */
3521 }
3522 #endif /* USE_X_TOOLKIT || USE_GTK */
3523
3524 /* Tell the server what size and position, etc, we want, and how
3525 badly we want them. This should be done after we have the menu
3526 bar so that its size can be taken into account. */
3527 BLOCK_INPUT;
3528 x_wm_set_size_hint (f, window_prompting, 0);
3529 UNBLOCK_INPUT;
3530
3531 /* Make the window appear on the frame and enable display, unless
3532 the caller says not to. However, with explicit parent, Emacs
3533 cannot control visibility, so don't try. */
3534 if (! f->output_data.x->explicit_parent)
3535 {
3536 Lisp_Object visibility;
3537
3538 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
3539 RES_TYPE_SYMBOL);
3540 if (EQ (visibility, Qunbound))
3541 visibility = Qt;
3542
3543 if (EQ (visibility, Qicon))
3544 x_iconify_frame (f);
3545 else if (! NILP (visibility))
3546 x_make_frame_visible (f);
3547 else
3548 /* Must have been Qnil. */
3549 ;
3550 }
3551
3552 /* Set the WM leader property. GTK does this itself, so this is not
3553 needed when using GTK. */
3554 if (dpyinfo->client_leader_window != 0)
3555 {
3556 BLOCK_INPUT;
3557 XChangeProperty (FRAME_X_DISPLAY (f),
3558 FRAME_OUTER_WINDOW (f),
3559 dpyinfo->Xatom_wm_client_leader,
3560 XA_WINDOW, 32, PropModeReplace,
3561 (char *) &dpyinfo->client_leader_window, 1);
3562 UNBLOCK_INPUT;
3563 }
3564
3565 UNGCPRO;
3566
3567 /* Make sure windows on this frame appear in calls to next-window
3568 and similar functions. */
3569 Vwindow_list = Qnil;
3570
3571 return unbind_to (count, frame);
3572 }
3573
3574
3575 /* FRAME is used only to get a handle on the X display. We don't pass the
3576 display info directly because we're called from frame.c, which doesn't
3577 know about that structure. */
3578
3579 Lisp_Object
3580 x_get_focus_frame (frame)
3581 struct frame *frame;
3582 {
3583 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3584 Lisp_Object xfocus;
3585 if (! dpyinfo->x_focus_frame)
3586 return Qnil;
3587
3588 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3589 return xfocus;
3590 }
3591
3592
3593 /* In certain situations, when the window manager follows a
3594 click-to-focus policy, there seems to be no way around calling
3595 XSetInputFocus to give another frame the input focus .
3596
3597 In an ideal world, XSetInputFocus should generally be avoided so
3598 that applications don't interfere with the window manager's focus
3599 policy. But I think it's okay to use when it's clearly done
3600 following a user-command. */
3601
3602 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
3603 doc: /* Set the input focus to FRAME.
3604 FRAME nil means use the selected frame. */)
3605 (frame)
3606 Lisp_Object frame;
3607 {
3608 struct frame *f = check_x_frame (frame);
3609 Display *dpy = FRAME_X_DISPLAY (f);
3610 int count;
3611
3612 BLOCK_INPUT;
3613 count = x_catch_errors (dpy);
3614 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3615 RevertToParent, CurrentTime);
3616 x_uncatch_errors (dpy, count);
3617 UNBLOCK_INPUT;
3618
3619 return Qnil;
3620 }
3621
3622 \f
3623 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
3624 doc: /* Internal function called by `color-defined-p', which see. */)
3625 (color, frame)
3626 Lisp_Object color, frame;
3627 {
3628 XColor foo;
3629 FRAME_PTR f = check_x_frame (frame);
3630
3631 CHECK_STRING (color);
3632
3633 if (x_defined_color (f, SDATA (color), &foo, 0))
3634 return Qt;
3635 else
3636 return Qnil;
3637 }
3638
3639 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
3640 doc: /* Internal function called by `color-values', which see. */)
3641 (color, frame)
3642 Lisp_Object color, frame;
3643 {
3644 XColor foo;
3645 FRAME_PTR f = check_x_frame (frame);
3646
3647 CHECK_STRING (color);
3648
3649 if (x_defined_color (f, SDATA (color), &foo, 0))
3650 {
3651 Lisp_Object rgb[3];
3652
3653 rgb[0] = make_number (foo.red);
3654 rgb[1] = make_number (foo.green);
3655 rgb[2] = make_number (foo.blue);
3656 return Flist (3, rgb);
3657 }
3658 else
3659 return Qnil;
3660 }
3661
3662 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
3663 doc: /* Internal function called by `display-color-p', which see. */)
3664 (display)
3665 Lisp_Object display;
3666 {
3667 struct x_display_info *dpyinfo = check_x_display_info (display);
3668
3669 if (dpyinfo->n_planes <= 2)
3670 return Qnil;
3671
3672 switch (dpyinfo->visual->class)
3673 {
3674 case StaticColor:
3675 case PseudoColor:
3676 case TrueColor:
3677 case DirectColor:
3678 return Qt;
3679
3680 default:
3681 return Qnil;
3682 }
3683 }
3684
3685 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3686 0, 1, 0,
3687 doc: /* Return t if the X display supports shades of gray.
3688 Note that color displays do support shades of gray.
3689 The optional argument DISPLAY specifies which display to ask about.
3690 DISPLAY should be either a frame or a display name (a string).
3691 If omitted or nil, that stands for the selected frame's display. */)
3692 (display)
3693 Lisp_Object display;
3694 {
3695 struct x_display_info *dpyinfo = check_x_display_info (display);
3696
3697 if (dpyinfo->n_planes <= 1)
3698 return Qnil;
3699
3700 switch (dpyinfo->visual->class)
3701 {
3702 case StaticColor:
3703 case PseudoColor:
3704 case TrueColor:
3705 case DirectColor:
3706 case StaticGray:
3707 case GrayScale:
3708 return Qt;
3709
3710 default:
3711 return Qnil;
3712 }
3713 }
3714
3715 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3716 0, 1, 0,
3717 doc: /* Returns the width in pixels of the X display DISPLAY.
3718 The optional argument DISPLAY specifies which display to ask about.
3719 DISPLAY should be either a frame or a display name (a string).
3720 If omitted or nil, that stands for the selected frame's display. */)
3721 (display)
3722 Lisp_Object display;
3723 {
3724 struct x_display_info *dpyinfo = check_x_display_info (display);
3725
3726 return make_number (dpyinfo->width);
3727 }
3728
3729 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3730 Sx_display_pixel_height, 0, 1, 0,
3731 doc: /* Returns the height in pixels of the X display DISPLAY.
3732 The optional argument DISPLAY specifies which display to ask about.
3733 DISPLAY should be either a frame or a display name (a string).
3734 If omitted or nil, that stands for the selected frame's display. */)
3735 (display)
3736 Lisp_Object display;
3737 {
3738 struct x_display_info *dpyinfo = check_x_display_info (display);
3739
3740 return make_number (dpyinfo->height);
3741 }
3742
3743 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3744 0, 1, 0,
3745 doc: /* Returns the number of bitplanes of the X display DISPLAY.
3746 The optional argument DISPLAY specifies which display to ask about.
3747 DISPLAY should be either a frame or a display name (a string).
3748 If omitted or nil, that stands for the selected frame's display. */)
3749 (display)
3750 Lisp_Object display;
3751 {
3752 struct x_display_info *dpyinfo = check_x_display_info (display);
3753
3754 return make_number (dpyinfo->n_planes);
3755 }
3756
3757 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3758 0, 1, 0,
3759 doc: /* Returns the number of color cells of the X display DISPLAY.
3760 The optional argument DISPLAY specifies which display to ask about.
3761 DISPLAY should be either a frame or a display name (a string).
3762 If omitted or nil, that stands for the selected frame's display. */)
3763 (display)
3764 Lisp_Object display;
3765 {
3766 struct x_display_info *dpyinfo = check_x_display_info (display);
3767
3768 return make_number (DisplayCells (dpyinfo->display,
3769 XScreenNumberOfScreen (dpyinfo->screen)));
3770 }
3771
3772 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3773 Sx_server_max_request_size,
3774 0, 1, 0,
3775 doc: /* Returns the maximum request size of the X server of display DISPLAY.
3776 The optional argument DISPLAY specifies which display to ask about.
3777 DISPLAY should be either a frame or a display name (a string).
3778 If omitted or nil, that stands for the selected frame's display. */)
3779 (display)
3780 Lisp_Object display;
3781 {
3782 struct x_display_info *dpyinfo = check_x_display_info (display);
3783
3784 return make_number (MAXREQUEST (dpyinfo->display));
3785 }
3786
3787 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3788 doc: /* Returns the vendor ID string of the X server of display DISPLAY.
3789 The optional argument DISPLAY specifies which display to ask about.
3790 DISPLAY should be either a frame or a display name (a string).
3791 If omitted or nil, that stands for the selected frame's display. */)
3792 (display)
3793 Lisp_Object display;
3794 {
3795 struct x_display_info *dpyinfo = check_x_display_info (display);
3796 char *vendor = ServerVendor (dpyinfo->display);
3797
3798 if (! vendor) vendor = "";
3799 return build_string (vendor);
3800 }
3801
3802 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3803 doc: /* Returns the version numbers of the X server of display DISPLAY.
3804 The value is a list of three integers: the major and minor
3805 version numbers of the X Protocol in use, and the vendor-specific release
3806 number. See also the function `x-server-vendor'.
3807
3808 The optional argument DISPLAY specifies which display to ask about.
3809 DISPLAY should be either a frame or a display name (a string).
3810 If omitted or nil, that stands for the selected frame's display. */)
3811 (display)
3812 Lisp_Object display;
3813 {
3814 struct x_display_info *dpyinfo = check_x_display_info (display);
3815 Display *dpy = dpyinfo->display;
3816
3817 return Fcons (make_number (ProtocolVersion (dpy)),
3818 Fcons (make_number (ProtocolRevision (dpy)),
3819 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3820 }
3821
3822 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3823 doc: /* Return the number of screens on the X server of display DISPLAY.
3824 The optional argument DISPLAY specifies which display to ask about.
3825 DISPLAY should be either a frame or a display name (a string).
3826 If omitted or nil, that stands for the selected frame's display. */)
3827 (display)
3828 Lisp_Object display;
3829 {
3830 struct x_display_info *dpyinfo = check_x_display_info (display);
3831
3832 return make_number (ScreenCount (dpyinfo->display));
3833 }
3834
3835 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3836 doc: /* Return the height in millimeters of the X display DISPLAY.
3837 The optional argument DISPLAY specifies which display to ask about.
3838 DISPLAY should be either a frame or a display name (a string).
3839 If omitted or nil, that stands for the selected frame's display. */)
3840 (display)
3841 Lisp_Object display;
3842 {
3843 struct x_display_info *dpyinfo = check_x_display_info (display);
3844
3845 return make_number (HeightMMOfScreen (dpyinfo->screen));
3846 }
3847
3848 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3849 doc: /* Return the width in millimeters of the X display DISPLAY.
3850 The optional argument DISPLAY specifies which display to ask about.
3851 DISPLAY should be either a frame or a display name (a string).
3852 If omitted or nil, that stands for the selected frame's display. */)
3853 (display)
3854 Lisp_Object display;
3855 {
3856 struct x_display_info *dpyinfo = check_x_display_info (display);
3857
3858 return make_number (WidthMMOfScreen (dpyinfo->screen));
3859 }
3860
3861 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3862 Sx_display_backing_store, 0, 1, 0,
3863 doc: /* Returns an indication of whether X display DISPLAY does backing store.
3864 The value may be `always', `when-mapped', or `not-useful'.
3865 The optional argument DISPLAY specifies which display to ask about.
3866 DISPLAY should be either a frame or a display name (a string).
3867 If omitted or nil, that stands for the selected frame's display. */)
3868 (display)
3869 Lisp_Object display;
3870 {
3871 struct x_display_info *dpyinfo = check_x_display_info (display);
3872 Lisp_Object result;
3873
3874 switch (DoesBackingStore (dpyinfo->screen))
3875 {
3876 case Always:
3877 result = intern ("always");
3878 break;
3879
3880 case WhenMapped:
3881 result = intern ("when-mapped");
3882 break;
3883
3884 case NotUseful:
3885 result = intern ("not-useful");
3886 break;
3887
3888 default:
3889 error ("Strange value for BackingStore parameter of screen");
3890 result = Qnil;
3891 }
3892
3893 return result;
3894 }
3895
3896 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3897 Sx_display_visual_class, 0, 1, 0,
3898 doc: /* Return the visual class of the X display DISPLAY.
3899 The value is one of the symbols `static-gray', `gray-scale',
3900 `static-color', `pseudo-color', `true-color', or `direct-color'.
3901
3902 The optional argument DISPLAY specifies which display to ask about.
3903 DISPLAY should be either a frame or a display name (a string).
3904 If omitted or nil, that stands for the selected frame's display. */)
3905 (display)
3906 Lisp_Object display;
3907 {
3908 struct x_display_info *dpyinfo = check_x_display_info (display);
3909 Lisp_Object result;
3910
3911 switch (dpyinfo->visual->class)
3912 {
3913 case StaticGray:
3914 result = intern ("static-gray");
3915 break;
3916 case GrayScale:
3917 result = intern ("gray-scale");
3918 break;
3919 case StaticColor:
3920 result = intern ("static-color");
3921 break;
3922 case PseudoColor:
3923 result = intern ("pseudo-color");
3924 break;
3925 case TrueColor:
3926 result = intern ("true-color");
3927 break;
3928 case DirectColor:
3929 result = intern ("direct-color");
3930 break;
3931 default:
3932 error ("Display has an unknown visual class");
3933 result = Qnil;
3934 }
3935
3936 return result;
3937 }
3938
3939 DEFUN ("x-display-save-under", Fx_display_save_under,
3940 Sx_display_save_under, 0, 1, 0,
3941 doc: /* Returns t if the X display DISPLAY supports the save-under feature.
3942 The optional argument DISPLAY specifies which display to ask about.
3943 DISPLAY should be either a frame or a display name (a string).
3944 If omitted or nil, that stands for the selected frame's display. */)
3945 (display)
3946 Lisp_Object display;
3947 {
3948 struct x_display_info *dpyinfo = check_x_display_info (display);
3949
3950 if (DoesSaveUnders (dpyinfo->screen) == True)
3951 return Qt;
3952 else
3953 return Qnil;
3954 }
3955 \f
3956 int
3957 x_pixel_width (f)
3958 register struct frame *f;
3959 {
3960 return FRAME_PIXEL_WIDTH (f);
3961 }
3962
3963 int
3964 x_pixel_height (f)
3965 register struct frame *f;
3966 {
3967 return FRAME_PIXEL_HEIGHT (f);
3968 }
3969
3970 int
3971 x_char_width (f)
3972 register struct frame *f;
3973 {
3974 return FRAME_COLUMN_WIDTH (f);
3975 }
3976
3977 int
3978 x_char_height (f)
3979 register struct frame *f;
3980 {
3981 return FRAME_LINE_HEIGHT (f);
3982 }
3983
3984 int
3985 x_screen_planes (f)
3986 register struct frame *f;
3987 {
3988 return FRAME_X_DISPLAY_INFO (f)->n_planes;
3989 }
3990
3991
3992 \f
3993 /************************************************************************
3994 X Displays
3995 ************************************************************************/
3996
3997 \f
3998 /* Mapping visual names to visuals. */
3999
4000 static struct visual_class
4001 {
4002 char *name;
4003 int class;
4004 }
4005 visual_classes[] =
4006 {
4007 {"StaticGray", StaticGray},
4008 {"GrayScale", GrayScale},
4009 {"StaticColor", StaticColor},
4010 {"PseudoColor", PseudoColor},
4011 {"TrueColor", TrueColor},
4012 {"DirectColor", DirectColor},
4013 {NULL, 0}
4014 };
4015
4016
4017 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4018
4019 /* Value is the screen number of screen SCR. This is a substitute for
4020 the X function with the same name when that doesn't exist. */
4021
4022 int
4023 XScreenNumberOfScreen (scr)
4024 register Screen *scr;
4025 {
4026 Display *dpy = scr->display;
4027 int i;
4028
4029 for (i = 0; i < dpy->nscreens; ++i)
4030 if (scr == dpy->screens + i)
4031 break;
4032
4033 return i;
4034 }
4035
4036 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4037
4038
4039 /* Select the visual that should be used on display DPYINFO. Set
4040 members of DPYINFO appropriately. Called from x_term_init. */
4041
4042 void
4043 select_visual (dpyinfo)
4044 struct x_display_info *dpyinfo;
4045 {
4046 Display *dpy = dpyinfo->display;
4047 Screen *screen = dpyinfo->screen;
4048 Lisp_Object value;
4049
4050 /* See if a visual is specified. */
4051 value = display_x_get_resource (dpyinfo,
4052 build_string ("visualClass"),
4053 build_string ("VisualClass"),
4054 Qnil, Qnil);
4055 if (STRINGP (value))
4056 {
4057 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4058 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4059 depth, a decimal number. NAME is compared with case ignored. */
4060 char *s = (char *) alloca (SBYTES (value) + 1);
4061 char *dash;
4062 int i, class = -1;
4063 XVisualInfo vinfo;
4064
4065 strcpy (s, SDATA (value));
4066 dash = index (s, '-');
4067 if (dash)
4068 {
4069 dpyinfo->n_planes = atoi (dash + 1);
4070 *dash = '\0';
4071 }
4072 else
4073 /* We won't find a matching visual with depth 0, so that
4074 an error will be printed below. */
4075 dpyinfo->n_planes = 0;
4076
4077 /* Determine the visual class. */
4078 for (i = 0; visual_classes[i].name; ++i)
4079 if (xstricmp (s, visual_classes[i].name) == 0)
4080 {
4081 class = visual_classes[i].class;
4082 break;
4083 }
4084
4085 /* Look up a matching visual for the specified class. */
4086 if (class == -1
4087 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
4088 dpyinfo->n_planes, class, &vinfo))
4089 fatal ("Invalid visual specification `%s'", SDATA (value));
4090
4091 dpyinfo->visual = vinfo.visual;
4092 }
4093 else
4094 {
4095 int n_visuals;
4096 XVisualInfo *vinfo, vinfo_template;
4097
4098 dpyinfo->visual = DefaultVisualOfScreen (screen);
4099
4100 #ifdef HAVE_X11R4
4101 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
4102 #else
4103 vinfo_template.visualid = dpyinfo->visual->visualid;
4104 #endif
4105 vinfo_template.screen = XScreenNumberOfScreen (screen);
4106 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
4107 &vinfo_template, &n_visuals);
4108 if (n_visuals != 1)
4109 fatal ("Can't get proper X visual info");
4110
4111 dpyinfo->n_planes = vinfo->depth;
4112 XFree ((char *) vinfo);
4113 }
4114 }
4115
4116
4117 /* Return the X display structure for the display named NAME.
4118 Open a new connection if necessary. */
4119
4120 struct x_display_info *
4121 x_display_info_for_name (name)
4122 Lisp_Object name;
4123 {
4124 Lisp_Object names;
4125 struct x_display_info *dpyinfo;
4126
4127 CHECK_STRING (name);
4128
4129 if (! EQ (Vwindow_system, intern ("x")))
4130 error ("Not using X Windows");
4131
4132 for (dpyinfo = x_display_list, names = x_display_name_list;
4133 dpyinfo;
4134 dpyinfo = dpyinfo->next, names = XCDR (names))
4135 {
4136 Lisp_Object tem;
4137 tem = Fstring_equal (XCAR (XCAR (names)), name);
4138 if (!NILP (tem))
4139 return dpyinfo;
4140 }
4141
4142 /* Use this general default value to start with. */
4143 Vx_resource_name = Vinvocation_name;
4144
4145 validate_x_resource_name ();
4146
4147 dpyinfo = x_term_init (name, (char *)0,
4148 (char *) SDATA (Vx_resource_name));
4149
4150 if (dpyinfo == 0)
4151 error ("Cannot connect to X server %s", SDATA (name));
4152
4153 x_in_use = 1;
4154 XSETFASTINT (Vwindow_system_version, 11);
4155
4156 return dpyinfo;
4157 }
4158
4159
4160 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4161 1, 3, 0,
4162 doc: /* Open a connection to an X server.
4163 DISPLAY is the name of the display to connect to.
4164 Optional second arg XRM-STRING is a string of resources in xrdb format.
4165 If the optional third arg MUST-SUCCEED is non-nil,
4166 terminate Emacs if we can't open the connection. */)
4167 (display, xrm_string, must_succeed)
4168 Lisp_Object display, xrm_string, must_succeed;
4169 {
4170 unsigned char *xrm_option;
4171 struct x_display_info *dpyinfo;
4172
4173 CHECK_STRING (display);
4174 if (! NILP (xrm_string))
4175 CHECK_STRING (xrm_string);
4176
4177 if (! EQ (Vwindow_system, intern ("x")))
4178 error ("Not using X Windows");
4179
4180 if (! NILP (xrm_string))
4181 xrm_option = (unsigned char *) SDATA (xrm_string);
4182 else
4183 xrm_option = (unsigned char *) 0;
4184
4185 validate_x_resource_name ();
4186
4187 /* This is what opens the connection and sets x_current_display.
4188 This also initializes many symbols, such as those used for input. */
4189 dpyinfo = x_term_init (display, xrm_option,
4190 (char *) SDATA (Vx_resource_name));
4191
4192 if (dpyinfo == 0)
4193 {
4194 if (!NILP (must_succeed))
4195 fatal ("Cannot connect to X server %s.\n\
4196 Check the DISPLAY environment variable or use `-d'.\n\
4197 Also use the `xauth' program to verify that you have the proper\n\
4198 authorization information needed to connect the X server.\n\
4199 An insecure way to solve the problem may be to use `xhost'.\n",
4200 SDATA (display));
4201 else
4202 error ("Cannot connect to X server %s", SDATA (display));
4203 }
4204
4205 x_in_use = 1;
4206
4207 XSETFASTINT (Vwindow_system_version, 11);
4208 return Qnil;
4209 }
4210
4211 DEFUN ("x-close-connection", Fx_close_connection,
4212 Sx_close_connection, 1, 1, 0,
4213 doc: /* Close the connection to DISPLAY's X server.
4214 For DISPLAY, specify either a frame or a display name (a string).
4215 If DISPLAY is nil, that stands for the selected frame's display. */)
4216 (display)
4217 Lisp_Object display;
4218 {
4219 struct x_display_info *dpyinfo = check_x_display_info (display);
4220 int i;
4221
4222 if (dpyinfo->reference_count > 0)
4223 error ("Display still has frames on it");
4224
4225 BLOCK_INPUT;
4226 /* Free the fonts in the font table. */
4227 for (i = 0; i < dpyinfo->n_fonts; i++)
4228 if (dpyinfo->font_table[i].name)
4229 {
4230 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4231 }
4232
4233 x_destroy_all_bitmaps (dpyinfo);
4234 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4235
4236 #ifdef USE_X_TOOLKIT
4237 XtCloseDisplay (dpyinfo->display);
4238 #else
4239 XCloseDisplay (dpyinfo->display);
4240 #endif
4241
4242 x_delete_display (dpyinfo);
4243 UNBLOCK_INPUT;
4244
4245 return Qnil;
4246 }
4247
4248 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4249 doc: /* Return the list of display names that Emacs has connections to. */)
4250 ()
4251 {
4252 Lisp_Object tail, result;
4253
4254 result = Qnil;
4255 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
4256 result = Fcons (XCAR (XCAR (tail)), result);
4257
4258 return result;
4259 }
4260
4261 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4262 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
4263 If ON is nil, allow buffering of requests.
4264 Turning on synchronization prohibits the Xlib routines from buffering
4265 requests and seriously degrades performance, but makes debugging much
4266 easier.
4267 The optional second argument DISPLAY specifies which display to act on.
4268 DISPLAY should be either a frame or a display name (a string).
4269 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
4270 (on, display)
4271 Lisp_Object display, on;
4272 {
4273 struct x_display_info *dpyinfo = check_x_display_info (display);
4274
4275 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4276
4277 return Qnil;
4278 }
4279
4280 /* Wait for responses to all X commands issued so far for frame F. */
4281
4282 void
4283 x_sync (f)
4284 FRAME_PTR f;
4285 {
4286 BLOCK_INPUT;
4287 XSync (FRAME_X_DISPLAY (f), False);
4288 UNBLOCK_INPUT;
4289 }
4290
4291 \f
4292 /***********************************************************************
4293 General X functions exposed to Elisp.
4294 ***********************************************************************/
4295
4296 DEFUN ("x-send-client-message", Fx_send_client_event,
4297 Sx_send_client_message, 6, 6, 0,
4298 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
4299
4300 For DISPLAY, specify either a frame or a display name (a string).
4301 If DISPLAY is nil, that stands for the selected frame's display.
4302 DEST may be an integer, in which case it is a Window id. The value 0 may
4303 be used to send to the root window of the DISPLAY.
4304 If DEST is a frame the event is sent to the outer window of that frame.
4305 Nil means the currently selected frame.
4306 If DEST is the string "PointerWindow" the event is sent to the window that
4307 contains the pointer. If DEST is the string "InputFocus" the event is
4308 sent to the window that has the input focus.
4309 FROM is the frame sending the event. Use nil for currently selected frame.
4310 MESSAGE-TYPE is the name of an Atom as a string.
4311 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
4312 bits. VALUES is a list of integer and/or strings containing the values to
4313 send. If a value is a string, it is converted to an Atom and the value of
4314 the Atom is sent. If more values than fits into the event is given,
4315 the excessive values are ignored. */)
4316 (display, dest, from, message_type, format, values)
4317 Lisp_Object display, dest, from, message_type, format, values;
4318 {
4319 struct x_display_info *dpyinfo = check_x_display_info (display);
4320 Window wdest;
4321 XEvent event;
4322 Lisp_Object cons;
4323 int i;
4324 int max_nr_values = (int) sizeof (event.xclient.data.b);
4325 struct frame *f = check_x_frame (from);
4326
4327 CHECK_STRING (message_type);
4328 CHECK_NUMBER (format);
4329 CHECK_CONS (values);
4330
4331 for (cons = values; CONSP (cons); cons = XCDR (cons))
4332 {
4333 Lisp_Object o = XCAR (cons);
4334
4335 if (! INTEGERP (o) && ! STRINGP (o))
4336 error ("Bad data in VALUES, must be integer or string");
4337 }
4338
4339 event.xclient.type = ClientMessage;
4340 event.xclient.format = XFASTINT (format);
4341
4342 if (event.xclient.format != 8 && event.xclient.format != 16
4343 && event.xclient.format != 32)
4344 error ("FORMAT must be one of 8, 16 or 32");
4345 if (event.xclient.format == 16) max_nr_values /= 2;
4346 if (event.xclient.format == 32) max_nr_values /= 4;
4347
4348 if (FRAMEP (dest) || NILP (dest))
4349 {
4350 struct frame *fdest = check_x_frame (dest);
4351 wdest = FRAME_OUTER_WINDOW (fdest);
4352 }
4353 else if (STRINGP (dest))
4354 {
4355 if (strcmp (SDATA (dest), "PointerWindow") == 0)
4356 wdest = PointerWindow;
4357 else if (strcmp (SDATA (dest), "InputFocus") == 0)
4358 wdest = InputFocus;
4359 else
4360 error ("DEST as a string must be one of PointerWindow or InputFocus");
4361 }
4362 else
4363 {
4364 CHECK_NUMBER (dest);
4365 wdest = (Window) XFASTINT (dest);
4366 if (wdest == 0) wdest = dpyinfo->root_window;
4367 }
4368
4369 BLOCK_INPUT;
4370 for (cons = values, i = 0;
4371 CONSP (cons) && i < max_nr_values;
4372 cons = XCDR (cons), ++i)
4373 {
4374 Lisp_Object o = XCAR (cons);
4375 long val;
4376
4377 if (INTEGERP (o))
4378 val = XINT (o);
4379 else if (STRINGP (o))
4380 val = XInternAtom (dpyinfo->display, SDATA (o), False);
4381
4382 if (event.xclient.format == 8)
4383 event.xclient.data.b[i] = (char) val;
4384 else if (event.xclient.format == 16)
4385 event.xclient.data.s[i] = (short) val;
4386 else
4387 event.xclient.data.l[i] = val;
4388 }
4389
4390 for ( ; i < max_nr_values; ++i)
4391 if (event.xclient.format == 8)
4392 event.xclient.data.b[i] = 0;
4393 else if (event.xclient.format == 16)
4394 event.xclient.data.s[i] = 0;
4395 else
4396 event.xclient.data.l[i] = 0;
4397
4398 event.xclient.message_type
4399 = XInternAtom (dpyinfo->display, SDATA (message_type), False);
4400 event.xclient.display = dpyinfo->display;
4401 event.xclient.window = FRAME_OUTER_WINDOW (f);
4402
4403 XSendEvent (dpyinfo->display, wdest, False, 0xffff, &event);
4404
4405 XFlush (dpyinfo->display);
4406 UNBLOCK_INPUT;
4407
4408 return Qnil;
4409 }
4410 \f
4411 /***********************************************************************
4412 Image types
4413 ***********************************************************************/
4414
4415 /* Value is the number of elements of vector VECTOR. */
4416
4417 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4418
4419 /* List of supported image types. Use define_image_type to add new
4420 types. Use lookup_image_type to find a type for a given symbol. */
4421
4422 static struct image_type *image_types;
4423
4424 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4425
4426 Lisp_Object Qxbm;
4427
4428 /* Keywords. */
4429
4430 extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
4431 extern Lisp_Object QCdata, QCtype;
4432 Lisp_Object QCascent, QCmargin, QCrelief;
4433 Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
4434 Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
4435
4436 /* Other symbols. */
4437
4438 Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
4439
4440 /* Time in seconds after which images should be removed from the cache
4441 if not displayed. */
4442
4443 Lisp_Object Vimage_cache_eviction_delay;
4444
4445 /* Function prototypes. */
4446
4447 static void define_image_type P_ ((struct image_type *type));
4448 static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
4449 static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
4450 static void x_laplace P_ ((struct frame *, struct image *));
4451 static void x_emboss P_ ((struct frame *, struct image *));
4452 static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
4453 Lisp_Object));
4454
4455
4456 /* Define a new image type from TYPE. This adds a copy of TYPE to
4457 image_types and adds the symbol *TYPE->type to Vimage_types. */
4458
4459 static void
4460 define_image_type (type)
4461 struct image_type *type;
4462 {
4463 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4464 The initialized data segment is read-only. */
4465 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
4466 bcopy (type, p, sizeof *p);
4467 p->next = image_types;
4468 image_types = p;
4469 Vimage_types = Fcons (*p->type, Vimage_types);
4470 }
4471
4472
4473 /* Look up image type SYMBOL, and return a pointer to its image_type
4474 structure. Value is null if SYMBOL is not a known image type. */
4475
4476 static INLINE struct image_type *
4477 lookup_image_type (symbol)
4478 Lisp_Object symbol;
4479 {
4480 struct image_type *type;
4481
4482 for (type = image_types; type; type = type->next)
4483 if (EQ (symbol, *type->type))
4484 break;
4485
4486 return type;
4487 }
4488
4489
4490 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4491 valid image specification is a list whose car is the symbol
4492 `image', and whose rest is a property list. The property list must
4493 contain a value for key `:type'. That value must be the name of a
4494 supported image type. The rest of the property list depends on the
4495 image type. */
4496
4497 int
4498 valid_image_p (object)
4499 Lisp_Object object;
4500 {
4501 int valid_p = 0;
4502
4503 if (IMAGEP (object))
4504 {
4505 Lisp_Object tem;
4506
4507 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
4508 if (EQ (XCAR (tem), QCtype))
4509 {
4510 tem = XCDR (tem);
4511 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
4512 {
4513 struct image_type *type;
4514 type = lookup_image_type (XCAR (tem));
4515 if (type)
4516 valid_p = type->valid_p (object);
4517 }
4518
4519 break;
4520 }
4521 }
4522
4523 return valid_p;
4524 }
4525
4526
4527 /* Log error message with format string FORMAT and argument ARG.
4528 Signaling an error, e.g. when an image cannot be loaded, is not a
4529 good idea because this would interrupt redisplay, and the error
4530 message display would lead to another redisplay. This function
4531 therefore simply displays a message. */
4532
4533 static void
4534 image_error (format, arg1, arg2)
4535 char *format;
4536 Lisp_Object arg1, arg2;
4537 {
4538 add_to_log (format, arg1, arg2);
4539 }
4540
4541
4542 \f
4543 /***********************************************************************
4544 Image specifications
4545 ***********************************************************************/
4546
4547 enum image_value_type
4548 {
4549 IMAGE_DONT_CHECK_VALUE_TYPE,
4550 IMAGE_STRING_VALUE,
4551 IMAGE_STRING_OR_NIL_VALUE,
4552 IMAGE_SYMBOL_VALUE,
4553 IMAGE_POSITIVE_INTEGER_VALUE,
4554 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
4555 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
4556 IMAGE_ASCENT_VALUE,
4557 IMAGE_INTEGER_VALUE,
4558 IMAGE_FUNCTION_VALUE,
4559 IMAGE_NUMBER_VALUE,
4560 IMAGE_BOOL_VALUE
4561 };
4562
4563 /* Structure used when parsing image specifications. */
4564
4565 struct image_keyword
4566 {
4567 /* Name of keyword. */
4568 char *name;
4569
4570 /* The type of value allowed. */
4571 enum image_value_type type;
4572
4573 /* Non-zero means key must be present. */
4574 int mandatory_p;
4575
4576 /* Used to recognize duplicate keywords in a property list. */
4577 int count;
4578
4579 /* The value that was found. */
4580 Lisp_Object value;
4581 };
4582
4583
4584 static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
4585 int, Lisp_Object));
4586 static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
4587
4588
4589 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
4590 has the format (image KEYWORD VALUE ...). One of the keyword/
4591 value pairs must be `:type TYPE'. KEYWORDS is a vector of
4592 image_keywords structures of size NKEYWORDS describing other
4593 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
4594
4595 static int
4596 parse_image_spec (spec, keywords, nkeywords, type)
4597 Lisp_Object spec;
4598 struct image_keyword *keywords;
4599 int nkeywords;
4600 Lisp_Object type;
4601 {
4602 int i;
4603 Lisp_Object plist;
4604
4605 if (!IMAGEP (spec))
4606 return 0;
4607
4608 plist = XCDR (spec);
4609 while (CONSP (plist))
4610 {
4611 Lisp_Object key, value;
4612
4613 /* First element of a pair must be a symbol. */
4614 key = XCAR (plist);
4615 plist = XCDR (plist);
4616 if (!SYMBOLP (key))
4617 return 0;
4618
4619 /* There must follow a value. */
4620 if (!CONSP (plist))
4621 return 0;
4622 value = XCAR (plist);
4623 plist = XCDR (plist);
4624
4625 /* Find key in KEYWORDS. Error if not found. */
4626 for (i = 0; i < nkeywords; ++i)
4627 if (strcmp (keywords[i].name, SDATA (SYMBOL_NAME (key))) == 0)
4628 break;
4629
4630 if (i == nkeywords)
4631 continue;
4632
4633 /* Record that we recognized the keyword. If a keywords
4634 was found more than once, it's an error. */
4635 keywords[i].value = value;
4636 ++keywords[i].count;
4637
4638 if (keywords[i].count > 1)
4639 return 0;
4640
4641 /* Check type of value against allowed type. */
4642 switch (keywords[i].type)
4643 {
4644 case IMAGE_STRING_VALUE:
4645 if (!STRINGP (value))
4646 return 0;
4647 break;
4648
4649 case IMAGE_STRING_OR_NIL_VALUE:
4650 if (!STRINGP (value) && !NILP (value))
4651 return 0;
4652 break;
4653
4654 case IMAGE_SYMBOL_VALUE:
4655 if (!SYMBOLP (value))
4656 return 0;
4657 break;
4658
4659 case IMAGE_POSITIVE_INTEGER_VALUE:
4660 if (!INTEGERP (value) || XINT (value) <= 0)
4661 return 0;
4662 break;
4663
4664 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
4665 if (INTEGERP (value) && XINT (value) >= 0)
4666 break;
4667 if (CONSP (value)
4668 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
4669 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
4670 break;
4671 return 0;
4672
4673 case IMAGE_ASCENT_VALUE:
4674 if (SYMBOLP (value) && EQ (value, Qcenter))
4675 break;
4676 else if (INTEGERP (value)
4677 && XINT (value) >= 0
4678 && XINT (value) <= 100)
4679 break;
4680 return 0;
4681
4682 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
4683 if (!INTEGERP (value) || XINT (value) < 0)
4684 return 0;
4685 break;
4686
4687 case IMAGE_DONT_CHECK_VALUE_TYPE:
4688 break;
4689
4690 case IMAGE_FUNCTION_VALUE:
4691 value = indirect_function (value);
4692 if (SUBRP (value)
4693 || COMPILEDP (value)
4694 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
4695 break;
4696 return 0;
4697
4698 case IMAGE_NUMBER_VALUE:
4699 if (!INTEGERP (value) && !FLOATP (value))
4700 return 0;
4701 break;
4702
4703 case IMAGE_INTEGER_VALUE:
4704 if (!INTEGERP (value))
4705 return 0;
4706 break;
4707
4708 case IMAGE_BOOL_VALUE:
4709 if (!NILP (value) && !EQ (value, Qt))
4710 return 0;
4711 break;
4712
4713 default:
4714 abort ();
4715 break;
4716 }
4717
4718 if (EQ (key, QCtype) && !EQ (type, value))
4719 return 0;
4720 }
4721
4722 /* Check that all mandatory fields are present. */
4723 for (i = 0; i < nkeywords; ++i)
4724 if (keywords[i].mandatory_p && keywords[i].count == 0)
4725 return 0;
4726
4727 return NILP (plist);
4728 }
4729
4730
4731 /* Return the value of KEY in image specification SPEC. Value is nil
4732 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
4733 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
4734
4735 static Lisp_Object
4736 image_spec_value (spec, key, found)
4737 Lisp_Object spec, key;
4738 int *found;
4739 {
4740 Lisp_Object tail;
4741
4742 xassert (valid_image_p (spec));
4743
4744 for (tail = XCDR (spec);
4745 CONSP (tail) && CONSP (XCDR (tail));
4746 tail = XCDR (XCDR (tail)))
4747 {
4748 if (EQ (XCAR (tail), key))
4749 {
4750 if (found)
4751 *found = 1;
4752 return XCAR (XCDR (tail));
4753 }
4754 }
4755
4756 if (found)
4757 *found = 0;
4758 return Qnil;
4759 }
4760
4761
4762 DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
4763 doc: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
4764 PIXELS non-nil means return the size in pixels, otherwise return the
4765 size in canonical character units.
4766 FRAME is the frame on which the image will be displayed. FRAME nil
4767 or omitted means use the selected frame. */)
4768 (spec, pixels, frame)
4769 Lisp_Object spec, pixels, frame;
4770 {
4771 Lisp_Object size;
4772
4773 size = Qnil;
4774 if (valid_image_p (spec))
4775 {
4776 struct frame *f = check_x_frame (frame);
4777 int id = lookup_image (f, spec);
4778 struct image *img = IMAGE_FROM_ID (f, id);
4779 int width = img->width + 2 * img->hmargin;
4780 int height = img->height + 2 * img->vmargin;
4781
4782 if (NILP (pixels))
4783 size = Fcons (make_float ((double) width / FRAME_COLUMN_WIDTH (f)),
4784 make_float ((double) height / FRAME_LINE_HEIGHT (f)));
4785 else
4786 size = Fcons (make_number (width), make_number (height));
4787 }
4788 else
4789 error ("Invalid image specification");
4790
4791 return size;
4792 }
4793
4794
4795 DEFUN ("image-mask-p", Fimage_mask_p, Simage_mask_p, 1, 2, 0,
4796 doc: /* Return t if image SPEC has a mask bitmap.
4797 FRAME is the frame on which the image will be displayed. FRAME nil
4798 or omitted means use the selected frame. */)
4799 (spec, frame)
4800 Lisp_Object spec, frame;
4801 {
4802 Lisp_Object mask;
4803
4804 mask = Qnil;
4805 if (valid_image_p (spec))
4806 {
4807 struct frame *f = check_x_frame (frame);
4808 int id = lookup_image (f, spec);
4809 struct image *img = IMAGE_FROM_ID (f, id);
4810 if (img->mask)
4811 mask = Qt;
4812 }
4813 else
4814 error ("Invalid image specification");
4815
4816 return mask;
4817 }
4818
4819
4820 \f
4821 /***********************************************************************
4822 Image type independent image structures
4823 ***********************************************************************/
4824
4825 static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
4826 static void free_image P_ ((struct frame *f, struct image *img));
4827
4828
4829 /* Allocate and return a new image structure for image specification
4830 SPEC. SPEC has a hash value of HASH. */
4831
4832 static struct image *
4833 make_image (spec, hash)
4834 Lisp_Object spec;
4835 unsigned hash;
4836 {
4837 struct image *img = (struct image *) xmalloc (sizeof *img);
4838
4839 xassert (valid_image_p (spec));
4840 bzero (img, sizeof *img);
4841 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
4842 xassert (img->type != NULL);
4843 img->spec = spec;
4844 img->data.lisp_val = Qnil;
4845 img->ascent = DEFAULT_IMAGE_ASCENT;
4846 img->hash = hash;
4847 return img;
4848 }
4849
4850
4851 /* Free image IMG which was used on frame F, including its resources. */
4852
4853 static void
4854 free_image (f, img)
4855 struct frame *f;
4856 struct image *img;
4857 {
4858 if (img)
4859 {
4860 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
4861
4862 /* Remove IMG from the hash table of its cache. */
4863 if (img->prev)
4864 img->prev->next = img->next;
4865 else
4866 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
4867
4868 if (img->next)
4869 img->next->prev = img->prev;
4870
4871 c->images[img->id] = NULL;
4872
4873 /* Free resources, then free IMG. */
4874 img->type->free (f, img);
4875 xfree (img);
4876 }
4877 }
4878
4879
4880 /* Prepare image IMG for display on frame F. Must be called before
4881 drawing an image. */
4882
4883 void
4884 prepare_image_for_display (f, img)
4885 struct frame *f;
4886 struct image *img;
4887 {
4888 EMACS_TIME t;
4889
4890 /* We're about to display IMG, so set its timestamp to `now'. */
4891 EMACS_GET_TIME (t);
4892 img->timestamp = EMACS_SECS (t);
4893
4894 /* If IMG doesn't have a pixmap yet, load it now, using the image
4895 type dependent loader function. */
4896 if (img->pixmap == None && !img->load_failed_p)
4897 img->load_failed_p = img->type->load (f, img) == 0;
4898 }
4899
4900
4901 /* Value is the number of pixels for the ascent of image IMG when
4902 drawn in face FACE. */
4903
4904 int
4905 image_ascent (img, face)
4906 struct image *img;
4907 struct face *face;
4908 {
4909 int height = img->height + img->vmargin;
4910 int ascent;
4911
4912 if (img->ascent == CENTERED_IMAGE_ASCENT)
4913 {
4914 if (face->font)
4915 /* This expression is arranged so that if the image can't be
4916 exactly centered, it will be moved slightly up. This is
4917 because a typical font is `top-heavy' (due to the presence
4918 uppercase letters), so the image placement should err towards
4919 being top-heavy too. It also just generally looks better. */
4920 ascent = (height + face->font->ascent - face->font->descent + 1) / 2;
4921 else
4922 ascent = height / 2;
4923 }
4924 else
4925 ascent = height * img->ascent / 100.0;
4926
4927 return ascent;
4928 }
4929
4930 \f
4931 /* Image background colors. */
4932
4933 static unsigned long
4934 four_corners_best (ximg, width, height)
4935 XImage *ximg;
4936 unsigned long width, height;
4937 {
4938 unsigned long corners[4], best;
4939 int i, best_count;
4940
4941 /* Get the colors at the corners of ximg. */
4942 corners[0] = XGetPixel (ximg, 0, 0);
4943 corners[1] = XGetPixel (ximg, width - 1, 0);
4944 corners[2] = XGetPixel (ximg, width - 1, height - 1);
4945 corners[3] = XGetPixel (ximg, 0, height - 1);
4946
4947 /* Choose the most frequently found color as background. */
4948 for (i = best_count = 0; i < 4; ++i)
4949 {
4950 int j, n;
4951
4952 for (j = n = 0; j < 4; ++j)
4953 if (corners[i] == corners[j])
4954 ++n;
4955
4956 if (n > best_count)
4957 best = corners[i], best_count = n;
4958 }
4959
4960 return best;
4961 }
4962
4963 /* Return the `background' field of IMG. If IMG doesn't have one yet,
4964 it is guessed heuristically. If non-zero, XIMG is an existing XImage
4965 object to use for the heuristic. */
4966
4967 unsigned long
4968 image_background (img, f, ximg)
4969 struct image *img;
4970 struct frame *f;
4971 XImage *ximg;
4972 {
4973 if (! img->background_valid)
4974 /* IMG doesn't have a background yet, try to guess a reasonable value. */
4975 {
4976 int free_ximg = !ximg;
4977
4978 if (! ximg)
4979 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
4980 0, 0, img->width, img->height, ~0, ZPixmap);
4981
4982 img->background = four_corners_best (ximg, img->width, img->height);
4983
4984 if (free_ximg)
4985 XDestroyImage (ximg);
4986
4987 img->background_valid = 1;
4988 }
4989
4990 return img->background;
4991 }
4992
4993 /* Return the `background_transparent' field of IMG. If IMG doesn't
4994 have one yet, it is guessed heuristically. If non-zero, MASK is an
4995 existing XImage object to use for the heuristic. */
4996
4997 int
4998 image_background_transparent (img, f, mask)
4999 struct image *img;
5000 struct frame *f;
5001 XImage *mask;
5002 {
5003 if (! img->background_transparent_valid)
5004 /* IMG doesn't have a background yet, try to guess a reasonable value. */
5005 {
5006 if (img->mask)
5007 {
5008 int free_mask = !mask;
5009
5010 if (! mask)
5011 mask = XGetImage (FRAME_X_DISPLAY (f), img->mask,
5012 0, 0, img->width, img->height, ~0, ZPixmap);
5013
5014 img->background_transparent
5015 = !four_corners_best (mask, img->width, img->height);
5016
5017 if (free_mask)
5018 XDestroyImage (mask);
5019 }
5020 else
5021 img->background_transparent = 0;
5022
5023 img->background_transparent_valid = 1;
5024 }
5025
5026 return img->background_transparent;
5027 }
5028
5029 \f
5030 /***********************************************************************
5031 Helper functions for X image types
5032 ***********************************************************************/
5033
5034 static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
5035 int, int));
5036 static void x_clear_image P_ ((struct frame *f, struct image *img));
5037 static unsigned long x_alloc_image_color P_ ((struct frame *f,
5038 struct image *img,
5039 Lisp_Object color_name,
5040 unsigned long dflt));
5041
5042
5043 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5044 free the pixmap if any. MASK_P non-zero means clear the mask
5045 pixmap if any. COLORS_P non-zero means free colors allocated for
5046 the image, if any. */
5047
5048 static void
5049 x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
5050 struct frame *f;
5051 struct image *img;
5052 int pixmap_p, mask_p, colors_p;
5053 {
5054 if (pixmap_p && img->pixmap)
5055 {
5056 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
5057 img->pixmap = None;
5058 img->background_valid = 0;
5059 }
5060
5061 if (mask_p && img->mask)
5062 {
5063 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
5064 img->mask = None;
5065 img->background_transparent_valid = 0;
5066 }
5067
5068 if (colors_p && img->ncolors)
5069 {
5070 x_free_colors (f, img->colors, img->ncolors);
5071 xfree (img->colors);
5072 img->colors = NULL;
5073 img->ncolors = 0;
5074 }
5075 }
5076
5077 /* Free X resources of image IMG which is used on frame F. */
5078
5079 static void
5080 x_clear_image (f, img)
5081 struct frame *f;
5082 struct image *img;
5083 {
5084 BLOCK_INPUT;
5085 x_clear_image_1 (f, img, 1, 1, 1);
5086 UNBLOCK_INPUT;
5087 }
5088
5089
5090 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5091 cannot be allocated, use DFLT. Add a newly allocated color to
5092 IMG->colors, so that it can be freed again. Value is the pixel
5093 color. */
5094
5095 static unsigned long
5096 x_alloc_image_color (f, img, color_name, dflt)
5097 struct frame *f;
5098 struct image *img;
5099 Lisp_Object color_name;
5100 unsigned long dflt;
5101 {
5102 XColor color;
5103 unsigned long result;
5104
5105 xassert (STRINGP (color_name));
5106
5107 if (x_defined_color (f, SDATA (color_name), &color, 1))
5108 {
5109 /* This isn't called frequently so we get away with simply
5110 reallocating the color vector to the needed size, here. */
5111 ++img->ncolors;
5112 img->colors =
5113 (unsigned long *) xrealloc (img->colors,
5114 img->ncolors * sizeof *img->colors);
5115 img->colors[img->ncolors - 1] = color.pixel;
5116 result = color.pixel;
5117 }
5118 else
5119 result = dflt;
5120
5121 return result;
5122 }
5123
5124
5125 \f
5126 /***********************************************************************
5127 Image Cache
5128 ***********************************************************************/
5129
5130 static void cache_image P_ ((struct frame *f, struct image *img));
5131 static void postprocess_image P_ ((struct frame *, struct image *));
5132
5133
5134 /* Return a new, initialized image cache that is allocated from the
5135 heap. Call free_image_cache to free an image cache. */
5136
5137 struct image_cache *
5138 make_image_cache ()
5139 {
5140 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
5141 int size;
5142
5143 bzero (c, sizeof *c);
5144 c->size = 50;
5145 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
5146 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5147 c->buckets = (struct image **) xmalloc (size);
5148 bzero (c->buckets, size);
5149 return c;
5150 }
5151
5152
5153 /* Free image cache of frame F. Be aware that X frames share images
5154 caches. */
5155
5156 void
5157 free_image_cache (f)
5158 struct frame *f;
5159 {
5160 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5161 if (c)
5162 {
5163 int i;
5164
5165 /* Cache should not be referenced by any frame when freed. */
5166 xassert (c->refcount == 0);
5167
5168 for (i = 0; i < c->used; ++i)
5169 free_image (f, c->images[i]);
5170 xfree (c->images);
5171 xfree (c->buckets);
5172 xfree (c);
5173 FRAME_X_IMAGE_CACHE (f) = NULL;
5174 }
5175 }
5176
5177
5178 /* Clear image cache of frame F. FORCE_P non-zero means free all
5179 images. FORCE_P zero means clear only images that haven't been
5180 displayed for some time. Should be called from time to time to
5181 reduce the number of loaded images. If image-eviction-seconds is
5182 non-nil, this frees images in the cache which weren't displayed for
5183 at least that many seconds. */
5184
5185 void
5186 clear_image_cache (f, force_p)
5187 struct frame *f;
5188 int force_p;
5189 {
5190 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5191
5192 if (c && INTEGERP (Vimage_cache_eviction_delay))
5193 {
5194 EMACS_TIME t;
5195 unsigned long old;
5196 int i, nfreed;
5197
5198 EMACS_GET_TIME (t);
5199 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
5200
5201 /* Block input so that we won't be interrupted by a SIGIO
5202 while being in an inconsistent state. */
5203 BLOCK_INPUT;
5204
5205 for (i = nfreed = 0; i < c->used; ++i)
5206 {
5207 struct image *img = c->images[i];
5208 if (img != NULL
5209 && (force_p || img->timestamp < old))
5210 {
5211 free_image (f, img);
5212 ++nfreed;
5213 }
5214 }
5215
5216 /* We may be clearing the image cache because, for example,
5217 Emacs was iconified for a longer period of time. In that
5218 case, current matrices may still contain references to
5219 images freed above. So, clear these matrices. */
5220 if (nfreed)
5221 {
5222 Lisp_Object tail, frame;
5223
5224 FOR_EACH_FRAME (tail, frame)
5225 {
5226 struct frame *f = XFRAME (frame);
5227 if (FRAME_X_P (f)
5228 && FRAME_X_IMAGE_CACHE (f) == c)
5229 clear_current_matrices (f);
5230 }
5231
5232 ++windows_or_buffers_changed;
5233 }
5234
5235 UNBLOCK_INPUT;
5236 }
5237 }
5238
5239
5240 DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
5241 0, 1, 0,
5242 doc: /* Clear the image cache of FRAME.
5243 FRAME nil or omitted means use the selected frame.
5244 FRAME t means clear the image caches of all frames. */)
5245 (frame)
5246 Lisp_Object frame;
5247 {
5248 if (EQ (frame, Qt))
5249 {
5250 Lisp_Object tail;
5251
5252 FOR_EACH_FRAME (tail, frame)
5253 if (FRAME_X_P (XFRAME (frame)))
5254 clear_image_cache (XFRAME (frame), 1);
5255 }
5256 else
5257 clear_image_cache (check_x_frame (frame), 1);
5258
5259 return Qnil;
5260 }
5261
5262
5263 /* Compute masks and transform image IMG on frame F, as specified
5264 by the image's specification, */
5265
5266 static void
5267 postprocess_image (f, img)
5268 struct frame *f;
5269 struct image *img;
5270 {
5271 /* Manipulation of the image's mask. */
5272 if (img->pixmap)
5273 {
5274 Lisp_Object conversion, spec;
5275 Lisp_Object mask;
5276
5277 spec = img->spec;
5278
5279 /* `:heuristic-mask t'
5280 `:mask heuristic'
5281 means build a mask heuristically.
5282 `:heuristic-mask (R G B)'
5283 `:mask (heuristic (R G B))'
5284 means build a mask from color (R G B) in the
5285 image.
5286 `:mask nil'
5287 means remove a mask, if any. */
5288
5289 mask = image_spec_value (spec, QCheuristic_mask, NULL);
5290 if (!NILP (mask))
5291 x_build_heuristic_mask (f, img, mask);
5292 else
5293 {
5294 int found_p;
5295
5296 mask = image_spec_value (spec, QCmask, &found_p);
5297
5298 if (EQ (mask, Qheuristic))
5299 x_build_heuristic_mask (f, img, Qt);
5300 else if (CONSP (mask)
5301 && EQ (XCAR (mask), Qheuristic))
5302 {
5303 if (CONSP (XCDR (mask)))
5304 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
5305 else
5306 x_build_heuristic_mask (f, img, XCDR (mask));
5307 }
5308 else if (NILP (mask) && found_p && img->mask)
5309 {
5310 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
5311 img->mask = None;
5312 }
5313 }
5314
5315
5316 /* Should we apply an image transformation algorithm? */
5317 conversion = image_spec_value (spec, QCconversion, NULL);
5318 if (EQ (conversion, Qdisabled))
5319 x_disable_image (f, img);
5320 else if (EQ (conversion, Qlaplace))
5321 x_laplace (f, img);
5322 else if (EQ (conversion, Qemboss))
5323 x_emboss (f, img);
5324 else if (CONSP (conversion)
5325 && EQ (XCAR (conversion), Qedge_detection))
5326 {
5327 Lisp_Object tem;
5328 tem = XCDR (conversion);
5329 if (CONSP (tem))
5330 x_edge_detection (f, img,
5331 Fplist_get (tem, QCmatrix),
5332 Fplist_get (tem, QCcolor_adjustment));
5333 }
5334 }
5335 }
5336
5337
5338 /* Return the id of image with Lisp specification SPEC on frame F.
5339 SPEC must be a valid Lisp image specification (see valid_image_p). */
5340
5341 int
5342 lookup_image (f, spec)
5343 struct frame *f;
5344 Lisp_Object spec;
5345 {
5346 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5347 struct image *img;
5348 int i;
5349 unsigned hash;
5350 struct gcpro gcpro1;
5351 EMACS_TIME now;
5352
5353 /* F must be a window-system frame, and SPEC must be a valid image
5354 specification. */
5355 xassert (FRAME_WINDOW_P (f));
5356 xassert (valid_image_p (spec));
5357
5358 GCPRO1 (spec);
5359
5360 /* Look up SPEC in the hash table of the image cache. */
5361 hash = sxhash (spec, 0);
5362 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
5363
5364 for (img = c->buckets[i]; img; img = img->next)
5365 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
5366 break;
5367
5368 /* If not found, create a new image and cache it. */
5369 if (img == NULL)
5370 {
5371 extern Lisp_Object Qpostscript;
5372
5373 BLOCK_INPUT;
5374 img = make_image (spec, hash);
5375 cache_image (f, img);
5376 img->load_failed_p = img->type->load (f, img) == 0;
5377
5378 /* If we can't load the image, and we don't have a width and
5379 height, use some arbitrary width and height so that we can
5380 draw a rectangle for it. */
5381 if (img->load_failed_p)
5382 {
5383 Lisp_Object value;
5384
5385 value = image_spec_value (spec, QCwidth, NULL);
5386 img->width = (INTEGERP (value)
5387 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
5388 value = image_spec_value (spec, QCheight, NULL);
5389 img->height = (INTEGERP (value)
5390 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
5391 }
5392 else
5393 {
5394 /* Handle image type independent image attributes
5395 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
5396 `:background COLOR'. */
5397 Lisp_Object ascent, margin, relief, bg;
5398
5399 ascent = image_spec_value (spec, QCascent, NULL);
5400 if (INTEGERP (ascent))
5401 img->ascent = XFASTINT (ascent);
5402 else if (EQ (ascent, Qcenter))
5403 img->ascent = CENTERED_IMAGE_ASCENT;
5404
5405 margin = image_spec_value (spec, QCmargin, NULL);
5406 if (INTEGERP (margin) && XINT (margin) >= 0)
5407 img->vmargin = img->hmargin = XFASTINT (margin);
5408 else if (CONSP (margin) && INTEGERP (XCAR (margin))
5409 && INTEGERP (XCDR (margin)))
5410 {
5411 if (XINT (XCAR (margin)) > 0)
5412 img->hmargin = XFASTINT (XCAR (margin));
5413 if (XINT (XCDR (margin)) > 0)
5414 img->vmargin = XFASTINT (XCDR (margin));
5415 }
5416
5417 relief = image_spec_value (spec, QCrelief, NULL);
5418 if (INTEGERP (relief))
5419 {
5420 img->relief = XINT (relief);
5421 img->hmargin += abs (img->relief);
5422 img->vmargin += abs (img->relief);
5423 }
5424
5425 if (! img->background_valid)
5426 {
5427 bg = image_spec_value (img->spec, QCbackground, NULL);
5428 if (!NILP (bg))
5429 {
5430 img->background
5431 = x_alloc_image_color (f, img, bg,
5432 FRAME_BACKGROUND_PIXEL (f));
5433 img->background_valid = 1;
5434 }
5435 }
5436
5437 /* Do image transformations and compute masks, unless we
5438 don't have the image yet. */
5439 if (!EQ (*img->type->type, Qpostscript))
5440 postprocess_image (f, img);
5441 }
5442
5443 UNBLOCK_INPUT;
5444 xassert (!interrupt_input_blocked);
5445 }
5446
5447 /* We're using IMG, so set its timestamp to `now'. */
5448 EMACS_GET_TIME (now);
5449 img->timestamp = EMACS_SECS (now);
5450
5451 UNGCPRO;
5452
5453 /* Value is the image id. */
5454 return img->id;
5455 }
5456
5457
5458 /* Cache image IMG in the image cache of frame F. */
5459
5460 static void
5461 cache_image (f, img)
5462 struct frame *f;
5463 struct image *img;
5464 {
5465 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5466 int i;
5467
5468 /* Find a free slot in c->images. */
5469 for (i = 0; i < c->used; ++i)
5470 if (c->images[i] == NULL)
5471 break;
5472
5473 /* If no free slot found, maybe enlarge c->images. */
5474 if (i == c->used && c->used == c->size)
5475 {
5476 c->size *= 2;
5477 c->images = (struct image **) xrealloc (c->images,
5478 c->size * sizeof *c->images);
5479 }
5480
5481 /* Add IMG to c->images, and assign IMG an id. */
5482 c->images[i] = img;
5483 img->id = i;
5484 if (i == c->used)
5485 ++c->used;
5486
5487 /* Add IMG to the cache's hash table. */
5488 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
5489 img->next = c->buckets[i];
5490 if (img->next)
5491 img->next->prev = img;
5492 img->prev = NULL;
5493 c->buckets[i] = img;
5494 }
5495
5496
5497 /* Call FN on every image in the image cache of frame F. Used to mark
5498 Lisp Objects in the image cache. */
5499
5500 void
5501 forall_images_in_image_cache (f, fn)
5502 struct frame *f;
5503 void (*fn) P_ ((struct image *img));
5504 {
5505 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
5506 {
5507 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5508 if (c)
5509 {
5510 int i;
5511 for (i = 0; i < c->used; ++i)
5512 if (c->images[i])
5513 fn (c->images[i]);
5514 }
5515 }
5516 }
5517
5518
5519 \f
5520 /***********************************************************************
5521 X support code
5522 ***********************************************************************/
5523
5524 static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
5525 XImage **, Pixmap *));
5526 static void x_destroy_x_image P_ ((XImage *));
5527 static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
5528
5529
5530 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5531 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5532 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5533 via xmalloc. Print error messages via image_error if an error
5534 occurs. Value is non-zero if successful. */
5535
5536 static int
5537 x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
5538 struct frame *f;
5539 int width, height, depth;
5540 XImage **ximg;
5541 Pixmap *pixmap;
5542 {
5543 Display *display = FRAME_X_DISPLAY (f);
5544 Screen *screen = FRAME_X_SCREEN (f);
5545 Window window = FRAME_X_WINDOW (f);
5546
5547 xassert (interrupt_input_blocked);
5548
5549 if (depth <= 0)
5550 depth = DefaultDepthOfScreen (screen);
5551 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
5552 depth, ZPixmap, 0, NULL, width, height,
5553 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
5554 if (*ximg == NULL)
5555 {
5556 image_error ("Unable to allocate X image", Qnil, Qnil);
5557 return 0;
5558 }
5559
5560 /* Allocate image raster. */
5561 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
5562
5563 /* Allocate a pixmap of the same size. */
5564 *pixmap = XCreatePixmap (display, window, width, height, depth);
5565 if (*pixmap == None)
5566 {
5567 x_destroy_x_image (*ximg);
5568 *ximg = NULL;
5569 image_error ("Unable to create X pixmap", Qnil, Qnil);
5570 return 0;
5571 }
5572
5573 return 1;
5574 }
5575
5576
5577 /* Destroy XImage XIMG. Free XIMG->data. */
5578
5579 static void
5580 x_destroy_x_image (ximg)
5581 XImage *ximg;
5582 {
5583 xassert (interrupt_input_blocked);
5584 if (ximg)
5585 {
5586 xfree (ximg->data);
5587 ximg->data = NULL;
5588 XDestroyImage (ximg);
5589 }
5590 }
5591
5592
5593 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5594 are width and height of both the image and pixmap. */
5595
5596 static void
5597 x_put_x_image (f, ximg, pixmap, width, height)
5598 struct frame *f;
5599 XImage *ximg;
5600 Pixmap pixmap;
5601 int width, height;
5602 {
5603 GC gc;
5604
5605 xassert (interrupt_input_blocked);
5606 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
5607 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
5608 XFreeGC (FRAME_X_DISPLAY (f), gc);
5609 }
5610
5611
5612 \f
5613 /***********************************************************************
5614 File Handling
5615 ***********************************************************************/
5616
5617 static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5618 static char *slurp_file P_ ((char *, int *));
5619
5620
5621 /* Find image file FILE. Look in data-directory, then
5622 x-bitmap-file-path. Value is the full name of the file found, or
5623 nil if not found. */
5624
5625 static Lisp_Object
5626 x_find_image_file (file)
5627 Lisp_Object file;
5628 {
5629 Lisp_Object file_found, search_path;
5630 struct gcpro gcpro1, gcpro2;
5631 int fd;
5632
5633 file_found = Qnil;
5634 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
5635 GCPRO2 (file_found, search_path);
5636
5637 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5638 fd = openp (search_path, file, Qnil, &file_found, Qnil);
5639
5640 if (fd == -1)
5641 file_found = Qnil;
5642 else
5643 close (fd);
5644
5645 UNGCPRO;
5646 return file_found;
5647 }
5648
5649
5650 /* Read FILE into memory. Value is a pointer to a buffer allocated
5651 with xmalloc holding FILE's contents. Value is null if an error
5652 occurred. *SIZE is set to the size of the file. */
5653
5654 static char *
5655 slurp_file (file, size)
5656 char *file;
5657 int *size;
5658 {
5659 FILE *fp = NULL;
5660 char *buf = NULL;
5661 struct stat st;
5662
5663 if (stat (file, &st) == 0
5664 && (fp = fopen (file, "r")) != NULL
5665 && (buf = (char *) xmalloc (st.st_size),
5666 fread (buf, 1, st.st_size, fp) == st.st_size))
5667 {
5668 *size = st.st_size;
5669 fclose (fp);
5670 }
5671 else
5672 {
5673 if (fp)
5674 fclose (fp);
5675 if (buf)
5676 {
5677 xfree (buf);
5678 buf = NULL;
5679 }
5680 }
5681
5682 return buf;
5683 }
5684
5685
5686 \f
5687 /***********************************************************************
5688 XBM images
5689 ***********************************************************************/
5690
5691 static int xbm_scan P_ ((char **, char *, char *, int *));
5692 static int xbm_load P_ ((struct frame *f, struct image *img));
5693 static int xbm_load_image P_ ((struct frame *f, struct image *img,
5694 char *, char *));
5695 static int xbm_image_p P_ ((Lisp_Object object));
5696 static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
5697 unsigned char **));
5698 static int xbm_file_p P_ ((Lisp_Object));
5699
5700
5701 /* Indices of image specification fields in xbm_format, below. */
5702
5703 enum xbm_keyword_index
5704 {
5705 XBM_TYPE,
5706 XBM_FILE,
5707 XBM_WIDTH,
5708 XBM_HEIGHT,
5709 XBM_DATA,
5710 XBM_FOREGROUND,
5711 XBM_BACKGROUND,
5712 XBM_ASCENT,
5713 XBM_MARGIN,
5714 XBM_RELIEF,
5715 XBM_ALGORITHM,
5716 XBM_HEURISTIC_MASK,
5717 XBM_MASK,
5718 XBM_LAST
5719 };
5720
5721 /* Vector of image_keyword structures describing the format
5722 of valid XBM image specifications. */
5723
5724 static struct image_keyword xbm_format[XBM_LAST] =
5725 {
5726 {":type", IMAGE_SYMBOL_VALUE, 1},
5727 {":file", IMAGE_STRING_VALUE, 0},
5728 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5729 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5730 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5731 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
5732 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
5733 {":ascent", IMAGE_ASCENT_VALUE, 0},
5734 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
5735 {":relief", IMAGE_INTEGER_VALUE, 0},
5736 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5737 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5738 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
5739 };
5740
5741 /* Structure describing the image type XBM. */
5742
5743 static struct image_type xbm_type =
5744 {
5745 &Qxbm,
5746 xbm_image_p,
5747 xbm_load,
5748 x_clear_image,
5749 NULL
5750 };
5751
5752 /* Tokens returned from xbm_scan. */
5753
5754 enum xbm_token
5755 {
5756 XBM_TK_IDENT = 256,
5757 XBM_TK_NUMBER
5758 };
5759
5760
5761 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5762 A valid specification is a list starting with the symbol `image'
5763 The rest of the list is a property list which must contain an
5764 entry `:type xbm..
5765
5766 If the specification specifies a file to load, it must contain
5767 an entry `:file FILENAME' where FILENAME is a string.
5768
5769 If the specification is for a bitmap loaded from memory it must
5770 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5771 WIDTH and HEIGHT are integers > 0. DATA may be:
5772
5773 1. a string large enough to hold the bitmap data, i.e. it must
5774 have a size >= (WIDTH + 7) / 8 * HEIGHT
5775
5776 2. a bool-vector of size >= WIDTH * HEIGHT
5777
5778 3. a vector of strings or bool-vectors, one for each line of the
5779 bitmap.
5780
5781 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
5782 may not be specified in this case because they are defined in the
5783 XBM file.
5784
5785 Both the file and data forms may contain the additional entries
5786 `:background COLOR' and `:foreground COLOR'. If not present,
5787 foreground and background of the frame on which the image is
5788 displayed is used. */
5789
5790 static int
5791 xbm_image_p (object)
5792 Lisp_Object object;
5793 {
5794 struct image_keyword kw[XBM_LAST];
5795
5796 bcopy (xbm_format, kw, sizeof kw);
5797 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
5798 return 0;
5799
5800 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
5801
5802 if (kw[XBM_FILE].count)
5803 {
5804 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
5805 return 0;
5806 }
5807 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
5808 {
5809 /* In-memory XBM file. */
5810 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
5811 return 0;
5812 }
5813 else
5814 {
5815 Lisp_Object data;
5816 int width, height;
5817
5818 /* Entries for `:width', `:height' and `:data' must be present. */
5819 if (!kw[XBM_WIDTH].count
5820 || !kw[XBM_HEIGHT].count
5821 || !kw[XBM_DATA].count)
5822 return 0;
5823
5824 data = kw[XBM_DATA].value;
5825 width = XFASTINT (kw[XBM_WIDTH].value);
5826 height = XFASTINT (kw[XBM_HEIGHT].value);
5827
5828 /* Check type of data, and width and height against contents of
5829 data. */
5830 if (VECTORP (data))
5831 {
5832 int i;
5833
5834 /* Number of elements of the vector must be >= height. */
5835 if (XVECTOR (data)->size < height)
5836 return 0;
5837
5838 /* Each string or bool-vector in data must be large enough
5839 for one line of the image. */
5840 for (i = 0; i < height; ++i)
5841 {
5842 Lisp_Object elt = XVECTOR (data)->contents[i];
5843
5844 if (STRINGP (elt))
5845 {
5846 if (SCHARS (elt)
5847 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
5848 return 0;
5849 }
5850 else if (BOOL_VECTOR_P (elt))
5851 {
5852 if (XBOOL_VECTOR (elt)->size < width)
5853 return 0;
5854 }
5855 else
5856 return 0;
5857 }
5858 }
5859 else if (STRINGP (data))
5860 {
5861 if (SCHARS (data)
5862 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
5863 return 0;
5864 }
5865 else if (BOOL_VECTOR_P (data))
5866 {
5867 if (XBOOL_VECTOR (data)->size < width * height)
5868 return 0;
5869 }
5870 else
5871 return 0;
5872 }
5873
5874 return 1;
5875 }
5876
5877
5878 /* Scan a bitmap file. FP is the stream to read from. Value is
5879 either an enumerator from enum xbm_token, or a character for a
5880 single-character token, or 0 at end of file. If scanning an
5881 identifier, store the lexeme of the identifier in SVAL. If
5882 scanning a number, store its value in *IVAL. */
5883
5884 static int
5885 xbm_scan (s, end, sval, ival)
5886 char **s, *end;
5887 char *sval;
5888 int *ival;
5889 {
5890 int c;
5891
5892 loop:
5893
5894 /* Skip white space. */
5895 while (*s < end && (c = *(*s)++, isspace (c)))
5896 ;
5897
5898 if (*s >= end)
5899 c = 0;
5900 else if (isdigit (c))
5901 {
5902 int value = 0, digit;
5903
5904 if (c == '0' && *s < end)
5905 {
5906 c = *(*s)++;
5907 if (c == 'x' || c == 'X')
5908 {
5909 while (*s < end)
5910 {
5911 c = *(*s)++;
5912 if (isdigit (c))
5913 digit = c - '0';
5914 else if (c >= 'a' && c <= 'f')
5915 digit = c - 'a' + 10;
5916 else if (c >= 'A' && c <= 'F')
5917 digit = c - 'A' + 10;
5918 else
5919 break;
5920 value = 16 * value + digit;
5921 }
5922 }
5923 else if (isdigit (c))
5924 {
5925 value = c - '0';
5926 while (*s < end
5927 && (c = *(*s)++, isdigit (c)))
5928 value = 8 * value + c - '0';
5929 }
5930 }
5931 else
5932 {
5933 value = c - '0';
5934 while (*s < end
5935 && (c = *(*s)++, isdigit (c)))
5936 value = 10 * value + c - '0';
5937 }
5938
5939 if (*s < end)
5940 *s = *s - 1;
5941 *ival = value;
5942 c = XBM_TK_NUMBER;
5943 }
5944 else if (isalpha (c) || c == '_')
5945 {
5946 *sval++ = c;
5947 while (*s < end
5948 && (c = *(*s)++, (isalnum (c) || c == '_')))
5949 *sval++ = c;
5950 *sval = 0;
5951 if (*s < end)
5952 *s = *s - 1;
5953 c = XBM_TK_IDENT;
5954 }
5955 else if (c == '/' && **s == '*')
5956 {
5957 /* C-style comment. */
5958 ++*s;
5959 while (**s && (**s != '*' || *(*s + 1) != '/'))
5960 ++*s;
5961 if (**s)
5962 {
5963 *s += 2;
5964 goto loop;
5965 }
5966 }
5967
5968 return c;
5969 }
5970
5971
5972 /* Replacement for XReadBitmapFileData which isn't available under old
5973 X versions. CONTENTS is a pointer to a buffer to parse; END is the
5974 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
5975 the image. Return in *DATA the bitmap data allocated with xmalloc.
5976 Value is non-zero if successful. DATA null means just test if
5977 CONTENTS looks like an in-memory XBM file. */
5978
5979 static int
5980 xbm_read_bitmap_data (contents, end, width, height, data)
5981 char *contents, *end;
5982 int *width, *height;
5983 unsigned char **data;
5984 {
5985 char *s = contents;
5986 char buffer[BUFSIZ];
5987 int padding_p = 0;
5988 int v10 = 0;
5989 int bytes_per_line, i, nbytes;
5990 unsigned char *p;
5991 int value;
5992 int LA1;
5993
5994 #define match() \
5995 LA1 = xbm_scan (&s, end, buffer, &value)
5996
5997 #define expect(TOKEN) \
5998 if (LA1 != (TOKEN)) \
5999 goto failure; \
6000 else \
6001 match ()
6002
6003 #define expect_ident(IDENT) \
6004 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6005 match (); \
6006 else \
6007 goto failure
6008
6009 *width = *height = -1;
6010 if (data)
6011 *data = NULL;
6012 LA1 = xbm_scan (&s, end, buffer, &value);
6013
6014 /* Parse defines for width, height and hot-spots. */
6015 while (LA1 == '#')
6016 {
6017 match ();
6018 expect_ident ("define");
6019 expect (XBM_TK_IDENT);
6020
6021 if (LA1 == XBM_TK_NUMBER);
6022 {
6023 char *p = strrchr (buffer, '_');
6024 p = p ? p + 1 : buffer;
6025 if (strcmp (p, "width") == 0)
6026 *width = value;
6027 else if (strcmp (p, "height") == 0)
6028 *height = value;
6029 }
6030 expect (XBM_TK_NUMBER);
6031 }
6032
6033 if (*width < 0 || *height < 0)
6034 goto failure;
6035 else if (data == NULL)
6036 goto success;
6037
6038 /* Parse bits. Must start with `static'. */
6039 expect_ident ("static");
6040 if (LA1 == XBM_TK_IDENT)
6041 {
6042 if (strcmp (buffer, "unsigned") == 0)
6043 {
6044 match ();
6045 expect_ident ("char");
6046 }
6047 else if (strcmp (buffer, "short") == 0)
6048 {
6049 match ();
6050 v10 = 1;
6051 if (*width % 16 && *width % 16 < 9)
6052 padding_p = 1;
6053 }
6054 else if (strcmp (buffer, "char") == 0)
6055 match ();
6056 else
6057 goto failure;
6058 }
6059 else
6060 goto failure;
6061
6062 expect (XBM_TK_IDENT);
6063 expect ('[');
6064 expect (']');
6065 expect ('=');
6066 expect ('{');
6067
6068 bytes_per_line = (*width + 7) / 8 + padding_p;
6069 nbytes = bytes_per_line * *height;
6070 p = *data = (char *) xmalloc (nbytes);
6071
6072 if (v10)
6073 {
6074 for (i = 0; i < nbytes; i += 2)
6075 {
6076 int val = value;
6077 expect (XBM_TK_NUMBER);
6078
6079 *p++ = val;
6080 if (!padding_p || ((i + 2) % bytes_per_line))
6081 *p++ = value >> 8;
6082
6083 if (LA1 == ',' || LA1 == '}')
6084 match ();
6085 else
6086 goto failure;
6087 }
6088 }
6089 else
6090 {
6091 for (i = 0; i < nbytes; ++i)
6092 {
6093 int val = value;
6094 expect (XBM_TK_NUMBER);
6095
6096 *p++ = val;
6097
6098 if (LA1 == ',' || LA1 == '}')
6099 match ();
6100 else
6101 goto failure;
6102 }
6103 }
6104
6105 success:
6106 return 1;
6107
6108 failure:
6109
6110 if (data && *data)
6111 {
6112 xfree (*data);
6113 *data = NULL;
6114 }
6115 return 0;
6116
6117 #undef match
6118 #undef expect
6119 #undef expect_ident
6120 }
6121
6122
6123 /* Load XBM image IMG which will be displayed on frame F from buffer
6124 CONTENTS. END is the end of the buffer. Value is non-zero if
6125 successful. */
6126
6127 static int
6128 xbm_load_image (f, img, contents, end)
6129 struct frame *f;
6130 struct image *img;
6131 char *contents, *end;
6132 {
6133 int rc;
6134 unsigned char *data;
6135 int success_p = 0;
6136
6137 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6138 if (rc)
6139 {
6140 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6141 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6142 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6143 Lisp_Object value;
6144
6145 xassert (img->width > 0 && img->height > 0);
6146
6147 /* Get foreground and background colors, maybe allocate colors. */
6148 value = image_spec_value (img->spec, QCforeground, NULL);
6149 if (!NILP (value))
6150 foreground = x_alloc_image_color (f, img, value, foreground);
6151 value = image_spec_value (img->spec, QCbackground, NULL);
6152 if (!NILP (value))
6153 {
6154 background = x_alloc_image_color (f, img, value, background);
6155 img->background = background;
6156 img->background_valid = 1;
6157 }
6158
6159 img->pixmap
6160 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6161 FRAME_X_WINDOW (f),
6162 data,
6163 img->width, img->height,
6164 foreground, background,
6165 depth);
6166 xfree (data);
6167
6168 if (img->pixmap == None)
6169 {
6170 x_clear_image (f, img);
6171 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6172 }
6173 else
6174 success_p = 1;
6175 }
6176 else
6177 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6178
6179 return success_p;
6180 }
6181
6182
6183 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6184
6185 static int
6186 xbm_file_p (data)
6187 Lisp_Object data;
6188 {
6189 int w, h;
6190 return (STRINGP (data)
6191 && xbm_read_bitmap_data (SDATA (data),
6192 (SDATA (data)
6193 + SBYTES (data)),
6194 &w, &h, NULL));
6195 }
6196
6197
6198 /* Fill image IMG which is used on frame F with pixmap data. Value is
6199 non-zero if successful. */
6200
6201 static int
6202 xbm_load (f, img)
6203 struct frame *f;
6204 struct image *img;
6205 {
6206 int success_p = 0;
6207 Lisp_Object file_name;
6208
6209 xassert (xbm_image_p (img->spec));
6210
6211 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6212 file_name = image_spec_value (img->spec, QCfile, NULL);
6213 if (STRINGP (file_name))
6214 {
6215 Lisp_Object file;
6216 char *contents;
6217 int size;
6218 struct gcpro gcpro1;
6219
6220 file = x_find_image_file (file_name);
6221 GCPRO1 (file);
6222 if (!STRINGP (file))
6223 {
6224 image_error ("Cannot find image file `%s'", file_name, Qnil);
6225 UNGCPRO;
6226 return 0;
6227 }
6228
6229 contents = slurp_file (SDATA (file), &size);
6230 if (contents == NULL)
6231 {
6232 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6233 UNGCPRO;
6234 return 0;
6235 }
6236
6237 success_p = xbm_load_image (f, img, contents, contents + size);
6238 UNGCPRO;
6239 }
6240 else
6241 {
6242 struct image_keyword fmt[XBM_LAST];
6243 Lisp_Object data;
6244 int depth;
6245 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6246 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6247 char *bits;
6248 int parsed_p;
6249 int in_memory_file_p = 0;
6250
6251 /* See if data looks like an in-memory XBM file. */
6252 data = image_spec_value (img->spec, QCdata, NULL);
6253 in_memory_file_p = xbm_file_p (data);
6254
6255 /* Parse the image specification. */
6256 bcopy (xbm_format, fmt, sizeof fmt);
6257 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
6258 xassert (parsed_p);
6259
6260 /* Get specified width, and height. */
6261 if (!in_memory_file_p)
6262 {
6263 img->width = XFASTINT (fmt[XBM_WIDTH].value);
6264 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
6265 xassert (img->width > 0 && img->height > 0);
6266 }
6267
6268 /* Get foreground and background colors, maybe allocate colors. */
6269 if (fmt[XBM_FOREGROUND].count
6270 && STRINGP (fmt[XBM_FOREGROUND].value))
6271 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
6272 foreground);
6273 if (fmt[XBM_BACKGROUND].count
6274 && STRINGP (fmt[XBM_BACKGROUND].value))
6275 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
6276 background);
6277
6278 if (in_memory_file_p)
6279 success_p = xbm_load_image (f, img, SDATA (data),
6280 (SDATA (data)
6281 + SBYTES (data)));
6282 else
6283 {
6284 if (VECTORP (data))
6285 {
6286 int i;
6287 char *p;
6288 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6289
6290 p = bits = (char *) alloca (nbytes * img->height);
6291 for (i = 0; i < img->height; ++i, p += nbytes)
6292 {
6293 Lisp_Object line = XVECTOR (data)->contents[i];
6294 if (STRINGP (line))
6295 bcopy (SDATA (line), p, nbytes);
6296 else
6297 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
6298 }
6299 }
6300 else if (STRINGP (data))
6301 bits = SDATA (data);
6302 else
6303 bits = XBOOL_VECTOR (data)->data;
6304
6305 /* Create the pixmap. */
6306 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6307 img->pixmap
6308 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6309 FRAME_X_WINDOW (f),
6310 bits,
6311 img->width, img->height,
6312 foreground, background,
6313 depth);
6314 if (img->pixmap)
6315 success_p = 1;
6316 else
6317 {
6318 image_error ("Unable to create pixmap for XBM image `%s'",
6319 img->spec, Qnil);
6320 x_clear_image (f, img);
6321 }
6322 }
6323 }
6324
6325 return success_p;
6326 }
6327
6328
6329 \f
6330 /***********************************************************************
6331 XPM images
6332 ***********************************************************************/
6333
6334 #if HAVE_XPM
6335
6336 static int xpm_image_p P_ ((Lisp_Object object));
6337 static int xpm_load P_ ((struct frame *f, struct image *img));
6338 static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
6339
6340 #include "X11/xpm.h"
6341
6342 /* The symbol `xpm' identifying XPM-format images. */
6343
6344 Lisp_Object Qxpm;
6345
6346 /* Indices of image specification fields in xpm_format, below. */
6347
6348 enum xpm_keyword_index
6349 {
6350 XPM_TYPE,
6351 XPM_FILE,
6352 XPM_DATA,
6353 XPM_ASCENT,
6354 XPM_MARGIN,
6355 XPM_RELIEF,
6356 XPM_ALGORITHM,
6357 XPM_HEURISTIC_MASK,
6358 XPM_MASK,
6359 XPM_COLOR_SYMBOLS,
6360 XPM_BACKGROUND,
6361 XPM_LAST
6362 };
6363
6364 /* Vector of image_keyword structures describing the format
6365 of valid XPM image specifications. */
6366
6367 static struct image_keyword xpm_format[XPM_LAST] =
6368 {
6369 {":type", IMAGE_SYMBOL_VALUE, 1},
6370 {":file", IMAGE_STRING_VALUE, 0},
6371 {":data", IMAGE_STRING_VALUE, 0},
6372 {":ascent", IMAGE_ASCENT_VALUE, 0},
6373 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6374 {":relief", IMAGE_INTEGER_VALUE, 0},
6375 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6376 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6377 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6378 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6379 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6380 };
6381
6382 /* Structure describing the image type XBM. */
6383
6384 static struct image_type xpm_type =
6385 {
6386 &Qxpm,
6387 xpm_image_p,
6388 xpm_load,
6389 x_clear_image,
6390 NULL
6391 };
6392
6393
6394 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6395 functions for allocating image colors. Our own functions handle
6396 color allocation failures more gracefully than the ones on the XPM
6397 lib. */
6398
6399 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6400 #define ALLOC_XPM_COLORS
6401 #endif
6402
6403 #ifdef ALLOC_XPM_COLORS
6404
6405 static void xpm_init_color_cache P_ ((struct frame *, XpmAttributes *));
6406 static void xpm_free_color_cache P_ ((void));
6407 static int xpm_lookup_color P_ ((struct frame *, char *, XColor *));
6408 static int xpm_color_bucket P_ ((char *));
6409 static struct xpm_cached_color *xpm_cache_color P_ ((struct frame *, char *,
6410 XColor *, int));
6411
6412 /* An entry in a hash table used to cache color definitions of named
6413 colors. This cache is necessary to speed up XPM image loading in
6414 case we do color allocations ourselves. Without it, we would need
6415 a call to XParseColor per pixel in the image. */
6416
6417 struct xpm_cached_color
6418 {
6419 /* Next in collision chain. */
6420 struct xpm_cached_color *next;
6421
6422 /* Color definition (RGB and pixel color). */
6423 XColor color;
6424
6425 /* Color name. */
6426 char name[1];
6427 };
6428
6429 /* The hash table used for the color cache, and its bucket vector
6430 size. */
6431
6432 #define XPM_COLOR_CACHE_BUCKETS 1001
6433 struct xpm_cached_color **xpm_color_cache;
6434
6435 /* Initialize the color cache. */
6436
6437 static void
6438 xpm_init_color_cache (f, attrs)
6439 struct frame *f;
6440 XpmAttributes *attrs;
6441 {
6442 size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
6443 xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
6444 memset (xpm_color_cache, 0, nbytes);
6445 init_color_table ();
6446
6447 if (attrs->valuemask & XpmColorSymbols)
6448 {
6449 int i;
6450 XColor color;
6451
6452 for (i = 0; i < attrs->numsymbols; ++i)
6453 if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6454 attrs->colorsymbols[i].value, &color))
6455 {
6456 color.pixel = lookup_rgb_color (f, color.red, color.green,
6457 color.blue);
6458 xpm_cache_color (f, attrs->colorsymbols[i].name, &color, -1);
6459 }
6460 }
6461 }
6462
6463
6464 /* Free the color cache. */
6465
6466 static void
6467 xpm_free_color_cache ()
6468 {
6469 struct xpm_cached_color *p, *next;
6470 int i;
6471
6472 for (i = 0; i < XPM_COLOR_CACHE_BUCKETS; ++i)
6473 for (p = xpm_color_cache[i]; p; p = next)
6474 {
6475 next = p->next;
6476 xfree (p);
6477 }
6478
6479 xfree (xpm_color_cache);
6480 xpm_color_cache = NULL;
6481 free_color_table ();
6482 }
6483
6484
6485 /* Return the bucket index for color named COLOR_NAME in the color
6486 cache. */
6487
6488 static int
6489 xpm_color_bucket (color_name)
6490 char *color_name;
6491 {
6492 unsigned h = 0;
6493 char *s;
6494
6495 for (s = color_name; *s; ++s)
6496 h = (h << 2) ^ *s;
6497 return h %= XPM_COLOR_CACHE_BUCKETS;
6498 }
6499
6500
6501 /* On frame F, cache values COLOR for color with name COLOR_NAME.
6502 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
6503 entry added. */
6504
6505 static struct xpm_cached_color *
6506 xpm_cache_color (f, color_name, color, bucket)
6507 struct frame *f;
6508 char *color_name;
6509 XColor *color;
6510 int bucket;
6511 {
6512 size_t nbytes;
6513 struct xpm_cached_color *p;
6514
6515 if (bucket < 0)
6516 bucket = xpm_color_bucket (color_name);
6517
6518 nbytes = sizeof *p + strlen (color_name);
6519 p = (struct xpm_cached_color *) xmalloc (nbytes);
6520 strcpy (p->name, color_name);
6521 p->color = *color;
6522 p->next = xpm_color_cache[bucket];
6523 xpm_color_cache[bucket] = p;
6524 return p;
6525 }
6526
6527
6528 /* Look up color COLOR_NAME for frame F in the color cache. If found,
6529 return the cached definition in *COLOR. Otherwise, make a new
6530 entry in the cache and allocate the color. Value is zero if color
6531 allocation failed. */
6532
6533 static int
6534 xpm_lookup_color (f, color_name, color)
6535 struct frame *f;
6536 char *color_name;
6537 XColor *color;
6538 {
6539 struct xpm_cached_color *p;
6540 int h = xpm_color_bucket (color_name);
6541
6542 for (p = xpm_color_cache[h]; p; p = p->next)
6543 if (strcmp (p->name, color_name) == 0)
6544 break;
6545
6546 if (p != NULL)
6547 *color = p->color;
6548 else if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6549 color_name, color))
6550 {
6551 color->pixel = lookup_rgb_color (f, color->red, color->green,
6552 color->blue);
6553 p = xpm_cache_color (f, color_name, color, h);
6554 }
6555 /* You get `opaque' at least from ImageMagick converting pbm to xpm
6556 with transparency, and it's useful. */
6557 else if (strcmp ("opaque", color_name) == 0)
6558 {
6559 bzero (color, sizeof (XColor)); /* Is this necessary/correct? */
6560 color->pixel = FRAME_FOREGROUND_PIXEL (f);
6561 p = xpm_cache_color (f, color_name, color, h);
6562 }
6563
6564 return p != NULL;
6565 }
6566
6567
6568 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
6569 CLOSURE is a pointer to the frame on which we allocate the
6570 color. Return in *COLOR the allocated color. Value is non-zero
6571 if successful. */
6572
6573 static int
6574 xpm_alloc_color (dpy, cmap, color_name, color, closure)
6575 Display *dpy;
6576 Colormap cmap;
6577 char *color_name;
6578 XColor *color;
6579 void *closure;
6580 {
6581 return xpm_lookup_color ((struct frame *) closure, color_name, color);
6582 }
6583
6584
6585 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
6586 is a pointer to the frame on which we allocate the color. Value is
6587 non-zero if successful. */
6588
6589 static int
6590 xpm_free_colors (dpy, cmap, pixels, npixels, closure)
6591 Display *dpy;
6592 Colormap cmap;
6593 Pixel *pixels;
6594 int npixels;
6595 void *closure;
6596 {
6597 return 1;
6598 }
6599
6600 #endif /* ALLOC_XPM_COLORS */
6601
6602
6603 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6604 for XPM images. Such a list must consist of conses whose car and
6605 cdr are strings. */
6606
6607 static int
6608 xpm_valid_color_symbols_p (color_symbols)
6609 Lisp_Object color_symbols;
6610 {
6611 while (CONSP (color_symbols))
6612 {
6613 Lisp_Object sym = XCAR (color_symbols);
6614 if (!CONSP (sym)
6615 || !STRINGP (XCAR (sym))
6616 || !STRINGP (XCDR (sym)))
6617 break;
6618 color_symbols = XCDR (color_symbols);
6619 }
6620
6621 return NILP (color_symbols);
6622 }
6623
6624
6625 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6626
6627 static int
6628 xpm_image_p (object)
6629 Lisp_Object object;
6630 {
6631 struct image_keyword fmt[XPM_LAST];
6632 bcopy (xpm_format, fmt, sizeof fmt);
6633 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
6634 /* Either `:file' or `:data' must be present. */
6635 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
6636 /* Either no `:color-symbols' or it's a list of conses
6637 whose car and cdr are strings. */
6638 && (fmt[XPM_COLOR_SYMBOLS].count == 0
6639 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
6640 }
6641
6642
6643 /* Load image IMG which will be displayed on frame F. Value is
6644 non-zero if successful. */
6645
6646 static int
6647 xpm_load (f, img)
6648 struct frame *f;
6649 struct image *img;
6650 {
6651 int rc;
6652 XpmAttributes attrs;
6653 Lisp_Object specified_file, color_symbols;
6654
6655 /* Configure the XPM lib. Use the visual of frame F. Allocate
6656 close colors. Return colors allocated. */
6657 bzero (&attrs, sizeof attrs);
6658 attrs.visual = FRAME_X_VISUAL (f);
6659 attrs.colormap = FRAME_X_COLORMAP (f);
6660 attrs.valuemask |= XpmVisual;
6661 attrs.valuemask |= XpmColormap;
6662
6663 #ifdef ALLOC_XPM_COLORS
6664 /* Allocate colors with our own functions which handle
6665 failing color allocation more gracefully. */
6666 attrs.color_closure = f;
6667 attrs.alloc_color = xpm_alloc_color;
6668 attrs.free_colors = xpm_free_colors;
6669 attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
6670 #else /* not ALLOC_XPM_COLORS */
6671 /* Let the XPM lib allocate colors. */
6672 attrs.valuemask |= XpmReturnAllocPixels;
6673 #ifdef XpmAllocCloseColors
6674 attrs.alloc_close_colors = 1;
6675 attrs.valuemask |= XpmAllocCloseColors;
6676 #else /* not XpmAllocCloseColors */
6677 attrs.closeness = 600;
6678 attrs.valuemask |= XpmCloseness;
6679 #endif /* not XpmAllocCloseColors */
6680 #endif /* ALLOC_XPM_COLORS */
6681
6682 /* If image specification contains symbolic color definitions, add
6683 these to `attrs'. */
6684 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
6685 if (CONSP (color_symbols))
6686 {
6687 Lisp_Object tail;
6688 XpmColorSymbol *xpm_syms;
6689 int i, size;
6690
6691 attrs.valuemask |= XpmColorSymbols;
6692
6693 /* Count number of symbols. */
6694 attrs.numsymbols = 0;
6695 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
6696 ++attrs.numsymbols;
6697
6698 /* Allocate an XpmColorSymbol array. */
6699 size = attrs.numsymbols * sizeof *xpm_syms;
6700 xpm_syms = (XpmColorSymbol *) alloca (size);
6701 bzero (xpm_syms, size);
6702 attrs.colorsymbols = xpm_syms;
6703
6704 /* Fill the color symbol array. */
6705 for (tail = color_symbols, i = 0;
6706 CONSP (tail);
6707 ++i, tail = XCDR (tail))
6708 {
6709 Lisp_Object name = XCAR (XCAR (tail));
6710 Lisp_Object color = XCDR (XCAR (tail));
6711 xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1);
6712 strcpy (xpm_syms[i].name, SDATA (name));
6713 xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
6714 strcpy (xpm_syms[i].value, SDATA (color));
6715 }
6716 }
6717
6718 /* Create a pixmap for the image, either from a file, or from a
6719 string buffer containing data in the same format as an XPM file. */
6720 #ifdef ALLOC_XPM_COLORS
6721 xpm_init_color_cache (f, &attrs);
6722 #endif
6723
6724 specified_file = image_spec_value (img->spec, QCfile, NULL);
6725 if (STRINGP (specified_file))
6726 {
6727 Lisp_Object file = x_find_image_file (specified_file);
6728 if (!STRINGP (file))
6729 {
6730 image_error ("Cannot find image file `%s'", specified_file, Qnil);
6731 return 0;
6732 }
6733
6734 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6735 SDATA (file), &img->pixmap, &img->mask,
6736 &attrs);
6737 }
6738 else
6739 {
6740 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
6741 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6742 SDATA (buffer),
6743 &img->pixmap, &img->mask,
6744 &attrs);
6745 }
6746
6747 if (rc == XpmSuccess)
6748 {
6749 #ifdef ALLOC_XPM_COLORS
6750 img->colors = colors_in_color_table (&img->ncolors);
6751 #else /* not ALLOC_XPM_COLORS */
6752 int i;
6753
6754 img->ncolors = attrs.nalloc_pixels;
6755 img->colors = (unsigned long *) xmalloc (img->ncolors
6756 * sizeof *img->colors);
6757 for (i = 0; i < attrs.nalloc_pixels; ++i)
6758 {
6759 img->colors[i] = attrs.alloc_pixels[i];
6760 #ifdef DEBUG_X_COLORS
6761 register_color (img->colors[i]);
6762 #endif
6763 }
6764 #endif /* not ALLOC_XPM_COLORS */
6765
6766 img->width = attrs.width;
6767 img->height = attrs.height;
6768 xassert (img->width > 0 && img->height > 0);
6769
6770 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6771 XpmFreeAttributes (&attrs);
6772 }
6773 else
6774 {
6775 switch (rc)
6776 {
6777 case XpmOpenFailed:
6778 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
6779 break;
6780
6781 case XpmFileInvalid:
6782 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
6783 break;
6784
6785 case XpmNoMemory:
6786 image_error ("Out of memory (%s)", img->spec, Qnil);
6787 break;
6788
6789 case XpmColorFailed:
6790 image_error ("Color allocation error (%s)", img->spec, Qnil);
6791 break;
6792
6793 default:
6794 image_error ("Unknown error (%s)", img->spec, Qnil);
6795 break;
6796 }
6797 }
6798
6799 #ifdef ALLOC_XPM_COLORS
6800 xpm_free_color_cache ();
6801 #endif
6802 return rc == XpmSuccess;
6803 }
6804
6805 #endif /* HAVE_XPM != 0 */
6806
6807 \f
6808 /***********************************************************************
6809 Color table
6810 ***********************************************************************/
6811
6812 /* An entry in the color table mapping an RGB color to a pixel color. */
6813
6814 struct ct_color
6815 {
6816 int r, g, b;
6817 unsigned long pixel;
6818
6819 /* Next in color table collision list. */
6820 struct ct_color *next;
6821 };
6822
6823 /* The bucket vector size to use. Must be prime. */
6824
6825 #define CT_SIZE 101
6826
6827 /* Value is a hash of the RGB color given by R, G, and B. */
6828
6829 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6830
6831 /* The color hash table. */
6832
6833 struct ct_color **ct_table;
6834
6835 /* Number of entries in the color table. */
6836
6837 int ct_colors_allocated;
6838
6839 /* Initialize the color table. */
6840
6841 static void
6842 init_color_table ()
6843 {
6844 int size = CT_SIZE * sizeof (*ct_table);
6845 ct_table = (struct ct_color **) xmalloc (size);
6846 bzero (ct_table, size);
6847 ct_colors_allocated = 0;
6848 }
6849
6850
6851 /* Free memory associated with the color table. */
6852
6853 static void
6854 free_color_table ()
6855 {
6856 int i;
6857 struct ct_color *p, *next;
6858
6859 for (i = 0; i < CT_SIZE; ++i)
6860 for (p = ct_table[i]; p; p = next)
6861 {
6862 next = p->next;
6863 xfree (p);
6864 }
6865
6866 xfree (ct_table);
6867 ct_table = NULL;
6868 }
6869
6870
6871 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6872 entry for that color already is in the color table, return the
6873 pixel color of that entry. Otherwise, allocate a new color for R,
6874 G, B, and make an entry in the color table. */
6875
6876 static unsigned long
6877 lookup_rgb_color (f, r, g, b)
6878 struct frame *f;
6879 int r, g, b;
6880 {
6881 unsigned hash = CT_HASH_RGB (r, g, b);
6882 int i = hash % CT_SIZE;
6883 struct ct_color *p;
6884 struct x_display_info *dpyinfo;
6885
6886 /* Handle TrueColor visuals specially, which improves performance by
6887 two orders of magnitude. Freeing colors on TrueColor visuals is
6888 a nop, and pixel colors specify RGB values directly. See also
6889 the Xlib spec, chapter 3.1. */
6890 dpyinfo = FRAME_X_DISPLAY_INFO (f);
6891 if (dpyinfo->red_bits > 0)
6892 {
6893 unsigned long pr, pg, pb;
6894
6895 /* Apply gamma-correction like normal color allocation does. */
6896 if (f->gamma)
6897 {
6898 XColor color;
6899 color.red = r, color.green = g, color.blue = b;
6900 gamma_correct (f, &color);
6901 r = color.red, g = color.green, b = color.blue;
6902 }
6903
6904 /* Scale down RGB values to the visual's bits per RGB, and shift
6905 them to the right position in the pixel color. Note that the
6906 original RGB values are 16-bit values, as usual in X. */
6907 pr = (r >> (16 - dpyinfo->red_bits)) << dpyinfo->red_offset;
6908 pg = (g >> (16 - dpyinfo->green_bits)) << dpyinfo->green_offset;
6909 pb = (b >> (16 - dpyinfo->blue_bits)) << dpyinfo->blue_offset;
6910
6911 /* Assemble the pixel color. */
6912 return pr | pg | pb;
6913 }
6914
6915 for (p = ct_table[i]; p; p = p->next)
6916 if (p->r == r && p->g == g && p->b == b)
6917 break;
6918
6919 if (p == NULL)
6920 {
6921 XColor color;
6922 Colormap cmap;
6923 int rc;
6924
6925 color.red = r;
6926 color.green = g;
6927 color.blue = b;
6928
6929 cmap = FRAME_X_COLORMAP (f);
6930 rc = x_alloc_nearest_color (f, cmap, &color);
6931
6932 if (rc)
6933 {
6934 ++ct_colors_allocated;
6935
6936 p = (struct ct_color *) xmalloc (sizeof *p);
6937 p->r = r;
6938 p->g = g;
6939 p->b = b;
6940 p->pixel = color.pixel;
6941 p->next = ct_table[i];
6942 ct_table[i] = p;
6943 }
6944 else
6945 return FRAME_FOREGROUND_PIXEL (f);
6946 }
6947
6948 return p->pixel;
6949 }
6950
6951
6952 /* Look up pixel color PIXEL which is used on frame F in the color
6953 table. If not already present, allocate it. Value is PIXEL. */
6954
6955 static unsigned long
6956 lookup_pixel_color (f, pixel)
6957 struct frame *f;
6958 unsigned long pixel;
6959 {
6960 int i = pixel % CT_SIZE;
6961 struct ct_color *p;
6962
6963 for (p = ct_table[i]; p; p = p->next)
6964 if (p->pixel == pixel)
6965 break;
6966
6967 if (p == NULL)
6968 {
6969 XColor color;
6970 Colormap cmap;
6971 int rc;
6972
6973 cmap = FRAME_X_COLORMAP (f);
6974 color.pixel = pixel;
6975 x_query_color (f, &color);
6976 rc = x_alloc_nearest_color (f, cmap, &color);
6977
6978 if (rc)
6979 {
6980 ++ct_colors_allocated;
6981
6982 p = (struct ct_color *) xmalloc (sizeof *p);
6983 p->r = color.red;
6984 p->g = color.green;
6985 p->b = color.blue;
6986 p->pixel = pixel;
6987 p->next = ct_table[i];
6988 ct_table[i] = p;
6989 }
6990 else
6991 return FRAME_FOREGROUND_PIXEL (f);
6992 }
6993
6994 return p->pixel;
6995 }
6996
6997
6998 /* Value is a vector of all pixel colors contained in the color table,
6999 allocated via xmalloc. Set *N to the number of colors. */
7000
7001 static unsigned long *
7002 colors_in_color_table (n)
7003 int *n;
7004 {
7005 int i, j;
7006 struct ct_color *p;
7007 unsigned long *colors;
7008
7009 if (ct_colors_allocated == 0)
7010 {
7011 *n = 0;
7012 colors = NULL;
7013 }
7014 else
7015 {
7016 colors = (unsigned long *) xmalloc (ct_colors_allocated
7017 * sizeof *colors);
7018 *n = ct_colors_allocated;
7019
7020 for (i = j = 0; i < CT_SIZE; ++i)
7021 for (p = ct_table[i]; p; p = p->next)
7022 colors[j++] = p->pixel;
7023 }
7024
7025 return colors;
7026 }
7027
7028
7029 \f
7030 /***********************************************************************
7031 Algorithms
7032 ***********************************************************************/
7033
7034 static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
7035 static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
7036 static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
7037
7038 /* Non-zero means draw a cross on images having `:conversion
7039 disabled'. */
7040
7041 int cross_disabled_images;
7042
7043 /* Edge detection matrices for different edge-detection
7044 strategies. */
7045
7046 static int emboss_matrix[9] = {
7047 /* x - 1 x x + 1 */
7048 2, -1, 0, /* y - 1 */
7049 -1, 0, 1, /* y */
7050 0, 1, -2 /* y + 1 */
7051 };
7052
7053 static int laplace_matrix[9] = {
7054 /* x - 1 x x + 1 */
7055 1, 0, 0, /* y - 1 */
7056 0, 0, 0, /* y */
7057 0, 0, -1 /* y + 1 */
7058 };
7059
7060 /* Value is the intensity of the color whose red/green/blue values
7061 are R, G, and B. */
7062
7063 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7064
7065
7066 /* On frame F, return an array of XColor structures describing image
7067 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7068 non-zero means also fill the red/green/blue members of the XColor
7069 structures. Value is a pointer to the array of XColors structures,
7070 allocated with xmalloc; it must be freed by the caller. */
7071
7072 static XColor *
7073 x_to_xcolors (f, img, rgb_p)
7074 struct frame *f;
7075 struct image *img;
7076 int rgb_p;
7077 {
7078 int x, y;
7079 XColor *colors, *p;
7080 XImage *ximg;
7081
7082 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
7083
7084 /* Get the X image IMG->pixmap. */
7085 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
7086 0, 0, img->width, img->height, ~0, ZPixmap);
7087
7088 /* Fill the `pixel' members of the XColor array. I wished there
7089 were an easy and portable way to circumvent XGetPixel. */
7090 p = colors;
7091 for (y = 0; y < img->height; ++y)
7092 {
7093 XColor *row = p;
7094
7095 for (x = 0; x < img->width; ++x, ++p)
7096 p->pixel = XGetPixel (ximg, x, y);
7097
7098 if (rgb_p)
7099 x_query_colors (f, row, img->width);
7100 }
7101
7102 XDestroyImage (ximg);
7103 return colors;
7104 }
7105
7106
7107 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7108 RGB members are set. F is the frame on which this all happens.
7109 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7110
7111 static void
7112 x_from_xcolors (f, img, colors)
7113 struct frame *f;
7114 struct image *img;
7115 XColor *colors;
7116 {
7117 int x, y;
7118 XImage *oimg;
7119 Pixmap pixmap;
7120 XColor *p;
7121
7122 init_color_table ();
7123
7124 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
7125 &oimg, &pixmap);
7126 p = colors;
7127 for (y = 0; y < img->height; ++y)
7128 for (x = 0; x < img->width; ++x, ++p)
7129 {
7130 unsigned long pixel;
7131 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
7132 XPutPixel (oimg, x, y, pixel);
7133 }
7134
7135 xfree (colors);
7136 x_clear_image_1 (f, img, 1, 0, 1);
7137
7138 x_put_x_image (f, oimg, pixmap, img->width, img->height);
7139 x_destroy_x_image (oimg);
7140 img->pixmap = pixmap;
7141 img->colors = colors_in_color_table (&img->ncolors);
7142 free_color_table ();
7143 }
7144
7145
7146 /* On frame F, perform edge-detection on image IMG.
7147
7148 MATRIX is a nine-element array specifying the transformation
7149 matrix. See emboss_matrix for an example.
7150
7151 COLOR_ADJUST is a color adjustment added to each pixel of the
7152 outgoing image. */
7153
7154 static void
7155 x_detect_edges (f, img, matrix, color_adjust)
7156 struct frame *f;
7157 struct image *img;
7158 int matrix[9], color_adjust;
7159 {
7160 XColor *colors = x_to_xcolors (f, img, 1);
7161 XColor *new, *p;
7162 int x, y, i, sum;
7163
7164 for (i = sum = 0; i < 9; ++i)
7165 sum += abs (matrix[i]);
7166
7167 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7168
7169 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
7170
7171 for (y = 0; y < img->height; ++y)
7172 {
7173 p = COLOR (new, 0, y);
7174 p->red = p->green = p->blue = 0xffff/2;
7175 p = COLOR (new, img->width - 1, y);
7176 p->red = p->green = p->blue = 0xffff/2;
7177 }
7178
7179 for (x = 1; x < img->width - 1; ++x)
7180 {
7181 p = COLOR (new, x, 0);
7182 p->red = p->green = p->blue = 0xffff/2;
7183 p = COLOR (new, x, img->height - 1);
7184 p->red = p->green = p->blue = 0xffff/2;
7185 }
7186
7187 for (y = 1; y < img->height - 1; ++y)
7188 {
7189 p = COLOR (new, 1, y);
7190
7191 for (x = 1; x < img->width - 1; ++x, ++p)
7192 {
7193 int r, g, b, y1, x1;
7194
7195 r = g = b = i = 0;
7196 for (y1 = y - 1; y1 < y + 2; ++y1)
7197 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
7198 if (matrix[i])
7199 {
7200 XColor *t = COLOR (colors, x1, y1);
7201 r += matrix[i] * t->red;
7202 g += matrix[i] * t->green;
7203 b += matrix[i] * t->blue;
7204 }
7205
7206 r = (r / sum + color_adjust) & 0xffff;
7207 g = (g / sum + color_adjust) & 0xffff;
7208 b = (b / sum + color_adjust) & 0xffff;
7209 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
7210 }
7211 }
7212
7213 xfree (colors);
7214 x_from_xcolors (f, img, new);
7215
7216 #undef COLOR
7217 }
7218
7219
7220 /* Perform the pre-defined `emboss' edge-detection on image IMG
7221 on frame F. */
7222
7223 static void
7224 x_emboss (f, img)
7225 struct frame *f;
7226 struct image *img;
7227 {
7228 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
7229 }
7230
7231
7232 /* Perform the pre-defined `laplace' edge-detection on image IMG
7233 on frame F. */
7234
7235 static void
7236 x_laplace (f, img)
7237 struct frame *f;
7238 struct image *img;
7239 {
7240 x_detect_edges (f, img, laplace_matrix, 45000);
7241 }
7242
7243
7244 /* Perform edge-detection on image IMG on frame F, with specified
7245 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7246
7247 MATRIX must be either
7248
7249 - a list of at least 9 numbers in row-major form
7250 - a vector of at least 9 numbers
7251
7252 COLOR_ADJUST nil means use a default; otherwise it must be a
7253 number. */
7254
7255 static void
7256 x_edge_detection (f, img, matrix, color_adjust)
7257 struct frame *f;
7258 struct image *img;
7259 Lisp_Object matrix, color_adjust;
7260 {
7261 int i = 0;
7262 int trans[9];
7263
7264 if (CONSP (matrix))
7265 {
7266 for (i = 0;
7267 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
7268 ++i, matrix = XCDR (matrix))
7269 trans[i] = XFLOATINT (XCAR (matrix));
7270 }
7271 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
7272 {
7273 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
7274 trans[i] = XFLOATINT (AREF (matrix, i));
7275 }
7276
7277 if (NILP (color_adjust))
7278 color_adjust = make_number (0xffff / 2);
7279
7280 if (i == 9 && NUMBERP (color_adjust))
7281 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
7282 }
7283
7284
7285 /* Transform image IMG on frame F so that it looks disabled. */
7286
7287 static void
7288 x_disable_image (f, img)
7289 struct frame *f;
7290 struct image *img;
7291 {
7292 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
7293
7294 if (dpyinfo->n_planes >= 2)
7295 {
7296 /* Color (or grayscale). Convert to gray, and equalize. Just
7297 drawing such images with a stipple can look very odd, so
7298 we're using this method instead. */
7299 XColor *colors = x_to_xcolors (f, img, 1);
7300 XColor *p, *end;
7301 const int h = 15000;
7302 const int l = 30000;
7303
7304 for (p = colors, end = colors + img->width * img->height;
7305 p < end;
7306 ++p)
7307 {
7308 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
7309 int i2 = (0xffff - h - l) * i / 0xffff + l;
7310 p->red = p->green = p->blue = i2;
7311 }
7312
7313 x_from_xcolors (f, img, colors);
7314 }
7315
7316 /* Draw a cross over the disabled image, if we must or if we
7317 should. */
7318 if (dpyinfo->n_planes < 2 || cross_disabled_images)
7319 {
7320 Display *dpy = FRAME_X_DISPLAY (f);
7321 GC gc;
7322
7323 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
7324 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
7325 XDrawLine (dpy, img->pixmap, gc, 0, 0,
7326 img->width - 1, img->height - 1);
7327 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
7328 img->width - 1, 0);
7329 XFreeGC (dpy, gc);
7330
7331 if (img->mask)
7332 {
7333 gc = XCreateGC (dpy, img->mask, 0, NULL);
7334 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
7335 XDrawLine (dpy, img->mask, gc, 0, 0,
7336 img->width - 1, img->height - 1);
7337 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
7338 img->width - 1, 0);
7339 XFreeGC (dpy, gc);
7340 }
7341 }
7342 }
7343
7344
7345 /* Build a mask for image IMG which is used on frame F. FILE is the
7346 name of an image file, for error messages. HOW determines how to
7347 determine the background color of IMG. If it is a list '(R G B)',
7348 with R, G, and B being integers >= 0, take that as the color of the
7349 background. Otherwise, determine the background color of IMG
7350 heuristically. Value is non-zero if successful. */
7351
7352 static int
7353 x_build_heuristic_mask (f, img, how)
7354 struct frame *f;
7355 struct image *img;
7356 Lisp_Object how;
7357 {
7358 Display *dpy = FRAME_X_DISPLAY (f);
7359 XImage *ximg, *mask_img;
7360 int x, y, rc, use_img_background;
7361 unsigned long bg = 0;
7362
7363 if (img->mask)
7364 {
7365 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
7366 img->mask = None;
7367 img->background_transparent_valid = 0;
7368 }
7369
7370 /* Create an image and pixmap serving as mask. */
7371 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
7372 &mask_img, &img->mask);
7373 if (!rc)
7374 return 0;
7375
7376 /* Get the X image of IMG->pixmap. */
7377 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
7378 ~0, ZPixmap);
7379
7380 /* Determine the background color of ximg. If HOW is `(R G B)'
7381 take that as color. Otherwise, use the image's background color. */
7382 use_img_background = 1;
7383
7384 if (CONSP (how))
7385 {
7386 int rgb[3], i;
7387
7388 for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
7389 {
7390 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
7391 how = XCDR (how);
7392 }
7393
7394 if (i == 3 && NILP (how))
7395 {
7396 char color_name[30];
7397 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
7398 bg = x_alloc_image_color (f, img, build_string (color_name), 0);
7399 use_img_background = 0;
7400 }
7401 }
7402
7403 if (use_img_background)
7404 bg = four_corners_best (ximg, img->width, img->height);
7405
7406 /* Set all bits in mask_img to 1 whose color in ximg is different
7407 from the background color bg. */
7408 for (y = 0; y < img->height; ++y)
7409 for (x = 0; x < img->width; ++x)
7410 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
7411
7412 /* Fill in the background_transparent field while we have the mask handy. */
7413 image_background_transparent (img, f, mask_img);
7414
7415 /* Put mask_img into img->mask. */
7416 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
7417 x_destroy_x_image (mask_img);
7418 XDestroyImage (ximg);
7419
7420 return 1;
7421 }
7422
7423
7424 \f
7425 /***********************************************************************
7426 PBM (mono, gray, color)
7427 ***********************************************************************/
7428
7429 static int pbm_image_p P_ ((Lisp_Object object));
7430 static int pbm_load P_ ((struct frame *f, struct image *img));
7431 static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
7432
7433 /* The symbol `pbm' identifying images of this type. */
7434
7435 Lisp_Object Qpbm;
7436
7437 /* Indices of image specification fields in gs_format, below. */
7438
7439 enum pbm_keyword_index
7440 {
7441 PBM_TYPE,
7442 PBM_FILE,
7443 PBM_DATA,
7444 PBM_ASCENT,
7445 PBM_MARGIN,
7446 PBM_RELIEF,
7447 PBM_ALGORITHM,
7448 PBM_HEURISTIC_MASK,
7449 PBM_MASK,
7450 PBM_FOREGROUND,
7451 PBM_BACKGROUND,
7452 PBM_LAST
7453 };
7454
7455 /* Vector of image_keyword structures describing the format
7456 of valid user-defined image specifications. */
7457
7458 static struct image_keyword pbm_format[PBM_LAST] =
7459 {
7460 {":type", IMAGE_SYMBOL_VALUE, 1},
7461 {":file", IMAGE_STRING_VALUE, 0},
7462 {":data", IMAGE_STRING_VALUE, 0},
7463 {":ascent", IMAGE_ASCENT_VALUE, 0},
7464 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7465 {":relief", IMAGE_INTEGER_VALUE, 0},
7466 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7467 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7468 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7469 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
7470 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7471 };
7472
7473 /* Structure describing the image type `pbm'. */
7474
7475 static struct image_type pbm_type =
7476 {
7477 &Qpbm,
7478 pbm_image_p,
7479 pbm_load,
7480 x_clear_image,
7481 NULL
7482 };
7483
7484
7485 /* Return non-zero if OBJECT is a valid PBM image specification. */
7486
7487 static int
7488 pbm_image_p (object)
7489 Lisp_Object object;
7490 {
7491 struct image_keyword fmt[PBM_LAST];
7492
7493 bcopy (pbm_format, fmt, sizeof fmt);
7494
7495 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
7496 return 0;
7497
7498 /* Must specify either :data or :file. */
7499 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
7500 }
7501
7502
7503 /* Scan a decimal number from *S and return it. Advance *S while
7504 reading the number. END is the end of the string. Value is -1 at
7505 end of input. */
7506
7507 static int
7508 pbm_scan_number (s, end)
7509 unsigned char **s, *end;
7510 {
7511 int c = 0, val = -1;
7512
7513 while (*s < end)
7514 {
7515 /* Skip white-space. */
7516 while (*s < end && (c = *(*s)++, isspace (c)))
7517 ;
7518
7519 if (c == '#')
7520 {
7521 /* Skip comment to end of line. */
7522 while (*s < end && (c = *(*s)++, c != '\n'))
7523 ;
7524 }
7525 else if (isdigit (c))
7526 {
7527 /* Read decimal number. */
7528 val = c - '0';
7529 while (*s < end && (c = *(*s)++, isdigit (c)))
7530 val = 10 * val + c - '0';
7531 break;
7532 }
7533 else
7534 break;
7535 }
7536
7537 return val;
7538 }
7539
7540
7541 /* Load PBM image IMG for use on frame F. */
7542
7543 static int
7544 pbm_load (f, img)
7545 struct frame *f;
7546 struct image *img;
7547 {
7548 int raw_p, x, y;
7549 int width, height, max_color_idx = 0;
7550 XImage *ximg;
7551 Lisp_Object file, specified_file;
7552 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
7553 struct gcpro gcpro1;
7554 unsigned char *contents = NULL;
7555 unsigned char *end, *p;
7556 int size;
7557
7558 specified_file = image_spec_value (img->spec, QCfile, NULL);
7559 file = Qnil;
7560 GCPRO1 (file);
7561
7562 if (STRINGP (specified_file))
7563 {
7564 file = x_find_image_file (specified_file);
7565 if (!STRINGP (file))
7566 {
7567 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7568 UNGCPRO;
7569 return 0;
7570 }
7571
7572 contents = slurp_file (SDATA (file), &size);
7573 if (contents == NULL)
7574 {
7575 image_error ("Error reading `%s'", file, Qnil);
7576 UNGCPRO;
7577 return 0;
7578 }
7579
7580 p = contents;
7581 end = contents + size;
7582 }
7583 else
7584 {
7585 Lisp_Object data;
7586 data = image_spec_value (img->spec, QCdata, NULL);
7587 p = SDATA (data);
7588 end = p + SBYTES (data);
7589 }
7590
7591 /* Check magic number. */
7592 if (end - p < 2 || *p++ != 'P')
7593 {
7594 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7595 error:
7596 xfree (contents);
7597 UNGCPRO;
7598 return 0;
7599 }
7600
7601 switch (*p++)
7602 {
7603 case '1':
7604 raw_p = 0, type = PBM_MONO;
7605 break;
7606
7607 case '2':
7608 raw_p = 0, type = PBM_GRAY;
7609 break;
7610
7611 case '3':
7612 raw_p = 0, type = PBM_COLOR;
7613 break;
7614
7615 case '4':
7616 raw_p = 1, type = PBM_MONO;
7617 break;
7618
7619 case '5':
7620 raw_p = 1, type = PBM_GRAY;
7621 break;
7622
7623 case '6':
7624 raw_p = 1, type = PBM_COLOR;
7625 break;
7626
7627 default:
7628 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7629 goto error;
7630 }
7631
7632 /* Read width, height, maximum color-component. Characters
7633 starting with `#' up to the end of a line are ignored. */
7634 width = pbm_scan_number (&p, end);
7635 height = pbm_scan_number (&p, end);
7636
7637 if (type != PBM_MONO)
7638 {
7639 max_color_idx = pbm_scan_number (&p, end);
7640 if (raw_p && max_color_idx > 255)
7641 max_color_idx = 255;
7642 }
7643
7644 if (width < 0
7645 || height < 0
7646 || (type != PBM_MONO && max_color_idx < 0))
7647 goto error;
7648
7649 if (!x_create_x_image_and_pixmap (f, width, height, 0,
7650 &ximg, &img->pixmap))
7651 goto error;
7652
7653 /* Initialize the color hash table. */
7654 init_color_table ();
7655
7656 if (type == PBM_MONO)
7657 {
7658 int c = 0, g;
7659 struct image_keyword fmt[PBM_LAST];
7660 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
7661 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
7662
7663 /* Parse the image specification. */
7664 bcopy (pbm_format, fmt, sizeof fmt);
7665 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
7666
7667 /* Get foreground and background colors, maybe allocate colors. */
7668 if (fmt[PBM_FOREGROUND].count
7669 && STRINGP (fmt[PBM_FOREGROUND].value))
7670 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
7671 if (fmt[PBM_BACKGROUND].count
7672 && STRINGP (fmt[PBM_BACKGROUND].value))
7673 {
7674 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
7675 img->background = bg;
7676 img->background_valid = 1;
7677 }
7678
7679 for (y = 0; y < height; ++y)
7680 for (x = 0; x < width; ++x)
7681 {
7682 if (raw_p)
7683 {
7684 if ((x & 7) == 0)
7685 c = *p++;
7686 g = c & 0x80;
7687 c <<= 1;
7688 }
7689 else
7690 g = pbm_scan_number (&p, end);
7691
7692 XPutPixel (ximg, x, y, g ? fg : bg);
7693 }
7694 }
7695 else
7696 {
7697 for (y = 0; y < height; ++y)
7698 for (x = 0; x < width; ++x)
7699 {
7700 int r, g, b;
7701
7702 if (type == PBM_GRAY)
7703 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
7704 else if (raw_p)
7705 {
7706 r = *p++;
7707 g = *p++;
7708 b = *p++;
7709 }
7710 else
7711 {
7712 r = pbm_scan_number (&p, end);
7713 g = pbm_scan_number (&p, end);
7714 b = pbm_scan_number (&p, end);
7715 }
7716
7717 if (r < 0 || g < 0 || b < 0)
7718 {
7719 xfree (ximg->data);
7720 ximg->data = NULL;
7721 XDestroyImage (ximg);
7722 image_error ("Invalid pixel value in image `%s'",
7723 img->spec, Qnil);
7724 goto error;
7725 }
7726
7727 /* RGB values are now in the range 0..max_color_idx.
7728 Scale this to the range 0..0xffff supported by X. */
7729 r = (double) r * 65535 / max_color_idx;
7730 g = (double) g * 65535 / max_color_idx;
7731 b = (double) b * 65535 / max_color_idx;
7732 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
7733 }
7734 }
7735
7736 /* Store in IMG->colors the colors allocated for the image, and
7737 free the color table. */
7738 img->colors = colors_in_color_table (&img->ncolors);
7739 free_color_table ();
7740
7741 /* Maybe fill in the background field while we have ximg handy. */
7742 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
7743 IMAGE_BACKGROUND (img, f, ximg);
7744
7745 /* Put the image into a pixmap. */
7746 x_put_x_image (f, ximg, img->pixmap, width, height);
7747 x_destroy_x_image (ximg);
7748
7749 img->width = width;
7750 img->height = height;
7751
7752 UNGCPRO;
7753 xfree (contents);
7754 return 1;
7755 }
7756
7757
7758 \f
7759 /***********************************************************************
7760 PNG
7761 ***********************************************************************/
7762
7763 #if HAVE_PNG
7764
7765 #if defined HAVE_LIBPNG_PNG_H
7766 # include <libpng/png.h>
7767 #else
7768 # include <png.h>
7769 #endif
7770
7771 /* Function prototypes. */
7772
7773 static int png_image_p P_ ((Lisp_Object object));
7774 static int png_load P_ ((struct frame *f, struct image *img));
7775
7776 /* The symbol `png' identifying images of this type. */
7777
7778 Lisp_Object Qpng;
7779
7780 /* Indices of image specification fields in png_format, below. */
7781
7782 enum png_keyword_index
7783 {
7784 PNG_TYPE,
7785 PNG_DATA,
7786 PNG_FILE,
7787 PNG_ASCENT,
7788 PNG_MARGIN,
7789 PNG_RELIEF,
7790 PNG_ALGORITHM,
7791 PNG_HEURISTIC_MASK,
7792 PNG_MASK,
7793 PNG_BACKGROUND,
7794 PNG_LAST
7795 };
7796
7797 /* Vector of image_keyword structures describing the format
7798 of valid user-defined image specifications. */
7799
7800 static struct image_keyword png_format[PNG_LAST] =
7801 {
7802 {":type", IMAGE_SYMBOL_VALUE, 1},
7803 {":data", IMAGE_STRING_VALUE, 0},
7804 {":file", IMAGE_STRING_VALUE, 0},
7805 {":ascent", IMAGE_ASCENT_VALUE, 0},
7806 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7807 {":relief", IMAGE_INTEGER_VALUE, 0},
7808 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7809 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7810 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7811 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7812 };
7813
7814 /* Structure describing the image type `png'. */
7815
7816 static struct image_type png_type =
7817 {
7818 &Qpng,
7819 png_image_p,
7820 png_load,
7821 x_clear_image,
7822 NULL
7823 };
7824
7825
7826 /* Return non-zero if OBJECT is a valid PNG image specification. */
7827
7828 static int
7829 png_image_p (object)
7830 Lisp_Object object;
7831 {
7832 struct image_keyword fmt[PNG_LAST];
7833 bcopy (png_format, fmt, sizeof fmt);
7834
7835 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
7836 return 0;
7837
7838 /* Must specify either the :data or :file keyword. */
7839 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
7840 }
7841
7842
7843 /* Error and warning handlers installed when the PNG library
7844 is initialized. */
7845
7846 static void
7847 my_png_error (png_ptr, msg)
7848 png_struct *png_ptr;
7849 char *msg;
7850 {
7851 xassert (png_ptr != NULL);
7852 image_error ("PNG error: %s", build_string (msg), Qnil);
7853 longjmp (png_ptr->jmpbuf, 1);
7854 }
7855
7856
7857 static void
7858 my_png_warning (png_ptr, msg)
7859 png_struct *png_ptr;
7860 char *msg;
7861 {
7862 xassert (png_ptr != NULL);
7863 image_error ("PNG warning: %s", build_string (msg), Qnil);
7864 }
7865
7866 /* Memory source for PNG decoding. */
7867
7868 struct png_memory_storage
7869 {
7870 unsigned char *bytes; /* The data */
7871 size_t len; /* How big is it? */
7872 int index; /* Where are we? */
7873 };
7874
7875
7876 /* Function set as reader function when reading PNG image from memory.
7877 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7878 bytes from the input to DATA. */
7879
7880 static void
7881 png_read_from_memory (png_ptr, data, length)
7882 png_structp png_ptr;
7883 png_bytep data;
7884 png_size_t length;
7885 {
7886 struct png_memory_storage *tbr
7887 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
7888
7889 if (length > tbr->len - tbr->index)
7890 png_error (png_ptr, "Read error");
7891
7892 bcopy (tbr->bytes + tbr->index, data, length);
7893 tbr->index = tbr->index + length;
7894 }
7895
7896 /* Load PNG image IMG for use on frame F. Value is non-zero if
7897 successful. */
7898
7899 static int
7900 png_load (f, img)
7901 struct frame *f;
7902 struct image *img;
7903 {
7904 Lisp_Object file, specified_file;
7905 Lisp_Object specified_data;
7906 int x, y, i;
7907 XImage *ximg, *mask_img = NULL;
7908 struct gcpro gcpro1;
7909 png_struct *png_ptr = NULL;
7910 png_info *info_ptr = NULL, *end_info = NULL;
7911 FILE *volatile fp = NULL;
7912 png_byte sig[8];
7913 png_byte * volatile pixels = NULL;
7914 png_byte ** volatile rows = NULL;
7915 png_uint_32 width, height;
7916 int bit_depth, color_type, interlace_type;
7917 png_byte channels;
7918 png_uint_32 row_bytes;
7919 int transparent_p;
7920 double screen_gamma;
7921 struct png_memory_storage tbr; /* Data to be read */
7922
7923 /* Find out what file to load. */
7924 specified_file = image_spec_value (img->spec, QCfile, NULL);
7925 specified_data = image_spec_value (img->spec, QCdata, NULL);
7926 file = Qnil;
7927 GCPRO1 (file);
7928
7929 if (NILP (specified_data))
7930 {
7931 file = x_find_image_file (specified_file);
7932 if (!STRINGP (file))
7933 {
7934 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7935 UNGCPRO;
7936 return 0;
7937 }
7938
7939 /* Open the image file. */
7940 fp = fopen (SDATA (file), "rb");
7941 if (!fp)
7942 {
7943 image_error ("Cannot open image file `%s'", file, Qnil);
7944 UNGCPRO;
7945 fclose (fp);
7946 return 0;
7947 }
7948
7949 /* Check PNG signature. */
7950 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
7951 || !png_check_sig (sig, sizeof sig))
7952 {
7953 image_error ("Not a PNG file: `%s'", file, Qnil);
7954 UNGCPRO;
7955 fclose (fp);
7956 return 0;
7957 }
7958 }
7959 else
7960 {
7961 /* Read from memory. */
7962 tbr.bytes = SDATA (specified_data);
7963 tbr.len = SBYTES (specified_data);
7964 tbr.index = 0;
7965
7966 /* Check PNG signature. */
7967 if (tbr.len < sizeof sig
7968 || !png_check_sig (tbr.bytes, sizeof sig))
7969 {
7970 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
7971 UNGCPRO;
7972 return 0;
7973 }
7974
7975 /* Need to skip past the signature. */
7976 tbr.bytes += sizeof (sig);
7977 }
7978
7979 /* Initialize read and info structs for PNG lib. */
7980 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
7981 my_png_error, my_png_warning);
7982 if (!png_ptr)
7983 {
7984 if (fp) fclose (fp);
7985 UNGCPRO;
7986 return 0;
7987 }
7988
7989 info_ptr = png_create_info_struct (png_ptr);
7990 if (!info_ptr)
7991 {
7992 png_destroy_read_struct (&png_ptr, NULL, NULL);
7993 if (fp) fclose (fp);
7994 UNGCPRO;
7995 return 0;
7996 }
7997
7998 end_info = png_create_info_struct (png_ptr);
7999 if (!end_info)
8000 {
8001 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
8002 if (fp) fclose (fp);
8003 UNGCPRO;
8004 return 0;
8005 }
8006
8007 /* Set error jump-back. We come back here when the PNG library
8008 detects an error. */
8009 if (setjmp (png_ptr->jmpbuf))
8010 {
8011 error:
8012 if (png_ptr)
8013 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8014 xfree (pixels);
8015 xfree (rows);
8016 if (fp) fclose (fp);
8017 UNGCPRO;
8018 return 0;
8019 }
8020
8021 /* Read image info. */
8022 if (!NILP (specified_data))
8023 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
8024 else
8025 png_init_io (png_ptr, fp);
8026
8027 png_set_sig_bytes (png_ptr, sizeof sig);
8028 png_read_info (png_ptr, info_ptr);
8029 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
8030 &interlace_type, NULL, NULL);
8031
8032 /* If image contains simply transparency data, we prefer to
8033 construct a clipping mask. */
8034 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
8035 transparent_p = 1;
8036 else
8037 transparent_p = 0;
8038
8039 /* This function is easier to write if we only have to handle
8040 one data format: RGB or RGBA with 8 bits per channel. Let's
8041 transform other formats into that format. */
8042
8043 /* Strip more than 8 bits per channel. */
8044 if (bit_depth == 16)
8045 png_set_strip_16 (png_ptr);
8046
8047 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8048 if available. */
8049 png_set_expand (png_ptr);
8050
8051 /* Convert grayscale images to RGB. */
8052 if (color_type == PNG_COLOR_TYPE_GRAY
8053 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
8054 png_set_gray_to_rgb (png_ptr);
8055
8056 screen_gamma = (f->gamma ? 1 / f->gamma / 0.45455 : 2.2);
8057
8058 #if 0 /* Avoid double gamma correction for PNG images. */
8059 { /* Tell the PNG lib to handle gamma correction for us. */
8060 int intent;
8061 double image_gamma;
8062 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8063 if (png_get_sRGB (png_ptr, info_ptr, &intent))
8064 /* The libpng documentation says this is right in this case. */
8065 png_set_gamma (png_ptr, screen_gamma, 0.45455);
8066 else
8067 #endif
8068 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
8069 /* Image contains gamma information. */
8070 png_set_gamma (png_ptr, screen_gamma, image_gamma);
8071 else
8072 /* Use the standard default for the image gamma. */
8073 png_set_gamma (png_ptr, screen_gamma, 0.45455);
8074 }
8075 #endif /* if 0 */
8076
8077 /* Handle alpha channel by combining the image with a background
8078 color. Do this only if a real alpha channel is supplied. For
8079 simple transparency, we prefer a clipping mask. */
8080 if (!transparent_p)
8081 {
8082 png_color_16 *image_bg;
8083 Lisp_Object specified_bg
8084 = image_spec_value (img->spec, QCbackground, NULL);
8085
8086 if (STRINGP (specified_bg))
8087 /* The user specified `:background', use that. */
8088 {
8089 XColor color;
8090 if (x_defined_color (f, SDATA (specified_bg), &color, 0))
8091 {
8092 png_color_16 user_bg;
8093
8094 bzero (&user_bg, sizeof user_bg);
8095 user_bg.red = color.red;
8096 user_bg.green = color.green;
8097 user_bg.blue = color.blue;
8098
8099 png_set_background (png_ptr, &user_bg,
8100 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8101 }
8102 }
8103 else if (png_get_bKGD (png_ptr, info_ptr, &image_bg))
8104 /* Image contains a background color with which to
8105 combine the image. */
8106 png_set_background (png_ptr, image_bg,
8107 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
8108 else
8109 {
8110 /* Image does not contain a background color with which
8111 to combine the image data via an alpha channel. Use
8112 the frame's background instead. */
8113 XColor color;
8114 Colormap cmap;
8115 png_color_16 frame_background;
8116
8117 cmap = FRAME_X_COLORMAP (f);
8118 color.pixel = FRAME_BACKGROUND_PIXEL (f);
8119 x_query_color (f, &color);
8120
8121 bzero (&frame_background, sizeof frame_background);
8122 frame_background.red = color.red;
8123 frame_background.green = color.green;
8124 frame_background.blue = color.blue;
8125
8126 png_set_background (png_ptr, &frame_background,
8127 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8128 }
8129 }
8130
8131 /* Update info structure. */
8132 png_read_update_info (png_ptr, info_ptr);
8133
8134 /* Get number of channels. Valid values are 1 for grayscale images
8135 and images with a palette, 2 for grayscale images with transparency
8136 information (alpha channel), 3 for RGB images, and 4 for RGB
8137 images with alpha channel, i.e. RGBA. If conversions above were
8138 sufficient we should only have 3 or 4 channels here. */
8139 channels = png_get_channels (png_ptr, info_ptr);
8140 xassert (channels == 3 || channels == 4);
8141
8142 /* Number of bytes needed for one row of the image. */
8143 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
8144
8145 /* Allocate memory for the image. */
8146 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
8147 rows = (png_byte **) xmalloc (height * sizeof *rows);
8148 for (i = 0; i < height; ++i)
8149 rows[i] = pixels + i * row_bytes;
8150
8151 /* Read the entire image. */
8152 png_read_image (png_ptr, rows);
8153 png_read_end (png_ptr, info_ptr);
8154 if (fp)
8155 {
8156 fclose (fp);
8157 fp = NULL;
8158 }
8159
8160 /* Create the X image and pixmap. */
8161 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
8162 &img->pixmap))
8163 goto error;
8164
8165 /* Create an image and pixmap serving as mask if the PNG image
8166 contains an alpha channel. */
8167 if (channels == 4
8168 && !transparent_p
8169 && !x_create_x_image_and_pixmap (f, width, height, 1,
8170 &mask_img, &img->mask))
8171 {
8172 x_destroy_x_image (ximg);
8173 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
8174 img->pixmap = None;
8175 goto error;
8176 }
8177
8178 /* Fill the X image and mask from PNG data. */
8179 init_color_table ();
8180
8181 for (y = 0; y < height; ++y)
8182 {
8183 png_byte *p = rows[y];
8184
8185 for (x = 0; x < width; ++x)
8186 {
8187 unsigned r, g, b;
8188
8189 r = *p++ << 8;
8190 g = *p++ << 8;
8191 b = *p++ << 8;
8192 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8193
8194 /* An alpha channel, aka mask channel, associates variable
8195 transparency with an image. Where other image formats
8196 support binary transparency---fully transparent or fully
8197 opaque---PNG allows up to 254 levels of partial transparency.
8198 The PNG library implements partial transparency by combining
8199 the image with a specified background color.
8200
8201 I'm not sure how to handle this here nicely: because the
8202 background on which the image is displayed may change, for
8203 real alpha channel support, it would be necessary to create
8204 a new image for each possible background.
8205
8206 What I'm doing now is that a mask is created if we have
8207 boolean transparency information. Otherwise I'm using
8208 the frame's background color to combine the image with. */
8209
8210 if (channels == 4)
8211 {
8212 if (mask_img)
8213 XPutPixel (mask_img, x, y, *p > 0);
8214 ++p;
8215 }
8216 }
8217 }
8218
8219 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8220 /* Set IMG's background color from the PNG image, unless the user
8221 overrode it. */
8222 {
8223 png_color_16 *bg;
8224 if (png_get_bKGD (png_ptr, info_ptr, &bg))
8225 {
8226 img->background = lookup_rgb_color (f, bg->red, bg->green, bg->blue);
8227 img->background_valid = 1;
8228 }
8229 }
8230
8231 /* Remember colors allocated for this image. */
8232 img->colors = colors_in_color_table (&img->ncolors);
8233 free_color_table ();
8234
8235 /* Clean up. */
8236 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8237 xfree (rows);
8238 xfree (pixels);
8239
8240 img->width = width;
8241 img->height = height;
8242
8243 /* Maybe fill in the background field while we have ximg handy. */
8244 IMAGE_BACKGROUND (img, f, ximg);
8245
8246 /* Put the image into the pixmap, then free the X image and its buffer. */
8247 x_put_x_image (f, ximg, img->pixmap, width, height);
8248 x_destroy_x_image (ximg);
8249
8250 /* Same for the mask. */
8251 if (mask_img)
8252 {
8253 /* Fill in the background_transparent field while we have the mask
8254 handy. */
8255 image_background_transparent (img, f, mask_img);
8256
8257 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8258 x_destroy_x_image (mask_img);
8259 }
8260
8261 UNGCPRO;
8262 return 1;
8263 }
8264
8265 #endif /* HAVE_PNG != 0 */
8266
8267
8268 \f
8269 /***********************************************************************
8270 JPEG
8271 ***********************************************************************/
8272
8273 #if HAVE_JPEG
8274
8275 /* Work around a warning about HAVE_STDLIB_H being redefined in
8276 jconfig.h. */
8277 #ifdef HAVE_STDLIB_H
8278 #define HAVE_STDLIB_H_1
8279 #undef HAVE_STDLIB_H
8280 #endif /* HAVE_STLIB_H */
8281
8282 #include <jpeglib.h>
8283 #include <jerror.h>
8284 #include <setjmp.h>
8285
8286 #ifdef HAVE_STLIB_H_1
8287 #define HAVE_STDLIB_H 1
8288 #endif
8289
8290 static int jpeg_image_p P_ ((Lisp_Object object));
8291 static int jpeg_load P_ ((struct frame *f, struct image *img));
8292
8293 /* The symbol `jpeg' identifying images of this type. */
8294
8295 Lisp_Object Qjpeg;
8296
8297 /* Indices of image specification fields in gs_format, below. */
8298
8299 enum jpeg_keyword_index
8300 {
8301 JPEG_TYPE,
8302 JPEG_DATA,
8303 JPEG_FILE,
8304 JPEG_ASCENT,
8305 JPEG_MARGIN,
8306 JPEG_RELIEF,
8307 JPEG_ALGORITHM,
8308 JPEG_HEURISTIC_MASK,
8309 JPEG_MASK,
8310 JPEG_BACKGROUND,
8311 JPEG_LAST
8312 };
8313
8314 /* Vector of image_keyword structures describing the format
8315 of valid user-defined image specifications. */
8316
8317 static struct image_keyword jpeg_format[JPEG_LAST] =
8318 {
8319 {":type", IMAGE_SYMBOL_VALUE, 1},
8320 {":data", IMAGE_STRING_VALUE, 0},
8321 {":file", IMAGE_STRING_VALUE, 0},
8322 {":ascent", IMAGE_ASCENT_VALUE, 0},
8323 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8324 {":relief", IMAGE_INTEGER_VALUE, 0},
8325 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8326 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8327 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8328 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8329 };
8330
8331 /* Structure describing the image type `jpeg'. */
8332
8333 static struct image_type jpeg_type =
8334 {
8335 &Qjpeg,
8336 jpeg_image_p,
8337 jpeg_load,
8338 x_clear_image,
8339 NULL
8340 };
8341
8342
8343 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8344
8345 static int
8346 jpeg_image_p (object)
8347 Lisp_Object object;
8348 {
8349 struct image_keyword fmt[JPEG_LAST];
8350
8351 bcopy (jpeg_format, fmt, sizeof fmt);
8352
8353 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
8354 return 0;
8355
8356 /* Must specify either the :data or :file keyword. */
8357 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
8358 }
8359
8360
8361 struct my_jpeg_error_mgr
8362 {
8363 struct jpeg_error_mgr pub;
8364 jmp_buf setjmp_buffer;
8365 };
8366
8367
8368 static void
8369 my_error_exit (cinfo)
8370 j_common_ptr cinfo;
8371 {
8372 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
8373 longjmp (mgr->setjmp_buffer, 1);
8374 }
8375
8376
8377 /* Init source method for JPEG data source manager. Called by
8378 jpeg_read_header() before any data is actually read. See
8379 libjpeg.doc from the JPEG lib distribution. */
8380
8381 static void
8382 our_init_source (cinfo)
8383 j_decompress_ptr cinfo;
8384 {
8385 }
8386
8387
8388 /* Fill input buffer method for JPEG data source manager. Called
8389 whenever more data is needed. We read the whole image in one step,
8390 so this only adds a fake end of input marker at the end. */
8391
8392 static boolean
8393 our_fill_input_buffer (cinfo)
8394 j_decompress_ptr cinfo;
8395 {
8396 /* Insert a fake EOI marker. */
8397 struct jpeg_source_mgr *src = cinfo->src;
8398 static JOCTET buffer[2];
8399
8400 buffer[0] = (JOCTET) 0xFF;
8401 buffer[1] = (JOCTET) JPEG_EOI;
8402
8403 src->next_input_byte = buffer;
8404 src->bytes_in_buffer = 2;
8405 return TRUE;
8406 }
8407
8408
8409 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8410 is the JPEG data source manager. */
8411
8412 static void
8413 our_skip_input_data (cinfo, num_bytes)
8414 j_decompress_ptr cinfo;
8415 long num_bytes;
8416 {
8417 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
8418
8419 if (src)
8420 {
8421 if (num_bytes > src->bytes_in_buffer)
8422 ERREXIT (cinfo, JERR_INPUT_EOF);
8423
8424 src->bytes_in_buffer -= num_bytes;
8425 src->next_input_byte += num_bytes;
8426 }
8427 }
8428
8429
8430 /* Method to terminate data source. Called by
8431 jpeg_finish_decompress() after all data has been processed. */
8432
8433 static void
8434 our_term_source (cinfo)
8435 j_decompress_ptr cinfo;
8436 {
8437 }
8438
8439
8440 /* Set up the JPEG lib for reading an image from DATA which contains
8441 LEN bytes. CINFO is the decompression info structure created for
8442 reading the image. */
8443
8444 static void
8445 jpeg_memory_src (cinfo, data, len)
8446 j_decompress_ptr cinfo;
8447 JOCTET *data;
8448 unsigned int len;
8449 {
8450 struct jpeg_source_mgr *src;
8451
8452 if (cinfo->src == NULL)
8453 {
8454 /* First time for this JPEG object? */
8455 cinfo->src = (struct jpeg_source_mgr *)
8456 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
8457 sizeof (struct jpeg_source_mgr));
8458 src = (struct jpeg_source_mgr *) cinfo->src;
8459 src->next_input_byte = data;
8460 }
8461
8462 src = (struct jpeg_source_mgr *) cinfo->src;
8463 src->init_source = our_init_source;
8464 src->fill_input_buffer = our_fill_input_buffer;
8465 src->skip_input_data = our_skip_input_data;
8466 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
8467 src->term_source = our_term_source;
8468 src->bytes_in_buffer = len;
8469 src->next_input_byte = data;
8470 }
8471
8472
8473 /* Load image IMG for use on frame F. Patterned after example.c
8474 from the JPEG lib. */
8475
8476 static int
8477 jpeg_load (f, img)
8478 struct frame *f;
8479 struct image *img;
8480 {
8481 struct jpeg_decompress_struct cinfo;
8482 struct my_jpeg_error_mgr mgr;
8483 Lisp_Object file, specified_file;
8484 Lisp_Object specified_data;
8485 FILE * volatile fp = NULL;
8486 JSAMPARRAY buffer;
8487 int row_stride, x, y;
8488 XImage *ximg = NULL;
8489 int rc;
8490 unsigned long *colors;
8491 int width, height;
8492 struct gcpro gcpro1;
8493
8494 /* Open the JPEG file. */
8495 specified_file = image_spec_value (img->spec, QCfile, NULL);
8496 specified_data = image_spec_value (img->spec, QCdata, NULL);
8497 file = Qnil;
8498 GCPRO1 (file);
8499
8500 if (NILP (specified_data))
8501 {
8502 file = x_find_image_file (specified_file);
8503 if (!STRINGP (file))
8504 {
8505 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8506 UNGCPRO;
8507 return 0;
8508 }
8509
8510 fp = fopen (SDATA (file), "r");
8511 if (fp == NULL)
8512 {
8513 image_error ("Cannot open `%s'", file, Qnil);
8514 UNGCPRO;
8515 return 0;
8516 }
8517 }
8518
8519 /* Customize libjpeg's error handling to call my_error_exit when an
8520 error is detected. This function will perform a longjmp. */
8521 cinfo.err = jpeg_std_error (&mgr.pub);
8522 mgr.pub.error_exit = my_error_exit;
8523
8524 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
8525 {
8526 if (rc == 1)
8527 {
8528 /* Called from my_error_exit. Display a JPEG error. */
8529 char buffer[JMSG_LENGTH_MAX];
8530 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
8531 image_error ("Error reading JPEG image `%s': %s", img->spec,
8532 build_string (buffer));
8533 }
8534
8535 /* Close the input file and destroy the JPEG object. */
8536 if (fp)
8537 fclose ((FILE *) fp);
8538 jpeg_destroy_decompress (&cinfo);
8539
8540 /* If we already have an XImage, free that. */
8541 x_destroy_x_image (ximg);
8542
8543 /* Free pixmap and colors. */
8544 x_clear_image (f, img);
8545
8546 UNGCPRO;
8547 return 0;
8548 }
8549
8550 /* Create the JPEG decompression object. Let it read from fp.
8551 Read the JPEG image header. */
8552 jpeg_create_decompress (&cinfo);
8553
8554 if (NILP (specified_data))
8555 jpeg_stdio_src (&cinfo, (FILE *) fp);
8556 else
8557 jpeg_memory_src (&cinfo, SDATA (specified_data),
8558 SBYTES (specified_data));
8559
8560 jpeg_read_header (&cinfo, TRUE);
8561
8562 /* Customize decompression so that color quantization will be used.
8563 Start decompression. */
8564 cinfo.quantize_colors = TRUE;
8565 jpeg_start_decompress (&cinfo);
8566 width = img->width = cinfo.output_width;
8567 height = img->height = cinfo.output_height;
8568
8569 /* Create X image and pixmap. */
8570 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8571 longjmp (mgr.setjmp_buffer, 2);
8572
8573 /* Allocate colors. When color quantization is used,
8574 cinfo.actual_number_of_colors has been set with the number of
8575 colors generated, and cinfo.colormap is a two-dimensional array
8576 of color indices in the range 0..cinfo.actual_number_of_colors.
8577 No more than 255 colors will be generated. */
8578 {
8579 int i, ir, ig, ib;
8580
8581 if (cinfo.out_color_components > 2)
8582 ir = 0, ig = 1, ib = 2;
8583 else if (cinfo.out_color_components > 1)
8584 ir = 0, ig = 1, ib = 0;
8585 else
8586 ir = 0, ig = 0, ib = 0;
8587
8588 /* Use the color table mechanism because it handles colors that
8589 cannot be allocated nicely. Such colors will be replaced with
8590 a default color, and we don't have to care about which colors
8591 can be freed safely, and which can't. */
8592 init_color_table ();
8593 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
8594 * sizeof *colors);
8595
8596 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
8597 {
8598 /* Multiply RGB values with 255 because X expects RGB values
8599 in the range 0..0xffff. */
8600 int r = cinfo.colormap[ir][i] << 8;
8601 int g = cinfo.colormap[ig][i] << 8;
8602 int b = cinfo.colormap[ib][i] << 8;
8603 colors[i] = lookup_rgb_color (f, r, g, b);
8604 }
8605
8606 /* Remember those colors actually allocated. */
8607 img->colors = colors_in_color_table (&img->ncolors);
8608 free_color_table ();
8609 }
8610
8611 /* Read pixels. */
8612 row_stride = width * cinfo.output_components;
8613 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
8614 row_stride, 1);
8615 for (y = 0; y < height; ++y)
8616 {
8617 jpeg_read_scanlines (&cinfo, buffer, 1);
8618 for (x = 0; x < cinfo.output_width; ++x)
8619 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
8620 }
8621
8622 /* Clean up. */
8623 jpeg_finish_decompress (&cinfo);
8624 jpeg_destroy_decompress (&cinfo);
8625 if (fp)
8626 fclose ((FILE *) fp);
8627
8628 /* Maybe fill in the background field while we have ximg handy. */
8629 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8630 IMAGE_BACKGROUND (img, f, ximg);
8631
8632 /* Put the image into the pixmap. */
8633 x_put_x_image (f, ximg, img->pixmap, width, height);
8634 x_destroy_x_image (ximg);
8635 UNGCPRO;
8636 return 1;
8637 }
8638
8639 #endif /* HAVE_JPEG */
8640
8641
8642 \f
8643 /***********************************************************************
8644 TIFF
8645 ***********************************************************************/
8646
8647 #if HAVE_TIFF
8648
8649 #include <tiffio.h>
8650
8651 static int tiff_image_p P_ ((Lisp_Object object));
8652 static int tiff_load P_ ((struct frame *f, struct image *img));
8653
8654 /* The symbol `tiff' identifying images of this type. */
8655
8656 Lisp_Object Qtiff;
8657
8658 /* Indices of image specification fields in tiff_format, below. */
8659
8660 enum tiff_keyword_index
8661 {
8662 TIFF_TYPE,
8663 TIFF_DATA,
8664 TIFF_FILE,
8665 TIFF_ASCENT,
8666 TIFF_MARGIN,
8667 TIFF_RELIEF,
8668 TIFF_ALGORITHM,
8669 TIFF_HEURISTIC_MASK,
8670 TIFF_MASK,
8671 TIFF_BACKGROUND,
8672 TIFF_LAST
8673 };
8674
8675 /* Vector of image_keyword structures describing the format
8676 of valid user-defined image specifications. */
8677
8678 static struct image_keyword tiff_format[TIFF_LAST] =
8679 {
8680 {":type", IMAGE_SYMBOL_VALUE, 1},
8681 {":data", IMAGE_STRING_VALUE, 0},
8682 {":file", IMAGE_STRING_VALUE, 0},
8683 {":ascent", IMAGE_ASCENT_VALUE, 0},
8684 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8685 {":relief", IMAGE_INTEGER_VALUE, 0},
8686 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8687 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8688 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8689 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8690 };
8691
8692 /* Structure describing the image type `tiff'. */
8693
8694 static struct image_type tiff_type =
8695 {
8696 &Qtiff,
8697 tiff_image_p,
8698 tiff_load,
8699 x_clear_image,
8700 NULL
8701 };
8702
8703
8704 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8705
8706 static int
8707 tiff_image_p (object)
8708 Lisp_Object object;
8709 {
8710 struct image_keyword fmt[TIFF_LAST];
8711 bcopy (tiff_format, fmt, sizeof fmt);
8712
8713 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
8714 return 0;
8715
8716 /* Must specify either the :data or :file keyword. */
8717 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
8718 }
8719
8720
8721 /* Reading from a memory buffer for TIFF images Based on the PNG
8722 memory source, but we have to provide a lot of extra functions.
8723 Blah.
8724
8725 We really only need to implement read and seek, but I am not
8726 convinced that the TIFF library is smart enough not to destroy
8727 itself if we only hand it the function pointers we need to
8728 override. */
8729
8730 typedef struct
8731 {
8732 unsigned char *bytes;
8733 size_t len;
8734 int index;
8735 }
8736 tiff_memory_source;
8737
8738
8739 static size_t
8740 tiff_read_from_memory (data, buf, size)
8741 thandle_t data;
8742 tdata_t buf;
8743 tsize_t size;
8744 {
8745 tiff_memory_source *src = (tiff_memory_source *) data;
8746
8747 if (size > src->len - src->index)
8748 return (size_t) -1;
8749 bcopy (src->bytes + src->index, buf, size);
8750 src->index += size;
8751 return size;
8752 }
8753
8754
8755 static size_t
8756 tiff_write_from_memory (data, buf, size)
8757 thandle_t data;
8758 tdata_t buf;
8759 tsize_t size;
8760 {
8761 return (size_t) -1;
8762 }
8763
8764
8765 static toff_t
8766 tiff_seek_in_memory (data, off, whence)
8767 thandle_t data;
8768 toff_t off;
8769 int whence;
8770 {
8771 tiff_memory_source *src = (tiff_memory_source *) data;
8772 int idx;
8773
8774 switch (whence)
8775 {
8776 case SEEK_SET: /* Go from beginning of source. */
8777 idx = off;
8778 break;
8779
8780 case SEEK_END: /* Go from end of source. */
8781 idx = src->len + off;
8782 break;
8783
8784 case SEEK_CUR: /* Go from current position. */
8785 idx = src->index + off;
8786 break;
8787
8788 default: /* Invalid `whence'. */
8789 return -1;
8790 }
8791
8792 if (idx > src->len || idx < 0)
8793 return -1;
8794
8795 src->index = idx;
8796 return src->index;
8797 }
8798
8799
8800 static int
8801 tiff_close_memory (data)
8802 thandle_t data;
8803 {
8804 /* NOOP */
8805 return 0;
8806 }
8807
8808
8809 static int
8810 tiff_mmap_memory (data, pbase, psize)
8811 thandle_t data;
8812 tdata_t *pbase;
8813 toff_t *psize;
8814 {
8815 /* It is already _IN_ memory. */
8816 return 0;
8817 }
8818
8819
8820 static void
8821 tiff_unmap_memory (data, base, size)
8822 thandle_t data;
8823 tdata_t base;
8824 toff_t size;
8825 {
8826 /* We don't need to do this. */
8827 }
8828
8829
8830 static toff_t
8831 tiff_size_of_memory (data)
8832 thandle_t data;
8833 {
8834 return ((tiff_memory_source *) data)->len;
8835 }
8836
8837
8838 static void
8839 tiff_error_handler (title, format, ap)
8840 const char *title, *format;
8841 va_list ap;
8842 {
8843 char buf[512];
8844 int len;
8845
8846 len = sprintf (buf, "TIFF error: %s ", title);
8847 vsprintf (buf + len, format, ap);
8848 add_to_log (buf, Qnil, Qnil);
8849 }
8850
8851
8852 static void
8853 tiff_warning_handler (title, format, ap)
8854 const char *title, *format;
8855 va_list ap;
8856 {
8857 char buf[512];
8858 int len;
8859
8860 len = sprintf (buf, "TIFF warning: %s ", title);
8861 vsprintf (buf + len, format, ap);
8862 add_to_log (buf, Qnil, Qnil);
8863 }
8864
8865
8866 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8867 successful. */
8868
8869 static int
8870 tiff_load (f, img)
8871 struct frame *f;
8872 struct image *img;
8873 {
8874 Lisp_Object file, specified_file;
8875 Lisp_Object specified_data;
8876 TIFF *tiff;
8877 int width, height, x, y;
8878 uint32 *buf;
8879 int rc;
8880 XImage *ximg;
8881 struct gcpro gcpro1;
8882 tiff_memory_source memsrc;
8883
8884 specified_file = image_spec_value (img->spec, QCfile, NULL);
8885 specified_data = image_spec_value (img->spec, QCdata, NULL);
8886 file = Qnil;
8887 GCPRO1 (file);
8888
8889 TIFFSetErrorHandler (tiff_error_handler);
8890 TIFFSetWarningHandler (tiff_warning_handler);
8891
8892 if (NILP (specified_data))
8893 {
8894 /* Read from a file */
8895 file = x_find_image_file (specified_file);
8896 if (!STRINGP (file))
8897 {
8898 image_error ("Cannot find image file `%s'", file, Qnil);
8899 UNGCPRO;
8900 return 0;
8901 }
8902
8903 /* Try to open the image file. */
8904 tiff = TIFFOpen (SDATA (file), "r");
8905 if (tiff == NULL)
8906 {
8907 image_error ("Cannot open `%s'", file, Qnil);
8908 UNGCPRO;
8909 return 0;
8910 }
8911 }
8912 else
8913 {
8914 /* Memory source! */
8915 memsrc.bytes = SDATA (specified_data);
8916 memsrc.len = SBYTES (specified_data);
8917 memsrc.index = 0;
8918
8919 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
8920 (TIFFReadWriteProc) tiff_read_from_memory,
8921 (TIFFReadWriteProc) tiff_write_from_memory,
8922 tiff_seek_in_memory,
8923 tiff_close_memory,
8924 tiff_size_of_memory,
8925 tiff_mmap_memory,
8926 tiff_unmap_memory);
8927
8928 if (!tiff)
8929 {
8930 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
8931 UNGCPRO;
8932 return 0;
8933 }
8934 }
8935
8936 /* Get width and height of the image, and allocate a raster buffer
8937 of width x height 32-bit values. */
8938 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
8939 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
8940 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
8941
8942 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
8943 TIFFClose (tiff);
8944 if (!rc)
8945 {
8946 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
8947 xfree (buf);
8948 UNGCPRO;
8949 return 0;
8950 }
8951
8952 /* Create the X image and pixmap. */
8953 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8954 {
8955 xfree (buf);
8956 UNGCPRO;
8957 return 0;
8958 }
8959
8960 /* Initialize the color table. */
8961 init_color_table ();
8962
8963 /* Process the pixel raster. Origin is in the lower-left corner. */
8964 for (y = 0; y < height; ++y)
8965 {
8966 uint32 *row = buf + y * width;
8967
8968 for (x = 0; x < width; ++x)
8969 {
8970 uint32 abgr = row[x];
8971 int r = TIFFGetR (abgr) << 8;
8972 int g = TIFFGetG (abgr) << 8;
8973 int b = TIFFGetB (abgr) << 8;
8974 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
8975 }
8976 }
8977
8978 /* Remember the colors allocated for the image. Free the color table. */
8979 img->colors = colors_in_color_table (&img->ncolors);
8980 free_color_table ();
8981
8982 img->width = width;
8983 img->height = height;
8984
8985 /* Maybe fill in the background field while we have ximg handy. */
8986 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8987 IMAGE_BACKGROUND (img, f, ximg);
8988
8989 /* Put the image into the pixmap, then free the X image and its buffer. */
8990 x_put_x_image (f, ximg, img->pixmap, width, height);
8991 x_destroy_x_image (ximg);
8992 xfree (buf);
8993
8994 UNGCPRO;
8995 return 1;
8996 }
8997
8998 #endif /* HAVE_TIFF != 0 */
8999
9000
9001 \f
9002 /***********************************************************************
9003 GIF
9004 ***********************************************************************/
9005
9006 #if HAVE_GIF
9007
9008 #include <gif_lib.h>
9009
9010 static int gif_image_p P_ ((Lisp_Object object));
9011 static int gif_load P_ ((struct frame *f, struct image *img));
9012
9013 /* The symbol `gif' identifying images of this type. */
9014
9015 Lisp_Object Qgif;
9016
9017 /* Indices of image specification fields in gif_format, below. */
9018
9019 enum gif_keyword_index
9020 {
9021 GIF_TYPE,
9022 GIF_DATA,
9023 GIF_FILE,
9024 GIF_ASCENT,
9025 GIF_MARGIN,
9026 GIF_RELIEF,
9027 GIF_ALGORITHM,
9028 GIF_HEURISTIC_MASK,
9029 GIF_MASK,
9030 GIF_IMAGE,
9031 GIF_BACKGROUND,
9032 GIF_LAST
9033 };
9034
9035 /* Vector of image_keyword structures describing the format
9036 of valid user-defined image specifications. */
9037
9038 static struct image_keyword gif_format[GIF_LAST] =
9039 {
9040 {":type", IMAGE_SYMBOL_VALUE, 1},
9041 {":data", IMAGE_STRING_VALUE, 0},
9042 {":file", IMAGE_STRING_VALUE, 0},
9043 {":ascent", IMAGE_ASCENT_VALUE, 0},
9044 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
9045 {":relief", IMAGE_INTEGER_VALUE, 0},
9046 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9047 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9048 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9049 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
9050 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
9051 };
9052
9053 /* Structure describing the image type `gif'. */
9054
9055 static struct image_type gif_type =
9056 {
9057 &Qgif,
9058 gif_image_p,
9059 gif_load,
9060 x_clear_image,
9061 NULL
9062 };
9063
9064
9065 /* Return non-zero if OBJECT is a valid GIF image specification. */
9066
9067 static int
9068 gif_image_p (object)
9069 Lisp_Object object;
9070 {
9071 struct image_keyword fmt[GIF_LAST];
9072 bcopy (gif_format, fmt, sizeof fmt);
9073
9074 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
9075 return 0;
9076
9077 /* Must specify either the :data or :file keyword. */
9078 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
9079 }
9080
9081
9082 /* Reading a GIF image from memory
9083 Based on the PNG memory stuff to a certain extent. */
9084
9085 typedef struct
9086 {
9087 unsigned char *bytes;
9088 size_t len;
9089 int index;
9090 }
9091 gif_memory_source;
9092
9093
9094 /* Make the current memory source available to gif_read_from_memory.
9095 It's done this way because not all versions of libungif support
9096 a UserData field in the GifFileType structure. */
9097 static gif_memory_source *current_gif_memory_src;
9098
9099 static int
9100 gif_read_from_memory (file, buf, len)
9101 GifFileType *file;
9102 GifByteType *buf;
9103 int len;
9104 {
9105 gif_memory_source *src = current_gif_memory_src;
9106
9107 if (len > src->len - src->index)
9108 return -1;
9109
9110 bcopy (src->bytes + src->index, buf, len);
9111 src->index += len;
9112 return len;
9113 }
9114
9115
9116 /* Load GIF image IMG for use on frame F. Value is non-zero if
9117 successful. */
9118
9119 static int
9120 gif_load (f, img)
9121 struct frame *f;
9122 struct image *img;
9123 {
9124 Lisp_Object file, specified_file;
9125 Lisp_Object specified_data;
9126 int rc, width, height, x, y, i;
9127 XImage *ximg;
9128 ColorMapObject *gif_color_map;
9129 unsigned long pixel_colors[256];
9130 GifFileType *gif;
9131 struct gcpro gcpro1;
9132 Lisp_Object image;
9133 int ino, image_left, image_top, image_width, image_height;
9134 gif_memory_source memsrc;
9135 unsigned char *raster;
9136
9137 specified_file = image_spec_value (img->spec, QCfile, NULL);
9138 specified_data = image_spec_value (img->spec, QCdata, NULL);
9139 file = Qnil;
9140 GCPRO1 (file);
9141
9142 if (NILP (specified_data))
9143 {
9144 file = x_find_image_file (specified_file);
9145 if (!STRINGP (file))
9146 {
9147 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9148 UNGCPRO;
9149 return 0;
9150 }
9151
9152 /* Open the GIF file. */
9153 gif = DGifOpenFileName (SDATA (file));
9154 if (gif == NULL)
9155 {
9156 image_error ("Cannot open `%s'", file, Qnil);
9157 UNGCPRO;
9158 return 0;
9159 }
9160 }
9161 else
9162 {
9163 /* Read from memory! */
9164 current_gif_memory_src = &memsrc;
9165 memsrc.bytes = SDATA (specified_data);
9166 memsrc.len = SBYTES (specified_data);
9167 memsrc.index = 0;
9168
9169 gif = DGifOpen (&memsrc, gif_read_from_memory);
9170 if (!gif)
9171 {
9172 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
9173 UNGCPRO;
9174 return 0;
9175 }
9176 }
9177
9178 /* Read entire contents. */
9179 rc = DGifSlurp (gif);
9180 if (rc == GIF_ERROR)
9181 {
9182 image_error ("Error reading `%s'", img->spec, Qnil);
9183 DGifCloseFile (gif);
9184 UNGCPRO;
9185 return 0;
9186 }
9187
9188 image = image_spec_value (img->spec, QCindex, NULL);
9189 ino = INTEGERP (image) ? XFASTINT (image) : 0;
9190 if (ino >= gif->ImageCount)
9191 {
9192 image_error ("Invalid image number `%s' in image `%s'",
9193 image, img->spec);
9194 DGifCloseFile (gif);
9195 UNGCPRO;
9196 return 0;
9197 }
9198
9199 width = img->width = max (gif->SWidth, gif->Image.Left + gif->Image.Width);
9200 height = img->height = max (gif->SHeight, gif->Image.Top + gif->Image.Height);
9201
9202 /* Create the X image and pixmap. */
9203 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
9204 {
9205 DGifCloseFile (gif);
9206 UNGCPRO;
9207 return 0;
9208 }
9209
9210 /* Allocate colors. */
9211 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
9212 if (!gif_color_map)
9213 gif_color_map = gif->SColorMap;
9214 init_color_table ();
9215 bzero (pixel_colors, sizeof pixel_colors);
9216
9217 for (i = 0; i < gif_color_map->ColorCount; ++i)
9218 {
9219 int r = gif_color_map->Colors[i].Red << 8;
9220 int g = gif_color_map->Colors[i].Green << 8;
9221 int b = gif_color_map->Colors[i].Blue << 8;
9222 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
9223 }
9224
9225 img->colors = colors_in_color_table (&img->ncolors);
9226 free_color_table ();
9227
9228 /* Clear the part of the screen image that are not covered by
9229 the image from the GIF file. Full animated GIF support
9230 requires more than can be done here (see the gif89 spec,
9231 disposal methods). Let's simply assume that the part
9232 not covered by a sub-image is in the frame's background color. */
9233 image_top = gif->SavedImages[ino].ImageDesc.Top;
9234 image_left = gif->SavedImages[ino].ImageDesc.Left;
9235 image_width = gif->SavedImages[ino].ImageDesc.Width;
9236 image_height = gif->SavedImages[ino].ImageDesc.Height;
9237
9238 for (y = 0; y < image_top; ++y)
9239 for (x = 0; x < width; ++x)
9240 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9241
9242 for (y = image_top + image_height; y < height; ++y)
9243 for (x = 0; x < width; ++x)
9244 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9245
9246 for (y = image_top; y < image_top + image_height; ++y)
9247 {
9248 for (x = 0; x < image_left; ++x)
9249 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9250 for (x = image_left + image_width; x < width; ++x)
9251 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9252 }
9253
9254 /* Read the GIF image into the X image. We use a local variable
9255 `raster' here because RasterBits below is a char *, and invites
9256 problems with bytes >= 0x80. */
9257 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
9258
9259 if (gif->SavedImages[ino].ImageDesc.Interlace)
9260 {
9261 static int interlace_start[] = {0, 4, 2, 1};
9262 static int interlace_increment[] = {8, 8, 4, 2};
9263 int pass;
9264 int row = interlace_start[0];
9265
9266 pass = 0;
9267
9268 for (y = 0; y < image_height; y++)
9269 {
9270 if (row >= image_height)
9271 {
9272 row = interlace_start[++pass];
9273 while (row >= image_height)
9274 row = interlace_start[++pass];
9275 }
9276
9277 for (x = 0; x < image_width; x++)
9278 {
9279 int i = raster[(y * image_width) + x];
9280 XPutPixel (ximg, x + image_left, row + image_top,
9281 pixel_colors[i]);
9282 }
9283
9284 row += interlace_increment[pass];
9285 }
9286 }
9287 else
9288 {
9289 for (y = 0; y < image_height; ++y)
9290 for (x = 0; x < image_width; ++x)
9291 {
9292 int i = raster[y * image_width + x];
9293 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
9294 }
9295 }
9296
9297 DGifCloseFile (gif);
9298
9299 /* Maybe fill in the background field while we have ximg handy. */
9300 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
9301 IMAGE_BACKGROUND (img, f, ximg);
9302
9303 /* Put the image into the pixmap, then free the X image and its buffer. */
9304 x_put_x_image (f, ximg, img->pixmap, width, height);
9305 x_destroy_x_image (ximg);
9306
9307 UNGCPRO;
9308 return 1;
9309 }
9310
9311 #endif /* HAVE_GIF != 0 */
9312
9313
9314 \f
9315 /***********************************************************************
9316 Ghostscript
9317 ***********************************************************************/
9318
9319 static int gs_image_p P_ ((Lisp_Object object));
9320 static int gs_load P_ ((struct frame *f, struct image *img));
9321 static void gs_clear_image P_ ((struct frame *f, struct image *img));
9322
9323 /* The symbol `postscript' identifying images of this type. */
9324
9325 Lisp_Object Qpostscript;
9326
9327 /* Keyword symbols. */
9328
9329 Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
9330
9331 /* Indices of image specification fields in gs_format, below. */
9332
9333 enum gs_keyword_index
9334 {
9335 GS_TYPE,
9336 GS_PT_WIDTH,
9337 GS_PT_HEIGHT,
9338 GS_FILE,
9339 GS_LOADER,
9340 GS_BOUNDING_BOX,
9341 GS_ASCENT,
9342 GS_MARGIN,
9343 GS_RELIEF,
9344 GS_ALGORITHM,
9345 GS_HEURISTIC_MASK,
9346 GS_MASK,
9347 GS_BACKGROUND,
9348 GS_LAST
9349 };
9350
9351 /* Vector of image_keyword structures describing the format
9352 of valid user-defined image specifications. */
9353
9354 static struct image_keyword gs_format[GS_LAST] =
9355 {
9356 {":type", IMAGE_SYMBOL_VALUE, 1},
9357 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9358 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9359 {":file", IMAGE_STRING_VALUE, 1},
9360 {":loader", IMAGE_FUNCTION_VALUE, 0},
9361 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
9362 {":ascent", IMAGE_ASCENT_VALUE, 0},
9363 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
9364 {":relief", IMAGE_INTEGER_VALUE, 0},
9365 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9366 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9367 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9368 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
9369 };
9370
9371 /* Structure describing the image type `ghostscript'. */
9372
9373 static struct image_type gs_type =
9374 {
9375 &Qpostscript,
9376 gs_image_p,
9377 gs_load,
9378 gs_clear_image,
9379 NULL
9380 };
9381
9382
9383 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9384
9385 static void
9386 gs_clear_image (f, img)
9387 struct frame *f;
9388 struct image *img;
9389 {
9390 /* IMG->data.ptr_val may contain a recorded colormap. */
9391 xfree (img->data.ptr_val);
9392 x_clear_image (f, img);
9393 }
9394
9395
9396 /* Return non-zero if OBJECT is a valid Ghostscript image
9397 specification. */
9398
9399 static int
9400 gs_image_p (object)
9401 Lisp_Object object;
9402 {
9403 struct image_keyword fmt[GS_LAST];
9404 Lisp_Object tem;
9405 int i;
9406
9407 bcopy (gs_format, fmt, sizeof fmt);
9408
9409 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
9410 return 0;
9411
9412 /* Bounding box must be a list or vector containing 4 integers. */
9413 tem = fmt[GS_BOUNDING_BOX].value;
9414 if (CONSP (tem))
9415 {
9416 for (i = 0; i < 4; ++i, tem = XCDR (tem))
9417 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
9418 return 0;
9419 if (!NILP (tem))
9420 return 0;
9421 }
9422 else if (VECTORP (tem))
9423 {
9424 if (XVECTOR (tem)->size != 4)
9425 return 0;
9426 for (i = 0; i < 4; ++i)
9427 if (!INTEGERP (XVECTOR (tem)->contents[i]))
9428 return 0;
9429 }
9430 else
9431 return 0;
9432
9433 return 1;
9434 }
9435
9436
9437 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9438 if successful. */
9439
9440 static int
9441 gs_load (f, img)
9442 struct frame *f;
9443 struct image *img;
9444 {
9445 char buffer[100];
9446 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
9447 struct gcpro gcpro1, gcpro2;
9448 Lisp_Object frame;
9449 double in_width, in_height;
9450 Lisp_Object pixel_colors = Qnil;
9451
9452 /* Compute pixel size of pixmap needed from the given size in the
9453 image specification. Sizes in the specification are in pt. 1 pt
9454 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9455 info. */
9456 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
9457 in_width = XFASTINT (pt_width) / 72.0;
9458 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
9459 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
9460 in_height = XFASTINT (pt_height) / 72.0;
9461 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
9462
9463 /* Create the pixmap. */
9464 xassert (img->pixmap == None);
9465 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9466 img->width, img->height,
9467 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
9468
9469 if (!img->pixmap)
9470 {
9471 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
9472 return 0;
9473 }
9474
9475 /* Call the loader to fill the pixmap. It returns a process object
9476 if successful. We do not record_unwind_protect here because
9477 other places in redisplay like calling window scroll functions
9478 don't either. Let the Lisp loader use `unwind-protect' instead. */
9479 GCPRO2 (window_and_pixmap_id, pixel_colors);
9480
9481 sprintf (buffer, "%lu %lu",
9482 (unsigned long) FRAME_X_WINDOW (f),
9483 (unsigned long) img->pixmap);
9484 window_and_pixmap_id = build_string (buffer);
9485
9486 sprintf (buffer, "%lu %lu",
9487 FRAME_FOREGROUND_PIXEL (f),
9488 FRAME_BACKGROUND_PIXEL (f));
9489 pixel_colors = build_string (buffer);
9490
9491 XSETFRAME (frame, f);
9492 loader = image_spec_value (img->spec, QCloader, NULL);
9493 if (NILP (loader))
9494 loader = intern ("gs-load-image");
9495
9496 img->data.lisp_val = call6 (loader, frame, img->spec,
9497 make_number (img->width),
9498 make_number (img->height),
9499 window_and_pixmap_id,
9500 pixel_colors);
9501 UNGCPRO;
9502 return PROCESSP (img->data.lisp_val);
9503 }
9504
9505
9506 /* Kill the Ghostscript process that was started to fill PIXMAP on
9507 frame F. Called from XTread_socket when receiving an event
9508 telling Emacs that Ghostscript has finished drawing. */
9509
9510 void
9511 x_kill_gs_process (pixmap, f)
9512 Pixmap pixmap;
9513 struct frame *f;
9514 {
9515 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9516 int class, i;
9517 struct image *img;
9518
9519 /* Find the image containing PIXMAP. */
9520 for (i = 0; i < c->used; ++i)
9521 if (c->images[i]->pixmap == pixmap)
9522 break;
9523
9524 /* Should someone in between have cleared the image cache, for
9525 instance, give up. */
9526 if (i == c->used)
9527 return;
9528
9529 /* Kill the GS process. We should have found PIXMAP in the image
9530 cache and its image should contain a process object. */
9531 img = c->images[i];
9532 xassert (PROCESSP (img->data.lisp_val));
9533 Fkill_process (img->data.lisp_val, Qnil);
9534 img->data.lisp_val = Qnil;
9535
9536 /* On displays with a mutable colormap, figure out the colors
9537 allocated for the image by looking at the pixels of an XImage for
9538 img->pixmap. */
9539 class = FRAME_X_VISUAL (f)->class;
9540 if (class != StaticColor && class != StaticGray && class != TrueColor)
9541 {
9542 XImage *ximg;
9543
9544 BLOCK_INPUT;
9545
9546 /* Try to get an XImage for img->pixmep. */
9547 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9548 0, 0, img->width, img->height, ~0, ZPixmap);
9549 if (ximg)
9550 {
9551 int x, y;
9552
9553 /* Initialize the color table. */
9554 init_color_table ();
9555
9556 /* For each pixel of the image, look its color up in the
9557 color table. After having done so, the color table will
9558 contain an entry for each color used by the image. */
9559 for (y = 0; y < img->height; ++y)
9560 for (x = 0; x < img->width; ++x)
9561 {
9562 unsigned long pixel = XGetPixel (ximg, x, y);
9563 lookup_pixel_color (f, pixel);
9564 }
9565
9566 /* Record colors in the image. Free color table and XImage. */
9567 img->colors = colors_in_color_table (&img->ncolors);
9568 free_color_table ();
9569 XDestroyImage (ximg);
9570
9571 #if 0 /* This doesn't seem to be the case. If we free the colors
9572 here, we get a BadAccess later in x_clear_image when
9573 freeing the colors. */
9574 /* We have allocated colors once, but Ghostscript has also
9575 allocated colors on behalf of us. So, to get the
9576 reference counts right, free them once. */
9577 if (img->ncolors)
9578 x_free_colors (f, img->colors, img->ncolors);
9579 #endif
9580 }
9581 else
9582 image_error ("Cannot get X image of `%s'; colors will not be freed",
9583 img->spec, Qnil);
9584
9585 UNBLOCK_INPUT;
9586 }
9587
9588 /* Now that we have the pixmap, compute mask and transform the
9589 image if requested. */
9590 BLOCK_INPUT;
9591 postprocess_image (f, img);
9592 UNBLOCK_INPUT;
9593 }
9594
9595
9596 \f
9597 /***********************************************************************
9598 Window properties
9599 ***********************************************************************/
9600
9601 DEFUN ("x-change-window-property", Fx_change_window_property,
9602 Sx_change_window_property, 2, 3, 0,
9603 doc: /* Change window property PROP to VALUE on the X window of FRAME.
9604 PROP and VALUE must be strings. FRAME nil or omitted means use the
9605 selected frame. Value is VALUE. */)
9606 (prop, value, frame)
9607 Lisp_Object frame, prop, value;
9608 {
9609 struct frame *f = check_x_frame (frame);
9610 Atom prop_atom;
9611
9612 CHECK_STRING (prop);
9613 CHECK_STRING (value);
9614
9615 BLOCK_INPUT;
9616 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9617 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9618 prop_atom, XA_STRING, 8, PropModeReplace,
9619 SDATA (value), SCHARS (value));
9620
9621 /* Make sure the property is set when we return. */
9622 XFlush (FRAME_X_DISPLAY (f));
9623 UNBLOCK_INPUT;
9624
9625 return value;
9626 }
9627
9628
9629 DEFUN ("x-delete-window-property", Fx_delete_window_property,
9630 Sx_delete_window_property, 1, 2, 0,
9631 doc: /* Remove window property PROP from X window of FRAME.
9632 FRAME nil or omitted means use the selected frame. Value is PROP. */)
9633 (prop, frame)
9634 Lisp_Object prop, frame;
9635 {
9636 struct frame *f = check_x_frame (frame);
9637 Atom prop_atom;
9638
9639 CHECK_STRING (prop);
9640 BLOCK_INPUT;
9641 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9642 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
9643
9644 /* Make sure the property is removed when we return. */
9645 XFlush (FRAME_X_DISPLAY (f));
9646 UNBLOCK_INPUT;
9647
9648 return prop;
9649 }
9650
9651
9652 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
9653 1, 2, 0,
9654 doc: /* Value is the value of window property PROP on FRAME.
9655 If FRAME is nil or omitted, use the selected frame. Value is nil
9656 if FRAME hasn't a property with name PROP or if PROP has no string
9657 value. */)
9658 (prop, frame)
9659 Lisp_Object prop, frame;
9660 {
9661 struct frame *f = check_x_frame (frame);
9662 Atom prop_atom;
9663 int rc;
9664 Lisp_Object prop_value = Qnil;
9665 char *tmp_data = NULL;
9666 Atom actual_type;
9667 int actual_format;
9668 unsigned long actual_size, bytes_remaining;
9669
9670 CHECK_STRING (prop);
9671 BLOCK_INPUT;
9672 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9673 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9674 prop_atom, 0, 0, False, XA_STRING,
9675 &actual_type, &actual_format, &actual_size,
9676 &bytes_remaining, (unsigned char **) &tmp_data);
9677 if (rc == Success)
9678 {
9679 int size = bytes_remaining;
9680
9681 XFree (tmp_data);
9682 tmp_data = NULL;
9683
9684 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9685 prop_atom, 0, bytes_remaining,
9686 False, XA_STRING,
9687 &actual_type, &actual_format,
9688 &actual_size, &bytes_remaining,
9689 (unsigned char **) &tmp_data);
9690 if (rc == Success && tmp_data)
9691 prop_value = make_string (tmp_data, size);
9692
9693 XFree (tmp_data);
9694 }
9695
9696 UNBLOCK_INPUT;
9697 return prop_value;
9698 }
9699
9700
9701 \f
9702 /***********************************************************************
9703 Busy cursor
9704 ***********************************************************************/
9705
9706 /* If non-null, an asynchronous timer that, when it expires, displays
9707 an hourglass cursor on all frames. */
9708
9709 static struct atimer *hourglass_atimer;
9710
9711 /* Non-zero means an hourglass cursor is currently shown. */
9712
9713 static int hourglass_shown_p;
9714
9715 /* Number of seconds to wait before displaying an hourglass cursor. */
9716
9717 static Lisp_Object Vhourglass_delay;
9718
9719 /* Default number of seconds to wait before displaying an hourglass
9720 cursor. */
9721
9722 #define DEFAULT_HOURGLASS_DELAY 1
9723
9724 /* Function prototypes. */
9725
9726 static void show_hourglass P_ ((struct atimer *));
9727 static void hide_hourglass P_ ((void));
9728
9729
9730 /* Cancel a currently active hourglass timer, and start a new one. */
9731
9732 void
9733 start_hourglass ()
9734 {
9735 EMACS_TIME delay;
9736 int secs, usecs = 0;
9737
9738 cancel_hourglass ();
9739
9740 if (INTEGERP (Vhourglass_delay)
9741 && XINT (Vhourglass_delay) > 0)
9742 secs = XFASTINT (Vhourglass_delay);
9743 else if (FLOATP (Vhourglass_delay)
9744 && XFLOAT_DATA (Vhourglass_delay) > 0)
9745 {
9746 Lisp_Object tem;
9747 tem = Ftruncate (Vhourglass_delay, Qnil);
9748 secs = XFASTINT (tem);
9749 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
9750 }
9751 else
9752 secs = DEFAULT_HOURGLASS_DELAY;
9753
9754 EMACS_SET_SECS_USECS (delay, secs, usecs);
9755 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
9756 show_hourglass, NULL);
9757 }
9758
9759
9760 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
9761 shown. */
9762
9763 void
9764 cancel_hourglass ()
9765 {
9766 if (hourglass_atimer)
9767 {
9768 cancel_atimer (hourglass_atimer);
9769 hourglass_atimer = NULL;
9770 }
9771
9772 if (hourglass_shown_p)
9773 hide_hourglass ();
9774 }
9775
9776
9777 /* Timer function of hourglass_atimer. TIMER is equal to
9778 hourglass_atimer.
9779
9780 Display an hourglass pointer on all frames by mapping the frames'
9781 hourglass_window. Set the hourglass_p flag in the frames'
9782 output_data.x structure to indicate that an hourglass cursor is
9783 shown on the frames. */
9784
9785 static void
9786 show_hourglass (timer)
9787 struct atimer *timer;
9788 {
9789 /* The timer implementation will cancel this timer automatically
9790 after this function has run. Set hourglass_atimer to null
9791 so that we know the timer doesn't have to be canceled. */
9792 hourglass_atimer = NULL;
9793
9794 if (!hourglass_shown_p)
9795 {
9796 Lisp_Object rest, frame;
9797
9798 BLOCK_INPUT;
9799
9800 FOR_EACH_FRAME (rest, frame)
9801 {
9802 struct frame *f = XFRAME (frame);
9803
9804 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
9805 {
9806 Display *dpy = FRAME_X_DISPLAY (f);
9807
9808 #ifdef USE_X_TOOLKIT
9809 if (f->output_data.x->widget)
9810 #else
9811 if (FRAME_OUTER_WINDOW (f))
9812 #endif
9813 {
9814 f->output_data.x->hourglass_p = 1;
9815
9816 if (!f->output_data.x->hourglass_window)
9817 {
9818 unsigned long mask = CWCursor;
9819 XSetWindowAttributes attrs;
9820
9821 attrs.cursor = f->output_data.x->hourglass_cursor;
9822
9823 f->output_data.x->hourglass_window
9824 = XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
9825 0, 0, 32000, 32000, 0, 0,
9826 InputOnly,
9827 CopyFromParent,
9828 mask, &attrs);
9829 }
9830
9831 XMapRaised (dpy, f->output_data.x->hourglass_window);
9832 XFlush (dpy);
9833 }
9834 }
9835 }
9836
9837 hourglass_shown_p = 1;
9838 UNBLOCK_INPUT;
9839 }
9840 }
9841
9842
9843 /* Hide the hourglass pointer on all frames, if it is currently
9844 shown. */
9845
9846 static void
9847 hide_hourglass ()
9848 {
9849 if (hourglass_shown_p)
9850 {
9851 Lisp_Object rest, frame;
9852
9853 BLOCK_INPUT;
9854 FOR_EACH_FRAME (rest, frame)
9855 {
9856 struct frame *f = XFRAME (frame);
9857
9858 if (FRAME_X_P (f)
9859 /* Watch out for newly created frames. */
9860 && f->output_data.x->hourglass_window)
9861 {
9862 XUnmapWindow (FRAME_X_DISPLAY (f),
9863 f->output_data.x->hourglass_window);
9864 /* Sync here because XTread_socket looks at the
9865 hourglass_p flag that is reset to zero below. */
9866 XSync (FRAME_X_DISPLAY (f), False);
9867 f->output_data.x->hourglass_p = 0;
9868 }
9869 }
9870
9871 hourglass_shown_p = 0;
9872 UNBLOCK_INPUT;
9873 }
9874 }
9875
9876
9877 \f
9878 /***********************************************************************
9879 Tool tips
9880 ***********************************************************************/
9881
9882 static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
9883 Lisp_Object, Lisp_Object));
9884 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
9885 Lisp_Object, int, int, int *, int *));
9886
9887 /* The frame of a currently visible tooltip. */
9888
9889 Lisp_Object tip_frame;
9890
9891 /* If non-nil, a timer started that hides the last tooltip when it
9892 fires. */
9893
9894 Lisp_Object tip_timer;
9895 Window tip_window;
9896
9897 /* If non-nil, a vector of 3 elements containing the last args
9898 with which x-show-tip was called. See there. */
9899
9900 Lisp_Object last_show_tip_args;
9901
9902 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
9903
9904 Lisp_Object Vx_max_tooltip_size;
9905
9906
9907 static Lisp_Object
9908 unwind_create_tip_frame (frame)
9909 Lisp_Object frame;
9910 {
9911 Lisp_Object deleted;
9912
9913 deleted = unwind_create_frame (frame);
9914 if (EQ (deleted, Qt))
9915 {
9916 tip_window = None;
9917 tip_frame = Qnil;
9918 }
9919
9920 return deleted;
9921 }
9922
9923
9924 /* Create a frame for a tooltip on the display described by DPYINFO.
9925 PARMS is a list of frame parameters. TEXT is the string to
9926 display in the tip frame. Value is the frame.
9927
9928 Note that functions called here, esp. x_default_parameter can
9929 signal errors, for instance when a specified color name is
9930 undefined. We have to make sure that we're in a consistent state
9931 when this happens. */
9932
9933 static Lisp_Object
9934 x_create_tip_frame (dpyinfo, parms, text)
9935 struct x_display_info *dpyinfo;
9936 Lisp_Object parms, text;
9937 {
9938 struct frame *f;
9939 Lisp_Object frame, tem;
9940 Lisp_Object name;
9941 long window_prompting = 0;
9942 int width, height;
9943 int count = SPECPDL_INDEX ();
9944 struct gcpro gcpro1, gcpro2, gcpro3;
9945 struct kboard *kb;
9946 int face_change_count_before = face_change_count;
9947 Lisp_Object buffer;
9948 struct buffer *old_buffer;
9949
9950 check_x ();
9951
9952 /* Use this general default value to start with until we know if
9953 this frame has a specified name. */
9954 Vx_resource_name = Vinvocation_name;
9955
9956 #ifdef MULTI_KBOARD
9957 kb = dpyinfo->kboard;
9958 #else
9959 kb = &the_only_kboard;
9960 #endif
9961
9962 /* Get the name of the frame to use for resource lookup. */
9963 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
9964 if (!STRINGP (name)
9965 && !EQ (name, Qunbound)
9966 && !NILP (name))
9967 error ("Invalid frame name--not a string or nil");
9968 Vx_resource_name = name;
9969
9970 frame = Qnil;
9971 GCPRO3 (parms, name, frame);
9972 f = make_frame (1);
9973 XSETFRAME (frame, f);
9974
9975 buffer = Fget_buffer_create (build_string (" *tip*"));
9976 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
9977 old_buffer = current_buffer;
9978 set_buffer_internal_1 (XBUFFER (buffer));
9979 current_buffer->truncate_lines = Qnil;
9980 Ferase_buffer ();
9981 Finsert (1, &text);
9982 set_buffer_internal_1 (old_buffer);
9983
9984 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
9985 record_unwind_protect (unwind_create_tip_frame, frame);
9986
9987 f->display_method = &x_display_method;
9988
9989 /* By setting the output method, we're essentially saying that
9990 the frame is live, as per FRAME_LIVE_P. If we get a signal
9991 from this point on, x_destroy_window might screw up reference
9992 counts etc. */
9993 f->output_method = output_x_window;
9994 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
9995 bzero (f->output_data.x, sizeof (struct x_output));
9996 f->output_data.x->icon_bitmap = -1;
9997 FRAME_FONTSET (f) = -1;
9998 f->output_data.x->scroll_bar_foreground_pixel = -1;
9999 f->output_data.x->scroll_bar_background_pixel = -1;
10000 #ifdef USE_TOOLKIT_SCROLL_BARS
10001 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
10002 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
10003 #endif /* USE_TOOLKIT_SCROLL_BARS */
10004 f->icon_name = Qnil;
10005 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
10006 #if GLYPH_DEBUG
10007 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
10008 dpyinfo_refcount = dpyinfo->reference_count;
10009 #endif /* GLYPH_DEBUG */
10010 #ifdef MULTI_KBOARD
10011 FRAME_KBOARD (f) = kb;
10012 #endif
10013 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10014 f->output_data.x->explicit_parent = 0;
10015
10016 /* These colors will be set anyway later, but it's important
10017 to get the color reference counts right, so initialize them! */
10018 {
10019 Lisp_Object black;
10020 struct gcpro gcpro1;
10021
10022 black = build_string ("black");
10023 GCPRO1 (black);
10024 f->output_data.x->foreground_pixel
10025 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10026 f->output_data.x->background_pixel
10027 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10028 f->output_data.x->cursor_pixel
10029 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10030 f->output_data.x->cursor_foreground_pixel
10031 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10032 f->output_data.x->border_pixel
10033 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10034 f->output_data.x->mouse_pixel
10035 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10036 UNGCPRO;
10037 }
10038
10039 /* Set the name; the functions to which we pass f expect the name to
10040 be set. */
10041 if (EQ (name, Qunbound) || NILP (name))
10042 {
10043 f->name = build_string (dpyinfo->x_id_name);
10044 f->explicit_name = 0;
10045 }
10046 else
10047 {
10048 f->name = name;
10049 f->explicit_name = 1;
10050 /* use the frame's title when getting resources for this frame. */
10051 specbind (Qx_resource_name, name);
10052 }
10053
10054 /* Extract the window parameters from the supplied values that are
10055 needed to determine window geometry. */
10056 {
10057 Lisp_Object font;
10058
10059 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
10060
10061 BLOCK_INPUT;
10062 /* First, try whatever font the caller has specified. */
10063 if (STRINGP (font))
10064 {
10065 tem = Fquery_fontset (font, Qnil);
10066 if (STRINGP (tem))
10067 font = x_new_fontset (f, SDATA (tem));
10068 else
10069 font = x_new_font (f, SDATA (font));
10070 }
10071
10072 /* Try out a font which we hope has bold and italic variations. */
10073 if (!STRINGP (font))
10074 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10075 if (!STRINGP (font))
10076 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10077 if (! STRINGP (font))
10078 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10079 if (! STRINGP (font))
10080 /* This was formerly the first thing tried, but it finds too many fonts
10081 and takes too long. */
10082 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10083 /* If those didn't work, look for something which will at least work. */
10084 if (! STRINGP (font))
10085 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10086 UNBLOCK_INPUT;
10087 if (! STRINGP (font))
10088 font = build_string ("fixed");
10089
10090 x_default_parameter (f, parms, Qfont, font,
10091 "font", "Font", RES_TYPE_STRING);
10092 }
10093
10094 x_default_parameter (f, parms, Qborder_width, make_number (2),
10095 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
10096
10097 /* This defaults to 2 in order to match xterm. We recognize either
10098 internalBorderWidth or internalBorder (which is what xterm calls
10099 it). */
10100 if (NILP (Fassq (Qinternal_border_width, parms)))
10101 {
10102 Lisp_Object value;
10103
10104 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
10105 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
10106 if (! EQ (value, Qunbound))
10107 parms = Fcons (Fcons (Qinternal_border_width, value),
10108 parms);
10109 }
10110
10111 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
10112 "internalBorderWidth", "internalBorderWidth",
10113 RES_TYPE_NUMBER);
10114
10115 /* Also do the stuff which must be set before the window exists. */
10116 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
10117 "foreground", "Foreground", RES_TYPE_STRING);
10118 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
10119 "background", "Background", RES_TYPE_STRING);
10120 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
10121 "pointerColor", "Foreground", RES_TYPE_STRING);
10122 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
10123 "cursorColor", "Foreground", RES_TYPE_STRING);
10124 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
10125 "borderColor", "BorderColor", RES_TYPE_STRING);
10126
10127 /* Init faces before x_default_parameter is called for scroll-bar
10128 parameters because that function calls x_set_scroll_bar_width,
10129 which calls change_frame_size, which calls Fset_window_buffer,
10130 which runs hooks, which call Fvertical_motion. At the end, we
10131 end up in init_iterator with a null face cache, which should not
10132 happen. */
10133 init_frame_faces (f);
10134
10135 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10136
10137 window_prompting = x_figure_window_size (f, parms, 0);
10138
10139 {
10140 XSetWindowAttributes attrs;
10141 unsigned long mask;
10142
10143 BLOCK_INPUT;
10144 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
10145 if (DoesSaveUnders (dpyinfo->screen))
10146 mask |= CWSaveUnder;
10147
10148 /* Window managers look at the override-redirect flag to determine
10149 whether or net to give windows a decoration (Xlib spec, chapter
10150 3.2.8). */
10151 attrs.override_redirect = True;
10152 attrs.save_under = True;
10153 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
10154 /* Arrange for getting MapNotify and UnmapNotify events. */
10155 attrs.event_mask = StructureNotifyMask;
10156 tip_window
10157 = FRAME_X_WINDOW (f)
10158 = XCreateWindow (FRAME_X_DISPLAY (f),
10159 FRAME_X_DISPLAY_INFO (f)->root_window,
10160 /* x, y, width, height */
10161 0, 0, 1, 1,
10162 /* Border. */
10163 1,
10164 CopyFromParent, InputOutput, CopyFromParent,
10165 mask, &attrs);
10166 UNBLOCK_INPUT;
10167 }
10168
10169 x_make_gc (f);
10170
10171 x_default_parameter (f, parms, Qauto_raise, Qnil,
10172 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10173 x_default_parameter (f, parms, Qauto_lower, Qnil,
10174 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10175 x_default_parameter (f, parms, Qcursor_type, Qbox,
10176 "cursorType", "CursorType", RES_TYPE_SYMBOL);
10177
10178 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
10179 Change will not be effected unless different from the current
10180 FRAME_LINES (f). */
10181 width = FRAME_COLS (f);
10182 height = FRAME_LINES (f);
10183 SET_FRAME_COLS (f, 0);
10184 FRAME_LINES (f) = 0;
10185 change_frame_size (f, height, width, 1, 0, 0);
10186
10187 /* Add `tooltip' frame parameter's default value. */
10188 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
10189 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
10190 Qnil));
10191
10192 /* Set up faces after all frame parameters are known. This call
10193 also merges in face attributes specified for new frames.
10194
10195 Frame parameters may be changed if .Xdefaults contains
10196 specifications for the default font. For example, if there is an
10197 `Emacs.default.attributeBackground: pink', the `background-color'
10198 attribute of the frame get's set, which let's the internal border
10199 of the tooltip frame appear in pink. Prevent this. */
10200 {
10201 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
10202
10203 /* Set tip_frame here, so that */
10204 tip_frame = frame;
10205 call1 (Qface_set_after_frame_default, frame);
10206
10207 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
10208 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
10209 Qnil));
10210 }
10211
10212 f->no_split = 1;
10213
10214 UNGCPRO;
10215
10216 /* It is now ok to make the frame official even if we get an error
10217 below. And the frame needs to be on Vframe_list or making it
10218 visible won't work. */
10219 Vframe_list = Fcons (frame, Vframe_list);
10220
10221 /* Now that the frame is official, it counts as a reference to
10222 its display. */
10223 FRAME_X_DISPLAY_INFO (f)->reference_count++;
10224
10225 /* Setting attributes of faces of the tooltip frame from resources
10226 and similar will increment face_change_count, which leads to the
10227 clearing of all current matrices. Since this isn't necessary
10228 here, avoid it by resetting face_change_count to the value it
10229 had before we created the tip frame. */
10230 face_change_count = face_change_count_before;
10231
10232 /* Discard the unwind_protect. */
10233 return unbind_to (count, frame);
10234 }
10235
10236
10237 /* Compute where to display tip frame F. PARMS is the list of frame
10238 parameters for F. DX and DY are specified offsets from the current
10239 location of the mouse. WIDTH and HEIGHT are the width and height
10240 of the tooltip. Return coordinates relative to the root window of
10241 the display in *ROOT_X, and *ROOT_Y. */
10242
10243 static void
10244 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
10245 struct frame *f;
10246 Lisp_Object parms, dx, dy;
10247 int width, height;
10248 int *root_x, *root_y;
10249 {
10250 Lisp_Object left, top;
10251 int win_x, win_y;
10252 Window root, child;
10253 unsigned pmask;
10254
10255 /* User-specified position? */
10256 left = Fcdr (Fassq (Qleft, parms));
10257 top = Fcdr (Fassq (Qtop, parms));
10258
10259 /* Move the tooltip window where the mouse pointer is. Resize and
10260 show it. */
10261 if (!INTEGERP (left) || !INTEGERP (top))
10262 {
10263 BLOCK_INPUT;
10264 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
10265 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
10266 UNBLOCK_INPUT;
10267 }
10268
10269 if (INTEGERP (top))
10270 *root_y = XINT (top);
10271 else if (*root_y + XINT (dy) - height < 0)
10272 *root_y -= XINT (dy);
10273 else
10274 {
10275 *root_y -= height;
10276 *root_y += XINT (dy);
10277 }
10278
10279 if (INTEGERP (left))
10280 *root_x = XINT (left);
10281 else if (*root_x + XINT (dx) + width <= FRAME_X_DISPLAY_INFO (f)->width)
10282 /* It fits to the right of the pointer. */
10283 *root_x += XINT (dx);
10284 else if (width + XINT (dx) <= *root_x)
10285 /* It fits to the left of the pointer. */
10286 *root_x -= width + XINT (dx);
10287 else
10288 /* Put it left-justified on the screen--it ought to fit that way. */
10289 *root_x = 0;
10290 }
10291
10292
10293 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
10294 doc: /* Show STRING in a "tooltip" window on frame FRAME.
10295 A tooltip window is a small X window displaying a string.
10296
10297 FRAME nil or omitted means use the selected frame.
10298
10299 PARMS is an optional list of frame parameters which can be used to
10300 change the tooltip's appearance.
10301
10302 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
10303 means use the default timeout of 5 seconds.
10304
10305 If the list of frame parameters PARAMS contains a `left' parameters,
10306 the tooltip is displayed at that x-position. Otherwise it is
10307 displayed at the mouse position, with offset DX added (default is 5 if
10308 DX isn't specified). Likewise for the y-position; if a `top' frame
10309 parameter is specified, it determines the y-position of the tooltip
10310 window, otherwise it is displayed at the mouse position, with offset
10311 DY added (default is -10).
10312
10313 A tooltip's maximum size is specified by `x-max-tooltip-size'.
10314 Text larger than the specified size is clipped. */)
10315 (string, frame, parms, timeout, dx, dy)
10316 Lisp_Object string, frame, parms, timeout, dx, dy;
10317 {
10318 struct frame *f;
10319 struct window *w;
10320 int root_x, root_y;
10321 struct buffer *old_buffer;
10322 struct text_pos pos;
10323 int i, width, height;
10324 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10325 int old_windows_or_buffers_changed = windows_or_buffers_changed;
10326 int count = SPECPDL_INDEX ();
10327
10328 specbind (Qinhibit_redisplay, Qt);
10329
10330 GCPRO4 (string, parms, frame, timeout);
10331
10332 CHECK_STRING (string);
10333 f = check_x_frame (frame);
10334 if (NILP (timeout))
10335 timeout = make_number (5);
10336 else
10337 CHECK_NATNUM (timeout);
10338
10339 if (NILP (dx))
10340 dx = make_number (5);
10341 else
10342 CHECK_NUMBER (dx);
10343
10344 if (NILP (dy))
10345 dy = make_number (-10);
10346 else
10347 CHECK_NUMBER (dy);
10348
10349 if (NILP (last_show_tip_args))
10350 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
10351
10352 if (!NILP (tip_frame))
10353 {
10354 Lisp_Object last_string = AREF (last_show_tip_args, 0);
10355 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
10356 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
10357
10358 if (EQ (frame, last_frame)
10359 && !NILP (Fequal (last_string, string))
10360 && !NILP (Fequal (last_parms, parms)))
10361 {
10362 struct frame *f = XFRAME (tip_frame);
10363
10364 /* Only DX and DY have changed. */
10365 if (!NILP (tip_timer))
10366 {
10367 Lisp_Object timer = tip_timer;
10368 tip_timer = Qnil;
10369 call1 (Qcancel_timer, timer);
10370 }
10371
10372 BLOCK_INPUT;
10373 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
10374 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
10375 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10376 root_x, root_y);
10377 UNBLOCK_INPUT;
10378 goto start_timer;
10379 }
10380 }
10381
10382 /* Hide a previous tip, if any. */
10383 Fx_hide_tip ();
10384
10385 ASET (last_show_tip_args, 0, string);
10386 ASET (last_show_tip_args, 1, frame);
10387 ASET (last_show_tip_args, 2, parms);
10388
10389 /* Add default values to frame parameters. */
10390 if (NILP (Fassq (Qname, parms)))
10391 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
10392 if (NILP (Fassq (Qinternal_border_width, parms)))
10393 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
10394 if (NILP (Fassq (Qborder_width, parms)))
10395 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
10396 if (NILP (Fassq (Qborder_color, parms)))
10397 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
10398 if (NILP (Fassq (Qbackground_color, parms)))
10399 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
10400 parms);
10401
10402 /* Create a frame for the tooltip, and record it in the global
10403 variable tip_frame. */
10404 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
10405 f = XFRAME (frame);
10406
10407 /* Set up the frame's root window. */
10408 w = XWINDOW (FRAME_ROOT_WINDOW (f));
10409 w->left_col = w->top_line = make_number (0);
10410
10411 if (CONSP (Vx_max_tooltip_size)
10412 && INTEGERP (XCAR (Vx_max_tooltip_size))
10413 && XINT (XCAR (Vx_max_tooltip_size)) > 0
10414 && INTEGERP (XCDR (Vx_max_tooltip_size))
10415 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
10416 {
10417 w->total_cols = XCAR (Vx_max_tooltip_size);
10418 w->total_lines = XCDR (Vx_max_tooltip_size);
10419 }
10420 else
10421 {
10422 w->total_cols = make_number (80);
10423 w->total_lines = make_number (40);
10424 }
10425
10426 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
10427 adjust_glyphs (f);
10428 w->pseudo_window_p = 1;
10429
10430 /* Display the tooltip text in a temporary buffer. */
10431 old_buffer = current_buffer;
10432 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
10433 current_buffer->truncate_lines = Qnil;
10434 clear_glyph_matrix (w->desired_matrix);
10435 clear_glyph_matrix (w->current_matrix);
10436 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
10437 try_window (FRAME_ROOT_WINDOW (f), pos);
10438
10439 /* Compute width and height of the tooltip. */
10440 width = height = 0;
10441 for (i = 0; i < w->desired_matrix->nrows; ++i)
10442 {
10443 struct glyph_row *row = &w->desired_matrix->rows[i];
10444 struct glyph *last;
10445 int row_width;
10446
10447 /* Stop at the first empty row at the end. */
10448 if (!row->enabled_p || !row->displays_text_p)
10449 break;
10450
10451 /* Let the row go over the full width of the frame. */
10452 row->full_width_p = 1;
10453
10454 /* There's a glyph at the end of rows that is used to place
10455 the cursor there. Don't include the width of this glyph. */
10456 if (row->used[TEXT_AREA])
10457 {
10458 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
10459 row_width = row->pixel_width - last->pixel_width;
10460 }
10461 else
10462 row_width = row->pixel_width;
10463
10464 height += row->height;
10465 width = max (width, row_width);
10466 }
10467
10468 /* Add the frame's internal border to the width and height the X
10469 window should have. */
10470 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10471 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10472
10473 /* Move the tooltip window where the mouse pointer is. Resize and
10474 show it. */
10475 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
10476
10477 BLOCK_INPUT;
10478 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10479 root_x, root_y, width, height);
10480 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
10481 UNBLOCK_INPUT;
10482
10483 /* Draw into the window. */
10484 w->must_be_updated_p = 1;
10485 update_single_window (w, 1);
10486
10487 /* Restore original current buffer. */
10488 set_buffer_internal_1 (old_buffer);
10489 windows_or_buffers_changed = old_windows_or_buffers_changed;
10490
10491 start_timer:
10492 /* Let the tip disappear after timeout seconds. */
10493 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
10494 intern ("x-hide-tip"));
10495
10496 UNGCPRO;
10497 return unbind_to (count, Qnil);
10498 }
10499
10500
10501 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
10502 doc: /* Hide the current tooltip window, if there is any.
10503 Value is t if tooltip was open, nil otherwise. */)
10504 ()
10505 {
10506 int count;
10507 Lisp_Object deleted, frame, timer;
10508 struct gcpro gcpro1, gcpro2;
10509
10510 /* Return quickly if nothing to do. */
10511 if (NILP (tip_timer) && NILP (tip_frame))
10512 return Qnil;
10513
10514 frame = tip_frame;
10515 timer = tip_timer;
10516 GCPRO2 (frame, timer);
10517 tip_frame = tip_timer = deleted = Qnil;
10518
10519 count = SPECPDL_INDEX ();
10520 specbind (Qinhibit_redisplay, Qt);
10521 specbind (Qinhibit_quit, Qt);
10522
10523 if (!NILP (timer))
10524 call1 (Qcancel_timer, timer);
10525
10526 if (FRAMEP (frame))
10527 {
10528 Fdelete_frame (frame, Qnil);
10529 deleted = Qt;
10530
10531 #ifdef USE_LUCID
10532 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10533 redisplay procedure is not called when a tip frame over menu
10534 items is unmapped. Redisplay the menu manually... */
10535 {
10536 struct frame *f = SELECTED_FRAME ();
10537 Widget w = f->output_data.x->menubar_widget;
10538 extern void xlwmenu_redisplay P_ ((Widget));
10539
10540 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
10541 && w != NULL)
10542 {
10543 BLOCK_INPUT;
10544 xlwmenu_redisplay (w);
10545 UNBLOCK_INPUT;
10546 }
10547 }
10548 #endif /* USE_LUCID */
10549 }
10550
10551 UNGCPRO;
10552 return unbind_to (count, deleted);
10553 }
10554
10555
10556 \f
10557 /***********************************************************************
10558 File selection dialog
10559 ***********************************************************************/
10560
10561 #ifdef USE_MOTIF
10562
10563 /* Callback for "OK" and "Cancel" on file selection dialog. */
10564
10565 static void
10566 file_dialog_cb (widget, client_data, call_data)
10567 Widget widget;
10568 XtPointer call_data, client_data;
10569 {
10570 int *result = (int *) client_data;
10571 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
10572 *result = cb->reason;
10573 }
10574
10575
10576 /* Callback for unmapping a file selection dialog. This is used to
10577 capture the case where a dialog is closed via a window manager's
10578 closer button, for example. Using a XmNdestroyCallback didn't work
10579 in this case. */
10580
10581 static void
10582 file_dialog_unmap_cb (widget, client_data, call_data)
10583 Widget widget;
10584 XtPointer call_data, client_data;
10585 {
10586 int *result = (int *) client_data;
10587 *result = XmCR_CANCEL;
10588 }
10589
10590
10591 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10592 doc: /* Read file name, prompting with PROMPT in directory DIR.
10593 Use a file selection dialog.
10594 Select DEFAULT-FILENAME in the dialog's file selection box, if
10595 specified. Don't let the user enter a file name in the file
10596 selection dialog's entry field, if MUSTMATCH is non-nil. */)
10597 (prompt, dir, default_filename, mustmatch)
10598 Lisp_Object prompt, dir, default_filename, mustmatch;
10599 {
10600 int result;
10601 struct frame *f = SELECTED_FRAME ();
10602 Lisp_Object file = Qnil;
10603 Widget dialog, text, list, help;
10604 Arg al[10];
10605 int ac = 0;
10606 extern XtAppContext Xt_app_con;
10607 XmString dir_xmstring, pattern_xmstring;
10608 int count = SPECPDL_INDEX ();
10609 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10610
10611 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10612 CHECK_STRING (prompt);
10613 CHECK_STRING (dir);
10614
10615 /* Prevent redisplay. */
10616 specbind (Qinhibit_redisplay, Qt);
10617
10618 BLOCK_INPUT;
10619
10620 /* Create the dialog with PROMPT as title, using DIR as initial
10621 directory and using "*" as pattern. */
10622 dir = Fexpand_file_name (dir, Qnil);
10623 dir_xmstring = XmStringCreateLocalized (SDATA (dir));
10624 pattern_xmstring = XmStringCreateLocalized ("*");
10625
10626 XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
10627 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
10628 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
10629 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
10630 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
10631 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
10632 "fsb", al, ac);
10633 XmStringFree (dir_xmstring);
10634 XmStringFree (pattern_xmstring);
10635
10636 /* Add callbacks for OK and Cancel. */
10637 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
10638 (XtPointer) &result);
10639 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
10640 (XtPointer) &result);
10641 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
10642 (XtPointer) &result);
10643
10644 /* Disable the help button since we can't display help. */
10645 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
10646 XtSetSensitive (help, False);
10647
10648 /* Mark OK button as default. */
10649 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
10650 XmNshowAsDefault, True, NULL);
10651
10652 /* If MUSTMATCH is non-nil, disable the file entry field of the
10653 dialog, so that the user must select a file from the files list
10654 box. We can't remove it because we wouldn't have a way to get at
10655 the result file name, then. */
10656 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
10657 if (!NILP (mustmatch))
10658 {
10659 Widget label;
10660 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
10661 XtSetSensitive (text, False);
10662 XtSetSensitive (label, False);
10663 }
10664
10665 /* Manage the dialog, so that list boxes get filled. */
10666 XtManageChild (dialog);
10667
10668 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10669 must include the path for this to work. */
10670 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
10671 if (STRINGP (default_filename))
10672 {
10673 XmString default_xmstring;
10674 int item_pos;
10675
10676 default_xmstring
10677 = XmStringCreateLocalized (SDATA (default_filename));
10678
10679 if (!XmListItemExists (list, default_xmstring))
10680 {
10681 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10682 XmListAddItem (list, default_xmstring, 0);
10683 item_pos = 0;
10684 }
10685 else
10686 item_pos = XmListItemPos (list, default_xmstring);
10687 XmStringFree (default_xmstring);
10688
10689 /* Select the item and scroll it into view. */
10690 XmListSelectPos (list, item_pos, True);
10691 XmListSetPos (list, item_pos);
10692 }
10693
10694 /* Process events until the user presses Cancel or OK. */
10695 result = 0;
10696 while (result == 0)
10697 {
10698 XEvent event;
10699 XtAppNextEvent (Xt_app_con, &event);
10700 (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f) );
10701 }
10702
10703 /* Get the result. */
10704 if (result == XmCR_OK)
10705 {
10706 XmString text;
10707 String data;
10708
10709 XtVaGetValues (dialog, XmNtextString, &text, NULL);
10710 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
10711 XmStringFree (text);
10712 file = build_string (data);
10713 XtFree (data);
10714 }
10715 else
10716 file = Qnil;
10717
10718 /* Clean up. */
10719 XtUnmanageChild (dialog);
10720 XtDestroyWidget (dialog);
10721 UNBLOCK_INPUT;
10722 UNGCPRO;
10723
10724 /* Make "Cancel" equivalent to C-g. */
10725 if (NILP (file))
10726 Fsignal (Qquit, Qnil);
10727
10728 return unbind_to (count, file);
10729 }
10730
10731 #endif /* USE_MOTIF */
10732
10733 #ifdef USE_GTK
10734
10735 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10736 "Read file name, prompting with PROMPT in directory DIR.\n\
10737 Use a file selection dialog.\n\
10738 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10739 specified. Don't let the user enter a file name in the file\n\
10740 selection dialog's entry field, if MUSTMATCH is non-nil.")
10741 (prompt, dir, default_filename, mustmatch)
10742 Lisp_Object prompt, dir, default_filename, mustmatch;
10743 {
10744 FRAME_PTR f = SELECTED_FRAME ();
10745 char *fn;
10746 Lisp_Object file = Qnil;
10747 int count = specpdl_ptr - specpdl;
10748 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10749 char *cdef_file;
10750 char *cprompt;
10751
10752 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10753 CHECK_STRING (prompt);
10754 CHECK_STRING (dir);
10755
10756 /* Prevent redisplay. */
10757 specbind (Qinhibit_redisplay, Qt);
10758
10759 BLOCK_INPUT;
10760
10761 if (STRINGP (default_filename))
10762 cdef_file = SDATA (default_filename);
10763 else
10764 cdef_file = SDATA (dir);
10765
10766 fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch));
10767
10768 if (fn)
10769 {
10770 file = build_string (fn);
10771 xfree (fn);
10772 }
10773
10774 UNBLOCK_INPUT;
10775 UNGCPRO;
10776
10777 /* Make "Cancel" equivalent to C-g. */
10778 if (NILP (file))
10779 Fsignal (Qquit, Qnil);
10780
10781 return unbind_to (count, file);
10782 }
10783
10784 #endif /* USE_GTK */
10785
10786 \f
10787 /***********************************************************************
10788 Keyboard
10789 ***********************************************************************/
10790
10791 #ifdef HAVE_XKBGETKEYBOARD
10792 #include <X11/XKBlib.h>
10793 #include <X11/keysym.h>
10794 #endif
10795
10796 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
10797 Sx_backspace_delete_keys_p, 0, 1, 0,
10798 doc: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
10799 FRAME nil means use the selected frame.
10800 Value is t if we know that both keys are present, and are mapped to the
10801 usual X keysyms. */)
10802 (frame)
10803 Lisp_Object frame;
10804 {
10805 #ifdef HAVE_XKBGETKEYBOARD
10806 XkbDescPtr kb;
10807 struct frame *f = check_x_frame (frame);
10808 Display *dpy = FRAME_X_DISPLAY (f);
10809 Lisp_Object have_keys;
10810 int major, minor, op, event, error;
10811
10812 BLOCK_INPUT;
10813
10814 /* Check library version in case we're dynamically linked. */
10815 major = XkbMajorVersion;
10816 minor = XkbMinorVersion;
10817 if (!XkbLibraryVersion (&major, &minor))
10818 {
10819 UNBLOCK_INPUT;
10820 return Qnil;
10821 }
10822
10823 /* Check that the server supports XKB. */
10824 major = XkbMajorVersion;
10825 minor = XkbMinorVersion;
10826 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
10827 {
10828 UNBLOCK_INPUT;
10829 return Qnil;
10830 }
10831
10832 have_keys = Qnil;
10833 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
10834 if (kb)
10835 {
10836 int delete_keycode = 0, backspace_keycode = 0, i;
10837
10838 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
10839 {
10840 for (i = kb->min_key_code;
10841 (i < kb->max_key_code
10842 && (delete_keycode == 0 || backspace_keycode == 0));
10843 ++i)
10844 {
10845 /* The XKB symbolic key names can be seen most easily in
10846 the PS file generated by `xkbprint -label name
10847 $DISPLAY'. */
10848 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
10849 delete_keycode = i;
10850 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
10851 backspace_keycode = i;
10852 }
10853
10854 XkbFreeNames (kb, 0, True);
10855 }
10856
10857 XkbFreeClientMap (kb, 0, True);
10858
10859 if (delete_keycode
10860 && backspace_keycode
10861 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
10862 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
10863 have_keys = Qt;
10864 }
10865 UNBLOCK_INPUT;
10866 return have_keys;
10867 #else /* not HAVE_XKBGETKEYBOARD */
10868 return Qnil;
10869 #endif /* not HAVE_XKBGETKEYBOARD */
10870 }
10871
10872
10873 \f
10874 /***********************************************************************
10875 Initialization
10876 ***********************************************************************/
10877
10878 /* Keep this list in the same order as frame_parms in frame.c.
10879 Use 0 for unsupported frame parameters. */
10880
10881 frame_parm_handler x_frame_parm_handlers[] =
10882 {
10883 x_set_autoraise,
10884 x_set_autolower,
10885 x_set_background_color,
10886 x_set_border_color,
10887 x_set_border_width,
10888 x_set_cursor_color,
10889 x_set_cursor_type,
10890 x_set_font,
10891 x_set_foreground_color,
10892 x_set_icon_name,
10893 x_set_icon_type,
10894 x_set_internal_border_width,
10895 x_set_menu_bar_lines,
10896 x_set_mouse_color,
10897 x_explicitly_set_name,
10898 x_set_scroll_bar_width,
10899 x_set_title,
10900 x_set_unsplittable,
10901 x_set_vertical_scroll_bars,
10902 x_set_visibility,
10903 x_set_tool_bar_lines,
10904 x_set_scroll_bar_foreground,
10905 x_set_scroll_bar_background,
10906 x_set_screen_gamma,
10907 x_set_line_spacing,
10908 x_set_fringe_width,
10909 x_set_fringe_width,
10910 x_set_wait_for_wm,
10911 x_set_fullscreen,
10912 };
10913
10914 void
10915 syms_of_xfns ()
10916 {
10917 /* This is zero if not using X windows. */
10918 x_in_use = 0;
10919
10920 /* The section below is built by the lisp expression at the top of the file,
10921 just above where these variables are declared. */
10922 /*&&& init symbols here &&&*/
10923 Qnone = intern ("none");
10924 staticpro (&Qnone);
10925 Qsuppress_icon = intern ("suppress-icon");
10926 staticpro (&Qsuppress_icon);
10927 Qundefined_color = intern ("undefined-color");
10928 staticpro (&Qundefined_color);
10929 Qcenter = intern ("center");
10930 staticpro (&Qcenter);
10931 Qcompound_text = intern ("compound-text");
10932 staticpro (&Qcompound_text);
10933 Qcancel_timer = intern ("cancel-timer");
10934 staticpro (&Qcancel_timer);
10935 /* This is the end of symbol initialization. */
10936
10937 /* Text property `display' should be nonsticky by default. */
10938 Vtext_property_default_nonsticky
10939 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
10940
10941
10942 Qlaplace = intern ("laplace");
10943 staticpro (&Qlaplace);
10944 Qemboss = intern ("emboss");
10945 staticpro (&Qemboss);
10946 Qedge_detection = intern ("edge-detection");
10947 staticpro (&Qedge_detection);
10948 Qheuristic = intern ("heuristic");
10949 staticpro (&Qheuristic);
10950 QCmatrix = intern (":matrix");
10951 staticpro (&QCmatrix);
10952 QCcolor_adjustment = intern (":color-adjustment");
10953 staticpro (&QCcolor_adjustment);
10954 QCmask = intern (":mask");
10955 staticpro (&QCmask);
10956
10957 Fput (Qundefined_color, Qerror_conditions,
10958 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
10959 Fput (Qundefined_color, Qerror_message,
10960 build_string ("Undefined color"));
10961
10962 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
10963 doc: /* Non-nil means always draw a cross over disabled images.
10964 Disabled images are those having an `:conversion disabled' property.
10965 A cross is always drawn on black & white displays. */);
10966 cross_disabled_images = 0;
10967
10968 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
10969 doc: /* List of directories to search for window system bitmap files. */);
10970 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
10971
10972 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
10973 doc: /* The shape of the pointer when over text.
10974 Changing the value does not affect existing frames
10975 unless you set the mouse color. */);
10976 Vx_pointer_shape = Qnil;
10977
10978 #if 0 /* This doesn't really do anything. */
10979 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
10980 doc: /* The shape of the pointer when not over text.
10981 This variable takes effect when you create a new frame
10982 or when you set the mouse color. */);
10983 #endif
10984 Vx_nontext_pointer_shape = Qnil;
10985
10986 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
10987 doc: /* The shape of the pointer when Emacs is busy.
10988 This variable takes effect when you create a new frame
10989 or when you set the mouse color. */);
10990 Vx_hourglass_pointer_shape = Qnil;
10991
10992 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
10993 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
10994 display_hourglass_p = 1;
10995
10996 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
10997 doc: /* *Seconds to wait before displaying an hourglass pointer.
10998 Value must be an integer or float. */);
10999 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
11000
11001 #if 0 /* This doesn't really do anything. */
11002 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
11003 doc: /* The shape of the pointer when over the mode line.
11004 This variable takes effect when you create a new frame
11005 or when you set the mouse color. */);
11006 #endif
11007 Vx_mode_pointer_shape = Qnil;
11008
11009 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11010 &Vx_sensitive_text_pointer_shape,
11011 doc: /* The shape of the pointer when over mouse-sensitive text.
11012 This variable takes effect when you create a new frame
11013 or when you set the mouse color. */);
11014 Vx_sensitive_text_pointer_shape = Qnil;
11015
11016 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11017 &Vx_window_horizontal_drag_shape,
11018 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
11019 This variable takes effect when you create a new frame
11020 or when you set the mouse color. */);
11021 Vx_window_horizontal_drag_shape = Qnil;
11022
11023 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
11024 doc: /* A string indicating the foreground color of the cursor box. */);
11025 Vx_cursor_fore_pixel = Qnil;
11026
11027 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
11028 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
11029 Text larger than this is clipped. */);
11030 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
11031
11032 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
11033 doc: /* Non-nil if no X window manager is in use.
11034 Emacs doesn't try to figure this out; this is always nil
11035 unless you set it to something else. */);
11036 /* We don't have any way to find this out, so set it to nil
11037 and maybe the user would like to set it to t. */
11038 Vx_no_window_manager = Qnil;
11039
11040 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11041 &Vx_pixel_size_width_font_regexp,
11042 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
11043
11044 Since Emacs gets width of a font matching with this regexp from
11045 PIXEL_SIZE field of the name, font finding mechanism gets faster for
11046 such a font. This is especially effective for such large fonts as
11047 Chinese, Japanese, and Korean. */);
11048 Vx_pixel_size_width_font_regexp = Qnil;
11049
11050 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
11051 doc: /* Time after which cached images are removed from the cache.
11052 When an image has not been displayed this many seconds, remove it
11053 from the image cache. Value must be an integer or nil with nil
11054 meaning don't clear the cache. */);
11055 Vimage_cache_eviction_delay = make_number (30 * 60);
11056
11057 #ifdef USE_X_TOOLKIT
11058 Fprovide (intern ("x-toolkit"), Qnil);
11059 #ifdef USE_MOTIF
11060 Fprovide (intern ("motif"), Qnil);
11061
11062 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
11063 doc: /* Version info for LessTif/Motif. */);
11064 Vmotif_version_string = build_string (XmVERSION_STRING);
11065 #endif /* USE_MOTIF */
11066 #endif /* USE_X_TOOLKIT */
11067
11068 #ifdef USE_GTK
11069 Fprovide (intern ("gtk"), Qnil);
11070
11071 DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string,
11072 doc: /* Version info for GTK+. */);
11073 {
11074 char gtk_version[40];
11075 g_snprintf (gtk_version, sizeof (gtk_version), "%u.%u.%u",
11076 GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
11077 Vgtk_version_string = build_string (gtk_version);
11078 }
11079 #endif /* USE_GTK */
11080
11081 /* X window properties. */
11082 defsubr (&Sx_change_window_property);
11083 defsubr (&Sx_delete_window_property);
11084 defsubr (&Sx_window_property);
11085
11086 defsubr (&Sxw_display_color_p);
11087 defsubr (&Sx_display_grayscale_p);
11088 defsubr (&Sxw_color_defined_p);
11089 defsubr (&Sxw_color_values);
11090 defsubr (&Sx_server_max_request_size);
11091 defsubr (&Sx_server_vendor);
11092 defsubr (&Sx_server_version);
11093 defsubr (&Sx_display_pixel_width);
11094 defsubr (&Sx_display_pixel_height);
11095 defsubr (&Sx_display_mm_width);
11096 defsubr (&Sx_display_mm_height);
11097 defsubr (&Sx_display_screens);
11098 defsubr (&Sx_display_planes);
11099 defsubr (&Sx_display_color_cells);
11100 defsubr (&Sx_display_visual_class);
11101 defsubr (&Sx_display_backing_store);
11102 defsubr (&Sx_display_save_under);
11103 defsubr (&Sx_create_frame);
11104 defsubr (&Sx_open_connection);
11105 defsubr (&Sx_close_connection);
11106 defsubr (&Sx_display_list);
11107 defsubr (&Sx_synchronize);
11108 defsubr (&Sx_send_client_message);
11109 defsubr (&Sx_focus_frame);
11110 defsubr (&Sx_backspace_delete_keys_p);
11111
11112 /* Setting callback functions for fontset handler. */
11113 get_font_info_func = x_get_font_info;
11114
11115 #if 0 /* This function pointer doesn't seem to be used anywhere.
11116 And the pointer assigned has the wrong type, anyway. */
11117 list_fonts_func = x_list_fonts;
11118 #endif
11119
11120 load_font_func = x_load_font;
11121 find_ccl_program_func = x_find_ccl_program;
11122 query_font_func = x_query_font;
11123 set_frame_fontset_func = x_set_font;
11124 check_window_system_func = check_x;
11125
11126 /* Images. */
11127 Qxbm = intern ("xbm");
11128 staticpro (&Qxbm);
11129 QCconversion = intern (":conversion");
11130 staticpro (&QCconversion);
11131 QCheuristic_mask = intern (":heuristic-mask");
11132 staticpro (&QCheuristic_mask);
11133 QCcolor_symbols = intern (":color-symbols");
11134 staticpro (&QCcolor_symbols);
11135 QCascent = intern (":ascent");
11136 staticpro (&QCascent);
11137 QCmargin = intern (":margin");
11138 staticpro (&QCmargin);
11139 QCrelief = intern (":relief");
11140 staticpro (&QCrelief);
11141 Qpostscript = intern ("postscript");
11142 staticpro (&Qpostscript);
11143 QCloader = intern (":loader");
11144 staticpro (&QCloader);
11145 QCbounding_box = intern (":bounding-box");
11146 staticpro (&QCbounding_box);
11147 QCpt_width = intern (":pt-width");
11148 staticpro (&QCpt_width);
11149 QCpt_height = intern (":pt-height");
11150 staticpro (&QCpt_height);
11151 QCindex = intern (":index");
11152 staticpro (&QCindex);
11153 Qpbm = intern ("pbm");
11154 staticpro (&Qpbm);
11155
11156 #if HAVE_XPM
11157 Qxpm = intern ("xpm");
11158 staticpro (&Qxpm);
11159 #endif
11160
11161 #if HAVE_JPEG
11162 Qjpeg = intern ("jpeg");
11163 staticpro (&Qjpeg);
11164 #endif
11165
11166 #if HAVE_TIFF
11167 Qtiff = intern ("tiff");
11168 staticpro (&Qtiff);
11169 #endif
11170
11171 #if HAVE_GIF
11172 Qgif = intern ("gif");
11173 staticpro (&Qgif);
11174 #endif
11175
11176 #if HAVE_PNG
11177 Qpng = intern ("png");
11178 staticpro (&Qpng);
11179 #endif
11180
11181 defsubr (&Sclear_image_cache);
11182 defsubr (&Simage_size);
11183 defsubr (&Simage_mask_p);
11184
11185 hourglass_atimer = NULL;
11186 hourglass_shown_p = 0;
11187
11188 defsubr (&Sx_show_tip);
11189 defsubr (&Sx_hide_tip);
11190 tip_timer = Qnil;
11191 staticpro (&tip_timer);
11192 tip_frame = Qnil;
11193 staticpro (&tip_frame);
11194
11195 last_show_tip_args = Qnil;
11196 staticpro (&last_show_tip_args);
11197
11198 #ifdef USE_MOTIF
11199 defsubr (&Sx_file_dialog);
11200 #endif
11201 }
11202
11203
11204 void
11205 init_xfns ()
11206 {
11207 image_types = NULL;
11208 Vimage_types = Qnil;
11209
11210 define_image_type (&xbm_type);
11211 define_image_type (&gs_type);
11212 define_image_type (&pbm_type);
11213
11214 #if HAVE_XPM
11215 define_image_type (&xpm_type);
11216 #endif
11217
11218 #if HAVE_JPEG
11219 define_image_type (&jpeg_type);
11220 #endif
11221
11222 #if HAVE_TIFF
11223 define_image_type (&tiff_type);
11224 #endif
11225
11226 #if HAVE_GIF
11227 define_image_type (&gif_type);
11228 #endif
11229
11230 #if HAVE_PNG
11231 define_image_type (&png_type);
11232 #endif
11233 }
11234
11235 #endif /* HAVE_X_WINDOWS */
11236
11237 /* arch-tag: 55040d02-5485-4d58-8b22-95a7a05f3288
11238 (do not change this comment) */