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