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