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