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