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