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