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