20.6, 20.7 changes
[emacs.git] / src / xfns.c
blob0e20a7d386399a900877a578137668c6afbd9ad0
1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999
3 Free Software Foundation.
5 This file is part of GNU Emacs.
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.
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.
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. */
22 #include <config.h>
23 #include <signal.h>
24 #include <stdio.h>
25 #include <math.h>
27 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
31 #include "lisp.h"
32 #include "xterm.h"
33 #include "frame.h"
34 #include "window.h"
35 #include "buffer.h"
36 #include "intervals.h"
37 #include "dispextern.h"
38 #include "keyboard.h"
39 #include "blockinput.h"
40 #include <epaths.h>
41 #include "charset.h"
42 #include "fontset.h"
43 #include "systime.h"
44 #include "termhooks.h"
45 #include "atimer.h"
47 #ifdef HAVE_X_WINDOWS
49 #include <ctype.h>
50 #include <sys/types.h>
51 #include <sys/stat.h>
53 #ifndef VMS
54 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
55 #include "bitmaps/gray.xbm"
56 #else
57 #include <X11/bitmaps/gray>
58 #endif
59 #else
60 #include "[.bitmaps]gray.xbm"
61 #endif
63 #ifdef USE_X_TOOLKIT
64 #include <X11/Shell.h>
66 #ifndef USE_MOTIF
67 #include <X11/Xaw/Paned.h>
68 #include <X11/Xaw/Label.h>
69 #endif /* USE_MOTIF */
71 #ifdef USG
72 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
73 #include <X11/Xos.h>
74 #define USG
75 #else
76 #include <X11/Xos.h>
77 #endif
79 #include "widget.h"
81 #include "../lwlib/lwlib.h"
83 #ifdef USE_MOTIF
84 #include <Xm/Xm.h>
85 #include <Xm/DialogS.h>
86 #include <Xm/FileSB.h>
87 #endif
89 /* Do the EDITRES protocol if running X11R5
90 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
92 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
93 #define HACK_EDITRES
94 extern void _XEditResCheckMessages ();
95 #endif /* R5 + Athena */
97 /* Unique id counter for widgets created by the Lucid Widget Library. */
99 extern LWLIB_ID widget_id_tick;
101 #ifdef USE_LUCID
102 /* This is part of a kludge--see lwlib/xlwmenu.c. */
103 extern XFontStruct *xlwmenu_default_font;
104 #endif
106 extern void free_frame_menubar ();
107 extern double atof ();
109 #endif /* USE_X_TOOLKIT */
111 #define min(a,b) ((a) < (b) ? (a) : (b))
112 #define max(a,b) ((a) > (b) ? (a) : (b))
114 #ifdef HAVE_X11R4
115 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
116 #else
117 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
118 #endif
120 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
121 it, and including `bitmaps/gray' more than once is a problem when
122 config.h defines `static' as an empty replacement string. */
124 int gray_bitmap_width = gray_width;
125 int gray_bitmap_height = gray_height;
126 unsigned char *gray_bitmap_bits = gray_bits;
128 /* The name we're using in resource queries. Most often "emacs". */
130 Lisp_Object Vx_resource_name;
132 /* The application class we're using in resource queries.
133 Normally "Emacs". */
135 Lisp_Object Vx_resource_class;
137 /* Non-zero means we're allowed to display a busy cursor. */
139 int display_busy_cursor_p;
141 /* The background and shape of the mouse pointer, and shape when not
142 over text or in the modeline. */
144 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
145 Lisp_Object Vx_busy_pointer_shape;
147 /* The shape when over mouse-sensitive text. */
149 Lisp_Object Vx_sensitive_text_pointer_shape;
151 /* Color of chars displayed in cursor box. */
153 Lisp_Object Vx_cursor_fore_pixel;
155 /* Nonzero if using X. */
157 static int x_in_use;
159 /* Non nil if no window manager is in use. */
161 Lisp_Object Vx_no_window_manager;
163 /* Search path for bitmap files. */
165 Lisp_Object Vx_bitmap_file_path;
167 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
169 Lisp_Object Vx_pixel_size_width_font_regexp;
171 /* Evaluate this expression to rebuild the section of syms_of_xfns
172 that initializes and staticpros the symbols declared below. Note
173 that Emacs 18 has a bug that keeps C-x C-e from being able to
174 evaluate this expression.
176 (progn
177 ;; Accumulate a list of the symbols we want to initialize from the
178 ;; declarations at the top of the file.
179 (goto-char (point-min))
180 (search-forward "/\*&&& symbols declared here &&&*\/\n")
181 (let (symbol-list)
182 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
183 (setq symbol-list
184 (cons (buffer-substring (match-beginning 1) (match-end 1))
185 symbol-list))
186 (forward-line 1))
187 (setq symbol-list (nreverse symbol-list))
188 ;; Delete the section of syms_of_... where we initialize the symbols.
189 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
190 (let ((start (point)))
191 (while (looking-at "^ Q")
192 (forward-line 2))
193 (kill-region start (point)))
194 ;; Write a new symbol initialization section.
195 (while symbol-list
196 (insert (format " %s = intern (\"" (car symbol-list)))
197 (let ((start (point)))
198 (insert (substring (car symbol-list) 1))
199 (subst-char-in-region start (point) ?_ ?-))
200 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
201 (setq symbol-list (cdr symbol-list)))))
205 /*&&& symbols declared here &&&*/
206 Lisp_Object Qauto_raise;
207 Lisp_Object Qauto_lower;
208 Lisp_Object Qbar;
209 Lisp_Object Qborder_color;
210 Lisp_Object Qborder_width;
211 Lisp_Object Qbox;
212 Lisp_Object Qcursor_color;
213 Lisp_Object Qcursor_type;
214 Lisp_Object Qgeometry;
215 Lisp_Object Qicon_left;
216 Lisp_Object Qicon_top;
217 Lisp_Object Qicon_type;
218 Lisp_Object Qicon_name;
219 Lisp_Object Qinternal_border_width;
220 Lisp_Object Qleft;
221 Lisp_Object Qright;
222 Lisp_Object Qmouse_color;
223 Lisp_Object Qnone;
224 Lisp_Object Qouter_window_id;
225 Lisp_Object Qparent_id;
226 Lisp_Object Qscroll_bar_width;
227 Lisp_Object Qsuppress_icon;
228 extern Lisp_Object Qtop;
229 Lisp_Object Qundefined_color;
230 Lisp_Object Qvertical_scroll_bars;
231 Lisp_Object Qvisibility;
232 Lisp_Object Qwindow_id;
233 Lisp_Object Qx_frame_parameter;
234 Lisp_Object Qx_resource_name;
235 Lisp_Object Quser_position;
236 Lisp_Object Quser_size;
237 extern Lisp_Object Qdisplay;
238 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
239 Lisp_Object Qscreen_gamma, Qline_spacing, Qcenter;
241 /* The below are defined in frame.c. */
243 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
244 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
245 extern Lisp_Object Qtool_bar_lines;
247 extern Lisp_Object Vwindow_system_version;
249 Lisp_Object Qface_set_after_frame_default;
252 /* Error if we are not connected to X. */
254 void
255 check_x ()
257 if (! x_in_use)
258 error ("X windows are not in use or not initialized");
261 /* Nonzero if we can use mouse menus.
262 You should not call this unless HAVE_MENUS is defined. */
265 have_menus_p ()
267 return x_in_use;
270 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
271 and checking validity for X. */
273 FRAME_PTR
274 check_x_frame (frame)
275 Lisp_Object frame;
277 FRAME_PTR f;
279 if (NILP (frame))
280 frame = selected_frame;
281 CHECK_LIVE_FRAME (frame, 0);
282 f = XFRAME (frame);
283 if (! FRAME_X_P (f))
284 error ("Non-X frame used");
285 return f;
288 /* Let the user specify an X display with a frame.
289 nil stands for the selected frame--or, if that is not an X frame,
290 the first X display on the list. */
292 static struct x_display_info *
293 check_x_display_info (frame)
294 Lisp_Object frame;
296 if (NILP (frame))
298 struct frame *sf = XFRAME (selected_frame);
300 if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
301 return FRAME_X_DISPLAY_INFO (sf);
302 else if (x_display_list != 0)
303 return x_display_list;
304 else
305 error ("X windows are not in use or not initialized");
307 else if (STRINGP (frame))
308 return x_display_info_for_name (frame);
309 else
311 FRAME_PTR f;
313 CHECK_LIVE_FRAME (frame, 0);
314 f = XFRAME (frame);
315 if (! FRAME_X_P (f))
316 error ("Non-X frame used");
317 return FRAME_X_DISPLAY_INFO (f);
322 /* Return the Emacs frame-object corresponding to an X window.
323 It could be the frame's main window or an icon window. */
325 /* This function can be called during GC, so use GC_xxx type test macros. */
327 struct frame *
328 x_window_to_frame (dpyinfo, wdesc)
329 struct x_display_info *dpyinfo;
330 int wdesc;
332 Lisp_Object tail, frame;
333 struct frame *f;
335 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
337 frame = XCAR (tail);
338 if (!GC_FRAMEP (frame))
339 continue;
340 f = XFRAME (frame);
341 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
342 continue;
343 if (f->output_data.x->busy_window == wdesc)
344 return f;
345 #ifdef USE_X_TOOLKIT
346 if ((f->output_data.x->edit_widget
347 && XtWindow (f->output_data.x->edit_widget) == wdesc)
348 /* A tooltip frame? */
349 || (!f->output_data.x->edit_widget
350 && FRAME_X_WINDOW (f) == wdesc)
351 || f->output_data.x->icon_desc == wdesc)
352 return f;
353 #else /* not USE_X_TOOLKIT */
354 if (FRAME_X_WINDOW (f) == wdesc
355 || f->output_data.x->icon_desc == wdesc)
356 return f;
357 #endif /* not USE_X_TOOLKIT */
359 return 0;
362 #ifdef USE_X_TOOLKIT
363 /* Like x_window_to_frame but also compares the window with the widget's
364 windows. */
366 struct frame *
367 x_any_window_to_frame (dpyinfo, wdesc)
368 struct x_display_info *dpyinfo;
369 int wdesc;
371 Lisp_Object tail, frame;
372 struct frame *f, *found;
373 struct x_output *x;
375 found = NULL;
376 for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
378 frame = XCAR (tail);
379 if (!GC_FRAMEP (frame))
380 continue;
382 f = XFRAME (frame);
383 if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
385 /* This frame matches if the window is any of its widgets. */
386 x = f->output_data.x;
387 if (x->busy_window == wdesc)
388 found = f;
389 else if (x->widget)
391 if (wdesc == XtWindow (x->widget)
392 || wdesc == XtWindow (x->column_widget)
393 || wdesc == XtWindow (x->edit_widget))
394 found = f;
395 /* Match if the window is this frame's menubar. */
396 else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
397 found = f;
399 else if (FRAME_X_WINDOW (f) == wdesc)
400 /* A tooltip frame. */
401 found = f;
405 return found;
408 /* Likewise, but exclude the menu bar widget. */
410 struct frame *
411 x_non_menubar_window_to_frame (dpyinfo, wdesc)
412 struct x_display_info *dpyinfo;
413 int wdesc;
415 Lisp_Object tail, frame;
416 struct frame *f;
417 struct x_output *x;
419 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
421 frame = XCAR (tail);
422 if (!GC_FRAMEP (frame))
423 continue;
424 f = XFRAME (frame);
425 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
426 continue;
427 x = f->output_data.x;
428 /* This frame matches if the window is any of its widgets. */
429 if (x->busy_window == wdesc)
430 return f;
431 else if (x->widget)
433 if (wdesc == XtWindow (x->widget)
434 || wdesc == XtWindow (x->column_widget)
435 || wdesc == XtWindow (x->edit_widget))
436 return f;
438 else if (FRAME_X_WINDOW (f) == wdesc)
439 /* A tooltip frame. */
440 return f;
442 return 0;
445 /* Likewise, but consider only the menu bar widget. */
447 struct frame *
448 x_menubar_window_to_frame (dpyinfo, wdesc)
449 struct x_display_info *dpyinfo;
450 int wdesc;
452 Lisp_Object tail, frame;
453 struct frame *f;
454 struct x_output *x;
456 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
458 frame = XCAR (tail);
459 if (!GC_FRAMEP (frame))
460 continue;
461 f = XFRAME (frame);
462 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
463 continue;
464 x = f->output_data.x;
465 /* Match if the window is this frame's menubar. */
466 if (x->menubar_widget
467 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
468 return f;
470 return 0;
473 /* Return the frame whose principal (outermost) window is WDESC.
474 If WDESC is some other (smaller) window, we return 0. */
476 struct frame *
477 x_top_window_to_frame (dpyinfo, wdesc)
478 struct x_display_info *dpyinfo;
479 int wdesc;
481 Lisp_Object tail, frame;
482 struct frame *f;
483 struct x_output *x;
485 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
487 frame = XCAR (tail);
488 if (!GC_FRAMEP (frame))
489 continue;
490 f = XFRAME (frame);
491 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
492 continue;
493 x = f->output_data.x;
495 if (x->widget)
497 /* This frame matches if the window is its topmost widget. */
498 if (wdesc == XtWindow (x->widget))
499 return f;
500 #if 0 /* I don't know why it did this,
501 but it seems logically wrong,
502 and it causes trouble for MapNotify events. */
503 /* Match if the window is this frame's menubar. */
504 if (x->menubar_widget
505 && wdesc == XtWindow (x->menubar_widget))
506 return f;
507 #endif
509 else if (FRAME_X_WINDOW (f) == wdesc)
510 /* Tooltip frame. */
511 return f;
513 return 0;
515 #endif /* USE_X_TOOLKIT */
519 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
520 id, which is just an int that this section returns. Bitmaps are
521 reference counted so they can be shared among frames.
523 Bitmap indices are guaranteed to be > 0, so a negative number can
524 be used to indicate no bitmap.
526 If you use x_create_bitmap_from_data, then you must keep track of
527 the bitmaps yourself. That is, creating a bitmap from the same
528 data more than once will not be caught. */
531 /* Functions to access the contents of a bitmap, given an id. */
534 x_bitmap_height (f, id)
535 FRAME_PTR f;
536 int id;
538 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
542 x_bitmap_width (f, id)
543 FRAME_PTR f;
544 int id;
546 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
550 x_bitmap_pixmap (f, id)
551 FRAME_PTR f;
552 int id;
554 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
558 /* Allocate a new bitmap record. Returns index of new record. */
560 static int
561 x_allocate_bitmap_record (f)
562 FRAME_PTR f;
564 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
565 int i;
567 if (dpyinfo->bitmaps == NULL)
569 dpyinfo->bitmaps_size = 10;
570 dpyinfo->bitmaps
571 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
572 dpyinfo->bitmaps_last = 1;
573 return 1;
576 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
577 return ++dpyinfo->bitmaps_last;
579 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
580 if (dpyinfo->bitmaps[i].refcount == 0)
581 return i + 1;
583 dpyinfo->bitmaps_size *= 2;
584 dpyinfo->bitmaps
585 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
586 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
587 return ++dpyinfo->bitmaps_last;
590 /* Add one reference to the reference count of the bitmap with id ID. */
592 void
593 x_reference_bitmap (f, id)
594 FRAME_PTR f;
595 int id;
597 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
600 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
603 x_create_bitmap_from_data (f, bits, width, height)
604 struct frame *f;
605 char *bits;
606 unsigned int width, height;
608 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
609 Pixmap bitmap;
610 int id;
612 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
613 bits, width, height);
615 if (! bitmap)
616 return -1;
618 id = x_allocate_bitmap_record (f);
619 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
620 dpyinfo->bitmaps[id - 1].file = NULL;
621 dpyinfo->bitmaps[id - 1].refcount = 1;
622 dpyinfo->bitmaps[id - 1].depth = 1;
623 dpyinfo->bitmaps[id - 1].height = height;
624 dpyinfo->bitmaps[id - 1].width = width;
626 return id;
629 /* Create bitmap from file FILE for frame F. */
632 x_create_bitmap_from_file (f, file)
633 struct frame *f;
634 Lisp_Object file;
636 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
637 unsigned int width, height;
638 Pixmap bitmap;
639 int xhot, yhot, result, id;
640 Lisp_Object found;
641 int fd;
642 char *filename;
644 /* Look for an existing bitmap with the same name. */
645 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
647 if (dpyinfo->bitmaps[id].refcount
648 && dpyinfo->bitmaps[id].file
649 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
651 ++dpyinfo->bitmaps[id].refcount;
652 return id + 1;
656 /* Search bitmap-file-path for the file, if appropriate. */
657 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
658 if (fd < 0)
659 return -1;
660 /* XReadBitmapFile won't handle magic file names. */
661 if (fd == 0)
662 return -1;
663 emacs_close (fd);
665 filename = (char *) XSTRING (found)->data;
667 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
668 filename, &width, &height, &bitmap, &xhot, &yhot);
669 if (result != BitmapSuccess)
670 return -1;
672 id = x_allocate_bitmap_record (f);
673 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
674 dpyinfo->bitmaps[id - 1].refcount = 1;
675 dpyinfo->bitmaps[id - 1].file
676 = (char *) xmalloc (STRING_BYTES (XSTRING (file)) + 1);
677 dpyinfo->bitmaps[id - 1].depth = 1;
678 dpyinfo->bitmaps[id - 1].height = height;
679 dpyinfo->bitmaps[id - 1].width = width;
680 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
682 return id;
685 /* Remove reference to bitmap with id number ID. */
687 void
688 x_destroy_bitmap (f, id)
689 FRAME_PTR f;
690 int id;
692 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
694 if (id > 0)
696 --dpyinfo->bitmaps[id - 1].refcount;
697 if (dpyinfo->bitmaps[id - 1].refcount == 0)
699 BLOCK_INPUT;
700 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
701 if (dpyinfo->bitmaps[id - 1].file)
703 xfree (dpyinfo->bitmaps[id - 1].file);
704 dpyinfo->bitmaps[id - 1].file = NULL;
706 UNBLOCK_INPUT;
711 /* Free all the bitmaps for the display specified by DPYINFO. */
713 static void
714 x_destroy_all_bitmaps (dpyinfo)
715 struct x_display_info *dpyinfo;
717 int i;
718 for (i = 0; i < dpyinfo->bitmaps_last; i++)
719 if (dpyinfo->bitmaps[i].refcount > 0)
721 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
722 if (dpyinfo->bitmaps[i].file)
723 xfree (dpyinfo->bitmaps[i].file);
725 dpyinfo->bitmaps_last = 0;
728 /* Connect the frame-parameter names for X frames
729 to the ways of passing the parameter values to the window system.
731 The name of a parameter, as a Lisp symbol,
732 has an `x-frame-parameter' property which is an integer in Lisp
733 that is an index in this table. */
735 struct x_frame_parm_table
737 char *name;
738 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
741 static void x_create_im P_ ((struct frame *));
742 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
743 static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
744 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
745 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
746 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
747 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
748 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
749 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
750 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
751 void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
752 void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
753 void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
754 Lisp_Object));
755 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
756 void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
757 void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
758 void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
759 Lisp_Object));
760 void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
761 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
762 void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
763 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
764 void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
765 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
766 void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
767 Lisp_Object));
768 void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
769 Lisp_Object));
770 static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
771 Lisp_Object,
772 Lisp_Object,
773 char *, char *,
774 int));
775 static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
777 static struct x_frame_parm_table x_frame_parms[] =
779 "auto-raise", x_set_autoraise,
780 "auto-lower", x_set_autolower,
781 "background-color", x_set_background_color,
782 "border-color", x_set_border_color,
783 "border-width", x_set_border_width,
784 "cursor-color", x_set_cursor_color,
785 "cursor-type", x_set_cursor_type,
786 "font", x_set_font,
787 "foreground-color", x_set_foreground_color,
788 "icon-name", x_set_icon_name,
789 "icon-type", x_set_icon_type,
790 "internal-border-width", x_set_internal_border_width,
791 "menu-bar-lines", x_set_menu_bar_lines,
792 "mouse-color", x_set_mouse_color,
793 "name", x_explicitly_set_name,
794 "scroll-bar-width", x_set_scroll_bar_width,
795 "title", x_set_title,
796 "unsplittable", x_set_unsplittable,
797 "vertical-scroll-bars", x_set_vertical_scroll_bars,
798 "visibility", x_set_visibility,
799 "tool-bar-lines", x_set_tool_bar_lines,
800 "scroll-bar-foreground", x_set_scroll_bar_foreground,
801 "scroll-bar-background", x_set_scroll_bar_background,
802 "screen-gamma", x_set_screen_gamma,
803 "line-spacing", x_set_line_spacing
806 /* Attach the `x-frame-parameter' properties to
807 the Lisp symbol names of parameters relevant to X. */
809 void
810 init_x_parm_symbols ()
812 int i;
814 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
815 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
816 make_number (i));
819 /* Change the parameters of frame F as specified by ALIST.
820 If a parameter is not specially recognized, do nothing;
821 otherwise call the `x_set_...' function for that parameter. */
823 void
824 x_set_frame_parameters (f, alist)
825 FRAME_PTR f;
826 Lisp_Object alist;
828 Lisp_Object tail;
830 /* If both of these parameters are present, it's more efficient to
831 set them both at once. So we wait until we've looked at the
832 entire list before we set them. */
833 int width, height;
835 /* Same here. */
836 Lisp_Object left, top;
838 /* Same with these. */
839 Lisp_Object icon_left, icon_top;
841 /* Record in these vectors all the parms specified. */
842 Lisp_Object *parms;
843 Lisp_Object *values;
844 int i, p;
845 int left_no_change = 0, top_no_change = 0;
846 int icon_left_no_change = 0, icon_top_no_change = 0;
848 struct gcpro gcpro1, gcpro2;
850 i = 0;
851 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
852 i++;
854 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
855 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
857 /* Extract parm names and values into those vectors. */
859 i = 0;
860 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
862 Lisp_Object elt;
864 elt = Fcar (tail);
865 parms[i] = Fcar (elt);
866 values[i] = Fcdr (elt);
867 i++;
869 /* TAIL and ALIST are not used again below here. */
870 alist = tail = Qnil;
872 GCPRO2 (*parms, *values);
873 gcpro1.nvars = i;
874 gcpro2.nvars = i;
876 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
877 because their values appear in VALUES and strings are not valid. */
878 top = left = Qunbound;
879 icon_left = icon_top = Qunbound;
881 /* Provide default values for HEIGHT and WIDTH. */
882 if (FRAME_NEW_WIDTH (f))
883 width = FRAME_NEW_WIDTH (f);
884 else
885 width = FRAME_WIDTH (f);
887 if (FRAME_NEW_HEIGHT (f))
888 height = FRAME_NEW_HEIGHT (f);
889 else
890 height = FRAME_HEIGHT (f);
892 /* Process foreground_color and background_color before anything else.
893 They are independent of other properties, but other properties (e.g.,
894 cursor_color) are dependent upon them. */
895 for (p = 0; p < i; p++)
897 Lisp_Object prop, val;
899 prop = parms[p];
900 val = values[p];
901 if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
903 register Lisp_Object param_index, old_value;
905 param_index = Fget (prop, Qx_frame_parameter);
906 old_value = get_frame_param (f, prop);
907 store_frame_param (f, prop, val);
908 if (NATNUMP (param_index)
909 && (XFASTINT (param_index)
910 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
911 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
915 /* Now process them in reverse of specified order. */
916 for (i--; i >= 0; i--)
918 Lisp_Object prop, val;
920 prop = parms[i];
921 val = values[i];
923 if (EQ (prop, Qwidth) && NUMBERP (val))
924 width = XFASTINT (val);
925 else if (EQ (prop, Qheight) && NUMBERP (val))
926 height = XFASTINT (val);
927 else if (EQ (prop, Qtop))
928 top = val;
929 else if (EQ (prop, Qleft))
930 left = val;
931 else if (EQ (prop, Qicon_top))
932 icon_top = val;
933 else if (EQ (prop, Qicon_left))
934 icon_left = val;
935 else if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
936 /* Processed above. */
937 continue;
938 else
940 register Lisp_Object param_index, old_value;
942 param_index = Fget (prop, Qx_frame_parameter);
943 old_value = get_frame_param (f, prop);
944 store_frame_param (f, prop, val);
945 if (NATNUMP (param_index)
946 && (XFASTINT (param_index)
947 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
948 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
952 /* Don't die if just one of these was set. */
953 if (EQ (left, Qunbound))
955 left_no_change = 1;
956 if (f->output_data.x->left_pos < 0)
957 left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
958 else
959 XSETINT (left, f->output_data.x->left_pos);
961 if (EQ (top, Qunbound))
963 top_no_change = 1;
964 if (f->output_data.x->top_pos < 0)
965 top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
966 else
967 XSETINT (top, f->output_data.x->top_pos);
970 /* If one of the icon positions was not set, preserve or default it. */
971 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
973 icon_left_no_change = 1;
974 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
975 if (NILP (icon_left))
976 XSETINT (icon_left, 0);
978 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
980 icon_top_no_change = 1;
981 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
982 if (NILP (icon_top))
983 XSETINT (icon_top, 0);
986 /* Don't set these parameters unless they've been explicitly
987 specified. The window might be mapped or resized while we're in
988 this function, and we don't want to override that unless the lisp
989 code has asked for it.
991 Don't set these parameters unless they actually differ from the
992 window's current parameters; the window may not actually exist
993 yet. */
995 Lisp_Object frame;
997 check_frame_size (f, &height, &width);
999 XSETFRAME (frame, f);
1001 if (width != FRAME_WIDTH (f)
1002 || height != FRAME_HEIGHT (f)
1003 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
1004 Fset_frame_size (frame, make_number (width), make_number (height));
1006 if ((!NILP (left) || !NILP (top))
1007 && ! (left_no_change && top_no_change)
1008 && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
1009 && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
1011 int leftpos = 0;
1012 int toppos = 0;
1014 /* Record the signs. */
1015 f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
1016 if (EQ (left, Qminus))
1017 f->output_data.x->size_hint_flags |= XNegative;
1018 else if (INTEGERP (left))
1020 leftpos = XINT (left);
1021 if (leftpos < 0)
1022 f->output_data.x->size_hint_flags |= XNegative;
1024 else if (CONSP (left) && EQ (XCAR (left), Qminus)
1025 && CONSP (XCDR (left))
1026 && INTEGERP (XCAR (XCDR (left))))
1028 leftpos = - XINT (XCAR (XCDR (left)));
1029 f->output_data.x->size_hint_flags |= XNegative;
1031 else if (CONSP (left) && EQ (XCAR (left), Qplus)
1032 && CONSP (XCDR (left))
1033 && INTEGERP (XCAR (XCDR (left))))
1035 leftpos = XINT (XCAR (XCDR (left)));
1038 if (EQ (top, Qminus))
1039 f->output_data.x->size_hint_flags |= YNegative;
1040 else if (INTEGERP (top))
1042 toppos = XINT (top);
1043 if (toppos < 0)
1044 f->output_data.x->size_hint_flags |= YNegative;
1046 else if (CONSP (top) && EQ (XCAR (top), Qminus)
1047 && CONSP (XCDR (top))
1048 && INTEGERP (XCAR (XCDR (top))))
1050 toppos = - XINT (XCAR (XCDR (top)));
1051 f->output_data.x->size_hint_flags |= YNegative;
1053 else if (CONSP (top) && EQ (XCAR (top), Qplus)
1054 && CONSP (XCDR (top))
1055 && INTEGERP (XCAR (XCDR (top))))
1057 toppos = XINT (XCAR (XCDR (top)));
1061 /* Store the numeric value of the position. */
1062 f->output_data.x->top_pos = toppos;
1063 f->output_data.x->left_pos = leftpos;
1065 f->output_data.x->win_gravity = NorthWestGravity;
1067 /* Actually set that position, and convert to absolute. */
1068 x_set_offset (f, leftpos, toppos, -1);
1071 if ((!NILP (icon_left) || !NILP (icon_top))
1072 && ! (icon_left_no_change && icon_top_no_change))
1073 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
1076 UNGCPRO;
1079 /* Store the screen positions of frame F into XPTR and YPTR.
1080 These are the positions of the containing window manager window,
1081 not Emacs's own window. */
1083 void
1084 x_real_positions (f, xptr, yptr)
1085 FRAME_PTR f;
1086 int *xptr, *yptr;
1088 int win_x, win_y;
1089 Window child;
1091 /* This is pretty gross, but seems to be the easiest way out of
1092 the problem that arises when restarting window-managers. */
1094 #ifdef USE_X_TOOLKIT
1095 Window outer = (f->output_data.x->widget
1096 ? XtWindow (f->output_data.x->widget)
1097 : FRAME_X_WINDOW (f));
1098 #else
1099 Window outer = f->output_data.x->window_desc;
1100 #endif
1101 Window tmp_root_window;
1102 Window *tmp_children;
1103 unsigned int tmp_nchildren;
1105 while (1)
1107 int count = x_catch_errors (FRAME_X_DISPLAY (f));
1108 Window outer_window;
1110 XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
1111 &f->output_data.x->parent_desc,
1112 &tmp_children, &tmp_nchildren);
1113 XFree ((char *) tmp_children);
1115 win_x = win_y = 0;
1117 /* Find the position of the outside upper-left corner of
1118 the inner window, with respect to the outer window. */
1119 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
1120 outer_window = f->output_data.x->parent_desc;
1121 else
1122 outer_window = outer;
1124 XTranslateCoordinates (FRAME_X_DISPLAY (f),
1126 /* From-window, to-window. */
1127 outer_window,
1128 FRAME_X_DISPLAY_INFO (f)->root_window,
1130 /* From-position, to-position. */
1131 0, 0, &win_x, &win_y,
1133 /* Child of win. */
1134 &child);
1136 /* It is possible for the window returned by the XQueryNotify
1137 to become invalid by the time we call XTranslateCoordinates.
1138 That can happen when you restart some window managers.
1139 If so, we get an error in XTranslateCoordinates.
1140 Detect that and try the whole thing over. */
1141 if (! x_had_errors_p (FRAME_X_DISPLAY (f)))
1143 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1144 break;
1147 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1150 *xptr = win_x;
1151 *yptr = win_y;
1154 /* Insert a description of internally-recorded parameters of frame X
1155 into the parameter alist *ALISTPTR that is to be given to the user.
1156 Only parameters that are specific to the X window system
1157 and whose values are not correctly recorded in the frame's
1158 param_alist need to be considered here. */
1160 void
1161 x_report_frame_params (f, alistptr)
1162 struct frame *f;
1163 Lisp_Object *alistptr;
1165 char buf[16];
1166 Lisp_Object tem;
1168 /* Represent negative positions (off the top or left screen edge)
1169 in a way that Fmodify_frame_parameters will understand correctly. */
1170 XSETINT (tem, f->output_data.x->left_pos);
1171 if (f->output_data.x->left_pos >= 0)
1172 store_in_alist (alistptr, Qleft, tem);
1173 else
1174 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1176 XSETINT (tem, f->output_data.x->top_pos);
1177 if (f->output_data.x->top_pos >= 0)
1178 store_in_alist (alistptr, Qtop, tem);
1179 else
1180 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1182 store_in_alist (alistptr, Qborder_width,
1183 make_number (f->output_data.x->border_width));
1184 store_in_alist (alistptr, Qinternal_border_width,
1185 make_number (f->output_data.x->internal_border_width));
1186 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
1187 store_in_alist (alistptr, Qwindow_id,
1188 build_string (buf));
1189 #ifdef USE_X_TOOLKIT
1190 /* Tooltip frame may not have this widget. */
1191 if (f->output_data.x->widget)
1192 #endif
1193 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
1194 store_in_alist (alistptr, Qouter_window_id,
1195 build_string (buf));
1196 store_in_alist (alistptr, Qicon_name, f->icon_name);
1197 FRAME_SAMPLE_VISIBILITY (f);
1198 store_in_alist (alistptr, Qvisibility,
1199 (FRAME_VISIBLE_P (f) ? Qt
1200 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1201 store_in_alist (alistptr, Qdisplay,
1202 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
1204 if (f->output_data.x->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
1205 tem = Qnil;
1206 else
1207 XSETFASTINT (tem, f->output_data.x->parent_desc);
1208 store_in_alist (alistptr, Qparent_id, tem);
1213 /* Gamma-correct COLOR on frame F. */
1215 void
1216 gamma_correct (f, color)
1217 struct frame *f;
1218 XColor *color;
1220 if (f->gamma)
1222 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
1223 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
1224 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
1229 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1230 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1231 allocate the color. Value is zero if COLOR_NAME is invalid, or
1232 no color could be allocated. */
1235 x_defined_color (f, color_name, color, alloc_p)
1236 struct frame *f;
1237 char *color_name;
1238 XColor *color;
1239 int alloc_p;
1241 int success_p;
1242 Display *dpy = FRAME_X_DISPLAY (f);
1243 Colormap cmap = FRAME_X_COLORMAP (f);
1245 BLOCK_INPUT;
1246 success_p = XParseColor (dpy, cmap, color_name, color);
1247 if (success_p && alloc_p)
1248 success_p = x_alloc_nearest_color (f, cmap, color);
1249 UNBLOCK_INPUT;
1251 return success_p;
1255 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1256 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1257 Signal an error if color can't be allocated. */
1260 x_decode_color (f, color_name, mono_color)
1261 FRAME_PTR f;
1262 Lisp_Object color_name;
1263 int mono_color;
1265 XColor cdef;
1267 CHECK_STRING (color_name, 0);
1269 #if 0 /* Don't do this. It's wrong when we're not using the default
1270 colormap, it makes freeing difficult, and it's probably not
1271 an important optimization. */
1272 if (strcmp (XSTRING (color_name)->data, "black") == 0)
1273 return BLACK_PIX_DEFAULT (f);
1274 else if (strcmp (XSTRING (color_name)->data, "white") == 0)
1275 return WHITE_PIX_DEFAULT (f);
1276 #endif
1278 /* Return MONO_COLOR for monochrome frames. */
1279 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1280 return mono_color;
1282 /* x_defined_color is responsible for coping with failures
1283 by looking for a near-miss. */
1284 if (x_defined_color (f, XSTRING (color_name)->data, &cdef, 1))
1285 return cdef.pixel;
1287 Fsignal (Qerror, Fcons (build_string ("undefined color"),
1288 Fcons (color_name, Qnil)));
1293 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1294 the previous value of that parameter, NEW_VALUE is the new value. */
1296 static void
1297 x_set_line_spacing (f, new_value, old_value)
1298 struct frame *f;
1299 Lisp_Object new_value, old_value;
1301 if (NILP (new_value))
1302 f->extra_line_spacing = 0;
1303 else if (NATNUMP (new_value))
1304 f->extra_line_spacing = XFASTINT (new_value);
1305 else
1306 Fsignal (Qerror, Fcons (build_string ("Illegal line-spacing"),
1307 Fcons (new_value, Qnil)));
1308 if (FRAME_VISIBLE_P (f))
1309 redraw_frame (f);
1313 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1314 the previous value of that parameter, NEW_VALUE is the new value. */
1316 static void
1317 x_set_screen_gamma (f, new_value, old_value)
1318 struct frame *f;
1319 Lisp_Object new_value, old_value;
1321 if (NILP (new_value))
1322 f->gamma = 0;
1323 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
1324 /* The value 0.4545 is the normal viewing gamma. */
1325 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
1326 else
1327 Fsignal (Qerror, Fcons (build_string ("Illegal screen-gamma"),
1328 Fcons (new_value, Qnil)));
1330 clear_face_cache (0);
1334 /* Functions called only from `x_set_frame_param'
1335 to set individual parameters.
1337 If FRAME_X_WINDOW (f) is 0,
1338 the frame is being created and its X-window does not exist yet.
1339 In that case, just record the parameter's new value
1340 in the standard place; do not attempt to change the window. */
1342 void
1343 x_set_foreground_color (f, arg, oldval)
1344 struct frame *f;
1345 Lisp_Object arg, oldval;
1347 unsigned long pixel
1348 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1350 unload_color (f, f->output_data.x->foreground_pixel);
1351 f->output_data.x->foreground_pixel = pixel;
1353 if (FRAME_X_WINDOW (f) != 0)
1355 BLOCK_INPUT;
1356 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1357 f->output_data.x->foreground_pixel);
1358 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1359 f->output_data.x->foreground_pixel);
1360 UNBLOCK_INPUT;
1361 update_face_from_frame_parameter (f, Qforeground_color, arg);
1362 if (FRAME_VISIBLE_P (f))
1363 redraw_frame (f);
1367 void
1368 x_set_background_color (f, arg, oldval)
1369 struct frame *f;
1370 Lisp_Object arg, oldval;
1372 unsigned long pixel
1373 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1375 unload_color (f, f->output_data.x->background_pixel);
1376 f->output_data.x->background_pixel = pixel;
1378 if (FRAME_X_WINDOW (f) != 0)
1380 BLOCK_INPUT;
1381 /* The main frame area. */
1382 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1383 f->output_data.x->background_pixel);
1384 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1385 f->output_data.x->background_pixel);
1386 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1387 f->output_data.x->background_pixel);
1388 XSetWindowBackground (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1389 f->output_data.x->background_pixel);
1391 Lisp_Object bar;
1392 for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
1393 bar = XSCROLL_BAR (bar)->next)
1394 XSetWindowBackground (FRAME_X_DISPLAY (f),
1395 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
1396 f->output_data.x->background_pixel);
1398 UNBLOCK_INPUT;
1400 update_face_from_frame_parameter (f, Qbackground_color, arg);
1402 if (FRAME_VISIBLE_P (f))
1403 redraw_frame (f);
1407 void
1408 x_set_mouse_color (f, arg, oldval)
1409 struct frame *f;
1410 Lisp_Object arg, oldval;
1412 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1413 Cursor busy_cursor;
1414 int count;
1415 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1416 unsigned long mask_color = f->output_data.x->background_pixel;
1418 /* Don't let pointers be invisible. */
1419 if (mask_color == pixel
1420 && mask_color == f->output_data.x->background_pixel)
1421 pixel = f->output_data.x->foreground_pixel;
1423 unload_color (f, f->output_data.x->mouse_pixel);
1424 f->output_data.x->mouse_pixel = pixel;
1426 BLOCK_INPUT;
1428 /* It's not okay to crash if the user selects a screwy cursor. */
1429 count = x_catch_errors (FRAME_X_DISPLAY (f));
1431 if (!EQ (Qnil, Vx_pointer_shape))
1433 CHECK_NUMBER (Vx_pointer_shape, 0);
1434 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_pointer_shape));
1436 else
1437 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1438 x_check_errors (FRAME_X_DISPLAY (f), "bad text pointer cursor: %s");
1440 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1442 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1443 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1444 XINT (Vx_nontext_pointer_shape));
1446 else
1447 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr);
1448 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1450 if (!EQ (Qnil, Vx_busy_pointer_shape))
1452 CHECK_NUMBER (Vx_busy_pointer_shape, 0);
1453 busy_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1454 XINT (Vx_busy_pointer_shape));
1456 else
1457 busy_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_watch);
1458 x_check_errors (FRAME_X_DISPLAY (f), "bad busy pointer cursor: %s");
1460 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1461 if (!EQ (Qnil, Vx_mode_pointer_shape))
1463 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1464 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1465 XINT (Vx_mode_pointer_shape));
1467 else
1468 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1469 x_check_errors (FRAME_X_DISPLAY (f), "bad modeline pointer cursor: %s");
1471 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1473 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1474 cross_cursor
1475 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1476 XINT (Vx_sensitive_text_pointer_shape));
1478 else
1479 cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_crosshair);
1481 /* Check and report errors with the above calls. */
1482 x_check_errors (FRAME_X_DISPLAY (f), "can't set cursor shape: %s");
1483 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1486 XColor fore_color, back_color;
1488 fore_color.pixel = f->output_data.x->mouse_pixel;
1489 back_color.pixel = mask_color;
1490 XQueryColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
1491 &fore_color);
1492 XQueryColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
1493 &back_color);
1494 XRecolorCursor (FRAME_X_DISPLAY (f), cursor,
1495 &fore_color, &back_color);
1496 XRecolorCursor (FRAME_X_DISPLAY (f), nontext_cursor,
1497 &fore_color, &back_color);
1498 XRecolorCursor (FRAME_X_DISPLAY (f), mode_cursor,
1499 &fore_color, &back_color);
1500 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor,
1501 &fore_color, &back_color);
1502 XRecolorCursor (FRAME_X_DISPLAY (f), busy_cursor,
1503 &fore_color, &back_color);
1506 if (FRAME_X_WINDOW (f) != 0)
1507 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1509 if (cursor != f->output_data.x->text_cursor && f->output_data.x->text_cursor != 0)
1510 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->text_cursor);
1511 f->output_data.x->text_cursor = cursor;
1513 if (nontext_cursor != f->output_data.x->nontext_cursor
1514 && f->output_data.x->nontext_cursor != 0)
1515 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->nontext_cursor);
1516 f->output_data.x->nontext_cursor = nontext_cursor;
1518 if (busy_cursor != f->output_data.x->busy_cursor
1519 && f->output_data.x->busy_cursor != 0)
1520 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->busy_cursor);
1521 f->output_data.x->busy_cursor = busy_cursor;
1523 if (mode_cursor != f->output_data.x->modeline_cursor
1524 && f->output_data.x->modeline_cursor != 0)
1525 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->modeline_cursor);
1526 f->output_data.x->modeline_cursor = mode_cursor;
1528 if (cross_cursor != f->output_data.x->cross_cursor
1529 && f->output_data.x->cross_cursor != 0)
1530 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->cross_cursor);
1531 f->output_data.x->cross_cursor = cross_cursor;
1533 XFlush (FRAME_X_DISPLAY (f));
1534 UNBLOCK_INPUT;
1536 update_face_from_frame_parameter (f, Qmouse_color, arg);
1539 void
1540 x_set_cursor_color (f, arg, oldval)
1541 struct frame *f;
1542 Lisp_Object arg, oldval;
1544 unsigned long fore_pixel, pixel;
1545 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
1547 if (!NILP (Vx_cursor_fore_pixel))
1549 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1550 WHITE_PIX_DEFAULT (f));
1551 fore_pixel_allocated_p = 1;
1553 else
1554 fore_pixel = f->output_data.x->background_pixel;
1556 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1557 pixel_allocated_p = 1;
1559 /* Make sure that the cursor color differs from the background color. */
1560 if (pixel == f->output_data.x->background_pixel)
1562 if (pixel_allocated_p)
1564 x_free_colors (f, &pixel, 1);
1565 pixel_allocated_p = 0;
1568 pixel = f->output_data.x->mouse_pixel;
1569 if (pixel == fore_pixel)
1571 if (fore_pixel_allocated_p)
1573 x_free_colors (f, &fore_pixel, 1);
1574 fore_pixel_allocated_p = 0;
1576 fore_pixel = f->output_data.x->background_pixel;
1580 unload_color (f, f->output_data.x->cursor_foreground_pixel);
1581 if (!fore_pixel_allocated_p)
1582 fore_pixel = x_copy_color (f, fore_pixel);
1583 f->output_data.x->cursor_foreground_pixel = fore_pixel;
1585 unload_color (f, f->output_data.x->cursor_pixel);
1586 if (!pixel_allocated_p)
1587 pixel = x_copy_color (f, pixel);
1588 f->output_data.x->cursor_pixel = pixel;
1590 if (FRAME_X_WINDOW (f) != 0)
1592 BLOCK_INPUT;
1593 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1594 f->output_data.x->cursor_pixel);
1595 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1596 fore_pixel);
1597 UNBLOCK_INPUT;
1599 if (FRAME_VISIBLE_P (f))
1601 x_update_cursor (f, 0);
1602 x_update_cursor (f, 1);
1606 update_face_from_frame_parameter (f, Qcursor_color, arg);
1609 /* Set the border-color of frame F to value described by ARG.
1610 ARG can be a string naming a color.
1611 The border-color is used for the border that is drawn by the X server.
1612 Note that this does not fully take effect if done before
1613 F has an x-window; it must be redone when the window is created.
1615 Note: this is done in two routines because of the way X10 works.
1617 Note: under X11, this is normally the province of the window manager,
1618 and so emacs' border colors may be overridden. */
1620 void
1621 x_set_border_color (f, arg, oldval)
1622 struct frame *f;
1623 Lisp_Object arg, oldval;
1625 int pix;
1627 CHECK_STRING (arg, 0);
1628 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1629 x_set_border_pixel (f, pix);
1630 update_face_from_frame_parameter (f, Qborder_color, arg);
1633 /* Set the border-color of frame F to pixel value PIX.
1634 Note that this does not fully take effect if done before
1635 F has an x-window. */
1637 void
1638 x_set_border_pixel (f, pix)
1639 struct frame *f;
1640 int pix;
1642 unload_color (f, f->output_data.x->border_pixel);
1643 f->output_data.x->border_pixel = pix;
1645 if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
1647 BLOCK_INPUT;
1648 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1649 (unsigned long)pix);
1650 UNBLOCK_INPUT;
1652 if (FRAME_VISIBLE_P (f))
1653 redraw_frame (f);
1658 /* Value is the internal representation of the specified cursor type
1659 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1660 of the bar cursor. */
1662 enum text_cursor_kinds
1663 x_specified_cursor_type (arg, width)
1664 Lisp_Object arg;
1665 int *width;
1667 enum text_cursor_kinds type;
1669 if (EQ (arg, Qbar))
1671 type = BAR_CURSOR;
1672 *width = 2;
1674 else if (CONSP (arg)
1675 && EQ (XCAR (arg), Qbar)
1676 && INTEGERP (XCDR (arg))
1677 && XINT (XCDR (arg)) >= 0)
1679 type = BAR_CURSOR;
1680 *width = XINT (XCDR (arg));
1682 else if (NILP (arg))
1683 type = NO_CURSOR;
1684 else
1685 /* Treat anything unknown as "box cursor".
1686 It was bad to signal an error; people have trouble fixing
1687 .Xdefaults with Emacs, when it has something bad in it. */
1688 type = FILLED_BOX_CURSOR;
1690 return type;
1693 void
1694 x_set_cursor_type (f, arg, oldval)
1695 FRAME_PTR f;
1696 Lisp_Object arg, oldval;
1698 int width;
1700 FRAME_DESIRED_CURSOR (f) = x_specified_cursor_type (arg, &width);
1701 f->output_data.x->cursor_width = width;
1703 /* Make sure the cursor gets redrawn. This is overkill, but how
1704 often do people change cursor types? */
1705 update_mode_lines++;
1708 void
1709 x_set_icon_type (f, arg, oldval)
1710 struct frame *f;
1711 Lisp_Object arg, oldval;
1713 int result;
1715 if (STRINGP (arg))
1717 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1718 return;
1720 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1721 return;
1723 BLOCK_INPUT;
1724 if (NILP (arg))
1725 result = x_text_icon (f,
1726 (char *) XSTRING ((!NILP (f->icon_name)
1727 ? f->icon_name
1728 : f->name))->data);
1729 else
1730 result = x_bitmap_icon (f, arg);
1732 if (result)
1734 UNBLOCK_INPUT;
1735 error ("No icon window available");
1738 XFlush (FRAME_X_DISPLAY (f));
1739 UNBLOCK_INPUT;
1742 /* Return non-nil if frame F wants a bitmap icon. */
1744 Lisp_Object
1745 x_icon_type (f)
1746 FRAME_PTR f;
1748 Lisp_Object tem;
1750 tem = assq_no_quit (Qicon_type, f->param_alist);
1751 if (CONSP (tem))
1752 return XCDR (tem);
1753 else
1754 return Qnil;
1757 void
1758 x_set_icon_name (f, arg, oldval)
1759 struct frame *f;
1760 Lisp_Object arg, oldval;
1762 int result;
1764 if (STRINGP (arg))
1766 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1767 return;
1769 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1770 return;
1772 f->icon_name = arg;
1774 if (f->output_data.x->icon_bitmap != 0)
1775 return;
1777 BLOCK_INPUT;
1779 result = x_text_icon (f,
1780 (char *) XSTRING ((!NILP (f->icon_name)
1781 ? f->icon_name
1782 : !NILP (f->title)
1783 ? f->title
1784 : f->name))->data);
1786 if (result)
1788 UNBLOCK_INPUT;
1789 error ("No icon window available");
1792 XFlush (FRAME_X_DISPLAY (f));
1793 UNBLOCK_INPUT;
1796 void
1797 x_set_font (f, arg, oldval)
1798 struct frame *f;
1799 Lisp_Object arg, oldval;
1801 Lisp_Object result;
1802 Lisp_Object fontset_name;
1803 Lisp_Object frame;
1805 CHECK_STRING (arg, 1);
1807 fontset_name = Fquery_fontset (arg, Qnil);
1809 BLOCK_INPUT;
1810 result = (STRINGP (fontset_name)
1811 ? x_new_fontset (f, XSTRING (fontset_name)->data)
1812 : x_new_font (f, XSTRING (arg)->data));
1813 UNBLOCK_INPUT;
1815 if (EQ (result, Qnil))
1816 error ("Font `%s' is not defined", XSTRING (arg)->data);
1817 else if (EQ (result, Qt))
1818 error ("The characters of the given font have varying widths");
1819 else if (STRINGP (result))
1821 store_frame_param (f, Qfont, result);
1822 recompute_basic_faces (f);
1824 else
1825 abort ();
1827 do_pending_window_change (0);
1829 /* Don't call `face-set-after-frame-default' when faces haven't been
1830 initialized yet. This is the case when called from
1831 Fx_create_frame. In that case, the X widget or window doesn't
1832 exist either, and we can end up in x_report_frame_params with a
1833 null widget which gives a segfault. */
1834 if (FRAME_FACE_CACHE (f))
1836 XSETFRAME (frame, f);
1837 call1 (Qface_set_after_frame_default, frame);
1841 void
1842 x_set_border_width (f, arg, oldval)
1843 struct frame *f;
1844 Lisp_Object arg, oldval;
1846 CHECK_NUMBER (arg, 0);
1848 if (XINT (arg) == f->output_data.x->border_width)
1849 return;
1851 if (FRAME_X_WINDOW (f) != 0)
1852 error ("Cannot change the border width of a window");
1854 f->output_data.x->border_width = XINT (arg);
1857 void
1858 x_set_internal_border_width (f, arg, oldval)
1859 struct frame *f;
1860 Lisp_Object arg, oldval;
1862 int old = f->output_data.x->internal_border_width;
1864 CHECK_NUMBER (arg, 0);
1865 f->output_data.x->internal_border_width = XINT (arg);
1866 if (f->output_data.x->internal_border_width < 0)
1867 f->output_data.x->internal_border_width = 0;
1869 #ifdef USE_X_TOOLKIT
1870 if (f->output_data.x->edit_widget)
1871 widget_store_internal_border (f->output_data.x->edit_widget);
1872 #endif
1874 if (f->output_data.x->internal_border_width == old)
1875 return;
1877 if (FRAME_X_WINDOW (f) != 0)
1879 x_set_window_size (f, 0, f->width, f->height);
1880 SET_FRAME_GARBAGED (f);
1881 do_pending_window_change (0);
1885 void
1886 x_set_visibility (f, value, oldval)
1887 struct frame *f;
1888 Lisp_Object value, oldval;
1890 Lisp_Object frame;
1891 XSETFRAME (frame, f);
1893 if (NILP (value))
1894 Fmake_frame_invisible (frame, Qt);
1895 else if (EQ (value, Qicon))
1896 Ficonify_frame (frame);
1897 else
1898 Fmake_frame_visible (frame);
1901 static void
1902 x_set_menu_bar_lines_1 (window, n)
1903 Lisp_Object window;
1904 int n;
1906 struct window *w = XWINDOW (window);
1908 XSETFASTINT (w->top, XFASTINT (w->top) + n);
1909 XSETFASTINT (w->height, XFASTINT (w->height) - n);
1911 if (INTEGERP (w->orig_top))
1912 XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
1913 if (INTEGERP (w->orig_height))
1914 XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
1916 /* Handle just the top child in a vertical split. */
1917 if (!NILP (w->vchild))
1918 x_set_menu_bar_lines_1 (w->vchild, n);
1920 /* Adjust all children in a horizontal split. */
1921 for (window = w->hchild; !NILP (window); window = w->next)
1923 w = XWINDOW (window);
1924 x_set_menu_bar_lines_1 (window, n);
1928 void
1929 x_set_menu_bar_lines (f, value, oldval)
1930 struct frame *f;
1931 Lisp_Object value, oldval;
1933 int nlines;
1934 #ifndef USE_X_TOOLKIT
1935 int olines = FRAME_MENU_BAR_LINES (f);
1936 #endif
1938 /* Right now, menu bars don't work properly in minibuf-only frames;
1939 most of the commands try to apply themselves to the minibuffer
1940 frame itself, and get an error because you can't switch buffers
1941 in or split the minibuffer window. */
1942 if (FRAME_MINIBUF_ONLY_P (f))
1943 return;
1945 if (INTEGERP (value))
1946 nlines = XINT (value);
1947 else
1948 nlines = 0;
1950 /* Make sure we redisplay all windows in this frame. */
1951 windows_or_buffers_changed++;
1953 #ifdef USE_X_TOOLKIT
1954 FRAME_MENU_BAR_LINES (f) = 0;
1955 if (nlines)
1957 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1958 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1959 /* Make sure next redisplay shows the menu bar. */
1960 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1962 else
1964 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1965 free_frame_menubar (f);
1966 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1967 if (FRAME_X_P (f))
1968 f->output_data.x->menubar_widget = 0;
1970 #else /* not USE_X_TOOLKIT */
1971 FRAME_MENU_BAR_LINES (f) = nlines;
1972 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1973 #endif /* not USE_X_TOOLKIT */
1974 adjust_glyphs (f);
1978 /* Set the number of lines used for the tool bar of frame F to VALUE.
1979 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1980 is the old number of tool bar lines. This function changes the
1981 height of all windows on frame F to match the new tool bar height.
1982 The frame's height doesn't change. */
1984 void
1985 x_set_tool_bar_lines (f, value, oldval)
1986 struct frame *f;
1987 Lisp_Object value, oldval;
1989 int delta, nlines;
1991 /* Use VALUE only if an integer >= 0. */
1992 if (INTEGERP (value) && XINT (value) >= 0)
1993 nlines = XFASTINT (value);
1994 else
1995 nlines = 0;
1997 /* Make sure we redisplay all windows in this frame. */
1998 ++windows_or_buffers_changed;
2000 delta = nlines - FRAME_TOOL_BAR_LINES (f);
2001 FRAME_TOOL_BAR_LINES (f) = nlines;
2002 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f), delta);
2003 adjust_glyphs (f);
2007 /* Set the foreground color for scroll bars on frame F to VALUE.
2008 VALUE should be a string, a color name. If it isn't a string or
2009 isn't a valid color name, do nothing. OLDVAL is the old value of
2010 the frame parameter. */
2012 void
2013 x_set_scroll_bar_foreground (f, value, oldval)
2014 struct frame *f;
2015 Lisp_Object value, oldval;
2017 unsigned long pixel;
2019 if (STRINGP (value))
2020 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
2021 else
2022 pixel = -1;
2024 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
2025 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
2027 f->output_data.x->scroll_bar_foreground_pixel = pixel;
2028 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
2030 /* Remove all scroll bars because they have wrong colors. */
2031 if (condemn_scroll_bars_hook)
2032 (*condemn_scroll_bars_hook) (f);
2033 if (judge_scroll_bars_hook)
2034 (*judge_scroll_bars_hook) (f);
2036 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
2037 redraw_frame (f);
2042 /* Set the background color for scroll bars on frame F to VALUE VALUE
2043 should be a string, a color name. If it isn't a string or isn't a
2044 valid color name, do nothing. OLDVAL is the old value of the frame
2045 parameter. */
2047 void
2048 x_set_scroll_bar_background (f, value, oldval)
2049 struct frame *f;
2050 Lisp_Object value, oldval;
2052 unsigned long pixel;
2054 if (STRINGP (value))
2055 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
2056 else
2057 pixel = -1;
2059 if (f->output_data.x->scroll_bar_background_pixel != -1)
2060 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
2062 f->output_data.x->scroll_bar_background_pixel = pixel;
2063 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
2065 /* Remove all scroll bars because they have wrong colors. */
2066 if (condemn_scroll_bars_hook)
2067 (*condemn_scroll_bars_hook) (f);
2068 if (judge_scroll_bars_hook)
2069 (*judge_scroll_bars_hook) (f);
2071 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
2072 redraw_frame (f);
2077 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2078 x_id_name.
2080 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2081 name; if NAME is a string, set F's name to NAME and set
2082 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2084 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2085 suggesting a new name, which lisp code should override; if
2086 F->explicit_name is set, ignore the new name; otherwise, set it. */
2088 void
2089 x_set_name (f, name, explicit)
2090 struct frame *f;
2091 Lisp_Object name;
2092 int explicit;
2094 /* Make sure that requests from lisp code override requests from
2095 Emacs redisplay code. */
2096 if (explicit)
2098 /* If we're switching from explicit to implicit, we had better
2099 update the mode lines and thereby update the title. */
2100 if (f->explicit_name && NILP (name))
2101 update_mode_lines = 1;
2103 f->explicit_name = ! NILP (name);
2105 else if (f->explicit_name)
2106 return;
2108 /* If NAME is nil, set the name to the x_id_name. */
2109 if (NILP (name))
2111 /* Check for no change needed in this very common case
2112 before we do any consing. */
2113 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
2114 XSTRING (f->name)->data))
2115 return;
2116 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
2118 else
2119 CHECK_STRING (name, 0);
2121 /* Don't change the name if it's already NAME. */
2122 if (! NILP (Fstring_equal (name, f->name)))
2123 return;
2125 f->name = name;
2127 /* For setting the frame title, the title parameter should override
2128 the name parameter. */
2129 if (! NILP (f->title))
2130 name = f->title;
2132 if (FRAME_X_WINDOW (f))
2134 BLOCK_INPUT;
2135 #ifdef HAVE_X11R4
2137 XTextProperty text, icon;
2138 Lisp_Object icon_name;
2140 text.value = XSTRING (name)->data;
2141 text.encoding = XA_STRING;
2142 text.format = 8;
2143 text.nitems = STRING_BYTES (XSTRING (name));
2145 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
2147 icon.value = XSTRING (icon_name)->data;
2148 icon.encoding = XA_STRING;
2149 icon.format = 8;
2150 icon.nitems = STRING_BYTES (XSTRING (icon_name));
2151 #ifdef USE_X_TOOLKIT
2152 XSetWMName (FRAME_X_DISPLAY (f),
2153 XtWindow (f->output_data.x->widget), &text);
2154 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
2155 &icon);
2156 #else /* not USE_X_TOOLKIT */
2157 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
2158 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
2159 #endif /* not USE_X_TOOLKIT */
2161 #else /* not HAVE_X11R4 */
2162 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2163 XSTRING (name)->data);
2164 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2165 XSTRING (name)->data);
2166 #endif /* not HAVE_X11R4 */
2167 UNBLOCK_INPUT;
2171 /* This function should be called when the user's lisp code has
2172 specified a name for the frame; the name will override any set by the
2173 redisplay code. */
2174 void
2175 x_explicitly_set_name (f, arg, oldval)
2176 FRAME_PTR f;
2177 Lisp_Object arg, oldval;
2179 x_set_name (f, arg, 1);
2182 /* This function should be called by Emacs redisplay code to set the
2183 name; names set this way will never override names set by the user's
2184 lisp code. */
2185 void
2186 x_implicitly_set_name (f, arg, oldval)
2187 FRAME_PTR f;
2188 Lisp_Object arg, oldval;
2190 x_set_name (f, arg, 0);
2193 /* Change the title of frame F to NAME.
2194 If NAME is nil, use the frame name as the title.
2196 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2197 name; if NAME is a string, set F's name to NAME and set
2198 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2200 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2201 suggesting a new name, which lisp code should override; if
2202 F->explicit_name is set, ignore the new name; otherwise, set it. */
2204 void
2205 x_set_title (f, name, old_name)
2206 struct frame *f;
2207 Lisp_Object name, old_name;
2209 /* Don't change the title if it's already NAME. */
2210 if (EQ (name, f->title))
2211 return;
2213 update_mode_lines = 1;
2215 f->title = name;
2217 if (NILP (name))
2218 name = f->name;
2219 else
2220 CHECK_STRING (name, 0);
2222 if (FRAME_X_WINDOW (f))
2224 BLOCK_INPUT;
2225 #ifdef HAVE_X11R4
2227 XTextProperty text, icon;
2228 Lisp_Object icon_name;
2230 text.value = XSTRING (name)->data;
2231 text.encoding = XA_STRING;
2232 text.format = 8;
2233 text.nitems = STRING_BYTES (XSTRING (name));
2235 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
2237 icon.value = XSTRING (icon_name)->data;
2238 icon.encoding = XA_STRING;
2239 icon.format = 8;
2240 icon.nitems = STRING_BYTES (XSTRING (icon_name));
2241 #ifdef USE_X_TOOLKIT
2242 XSetWMName (FRAME_X_DISPLAY (f),
2243 XtWindow (f->output_data.x->widget), &text);
2244 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
2245 &icon);
2246 #else /* not USE_X_TOOLKIT */
2247 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
2248 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
2249 #endif /* not USE_X_TOOLKIT */
2251 #else /* not HAVE_X11R4 */
2252 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2253 XSTRING (name)->data);
2254 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2255 XSTRING (name)->data);
2256 #endif /* not HAVE_X11R4 */
2257 UNBLOCK_INPUT;
2261 void
2262 x_set_autoraise (f, arg, oldval)
2263 struct frame *f;
2264 Lisp_Object arg, oldval;
2266 f->auto_raise = !EQ (Qnil, arg);
2269 void
2270 x_set_autolower (f, arg, oldval)
2271 struct frame *f;
2272 Lisp_Object arg, oldval;
2274 f->auto_lower = !EQ (Qnil, arg);
2277 void
2278 x_set_unsplittable (f, arg, oldval)
2279 struct frame *f;
2280 Lisp_Object arg, oldval;
2282 f->no_split = !NILP (arg);
2285 void
2286 x_set_vertical_scroll_bars (f, arg, oldval)
2287 struct frame *f;
2288 Lisp_Object arg, oldval;
2290 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2291 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2292 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2293 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
2295 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
2296 = (NILP (arg)
2297 ? vertical_scroll_bar_none
2298 : EQ (Qright, arg)
2299 ? vertical_scroll_bar_right
2300 : vertical_scroll_bar_left);
2302 /* We set this parameter before creating the X window for the
2303 frame, so we can get the geometry right from the start.
2304 However, if the window hasn't been created yet, we shouldn't
2305 call x_set_window_size. */
2306 if (FRAME_X_WINDOW (f))
2307 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2308 do_pending_window_change (0);
2312 void
2313 x_set_scroll_bar_width (f, arg, oldval)
2314 struct frame *f;
2315 Lisp_Object arg, oldval;
2317 int wid = FONT_WIDTH (f->output_data.x->font);
2319 if (NILP (arg))
2321 #ifdef USE_TOOLKIT_SCROLL_BARS
2322 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2323 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2324 FRAME_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2325 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = width;
2326 #else
2327 /* Make the actual width at least 14 pixels and a multiple of a
2328 character width. */
2329 FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2331 /* Use all of that space (aside from required margins) for the
2332 scroll bar. */
2333 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
2334 #endif
2336 if (FRAME_X_WINDOW (f))
2337 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2338 do_pending_window_change (0);
2340 else if (INTEGERP (arg) && XINT (arg) > 0
2341 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2343 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
2344 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
2346 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2347 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
2348 if (FRAME_X_WINDOW (f))
2349 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2352 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
2353 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2354 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
2359 /* Subroutines of creating an X frame. */
2361 /* Make sure that Vx_resource_name is set to a reasonable value.
2362 Fix it up, or set it to `emacs' if it is too hopeless. */
2364 static void
2365 validate_x_resource_name ()
2367 int len = 0;
2368 /* Number of valid characters in the resource name. */
2369 int good_count = 0;
2370 /* Number of invalid characters in the resource name. */
2371 int bad_count = 0;
2372 Lisp_Object new;
2373 int i;
2375 if (!STRINGP (Vx_resource_class))
2376 Vx_resource_class = build_string (EMACS_CLASS);
2378 if (STRINGP (Vx_resource_name))
2380 unsigned char *p = XSTRING (Vx_resource_name)->data;
2381 int i;
2383 len = STRING_BYTES (XSTRING (Vx_resource_name));
2385 /* Only letters, digits, - and _ are valid in resource names.
2386 Count the valid characters and count the invalid ones. */
2387 for (i = 0; i < len; i++)
2389 int c = p[i];
2390 if (! ((c >= 'a' && c <= 'z')
2391 || (c >= 'A' && c <= 'Z')
2392 || (c >= '0' && c <= '9')
2393 || c == '-' || c == '_'))
2394 bad_count++;
2395 else
2396 good_count++;
2399 else
2400 /* Not a string => completely invalid. */
2401 bad_count = 5, good_count = 0;
2403 /* If name is valid already, return. */
2404 if (bad_count == 0)
2405 return;
2407 /* If name is entirely invalid, or nearly so, use `emacs'. */
2408 if (good_count == 0
2409 || (good_count == 1 && bad_count > 0))
2411 Vx_resource_name = build_string ("emacs");
2412 return;
2415 /* Name is partly valid. Copy it and replace the invalid characters
2416 with underscores. */
2418 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2420 for (i = 0; i < len; i++)
2422 int c = XSTRING (new)->data[i];
2423 if (! ((c >= 'a' && c <= 'z')
2424 || (c >= 'A' && c <= 'Z')
2425 || (c >= '0' && c <= '9')
2426 || c == '-' || c == '_'))
2427 XSTRING (new)->data[i] = '_';
2432 extern char *x_get_string_resource ();
2434 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2435 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2436 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2437 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2438 the name specified by the `-name' or `-rn' command-line arguments.\n\
2440 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2441 class, respectively. You must specify both of them or neither.\n\
2442 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2443 and the class is `Emacs.CLASS.SUBCLASS'.")
2444 (attribute, class, component, subclass)
2445 Lisp_Object attribute, class, component, subclass;
2447 register char *value;
2448 char *name_key;
2449 char *class_key;
2451 check_x ();
2453 CHECK_STRING (attribute, 0);
2454 CHECK_STRING (class, 0);
2456 if (!NILP (component))
2457 CHECK_STRING (component, 1);
2458 if (!NILP (subclass))
2459 CHECK_STRING (subclass, 2);
2460 if (NILP (component) != NILP (subclass))
2461 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2463 validate_x_resource_name ();
2465 /* Allocate space for the components, the dots which separate them,
2466 and the final '\0'. Make them big enough for the worst case. */
2467 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
2468 + (STRINGP (component)
2469 ? STRING_BYTES (XSTRING (component)) : 0)
2470 + STRING_BYTES (XSTRING (attribute))
2471 + 3);
2473 class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
2474 + STRING_BYTES (XSTRING (class))
2475 + (STRINGP (subclass)
2476 ? STRING_BYTES (XSTRING (subclass)) : 0)
2477 + 3);
2479 /* Start with emacs.FRAMENAME for the name (the specific one)
2480 and with `Emacs' for the class key (the general one). */
2481 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2482 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2484 strcat (class_key, ".");
2485 strcat (class_key, XSTRING (class)->data);
2487 if (!NILP (component))
2489 strcat (class_key, ".");
2490 strcat (class_key, XSTRING (subclass)->data);
2492 strcat (name_key, ".");
2493 strcat (name_key, XSTRING (component)->data);
2496 strcat (name_key, ".");
2497 strcat (name_key, XSTRING (attribute)->data);
2499 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2500 name_key, class_key);
2502 if (value != (char *) 0)
2503 return build_string (value);
2504 else
2505 return Qnil;
2508 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2510 Lisp_Object
2511 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
2512 struct x_display_info *dpyinfo;
2513 Lisp_Object attribute, class, component, subclass;
2515 register char *value;
2516 char *name_key;
2517 char *class_key;
2519 CHECK_STRING (attribute, 0);
2520 CHECK_STRING (class, 0);
2522 if (!NILP (component))
2523 CHECK_STRING (component, 1);
2524 if (!NILP (subclass))
2525 CHECK_STRING (subclass, 2);
2526 if (NILP (component) != NILP (subclass))
2527 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2529 validate_x_resource_name ();
2531 /* Allocate space for the components, the dots which separate them,
2532 and the final '\0'. Make them big enough for the worst case. */
2533 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
2534 + (STRINGP (component)
2535 ? STRING_BYTES (XSTRING (component)) : 0)
2536 + STRING_BYTES (XSTRING (attribute))
2537 + 3);
2539 class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
2540 + STRING_BYTES (XSTRING (class))
2541 + (STRINGP (subclass)
2542 ? STRING_BYTES (XSTRING (subclass)) : 0)
2543 + 3);
2545 /* Start with emacs.FRAMENAME for the name (the specific one)
2546 and with `Emacs' for the class key (the general one). */
2547 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2548 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2550 strcat (class_key, ".");
2551 strcat (class_key, XSTRING (class)->data);
2553 if (!NILP (component))
2555 strcat (class_key, ".");
2556 strcat (class_key, XSTRING (subclass)->data);
2558 strcat (name_key, ".");
2559 strcat (name_key, XSTRING (component)->data);
2562 strcat (name_key, ".");
2563 strcat (name_key, XSTRING (attribute)->data);
2565 value = x_get_string_resource (dpyinfo->xrdb, name_key, class_key);
2567 if (value != (char *) 0)
2568 return build_string (value);
2569 else
2570 return Qnil;
2573 /* Used when C code wants a resource value. */
2575 char *
2576 x_get_resource_string (attribute, class)
2577 char *attribute, *class;
2579 char *name_key;
2580 char *class_key;
2581 struct frame *sf = SELECTED_FRAME ();
2583 /* Allocate space for the components, the dots which separate them,
2584 and the final '\0'. */
2585 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
2586 + strlen (attribute) + 2);
2587 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2588 + strlen (class) + 2);
2590 sprintf (name_key, "%s.%s",
2591 XSTRING (Vinvocation_name)->data,
2592 attribute);
2593 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2595 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
2596 name_key, class_key);
2599 /* Types we might convert a resource string into. */
2600 enum resource_types
2602 RES_TYPE_NUMBER,
2603 RES_TYPE_FLOAT,
2604 RES_TYPE_BOOLEAN,
2605 RES_TYPE_STRING,
2606 RES_TYPE_SYMBOL
2609 /* Return the value of parameter PARAM.
2611 First search ALIST, then Vdefault_frame_alist, then the X defaults
2612 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2614 Convert the resource to the type specified by desired_type.
2616 If no default is specified, return Qunbound. If you call
2617 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2618 and don't let it get stored in any Lisp-visible variables! */
2620 static Lisp_Object
2621 x_get_arg (dpyinfo, alist, param, attribute, class, type)
2622 struct x_display_info *dpyinfo;
2623 Lisp_Object alist, param;
2624 char *attribute;
2625 char *class;
2626 enum resource_types type;
2628 register Lisp_Object tem;
2630 tem = Fassq (param, alist);
2631 if (EQ (tem, Qnil))
2632 tem = Fassq (param, Vdefault_frame_alist);
2633 if (EQ (tem, Qnil))
2636 if (attribute)
2638 tem = display_x_get_resource (dpyinfo,
2639 build_string (attribute),
2640 build_string (class),
2641 Qnil, Qnil);
2643 if (NILP (tem))
2644 return Qunbound;
2646 switch (type)
2648 case RES_TYPE_NUMBER:
2649 return make_number (atoi (XSTRING (tem)->data));
2651 case RES_TYPE_FLOAT:
2652 return make_float (atof (XSTRING (tem)->data));
2654 case RES_TYPE_BOOLEAN:
2655 tem = Fdowncase (tem);
2656 if (!strcmp (XSTRING (tem)->data, "on")
2657 || !strcmp (XSTRING (tem)->data, "true"))
2658 return Qt;
2659 else
2660 return Qnil;
2662 case RES_TYPE_STRING:
2663 return tem;
2665 case RES_TYPE_SYMBOL:
2666 /* As a special case, we map the values `true' and `on'
2667 to Qt, and `false' and `off' to Qnil. */
2669 Lisp_Object lower;
2670 lower = Fdowncase (tem);
2671 if (!strcmp (XSTRING (lower)->data, "on")
2672 || !strcmp (XSTRING (lower)->data, "true"))
2673 return Qt;
2674 else if (!strcmp (XSTRING (lower)->data, "off")
2675 || !strcmp (XSTRING (lower)->data, "false"))
2676 return Qnil;
2677 else
2678 return Fintern (tem, Qnil);
2681 default:
2682 abort ();
2685 else
2686 return Qunbound;
2688 return Fcdr (tem);
2691 /* Like x_get_arg, but also record the value in f->param_alist. */
2693 static Lisp_Object
2694 x_get_and_record_arg (f, alist, param, attribute, class, type)
2695 struct frame *f;
2696 Lisp_Object alist, param;
2697 char *attribute;
2698 char *class;
2699 enum resource_types type;
2701 Lisp_Object value;
2703 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
2704 attribute, class, type);
2705 if (! NILP (value))
2706 store_frame_param (f, param, value);
2708 return value;
2711 /* Record in frame F the specified or default value according to ALIST
2712 of the parameter named PROP (a Lisp symbol).
2713 If no value is specified for PROP, look for an X default for XPROP
2714 on the frame named NAME.
2715 If that is not found either, use the value DEFLT. */
2717 static Lisp_Object
2718 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2719 struct frame *f;
2720 Lisp_Object alist;
2721 Lisp_Object prop;
2722 Lisp_Object deflt;
2723 char *xprop;
2724 char *xclass;
2725 enum resource_types type;
2727 Lisp_Object tem;
2729 tem = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, prop, xprop, xclass, type);
2730 if (EQ (tem, Qunbound))
2731 tem = deflt;
2732 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2733 return tem;
2737 /* Record in frame F the specified or default value according to ALIST
2738 of the parameter named PROP (a Lisp symbol). If no value is
2739 specified for PROP, look for an X default for XPROP on the frame
2740 named NAME. If that is not found either, use the value DEFLT. */
2742 static Lisp_Object
2743 x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
2744 foreground_p)
2745 struct frame *f;
2746 Lisp_Object alist;
2747 Lisp_Object prop;
2748 char *xprop;
2749 char *xclass;
2750 int foreground_p;
2752 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2753 Lisp_Object tem;
2755 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
2756 if (EQ (tem, Qunbound))
2758 #ifdef USE_TOOLKIT_SCROLL_BARS
2760 /* See if an X resource for the scroll bar color has been
2761 specified. */
2762 tem = display_x_get_resource (dpyinfo,
2763 build_string (foreground_p
2764 ? "foreground"
2765 : "background"),
2766 build_string (""),
2767 build_string ("verticalScrollBar"),
2768 build_string (""));
2769 if (!STRINGP (tem))
2771 /* If nothing has been specified, scroll bars will use a
2772 toolkit-dependent default. Because these defaults are
2773 difficult to get at without actually creating a scroll
2774 bar, use nil to indicate that no color has been
2775 specified. */
2776 tem = Qnil;
2779 #else /* not USE_TOOLKIT_SCROLL_BARS */
2781 tem = Qnil;
2783 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2786 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2787 return tem;
2792 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2793 "Parse an X-style geometry string STRING.\n\
2794 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2795 The properties returned may include `top', `left', `height', and `width'.\n\
2796 The value of `left' or `top' may be an integer,\n\
2797 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2798 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2799 (string)
2800 Lisp_Object string;
2802 int geometry, x, y;
2803 unsigned int width, height;
2804 Lisp_Object result;
2806 CHECK_STRING (string, 0);
2808 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2809 &x, &y, &width, &height);
2811 #if 0
2812 if (!!(geometry & XValue) != !!(geometry & YValue))
2813 error ("Must specify both x and y position, or neither");
2814 #endif
2816 result = Qnil;
2817 if (geometry & XValue)
2819 Lisp_Object element;
2821 if (x >= 0 && (geometry & XNegative))
2822 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2823 else if (x < 0 && ! (geometry & XNegative))
2824 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2825 else
2826 element = Fcons (Qleft, make_number (x));
2827 result = Fcons (element, result);
2830 if (geometry & YValue)
2832 Lisp_Object element;
2834 if (y >= 0 && (geometry & YNegative))
2835 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2836 else if (y < 0 && ! (geometry & YNegative))
2837 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2838 else
2839 element = Fcons (Qtop, make_number (y));
2840 result = Fcons (element, result);
2843 if (geometry & WidthValue)
2844 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2845 if (geometry & HeightValue)
2846 result = Fcons (Fcons (Qheight, make_number (height)), result);
2848 return result;
2851 /* Calculate the desired size and position of this window,
2852 and return the flags saying which aspects were specified.
2854 This function does not make the coordinates positive. */
2856 #define DEFAULT_ROWS 40
2857 #define DEFAULT_COLS 80
2859 static int
2860 x_figure_window_size (f, parms)
2861 struct frame *f;
2862 Lisp_Object parms;
2864 register Lisp_Object tem0, tem1, tem2;
2865 long window_prompting = 0;
2866 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2868 /* Default values if we fall through.
2869 Actually, if that happens we should get
2870 window manager prompting. */
2871 SET_FRAME_WIDTH (f, DEFAULT_COLS);
2872 f->height = DEFAULT_ROWS;
2873 /* Window managers expect that if program-specified
2874 positions are not (0,0), they're intentional, not defaults. */
2875 f->output_data.x->top_pos = 0;
2876 f->output_data.x->left_pos = 0;
2878 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
2879 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
2880 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
2881 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2883 if (!EQ (tem0, Qunbound))
2885 CHECK_NUMBER (tem0, 0);
2886 f->height = XINT (tem0);
2888 if (!EQ (tem1, Qunbound))
2890 CHECK_NUMBER (tem1, 0);
2891 SET_FRAME_WIDTH (f, XINT (tem1));
2893 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2894 window_prompting |= USSize;
2895 else
2896 window_prompting |= PSize;
2899 f->output_data.x->vertical_scroll_bar_extra
2900 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2902 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
2903 f->output_data.x->flags_areas_extra
2904 = FRAME_FLAGS_AREA_WIDTH (f);
2905 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2906 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2908 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
2909 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
2910 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
2911 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2913 if (EQ (tem0, Qminus))
2915 f->output_data.x->top_pos = 0;
2916 window_prompting |= YNegative;
2918 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
2919 && CONSP (XCDR (tem0))
2920 && INTEGERP (XCAR (XCDR (tem0))))
2922 f->output_data.x->top_pos = - XINT (XCAR (XCDR (tem0)));
2923 window_prompting |= YNegative;
2925 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
2926 && CONSP (XCDR (tem0))
2927 && INTEGERP (XCAR (XCDR (tem0))))
2929 f->output_data.x->top_pos = XINT (XCAR (XCDR (tem0)));
2931 else if (EQ (tem0, Qunbound))
2932 f->output_data.x->top_pos = 0;
2933 else
2935 CHECK_NUMBER (tem0, 0);
2936 f->output_data.x->top_pos = XINT (tem0);
2937 if (f->output_data.x->top_pos < 0)
2938 window_prompting |= YNegative;
2941 if (EQ (tem1, Qminus))
2943 f->output_data.x->left_pos = 0;
2944 window_prompting |= XNegative;
2946 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
2947 && CONSP (XCDR (tem1))
2948 && INTEGERP (XCAR (XCDR (tem1))))
2950 f->output_data.x->left_pos = - XINT (XCAR (XCDR (tem1)));
2951 window_prompting |= XNegative;
2953 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
2954 && CONSP (XCDR (tem1))
2955 && INTEGERP (XCAR (XCDR (tem1))))
2957 f->output_data.x->left_pos = XINT (XCAR (XCDR (tem1)));
2959 else if (EQ (tem1, Qunbound))
2960 f->output_data.x->left_pos = 0;
2961 else
2963 CHECK_NUMBER (tem1, 0);
2964 f->output_data.x->left_pos = XINT (tem1);
2965 if (f->output_data.x->left_pos < 0)
2966 window_prompting |= XNegative;
2969 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2970 window_prompting |= USPosition;
2971 else
2972 window_prompting |= PPosition;
2975 return window_prompting;
2978 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2980 Status
2981 XSetWMProtocols (dpy, w, protocols, count)
2982 Display *dpy;
2983 Window w;
2984 Atom *protocols;
2985 int count;
2987 Atom prop;
2988 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2989 if (prop == None) return False;
2990 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2991 (unsigned char *) protocols, count);
2992 return True;
2994 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2996 #ifdef USE_X_TOOLKIT
2998 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2999 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3000 already be present because of the toolkit (Motif adds some of them,
3001 for example, but Xt doesn't). */
3003 static void
3004 hack_wm_protocols (f, widget)
3005 FRAME_PTR f;
3006 Widget widget;
3008 Display *dpy = XtDisplay (widget);
3009 Window w = XtWindow (widget);
3010 int need_delete = 1;
3011 int need_focus = 1;
3012 int need_save = 1;
3014 BLOCK_INPUT;
3016 Atom type, *atoms = 0;
3017 int format = 0;
3018 unsigned long nitems = 0;
3019 unsigned long bytes_after;
3021 if ((XGetWindowProperty (dpy, w,
3022 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
3023 (long)0, (long)100, False, XA_ATOM,
3024 &type, &format, &nitems, &bytes_after,
3025 (unsigned char **) &atoms)
3026 == Success)
3027 && format == 32 && type == XA_ATOM)
3028 while (nitems > 0)
3030 nitems--;
3031 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
3032 need_delete = 0;
3033 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
3034 need_focus = 0;
3035 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
3036 need_save = 0;
3038 if (atoms) XFree ((char *) atoms);
3041 Atom props [10];
3042 int count = 0;
3043 if (need_delete)
3044 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
3045 if (need_focus)
3046 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
3047 if (need_save)
3048 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
3049 if (count)
3050 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
3051 XA_ATOM, 32, PropModeAppend,
3052 (unsigned char *) props, count);
3054 UNBLOCK_INPUT;
3056 #endif
3060 /* Support routines for XIC (X Input Context). */
3062 #ifdef HAVE_X_I18N
3064 static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
3065 static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
3068 /* Supported XIM styles, ordered by preferenc. */
3070 static XIMStyle supported_xim_styles[] =
3072 XIMPreeditPosition | XIMStatusArea,
3073 XIMPreeditPosition | XIMStatusNothing,
3074 XIMPreeditPosition | XIMStatusNone,
3075 XIMPreeditNothing | XIMStatusArea,
3076 XIMPreeditNothing | XIMStatusNothing,
3077 XIMPreeditNothing | XIMStatusNone,
3078 XIMPreeditNone | XIMStatusArea,
3079 XIMPreeditNone | XIMStatusNothing,
3080 XIMPreeditNone | XIMStatusNone,
3085 /* Create an X fontset on frame F with base font name
3086 BASE_FONTNAME.. */
3088 static XFontSet
3089 xic_create_xfontset (f, base_fontname)
3090 struct frame *f;
3091 char *base_fontname;
3093 XFontSet xfs;
3094 char **missing_list;
3095 int missing_count;
3096 char *def_string;
3098 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
3099 base_fontname, &missing_list,
3100 &missing_count, &def_string);
3101 if (missing_list)
3102 XFreeStringList (missing_list);
3104 /* No need to free def_string. */
3105 return xfs;
3109 /* Value is the best input style, given user preferences USER (already
3110 checked to be supported by Emacs), and styles supported by the
3111 input method XIM. */
3113 static XIMStyle
3114 best_xim_style (user, xim)
3115 XIMStyles *user;
3116 XIMStyles *xim;
3118 int i, j;
3120 for (i = 0; i < user->count_styles; ++i)
3121 for (j = 0; j < xim->count_styles; ++j)
3122 if (user->supported_styles[i] == xim->supported_styles[j])
3123 return user->supported_styles[i];
3125 /* Return the default style. */
3126 return XIMPreeditNothing | XIMStatusNothing;
3129 /* Create XIC for frame F. */
3131 void
3132 create_frame_xic (f)
3133 struct frame *f;
3135 XIM xim;
3136 XIC xic = NULL;
3137 XFontSet xfs = NULL;
3138 static XIMStyle xic_style;
3140 if (FRAME_XIC (f))
3141 return;
3143 xim = FRAME_X_XIM (f);
3144 if (xim)
3146 XRectangle s_area;
3147 XPoint spot;
3148 XVaNestedList preedit_attr;
3149 XVaNestedList status_attr;
3150 char *base_fontname;
3151 int fontset;
3153 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
3154 spot.x = 0; spot.y = 1;
3155 /* Create X fontset. */
3156 fontset = FRAME_FONTSET (f);
3157 if (fontset < 0)
3158 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3159 else
3161 /* Determine the base fontname from the ASCII font name of
3162 FONTSET. */
3163 char *ascii_font = (char *) XSTRING (fontset_ascii (fontset))->data;
3164 char *p = ascii_font;
3165 int i;
3167 for (i = 0; *p; p++)
3168 if (*p == '-') i++;
3169 if (i != 14)
3170 /* As the font name doesn't conform to XLFD, we can't
3171 modify it to get a suitable base fontname for the
3172 frame. */
3173 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3174 else
3176 int len = strlen (ascii_font) + 1;
3177 char *p1;
3179 for (i = 0, p = ascii_font; i < 8; p++)
3181 if (*p == '-')
3183 i++;
3184 if (i == 3)
3185 p1 = p + 1;
3188 base_fontname = (char *) alloca (len);
3189 bzero (base_fontname, len);
3190 strcpy (base_fontname, "-*-*-");
3191 bcopy (p1, base_fontname + 5, p - p1);
3192 strcat (base_fontname, "*-*-*-*-*-*-*");
3195 xfs = xic_create_xfontset (f, base_fontname);
3197 /* Determine XIC style. */
3198 if (xic_style == 0)
3200 XIMStyles supported_list;
3201 supported_list.count_styles = (sizeof supported_xim_styles
3202 / sizeof supported_xim_styles[0]);
3203 supported_list.supported_styles = supported_xim_styles;
3204 xic_style = best_xim_style (&supported_list,
3205 FRAME_X_XIM_STYLES (f));
3208 preedit_attr = XVaCreateNestedList (0,
3209 XNFontSet, xfs,
3210 XNForeground,
3211 FRAME_FOREGROUND_PIXEL (f),
3212 XNBackground,
3213 FRAME_BACKGROUND_PIXEL (f),
3214 (xic_style & XIMPreeditPosition
3215 ? XNSpotLocation
3216 : NULL),
3217 &spot,
3218 NULL);
3219 status_attr = XVaCreateNestedList (0,
3220 XNArea,
3221 &s_area,
3222 XNFontSet,
3223 xfs,
3224 XNForeground,
3225 FRAME_FOREGROUND_PIXEL (f),
3226 XNBackground,
3227 FRAME_BACKGROUND_PIXEL (f),
3228 NULL);
3230 xic = XCreateIC (xim,
3231 XNInputStyle, xic_style,
3232 XNClientWindow, FRAME_X_WINDOW(f),
3233 XNFocusWindow, FRAME_X_WINDOW(f),
3234 XNStatusAttributes, status_attr,
3235 XNPreeditAttributes, preedit_attr,
3236 NULL);
3237 XFree (preedit_attr);
3238 XFree (status_attr);
3241 FRAME_XIC (f) = xic;
3242 FRAME_XIC_STYLE (f) = xic_style;
3243 FRAME_XIC_FONTSET (f) = xfs;
3247 /* Destroy XIC and free XIC fontset of frame F, if any. */
3249 void
3250 free_frame_xic (f)
3251 struct frame *f;
3253 if (FRAME_XIC (f) == NULL)
3254 return;
3256 XDestroyIC (FRAME_XIC (f));
3257 if (FRAME_XIC_FONTSET (f))
3258 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
3260 FRAME_XIC (f) = NULL;
3261 FRAME_XIC_FONTSET (f) = NULL;
3265 /* Place preedit area for XIC of window W's frame to specified
3266 pixel position X/Y. X and Y are relative to window W. */
3268 void
3269 xic_set_preeditarea (w, x, y)
3270 struct window *w;
3271 int x, y;
3273 struct frame *f = XFRAME (w->frame);
3274 XVaNestedList attr;
3275 XPoint spot;
3277 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x);
3278 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
3279 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
3280 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
3281 XFree (attr);
3285 /* Place status area for XIC in bottom right corner of frame F.. */
3287 void
3288 xic_set_statusarea (f)
3289 struct frame *f;
3291 XIC xic = FRAME_XIC (f);
3292 XVaNestedList attr;
3293 XRectangle area;
3294 XRectangle *needed;
3296 /* Negotiate geometry of status area. If input method has existing
3297 status area, use its current size. */
3298 area.x = area.y = area.width = area.height = 0;
3299 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
3300 XSetICValues (xic, XNStatusAttributes, attr, NULL);
3301 XFree (attr);
3303 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
3304 XGetICValues (xic, XNStatusAttributes, attr, NULL);
3305 XFree (attr);
3307 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
3309 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
3310 XGetICValues (xic, XNStatusAttributes, attr, NULL);
3311 XFree (attr);
3314 area.width = needed->width;
3315 area.height = needed->height;
3316 area.x = PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
3317 area.y = (PIXEL_HEIGHT (f) - area.height
3318 - FRAME_MENUBAR_HEIGHT (f) - FRAME_INTERNAL_BORDER_WIDTH (f));
3319 XFree (needed);
3321 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
3322 XSetICValues(xic, XNStatusAttributes, attr, NULL);
3323 XFree (attr);
3327 /* Set X fontset for XIC of frame F, using base font name
3328 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3330 void
3331 xic_set_xfontset (f, base_fontname)
3332 struct frame *f;
3333 char *base_fontname;
3335 XVaNestedList attr;
3336 XFontSet xfs;
3338 xfs = xic_create_xfontset (f, base_fontname);
3340 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
3341 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
3342 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
3343 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
3344 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
3345 XFree (attr);
3347 if (FRAME_XIC_FONTSET (f))
3348 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
3349 FRAME_XIC_FONTSET (f) = xfs;
3352 #endif /* HAVE_X_I18N */
3356 #ifdef USE_X_TOOLKIT
3358 /* Create and set up the X widget for frame F. */
3360 static void
3361 x_window (f, window_prompting, minibuffer_only)
3362 struct frame *f;
3363 long window_prompting;
3364 int minibuffer_only;
3366 XClassHint class_hints;
3367 XSetWindowAttributes attributes;
3368 unsigned long attribute_mask;
3369 Widget shell_widget;
3370 Widget pane_widget;
3371 Widget frame_widget;
3372 Arg al [25];
3373 int ac;
3375 BLOCK_INPUT;
3377 /* Use the resource name as the top-level widget name
3378 for looking up resources. Make a non-Lisp copy
3379 for the window manager, so GC relocation won't bother it.
3381 Elsewhere we specify the window name for the window manager. */
3384 char *str = (char *) XSTRING (Vx_resource_name)->data;
3385 f->namebuf = (char *) xmalloc (strlen (str) + 1);
3386 strcpy (f->namebuf, str);
3389 ac = 0;
3390 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
3391 XtSetArg (al[ac], XtNinput, 1); ac++;
3392 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
3393 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
3394 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3395 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3396 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
3397 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
3398 applicationShellWidgetClass,
3399 FRAME_X_DISPLAY (f), al, ac);
3401 f->output_data.x->widget = shell_widget;
3402 /* maybe_set_screen_title_format (shell_widget); */
3404 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
3405 (widget_value *) NULL,
3406 shell_widget, False,
3407 (lw_callback) NULL,
3408 (lw_callback) NULL,
3409 (lw_callback) NULL,
3410 (lw_callback) NULL);
3412 ac = 0;
3413 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3414 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3415 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
3416 XtSetValues (pane_widget, al, ac);
3417 f->output_data.x->column_widget = pane_widget;
3419 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3420 the emacs screen when changing menubar. This reduces flickering. */
3422 ac = 0;
3423 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
3424 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
3425 XtSetArg (al[ac], XtNallowResize, 1); ac++;
3426 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
3427 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
3428 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3429 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3430 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
3431 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
3432 al, ac);
3434 f->output_data.x->edit_widget = frame_widget;
3436 XtManageChild (frame_widget);
3438 /* Do some needed geometry management. */
3440 int len;
3441 char *tem, shell_position[32];
3442 Arg al[2];
3443 int ac = 0;
3444 int extra_borders = 0;
3445 int menubar_size
3446 = (f->output_data.x->menubar_widget
3447 ? (f->output_data.x->menubar_widget->core.height
3448 + f->output_data.x->menubar_widget->core.border_width)
3449 : 0);
3451 #if 0 /* Experimentally, we now get the right results
3452 for -geometry -0-0 without this. 24 Aug 96, rms. */
3453 if (FRAME_EXTERNAL_MENU_BAR (f))
3455 Dimension ibw = 0;
3456 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
3457 menubar_size += ibw;
3459 #endif
3461 f->output_data.x->menubar_height = menubar_size;
3463 #ifndef USE_LUCID
3464 /* Motif seems to need this amount added to the sizes
3465 specified for the shell widget. The Athena/Lucid widgets don't.
3466 Both conclusions reached experimentally. -- rms. */
3467 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
3468 &extra_borders, NULL);
3469 extra_borders *= 2;
3470 #endif
3472 /* Convert our geometry parameters into a geometry string
3473 and specify it.
3474 Note that we do not specify here whether the position
3475 is a user-specified or program-specified one.
3476 We pass that information later, in x_wm_set_size_hints. */
3478 int left = f->output_data.x->left_pos;
3479 int xneg = window_prompting & XNegative;
3480 int top = f->output_data.x->top_pos;
3481 int yneg = window_prompting & YNegative;
3482 if (xneg)
3483 left = -left;
3484 if (yneg)
3485 top = -top;
3487 if (window_prompting & USPosition)
3488 sprintf (shell_position, "=%dx%d%c%d%c%d",
3489 PIXEL_WIDTH (f) + extra_borders,
3490 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
3491 (xneg ? '-' : '+'), left,
3492 (yneg ? '-' : '+'), top);
3493 else
3494 sprintf (shell_position, "=%dx%d",
3495 PIXEL_WIDTH (f) + extra_borders,
3496 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
3499 len = strlen (shell_position) + 1;
3500 /* We don't free this because we don't know whether
3501 it is safe to free it while the frame exists.
3502 It isn't worth the trouble of arranging to free it
3503 when the frame is deleted. */
3504 tem = (char *) xmalloc (len);
3505 strncpy (tem, shell_position, len);
3506 XtSetArg (al[ac], XtNgeometry, tem); ac++;
3507 XtSetValues (shell_widget, al, ac);
3510 XtManageChild (pane_widget);
3511 XtRealizeWidget (shell_widget);
3513 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
3515 validate_x_resource_name ();
3517 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
3518 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
3519 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
3521 #ifdef HAVE_X_I18N
3522 FRAME_XIC (f) = NULL;
3523 create_frame_xic (f);
3524 #endif
3526 f->output_data.x->wm_hints.input = True;
3527 f->output_data.x->wm_hints.flags |= InputHint;
3528 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3529 &f->output_data.x->wm_hints);
3531 hack_wm_protocols (f, shell_widget);
3533 #ifdef HACK_EDITRES
3534 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
3535 #endif
3537 /* Do a stupid property change to force the server to generate a
3538 PropertyNotify event so that the event_stream server timestamp will
3539 be initialized to something relevant to the time we created the window.
3541 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
3542 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
3543 XA_ATOM, 32, PropModeAppend,
3544 (unsigned char*) NULL, 0);
3546 /* Make all the standard events reach the Emacs frame. */
3547 attributes.event_mask = STANDARD_EVENT_SET;
3549 #ifdef HAVE_X_I18N
3550 if (FRAME_XIC (f))
3552 /* XIM server might require some X events. */
3553 unsigned long fevent = NoEventMask;
3554 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
3555 attributes.event_mask |= fevent;
3557 #endif /* HAVE_X_I18N */
3559 attribute_mask = CWEventMask;
3560 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
3561 attribute_mask, &attributes);
3563 XtMapWidget (frame_widget);
3565 /* x_set_name normally ignores requests to set the name if the
3566 requested name is the same as the current name. This is the one
3567 place where that assumption isn't correct; f->name is set, but
3568 the X server hasn't been told. */
3570 Lisp_Object name;
3571 int explicit = f->explicit_name;
3573 f->explicit_name = 0;
3574 name = f->name;
3575 f->name = Qnil;
3576 x_set_name (f, name, explicit);
3579 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3580 f->output_data.x->text_cursor);
3582 UNBLOCK_INPUT;
3584 /* This is a no-op, except under Motif. Make sure main areas are
3585 set to something reasonable, in case we get an error later. */
3586 lw_set_main_areas (pane_widget, 0, frame_widget);
3589 #else /* not USE_X_TOOLKIT */
3591 /* Create and set up the X window for frame F. */
3593 void
3594 x_window (f)
3595 struct frame *f;
3598 XClassHint class_hints;
3599 XSetWindowAttributes attributes;
3600 unsigned long attribute_mask;
3602 attributes.background_pixel = f->output_data.x->background_pixel;
3603 attributes.border_pixel = f->output_data.x->border_pixel;
3604 attributes.bit_gravity = StaticGravity;
3605 attributes.backing_store = NotUseful;
3606 attributes.save_under = True;
3607 attributes.event_mask = STANDARD_EVENT_SET;
3608 attributes.colormap = FRAME_X_COLORMAP (f);
3609 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
3610 | CWColormap);
3612 BLOCK_INPUT;
3613 FRAME_X_WINDOW (f)
3614 = XCreateWindow (FRAME_X_DISPLAY (f),
3615 f->output_data.x->parent_desc,
3616 f->output_data.x->left_pos,
3617 f->output_data.x->top_pos,
3618 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
3619 f->output_data.x->border_width,
3620 CopyFromParent, /* depth */
3621 InputOutput, /* class */
3622 FRAME_X_VISUAL (f),
3623 attribute_mask, &attributes);
3625 #ifdef HAVE_X_I18N
3626 create_frame_xic (f);
3627 if (FRAME_XIC (f))
3629 /* XIM server might require some X events. */
3630 unsigned long fevent = NoEventMask;
3631 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
3632 attributes.event_mask |= fevent;
3633 attribute_mask = CWEventMask;
3634 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3635 attribute_mask, &attributes);
3637 #endif /* HAVE_X_I18N */
3639 validate_x_resource_name ();
3641 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
3642 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
3643 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
3645 /* The menubar is part of the ordinary display;
3646 it does not count in addition to the height of the window. */
3647 f->output_data.x->menubar_height = 0;
3649 /* This indicates that we use the "Passive Input" input model.
3650 Unless we do this, we don't get the Focus{In,Out} events that we
3651 need to draw the cursor correctly. Accursed bureaucrats.
3652 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3654 f->output_data.x->wm_hints.input = True;
3655 f->output_data.x->wm_hints.flags |= InputHint;
3656 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3657 &f->output_data.x->wm_hints);
3658 f->output_data.x->wm_hints.icon_pixmap = None;
3660 /* Request "save yourself" and "delete window" commands from wm. */
3662 Atom protocols[2];
3663 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
3664 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
3665 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
3668 /* x_set_name normally ignores requests to set the name if the
3669 requested name is the same as the current name. This is the one
3670 place where that assumption isn't correct; f->name is set, but
3671 the X server hasn't been told. */
3673 Lisp_Object name;
3674 int explicit = f->explicit_name;
3676 f->explicit_name = 0;
3677 name = f->name;
3678 f->name = Qnil;
3679 x_set_name (f, name, explicit);
3682 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3683 f->output_data.x->text_cursor);
3685 UNBLOCK_INPUT;
3687 if (FRAME_X_WINDOW (f) == 0)
3688 error ("Unable to create window");
3691 #endif /* not USE_X_TOOLKIT */
3693 /* Handle the icon stuff for this window. Perhaps later we might
3694 want an x_set_icon_position which can be called interactively as
3695 well. */
3697 static void
3698 x_icon (f, parms)
3699 struct frame *f;
3700 Lisp_Object parms;
3702 Lisp_Object icon_x, icon_y;
3703 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3705 /* Set the position of the icon. Note that twm groups all
3706 icons in an icon window. */
3707 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
3708 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
3709 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
3711 CHECK_NUMBER (icon_x, 0);
3712 CHECK_NUMBER (icon_y, 0);
3714 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
3715 error ("Both left and top icon corners of icon must be specified");
3717 BLOCK_INPUT;
3719 if (! EQ (icon_x, Qunbound))
3720 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3722 /* Start up iconic or window? */
3723 x_wm_set_window_state
3724 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
3725 Qicon)
3726 ? IconicState
3727 : NormalState));
3729 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
3730 ? f->icon_name
3731 : f->name))->data);
3733 UNBLOCK_INPUT;
3736 /* Make the GC's needed for this window, setting the
3737 background, border and mouse colors; also create the
3738 mouse cursor and the gray border tile. */
3740 static char cursor_bits[] =
3742 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3743 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3744 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3745 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3748 static void
3749 x_make_gc (f)
3750 struct frame *f;
3752 XGCValues gc_values;
3754 BLOCK_INPUT;
3756 /* Create the GC's of this frame.
3757 Note that many default values are used. */
3759 /* Normal video */
3760 gc_values.font = f->output_data.x->font->fid;
3761 gc_values.foreground = f->output_data.x->foreground_pixel;
3762 gc_values.background = f->output_data.x->background_pixel;
3763 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3764 f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
3765 FRAME_X_WINDOW (f),
3766 GCLineWidth | GCFont
3767 | GCForeground | GCBackground,
3768 &gc_values);
3770 /* Reverse video style. */
3771 gc_values.foreground = f->output_data.x->background_pixel;
3772 gc_values.background = f->output_data.x->foreground_pixel;
3773 f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
3774 FRAME_X_WINDOW (f),
3775 GCFont | GCForeground | GCBackground
3776 | GCLineWidth,
3777 &gc_values);
3779 /* Cursor has cursor-color background, background-color foreground. */
3780 gc_values.foreground = f->output_data.x->background_pixel;
3781 gc_values.background = f->output_data.x->cursor_pixel;
3782 gc_values.fill_style = FillOpaqueStippled;
3783 gc_values.stipple
3784 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3785 FRAME_X_DISPLAY_INFO (f)->root_window,
3786 cursor_bits, 16, 16);
3787 f->output_data.x->cursor_gc
3788 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3789 (GCFont | GCForeground | GCBackground
3790 | GCFillStyle /* | GCStipple */ | GCLineWidth),
3791 &gc_values);
3793 /* Reliefs. */
3794 f->output_data.x->white_relief.gc = 0;
3795 f->output_data.x->black_relief.gc = 0;
3797 /* Create the gray border tile used when the pointer is not in
3798 the frame. Since this depends on the frame's pixel values,
3799 this must be done on a per-frame basis. */
3800 f->output_data.x->border_tile
3801 = (XCreatePixmapFromBitmapData
3802 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3803 gray_bits, gray_width, gray_height,
3804 f->output_data.x->foreground_pixel,
3805 f->output_data.x->background_pixel,
3806 DefaultDepth (FRAME_X_DISPLAY (f),
3807 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
3809 UNBLOCK_INPUT;
3812 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3813 1, 1, 0,
3814 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3815 Returns an Emacs frame object.\n\
3816 ALIST is an alist of frame parameters.\n\
3817 If the parameters specify that the frame should not have a minibuffer,\n\
3818 and do not specify a specific minibuffer window to use,\n\
3819 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3820 be shared by the new frame.\n\
3822 This function is an internal primitive--use `make-frame' instead.")
3823 (parms)
3824 Lisp_Object parms;
3826 struct frame *f;
3827 Lisp_Object frame, tem;
3828 Lisp_Object name;
3829 int minibuffer_only = 0;
3830 long window_prompting = 0;
3831 int width, height;
3832 int count = specpdl_ptr - specpdl;
3833 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3834 Lisp_Object display;
3835 struct x_display_info *dpyinfo = NULL;
3836 Lisp_Object parent;
3837 struct kboard *kb;
3839 check_x ();
3841 /* Use this general default value to start with
3842 until we know if this frame has a specified name. */
3843 Vx_resource_name = Vinvocation_name;
3845 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
3846 if (EQ (display, Qunbound))
3847 display = Qnil;
3848 dpyinfo = check_x_display_info (display);
3849 #ifdef MULTI_KBOARD
3850 kb = dpyinfo->kboard;
3851 #else
3852 kb = &the_only_kboard;
3853 #endif
3855 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
3856 if (!STRINGP (name)
3857 && ! EQ (name, Qunbound)
3858 && ! NILP (name))
3859 error ("Invalid frame name--not a string or nil");
3861 if (STRINGP (name))
3862 Vx_resource_name = name;
3864 /* See if parent window is specified. */
3865 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
3866 if (EQ (parent, Qunbound))
3867 parent = Qnil;
3868 if (! NILP (parent))
3869 CHECK_NUMBER (parent, 0);
3871 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3872 /* No need to protect DISPLAY because that's not used after passing
3873 it to make_frame_without_minibuffer. */
3874 frame = Qnil;
3875 GCPRO4 (parms, parent, name, frame);
3876 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
3877 RES_TYPE_SYMBOL);
3878 if (EQ (tem, Qnone) || NILP (tem))
3879 f = make_frame_without_minibuffer (Qnil, kb, display);
3880 else if (EQ (tem, Qonly))
3882 f = make_minibuffer_frame ();
3883 minibuffer_only = 1;
3885 else if (WINDOWP (tem))
3886 f = make_frame_without_minibuffer (tem, kb, display);
3887 else
3888 f = make_frame (1);
3890 XSETFRAME (frame, f);
3892 /* Note that X Windows does support scroll bars. */
3893 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3895 f->output_method = output_x_window;
3896 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3897 bzero (f->output_data.x, sizeof (struct x_output));
3898 f->output_data.x->icon_bitmap = -1;
3899 f->output_data.x->fontset = -1;
3900 f->output_data.x->scroll_bar_foreground_pixel = -1;
3901 f->output_data.x->scroll_bar_background_pixel = -1;
3903 f->icon_name
3904 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
3905 RES_TYPE_STRING);
3906 if (! STRINGP (f->icon_name))
3907 f->icon_name = Qnil;
3909 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3910 #ifdef MULTI_KBOARD
3911 FRAME_KBOARD (f) = kb;
3912 #endif
3914 /* These colors will be set anyway later, but it's important
3915 to get the color reference counts right, so initialize them! */
3917 Lisp_Object black;
3918 struct gcpro gcpro1;
3920 black = build_string ("black");
3921 GCPRO1 (black);
3922 f->output_data.x->foreground_pixel
3923 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3924 f->output_data.x->background_pixel
3925 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3926 f->output_data.x->cursor_pixel
3927 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3928 f->output_data.x->cursor_foreground_pixel
3929 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3930 f->output_data.x->border_pixel
3931 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3932 f->output_data.x->mouse_pixel
3933 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3934 UNGCPRO;
3937 /* Specify the parent under which to make this X window. */
3939 if (!NILP (parent))
3941 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3942 f->output_data.x->explicit_parent = 1;
3944 else
3946 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3947 f->output_data.x->explicit_parent = 0;
3950 /* Set the name; the functions to which we pass f expect the name to
3951 be set. */
3952 if (EQ (name, Qunbound) || NILP (name))
3954 f->name = build_string (dpyinfo->x_id_name);
3955 f->explicit_name = 0;
3957 else
3959 f->name = name;
3960 f->explicit_name = 1;
3961 /* use the frame's title when getting resources for this frame. */
3962 specbind (Qx_resource_name, name);
3965 /* Extract the window parameters from the supplied values
3966 that are needed to determine window geometry. */
3968 Lisp_Object font;
3970 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
3972 BLOCK_INPUT;
3973 /* First, try whatever font the caller has specified. */
3974 if (STRINGP (font))
3976 tem = Fquery_fontset (font, Qnil);
3977 if (STRINGP (tem))
3978 font = x_new_fontset (f, XSTRING (tem)->data);
3979 else
3980 font = x_new_font (f, XSTRING (font)->data);
3983 /* Try out a font which we hope has bold and italic variations. */
3984 if (!STRINGP (font))
3985 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3986 if (!STRINGP (font))
3987 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3988 if (! STRINGP (font))
3989 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3990 if (! STRINGP (font))
3991 /* This was formerly the first thing tried, but it finds too many fonts
3992 and takes too long. */
3993 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3994 /* If those didn't work, look for something which will at least work. */
3995 if (! STRINGP (font))
3996 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3997 UNBLOCK_INPUT;
3998 if (! STRINGP (font))
3999 font = build_string ("fixed");
4001 x_default_parameter (f, parms, Qfont, font,
4002 "font", "Font", RES_TYPE_STRING);
4005 #ifdef USE_LUCID
4006 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4007 whereby it fails to get any font. */
4008 xlwmenu_default_font = f->output_data.x->font;
4009 #endif
4011 x_default_parameter (f, parms, Qborder_width, make_number (2),
4012 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4014 /* This defaults to 2 in order to match xterm. We recognize either
4015 internalBorderWidth or internalBorder (which is what xterm calls
4016 it). */
4017 if (NILP (Fassq (Qinternal_border_width, parms)))
4019 Lisp_Object value;
4021 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
4022 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
4023 if (! EQ (value, Qunbound))
4024 parms = Fcons (Fcons (Qinternal_border_width, value),
4025 parms);
4027 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
4028 "internalBorderWidth", "internalBorderWidth",
4029 RES_TYPE_NUMBER);
4030 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
4031 "verticalScrollBars", "ScrollBars",
4032 RES_TYPE_SYMBOL);
4034 /* Also do the stuff which must be set before the window exists. */
4035 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
4036 "foreground", "Foreground", RES_TYPE_STRING);
4037 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
4038 "background", "Background", RES_TYPE_STRING);
4039 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
4040 "pointerColor", "Foreground", RES_TYPE_STRING);
4041 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
4042 "cursorColor", "Foreground", RES_TYPE_STRING);
4043 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
4044 "borderColor", "BorderColor", RES_TYPE_STRING);
4045 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
4046 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
4047 x_default_parameter (f, parms, Qline_spacing, Qnil,
4048 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
4050 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
4051 "scrollBarForeground",
4052 "ScrollBarForeground", 1);
4053 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
4054 "scrollBarBackground",
4055 "ScrollBarBackground", 0);
4057 /* Init faces before x_default_parameter is called for scroll-bar
4058 parameters because that function calls x_set_scroll_bar_width,
4059 which calls change_frame_size, which calls Fset_window_buffer,
4060 which runs hooks, which call Fvertical_motion. At the end, we
4061 end up in init_iterator with a null face cache, which should not
4062 happen. */
4063 init_frame_faces (f);
4065 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
4066 "menuBar", "MenuBar", RES_TYPE_NUMBER);
4067 x_default_parameter (f, parms, Qtool_bar_lines, make_number (0),
4068 "toolBar", "ToolBar", RES_TYPE_NUMBER);
4069 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
4070 "bufferPredicate", "BufferPredicate",
4071 RES_TYPE_SYMBOL);
4072 x_default_parameter (f, parms, Qtitle, Qnil,
4073 "title", "Title", RES_TYPE_STRING);
4075 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
4076 window_prompting = x_figure_window_size (f, parms);
4078 if (window_prompting & XNegative)
4080 if (window_prompting & YNegative)
4081 f->output_data.x->win_gravity = SouthEastGravity;
4082 else
4083 f->output_data.x->win_gravity = NorthEastGravity;
4085 else
4087 if (window_prompting & YNegative)
4088 f->output_data.x->win_gravity = SouthWestGravity;
4089 else
4090 f->output_data.x->win_gravity = NorthWestGravity;
4093 f->output_data.x->size_hint_flags = window_prompting;
4095 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4096 f->no_split = minibuffer_only || EQ (tem, Qt);
4098 /* Create the X widget or window. Add the tool-bar height to the
4099 initial frame height so that the user gets a text display area of
4100 the size he specified with -g or via .Xdefaults. Later changes
4101 of the tool-bar height don't change the frame size. This is done
4102 so that users can create tall Emacs frames without having to
4103 guess how tall the tool-bar will get. */
4104 f->height += FRAME_TOOL_BAR_LINES (f);
4106 #ifdef USE_X_TOOLKIT
4107 x_window (f, window_prompting, minibuffer_only);
4108 #else
4109 x_window (f);
4110 #endif
4112 x_icon (f, parms);
4113 x_make_gc (f);
4115 /* Now consider the frame official. */
4116 FRAME_X_DISPLAY_INFO (f)->reference_count++;
4117 Vframe_list = Fcons (frame, Vframe_list);
4119 /* We need to do this after creating the X window, so that the
4120 icon-creation functions can say whose icon they're describing. */
4121 x_default_parameter (f, parms, Qicon_type, Qnil,
4122 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
4124 x_default_parameter (f, parms, Qauto_raise, Qnil,
4125 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4126 x_default_parameter (f, parms, Qauto_lower, Qnil,
4127 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4128 x_default_parameter (f, parms, Qcursor_type, Qbox,
4129 "cursorType", "CursorType", RES_TYPE_SYMBOL);
4130 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
4131 "scrollBarWidth", "ScrollBarWidth",
4132 RES_TYPE_NUMBER);
4134 /* Dimensions, especially f->height, must be done via change_frame_size.
4135 Change will not be effected unless different from the current
4136 f->height. */
4137 width = f->width;
4138 height = f->height;
4139 f->height = 0;
4140 SET_FRAME_WIDTH (f, 0);
4141 change_frame_size (f, height, width, 1, 0, 0);
4143 /* Set up faces after all frame parameters are known. */
4144 call1 (Qface_set_after_frame_default, frame);
4146 #ifdef USE_X_TOOLKIT
4147 /* Create the menu bar. */
4148 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4150 /* If this signals an error, we haven't set size hints for the
4151 frame and we didn't make it visible. */
4152 initialize_frame_menubar (f);
4154 /* This is a no-op, except under Motif where it arranges the
4155 main window for the widgets on it. */
4156 lw_set_main_areas (f->output_data.x->column_widget,
4157 f->output_data.x->menubar_widget,
4158 f->output_data.x->edit_widget);
4160 #endif /* USE_X_TOOLKIT */
4162 /* Tell the server what size and position, etc, we want, and how
4163 badly we want them. This should be done after we have the menu
4164 bar so that its size can be taken into account. */
4165 BLOCK_INPUT;
4166 x_wm_set_size_hint (f, window_prompting, 0);
4167 UNBLOCK_INPUT;
4169 /* Make the window appear on the frame and enable display, unless
4170 the caller says not to. However, with explicit parent, Emacs
4171 cannot control visibility, so don't try. */
4172 if (! f->output_data.x->explicit_parent)
4174 Lisp_Object visibility;
4176 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
4177 RES_TYPE_SYMBOL);
4178 if (EQ (visibility, Qunbound))
4179 visibility = Qt;
4181 if (EQ (visibility, Qicon))
4182 x_iconify_frame (f);
4183 else if (! NILP (visibility))
4184 x_make_frame_visible (f);
4185 else
4186 /* Must have been Qnil. */
4190 UNGCPRO;
4191 return unbind_to (count, frame);
4194 /* FRAME is used only to get a handle on the X display. We don't pass the
4195 display info directly because we're called from frame.c, which doesn't
4196 know about that structure. */
4198 Lisp_Object
4199 x_get_focus_frame (frame)
4200 struct frame *frame;
4202 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
4203 Lisp_Object xfocus;
4204 if (! dpyinfo->x_focus_frame)
4205 return Qnil;
4207 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
4208 return xfocus;
4212 /* In certain situations, when the window manager follows a
4213 click-to-focus policy, there seems to be no way around calling
4214 XSetInputFocus to give another frame the input focus .
4216 In an ideal world, XSetInputFocus should generally be avoided so
4217 that applications don't interfere with the window manager's focus
4218 policy. But I think it's okay to use when it's clearly done
4219 following a user-command. */
4221 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
4222 "Set the input focus to FRAME.\n\
4223 FRAME nil means use the selected frame.")
4224 (frame)
4225 Lisp_Object frame;
4227 struct frame *f = check_x_frame (frame);
4228 Display *dpy = FRAME_X_DISPLAY (f);
4229 int count;
4231 BLOCK_INPUT;
4232 count = x_catch_errors (dpy);
4233 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4234 RevertToParent, CurrentTime);
4235 x_uncatch_errors (dpy, count);
4236 UNBLOCK_INPUT;
4238 return Qnil;
4242 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
4243 "Internal function called by `color-defined-p', which see.")
4244 (color, frame)
4245 Lisp_Object color, frame;
4247 XColor foo;
4248 FRAME_PTR f = check_x_frame (frame);
4250 CHECK_STRING (color, 1);
4252 if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
4253 return Qt;
4254 else
4255 return Qnil;
4258 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
4259 "Internal function called by `color-values', which see.")
4260 (color, frame)
4261 Lisp_Object color, frame;
4263 XColor foo;
4264 FRAME_PTR f = check_x_frame (frame);
4266 CHECK_STRING (color, 1);
4268 if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
4270 Lisp_Object rgb[3];
4272 rgb[0] = make_number (foo.red);
4273 rgb[1] = make_number (foo.green);
4274 rgb[2] = make_number (foo.blue);
4275 return Flist (3, rgb);
4277 else
4278 return Qnil;
4281 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
4282 "Internal function called by `display-color-p', which see.")
4283 (display)
4284 Lisp_Object display;
4286 struct x_display_info *dpyinfo = check_x_display_info (display);
4288 if (dpyinfo->n_planes <= 2)
4289 return Qnil;
4291 switch (dpyinfo->visual->class)
4293 case StaticColor:
4294 case PseudoColor:
4295 case TrueColor:
4296 case DirectColor:
4297 return Qt;
4299 default:
4300 return Qnil;
4304 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
4305 0, 1, 0,
4306 "Return t if the X display supports shades of gray.\n\
4307 Note that color displays do support shades of gray.\n\
4308 The optional argument DISPLAY specifies which display to ask about.\n\
4309 DISPLAY should be either a frame or a display name (a string).\n\
4310 If omitted or nil, that stands for the selected frame's display.")
4311 (display)
4312 Lisp_Object display;
4314 struct x_display_info *dpyinfo = check_x_display_info (display);
4316 if (dpyinfo->n_planes <= 1)
4317 return Qnil;
4319 switch (dpyinfo->visual->class)
4321 case StaticColor:
4322 case PseudoColor:
4323 case TrueColor:
4324 case DirectColor:
4325 case StaticGray:
4326 case GrayScale:
4327 return Qt;
4329 default:
4330 return Qnil;
4334 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
4335 0, 1, 0,
4336 "Returns the width in pixels of the X display DISPLAY.\n\
4337 The optional argument DISPLAY specifies which display to ask about.\n\
4338 DISPLAY should be either a frame or a display name (a string).\n\
4339 If omitted or nil, that stands for the selected frame's display.")
4340 (display)
4341 Lisp_Object display;
4343 struct x_display_info *dpyinfo = check_x_display_info (display);
4345 return make_number (dpyinfo->width);
4348 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
4349 Sx_display_pixel_height, 0, 1, 0,
4350 "Returns the height in pixels of the X display DISPLAY.\n\
4351 The optional argument DISPLAY specifies which display to ask about.\n\
4352 DISPLAY should be either a frame or a display name (a string).\n\
4353 If omitted or nil, that stands for the selected frame's display.")
4354 (display)
4355 Lisp_Object display;
4357 struct x_display_info *dpyinfo = check_x_display_info (display);
4359 return make_number (dpyinfo->height);
4362 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
4363 0, 1, 0,
4364 "Returns the number of bitplanes of the X display DISPLAY.\n\
4365 The optional argument DISPLAY specifies which display to ask about.\n\
4366 DISPLAY should be either a frame or a display name (a string).\n\
4367 If omitted or nil, that stands for the selected frame's display.")
4368 (display)
4369 Lisp_Object display;
4371 struct x_display_info *dpyinfo = check_x_display_info (display);
4373 return make_number (dpyinfo->n_planes);
4376 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
4377 0, 1, 0,
4378 "Returns the number of color cells of the X display DISPLAY.\n\
4379 The optional argument DISPLAY specifies which display to ask about.\n\
4380 DISPLAY should be either a frame or a display name (a string).\n\
4381 If omitted or nil, that stands for the selected frame's display.")
4382 (display)
4383 Lisp_Object display;
4385 struct x_display_info *dpyinfo = check_x_display_info (display);
4387 return make_number (DisplayCells (dpyinfo->display,
4388 XScreenNumberOfScreen (dpyinfo->screen)));
4391 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
4392 Sx_server_max_request_size,
4393 0, 1, 0,
4394 "Returns the maximum request size of the X server of display DISPLAY.\n\
4395 The optional argument DISPLAY specifies which display to ask about.\n\
4396 DISPLAY should be either a frame or a display name (a string).\n\
4397 If omitted or nil, that stands for the selected frame's display.")
4398 (display)
4399 Lisp_Object display;
4401 struct x_display_info *dpyinfo = check_x_display_info (display);
4403 return make_number (MAXREQUEST (dpyinfo->display));
4406 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
4407 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4408 The optional argument DISPLAY specifies which display to ask about.\n\
4409 DISPLAY should be either a frame or a display name (a string).\n\
4410 If omitted or nil, that stands for the selected frame's display.")
4411 (display)
4412 Lisp_Object display;
4414 struct x_display_info *dpyinfo = check_x_display_info (display);
4415 char *vendor = ServerVendor (dpyinfo->display);
4417 if (! vendor) vendor = "";
4418 return build_string (vendor);
4421 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
4422 "Returns the version numbers of the X server of display DISPLAY.\n\
4423 The value is a list of three integers: the major and minor\n\
4424 version numbers of the X Protocol in use, and the vendor-specific release\n\
4425 number. See also the function `x-server-vendor'.\n\n\
4426 The optional argument DISPLAY specifies which display to ask about.\n\
4427 DISPLAY should be either a frame or a display name (a string).\n\
4428 If omitted or nil, that stands for the selected frame's display.")
4429 (display)
4430 Lisp_Object display;
4432 struct x_display_info *dpyinfo = check_x_display_info (display);
4433 Display *dpy = dpyinfo->display;
4435 return Fcons (make_number (ProtocolVersion (dpy)),
4436 Fcons (make_number (ProtocolRevision (dpy)),
4437 Fcons (make_number (VendorRelease (dpy)), Qnil)));
4440 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
4441 "Returns the number of screens on the X server of display DISPLAY.\n\
4442 The optional argument DISPLAY specifies which display to ask about.\n\
4443 DISPLAY should be either a frame or a display name (a string).\n\
4444 If omitted or nil, that stands for the selected frame's display.")
4445 (display)
4446 Lisp_Object display;
4448 struct x_display_info *dpyinfo = check_x_display_info (display);
4450 return make_number (ScreenCount (dpyinfo->display));
4453 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
4454 "Returns the height in millimeters of the X display DISPLAY.\n\
4455 The optional argument DISPLAY specifies which display to ask about.\n\
4456 DISPLAY should be either a frame or a display name (a string).\n\
4457 If omitted or nil, that stands for the selected frame's display.")
4458 (display)
4459 Lisp_Object display;
4461 struct x_display_info *dpyinfo = check_x_display_info (display);
4463 return make_number (HeightMMOfScreen (dpyinfo->screen));
4466 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
4467 "Returns the width in millimeters of the X display DISPLAY.\n\
4468 The optional argument DISPLAY specifies which display to ask about.\n\
4469 DISPLAY should be either a frame or a display name (a string).\n\
4470 If omitted or nil, that stands for the selected frame's display.")
4471 (display)
4472 Lisp_Object display;
4474 struct x_display_info *dpyinfo = check_x_display_info (display);
4476 return make_number (WidthMMOfScreen (dpyinfo->screen));
4479 DEFUN ("x-display-backing-store", Fx_display_backing_store,
4480 Sx_display_backing_store, 0, 1, 0,
4481 "Returns an indication of whether X display DISPLAY does backing store.\n\
4482 The value may be `always', `when-mapped', or `not-useful'.\n\
4483 The optional argument DISPLAY specifies which display to ask about.\n\
4484 DISPLAY should be either a frame or a display name (a string).\n\
4485 If omitted or nil, that stands for the selected frame's display.")
4486 (display)
4487 Lisp_Object display;
4489 struct x_display_info *dpyinfo = check_x_display_info (display);
4491 switch (DoesBackingStore (dpyinfo->screen))
4493 case Always:
4494 return intern ("always");
4496 case WhenMapped:
4497 return intern ("when-mapped");
4499 case NotUseful:
4500 return intern ("not-useful");
4502 default:
4503 error ("Strange value for BackingStore parameter of screen");
4507 DEFUN ("x-display-visual-class", Fx_display_visual_class,
4508 Sx_display_visual_class, 0, 1, 0,
4509 "Returns the visual class of the X display DISPLAY.\n\
4510 The value is one of the symbols `static-gray', `gray-scale',\n\
4511 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4512 The optional argument DISPLAY specifies which display to ask about.\n\
4513 DISPLAY should be either a frame or a display name (a string).\n\
4514 If omitted or nil, that stands for the selected frame's display.")
4515 (display)
4516 Lisp_Object display;
4518 struct x_display_info *dpyinfo = check_x_display_info (display);
4520 switch (dpyinfo->visual->class)
4522 case StaticGray: return (intern ("static-gray"));
4523 case GrayScale: return (intern ("gray-scale"));
4524 case StaticColor: return (intern ("static-color"));
4525 case PseudoColor: return (intern ("pseudo-color"));
4526 case TrueColor: return (intern ("true-color"));
4527 case DirectColor: return (intern ("direct-color"));
4528 default:
4529 error ("Display has an unknown visual class");
4533 DEFUN ("x-display-save-under", Fx_display_save_under,
4534 Sx_display_save_under, 0, 1, 0,
4535 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4536 The optional argument DISPLAY specifies which display to ask about.\n\
4537 DISPLAY should be either a frame or a display name (a string).\n\
4538 If omitted or nil, that stands for the selected frame's display.")
4539 (display)
4540 Lisp_Object display;
4542 struct x_display_info *dpyinfo = check_x_display_info (display);
4544 if (DoesSaveUnders (dpyinfo->screen) == True)
4545 return Qt;
4546 else
4547 return Qnil;
4551 x_pixel_width (f)
4552 register struct frame *f;
4554 return PIXEL_WIDTH (f);
4558 x_pixel_height (f)
4559 register struct frame *f;
4561 return PIXEL_HEIGHT (f);
4565 x_char_width (f)
4566 register struct frame *f;
4568 return FONT_WIDTH (f->output_data.x->font);
4572 x_char_height (f)
4573 register struct frame *f;
4575 return f->output_data.x->line_height;
4579 x_screen_planes (f)
4580 register struct frame *f;
4582 return FRAME_X_DISPLAY_INFO (f)->n_planes;
4587 /************************************************************************
4588 X Displays
4589 ************************************************************************/
4592 /* Mapping visual names to visuals. */
4594 static struct visual_class
4596 char *name;
4597 int class;
4599 visual_classes[] =
4601 {"StaticGray", StaticGray},
4602 {"GrayScale", GrayScale},
4603 {"StaticColor", StaticColor},
4604 {"PseudoColor", PseudoColor},
4605 {"TrueColor", TrueColor},
4606 {"DirectColor", DirectColor},
4607 NULL
4611 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4613 /* Value is the screen number of screen SCR. This is a substitute for
4614 the X function with the same name when that doesn't exist. */
4617 XScreenNumberOfScreen (scr)
4618 register Screen *scr;
4620 Display *dpy = scr->display;
4621 int i;
4623 for (i = 0; i < dpy->nscreens; ++i)
4624 if (scr == dpy->screens[i])
4625 break;
4627 return i;
4630 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4633 /* Select the visual that should be used on display DPYINFO. Set
4634 members of DPYINFO appropriately. Called from x_term_init. */
4636 void
4637 select_visual (dpyinfo)
4638 struct x_display_info *dpyinfo;
4640 Display *dpy = dpyinfo->display;
4641 Screen *screen = dpyinfo->screen;
4642 Lisp_Object value;
4644 /* See if a visual is specified. */
4645 value = display_x_get_resource (dpyinfo,
4646 build_string ("visualClass"),
4647 build_string ("VisualClass"),
4648 Qnil, Qnil);
4649 if (STRINGP (value))
4651 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4652 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4653 depth, a decimal number. NAME is compared with case ignored. */
4654 char *s = (char *) alloca (STRING_BYTES (XSTRING (value)) + 1);
4655 char *dash;
4656 int i, class = -1;
4657 XVisualInfo vinfo;
4659 strcpy (s, XSTRING (value)->data);
4660 dash = index (s, '-');
4661 if (dash)
4663 dpyinfo->n_planes = atoi (dash + 1);
4664 *dash = '\0';
4666 else
4667 /* We won't find a matching visual with depth 0, so that
4668 an error will be printed below. */
4669 dpyinfo->n_planes = 0;
4671 /* Determine the visual class. */
4672 for (i = 0; visual_classes[i].name; ++i)
4673 if (xstricmp (s, visual_classes[i].name) == 0)
4675 class = visual_classes[i].class;
4676 break;
4679 /* Look up a matching visual for the specified class. */
4680 if (class == -1
4681 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
4682 dpyinfo->n_planes, class, &vinfo))
4683 fatal ("Invalid visual specification `%s'", XSTRING (value)->data);
4685 dpyinfo->visual = vinfo.visual;
4687 else
4689 int n_visuals;
4690 XVisualInfo *vinfo, vinfo_template;
4692 dpyinfo->visual = DefaultVisualOfScreen (screen);
4694 #ifdef HAVE_X11R4
4695 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
4696 #else
4697 vinfo_template.visualid = dpyinfo->visual->visualid;
4698 #endif
4699 vinfo_template.screen = XScreenNumberOfScreen (screen);
4700 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
4701 &vinfo_template, &n_visuals);
4702 if (n_visuals != 1)
4703 fatal ("Can't get proper X visual info");
4705 dpyinfo->n_planes = vinfo->depth;
4706 XFree ((char *) vinfo);
4711 /* Return the X display structure for the display named NAME.
4712 Open a new connection if necessary. */
4714 struct x_display_info *
4715 x_display_info_for_name (name)
4716 Lisp_Object name;
4718 Lisp_Object names;
4719 struct x_display_info *dpyinfo;
4721 CHECK_STRING (name, 0);
4723 if (! EQ (Vwindow_system, intern ("x")))
4724 error ("Not using X Windows");
4726 for (dpyinfo = x_display_list, names = x_display_name_list;
4727 dpyinfo;
4728 dpyinfo = dpyinfo->next, names = XCDR (names))
4730 Lisp_Object tem;
4731 tem = Fstring_equal (XCAR (XCAR (names)), name);
4732 if (!NILP (tem))
4733 return dpyinfo;
4736 /* Use this general default value to start with. */
4737 Vx_resource_name = Vinvocation_name;
4739 validate_x_resource_name ();
4741 dpyinfo = x_term_init (name, (unsigned char *)0,
4742 (char *) XSTRING (Vx_resource_name)->data);
4744 if (dpyinfo == 0)
4745 error ("Cannot connect to X server %s", XSTRING (name)->data);
4747 x_in_use = 1;
4748 XSETFASTINT (Vwindow_system_version, 11);
4750 return dpyinfo;
4754 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4755 1, 3, 0, "Open a connection to an X server.\n\
4756 DISPLAY is the name of the display to connect to.\n\
4757 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4758 If the optional third arg MUST-SUCCEED is non-nil,\n\
4759 terminate Emacs if we can't open the connection.")
4760 (display, xrm_string, must_succeed)
4761 Lisp_Object display, xrm_string, must_succeed;
4763 unsigned char *xrm_option;
4764 struct x_display_info *dpyinfo;
4766 CHECK_STRING (display, 0);
4767 if (! NILP (xrm_string))
4768 CHECK_STRING (xrm_string, 1);
4770 if (! EQ (Vwindow_system, intern ("x")))
4771 error ("Not using X Windows");
4773 if (! NILP (xrm_string))
4774 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4775 else
4776 xrm_option = (unsigned char *) 0;
4778 validate_x_resource_name ();
4780 /* This is what opens the connection and sets x_current_display.
4781 This also initializes many symbols, such as those used for input. */
4782 dpyinfo = x_term_init (display, xrm_option,
4783 (char *) XSTRING (Vx_resource_name)->data);
4785 if (dpyinfo == 0)
4787 if (!NILP (must_succeed))
4788 fatal ("Cannot connect to X server %s.\n\
4789 Check the DISPLAY environment variable or use `-d'.\n\
4790 Also use the `xhost' program to verify that it is set to permit\n\
4791 connections from your machine.\n",
4792 XSTRING (display)->data);
4793 else
4794 error ("Cannot connect to X server %s", XSTRING (display)->data);
4797 x_in_use = 1;
4799 XSETFASTINT (Vwindow_system_version, 11);
4800 return Qnil;
4803 DEFUN ("x-close-connection", Fx_close_connection,
4804 Sx_close_connection, 1, 1, 0,
4805 "Close the connection to DISPLAY's X server.\n\
4806 For DISPLAY, specify either a frame or a display name (a string).\n\
4807 If DISPLAY is nil, that stands for the selected frame's display.")
4808 (display)
4809 Lisp_Object display;
4811 struct x_display_info *dpyinfo = check_x_display_info (display);
4812 int i;
4814 if (dpyinfo->reference_count > 0)
4815 error ("Display still has frames on it");
4817 BLOCK_INPUT;
4818 /* Free the fonts in the font table. */
4819 for (i = 0; i < dpyinfo->n_fonts; i++)
4820 if (dpyinfo->font_table[i].name)
4822 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
4823 xfree (dpyinfo->font_table[i].full_name);
4824 xfree (dpyinfo->font_table[i].name);
4825 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4828 x_destroy_all_bitmaps (dpyinfo);
4829 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4831 #ifdef USE_X_TOOLKIT
4832 XtCloseDisplay (dpyinfo->display);
4833 #else
4834 XCloseDisplay (dpyinfo->display);
4835 #endif
4837 x_delete_display (dpyinfo);
4838 UNBLOCK_INPUT;
4840 return Qnil;
4843 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4844 "Return the list of display names that Emacs has connections to.")
4847 Lisp_Object tail, result;
4849 result = Qnil;
4850 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
4851 result = Fcons (XCAR (XCAR (tail)), result);
4853 return result;
4856 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4857 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4858 If ON is nil, allow buffering of requests.\n\
4859 Turning on synchronization prohibits the Xlib routines from buffering\n\
4860 requests and seriously degrades performance, but makes debugging much\n\
4861 easier.\n\
4862 The optional second argument DISPLAY specifies which display to act on.\n\
4863 DISPLAY should be either a frame or a display name (a string).\n\
4864 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4865 (on, display)
4866 Lisp_Object display, on;
4868 struct x_display_info *dpyinfo = check_x_display_info (display);
4870 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4872 return Qnil;
4875 /* Wait for responses to all X commands issued so far for frame F. */
4877 void
4878 x_sync (f)
4879 FRAME_PTR f;
4881 BLOCK_INPUT;
4882 XSync (FRAME_X_DISPLAY (f), False);
4883 UNBLOCK_INPUT;
4887 /***********************************************************************
4888 Image types
4889 ***********************************************************************/
4891 /* Value is the number of elements of vector VECTOR. */
4893 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4895 /* List of supported image types. Use define_image_type to add new
4896 types. Use lookup_image_type to find a type for a given symbol. */
4898 static struct image_type *image_types;
4900 /* The symbol `image' which is the car of the lists used to represent
4901 images in Lisp. */
4903 extern Lisp_Object Qimage;
4905 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4907 Lisp_Object Qxbm;
4909 /* Keywords. */
4911 extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
4912 extern Lisp_Object QCdata;
4913 Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
4914 Lisp_Object QCalgorithm, QCcolor_symbols, QCheuristic_mask;
4915 Lisp_Object QCindex;
4917 /* Other symbols. */
4919 Lisp_Object Qlaplace;
4921 /* Time in seconds after which images should be removed from the cache
4922 if not displayed. */
4924 Lisp_Object Vimage_cache_eviction_delay;
4926 /* Function prototypes. */
4928 static void define_image_type P_ ((struct image_type *type));
4929 static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
4930 static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
4931 static void x_laplace P_ ((struct frame *, struct image *));
4932 static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
4933 Lisp_Object));
4936 /* Define a new image type from TYPE. This adds a copy of TYPE to
4937 image_types and adds the symbol *TYPE->type to Vimage_types. */
4939 static void
4940 define_image_type (type)
4941 struct image_type *type;
4943 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4944 The initialized data segment is read-only. */
4945 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
4946 bcopy (type, p, sizeof *p);
4947 p->next = image_types;
4948 image_types = p;
4949 Vimage_types = Fcons (*p->type, Vimage_types);
4953 /* Look up image type SYMBOL, and return a pointer to its image_type
4954 structure. Value is null if SYMBOL is not a known image type. */
4956 static INLINE struct image_type *
4957 lookup_image_type (symbol)
4958 Lisp_Object symbol;
4960 struct image_type *type;
4962 for (type = image_types; type; type = type->next)
4963 if (EQ (symbol, *type->type))
4964 break;
4966 return type;
4970 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4971 valid image specification is a list whose car is the symbol
4972 `image', and whose rest is a property list. The property list must
4973 contain a value for key `:type'. That value must be the name of a
4974 supported image type. The rest of the property list depends on the
4975 image type. */
4978 valid_image_p (object)
4979 Lisp_Object object;
4981 int valid_p = 0;
4983 if (CONSP (object) && EQ (XCAR (object), Qimage))
4985 Lisp_Object symbol = Fplist_get (XCDR (object), QCtype);
4986 struct image_type *type = lookup_image_type (symbol);
4988 if (type)
4989 valid_p = type->valid_p (object);
4992 return valid_p;
4996 /* Log error message with format string FORMAT and argument ARG.
4997 Signaling an error, e.g. when an image cannot be loaded, is not a
4998 good idea because this would interrupt redisplay, and the error
4999 message display would lead to another redisplay. This function
5000 therefore simply displays a message. */
5002 static void
5003 image_error (format, arg1, arg2)
5004 char *format;
5005 Lisp_Object arg1, arg2;
5007 add_to_log (format, arg1, arg2);
5012 /***********************************************************************
5013 Image specifications
5014 ***********************************************************************/
5016 enum image_value_type
5018 IMAGE_DONT_CHECK_VALUE_TYPE,
5019 IMAGE_STRING_VALUE,
5020 IMAGE_SYMBOL_VALUE,
5021 IMAGE_POSITIVE_INTEGER_VALUE,
5022 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
5023 IMAGE_ASCENT_VALUE,
5024 IMAGE_INTEGER_VALUE,
5025 IMAGE_FUNCTION_VALUE,
5026 IMAGE_NUMBER_VALUE,
5027 IMAGE_BOOL_VALUE
5030 /* Structure used when parsing image specifications. */
5032 struct image_keyword
5034 /* Name of keyword. */
5035 char *name;
5037 /* The type of value allowed. */
5038 enum image_value_type type;
5040 /* Non-zero means key must be present. */
5041 int mandatory_p;
5043 /* Used to recognize duplicate keywords in a property list. */
5044 int count;
5046 /* The value that was found. */
5047 Lisp_Object value;
5051 static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
5052 int, Lisp_Object));
5053 static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
5056 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5057 has the format (image KEYWORD VALUE ...). One of the keyword/
5058 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5059 image_keywords structures of size NKEYWORDS describing other
5060 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5062 static int
5063 parse_image_spec (spec, keywords, nkeywords, type)
5064 Lisp_Object spec;
5065 struct image_keyword *keywords;
5066 int nkeywords;
5067 Lisp_Object type;
5069 int i;
5070 Lisp_Object plist;
5072 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
5073 return 0;
5075 plist = XCDR (spec);
5076 while (CONSP (plist))
5078 Lisp_Object key, value;
5080 /* First element of a pair must be a symbol. */
5081 key = XCAR (plist);
5082 plist = XCDR (plist);
5083 if (!SYMBOLP (key))
5084 return 0;
5086 /* There must follow a value. */
5087 if (!CONSP (plist))
5088 return 0;
5089 value = XCAR (plist);
5090 plist = XCDR (plist);
5092 /* Find key in KEYWORDS. Error if not found. */
5093 for (i = 0; i < nkeywords; ++i)
5094 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
5095 break;
5097 if (i == nkeywords)
5098 continue;
5100 /* Record that we recognized the keyword. If a keywords
5101 was found more than once, it's an error. */
5102 keywords[i].value = value;
5103 ++keywords[i].count;
5105 if (keywords[i].count > 1)
5106 return 0;
5108 /* Check type of value against allowed type. */
5109 switch (keywords[i].type)
5111 case IMAGE_STRING_VALUE:
5112 if (!STRINGP (value))
5113 return 0;
5114 break;
5116 case IMAGE_SYMBOL_VALUE:
5117 if (!SYMBOLP (value))
5118 return 0;
5119 break;
5121 case IMAGE_POSITIVE_INTEGER_VALUE:
5122 if (!INTEGERP (value) || XINT (value) <= 0)
5123 return 0;
5124 break;
5126 case IMAGE_ASCENT_VALUE:
5127 if (SYMBOLP (value) && EQ (value, Qcenter))
5128 break;
5129 else if (INTEGERP (value)
5130 && XINT (value) >= 0
5131 && XINT (value) <= 100)
5132 break;
5133 return 0;
5135 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
5136 if (!INTEGERP (value) || XINT (value) < 0)
5137 return 0;
5138 break;
5140 case IMAGE_DONT_CHECK_VALUE_TYPE:
5141 break;
5143 case IMAGE_FUNCTION_VALUE:
5144 value = indirect_function (value);
5145 if (SUBRP (value)
5146 || COMPILEDP (value)
5147 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
5148 break;
5149 return 0;
5151 case IMAGE_NUMBER_VALUE:
5152 if (!INTEGERP (value) && !FLOATP (value))
5153 return 0;
5154 break;
5156 case IMAGE_INTEGER_VALUE:
5157 if (!INTEGERP (value))
5158 return 0;
5159 break;
5161 case IMAGE_BOOL_VALUE:
5162 if (!NILP (value) && !EQ (value, Qt))
5163 return 0;
5164 break;
5166 default:
5167 abort ();
5168 break;
5171 if (EQ (key, QCtype) && !EQ (type, value))
5172 return 0;
5175 /* Check that all mandatory fields are present. */
5176 for (i = 0; i < nkeywords; ++i)
5177 if (keywords[i].mandatory_p && keywords[i].count == 0)
5178 return 0;
5180 return NILP (plist);
5184 /* Return the value of KEY in image specification SPEC. Value is nil
5185 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5186 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5188 static Lisp_Object
5189 image_spec_value (spec, key, found)
5190 Lisp_Object spec, key;
5191 int *found;
5193 Lisp_Object tail;
5195 xassert (valid_image_p (spec));
5197 for (tail = XCDR (spec);
5198 CONSP (tail) && CONSP (XCDR (tail));
5199 tail = XCDR (XCDR (tail)))
5201 if (EQ (XCAR (tail), key))
5203 if (found)
5204 *found = 1;
5205 return XCAR (XCDR (tail));
5209 if (found)
5210 *found = 0;
5211 return Qnil;
5217 /***********************************************************************
5218 Image type independent image structures
5219 ***********************************************************************/
5221 static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
5222 static void free_image P_ ((struct frame *f, struct image *img));
5225 /* Allocate and return a new image structure for image specification
5226 SPEC. SPEC has a hash value of HASH. */
5228 static struct image *
5229 make_image (spec, hash)
5230 Lisp_Object spec;
5231 unsigned hash;
5233 struct image *img = (struct image *) xmalloc (sizeof *img);
5235 xassert (valid_image_p (spec));
5236 bzero (img, sizeof *img);
5237 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
5238 xassert (img->type != NULL);
5239 img->spec = spec;
5240 img->data.lisp_val = Qnil;
5241 img->ascent = DEFAULT_IMAGE_ASCENT;
5242 img->hash = hash;
5243 return img;
5247 /* Free image IMG which was used on frame F, including its resources. */
5249 static void
5250 free_image (f, img)
5251 struct frame *f;
5252 struct image *img;
5254 if (img)
5256 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5258 /* Remove IMG from the hash table of its cache. */
5259 if (img->prev)
5260 img->prev->next = img->next;
5261 else
5262 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
5264 if (img->next)
5265 img->next->prev = img->prev;
5267 c->images[img->id] = NULL;
5269 /* Free resources, then free IMG. */
5270 img->type->free (f, img);
5271 xfree (img);
5276 /* Prepare image IMG for display on frame F. Must be called before
5277 drawing an image. */
5279 void
5280 prepare_image_for_display (f, img)
5281 struct frame *f;
5282 struct image *img;
5284 EMACS_TIME t;
5286 /* We're about to display IMG, so set its timestamp to `now'. */
5287 EMACS_GET_TIME (t);
5288 img->timestamp = EMACS_SECS (t);
5290 /* If IMG doesn't have a pixmap yet, load it now, using the image
5291 type dependent loader function. */
5292 if (img->pixmap == 0 && !img->load_failed_p)
5293 img->load_failed_p = img->type->load (f, img) == 0;
5297 /* Value is the number of pixels for the ascent of image IMG when
5298 drawn in face FACE. */
5301 image_ascent (img, face)
5302 struct image *img;
5303 struct face *face;
5305 int height = img->height + img->margin;
5306 int ascent;
5308 if (img->ascent == CENTERED_IMAGE_ASCENT)
5310 if (face->font)
5311 ascent = height / 2 - (face->font->descent - face->font->ascent) / 2;
5312 else
5313 ascent = height / 2;
5315 else
5316 ascent = height * img->ascent / 100.0;
5318 return ascent;
5323 /***********************************************************************
5324 Helper functions for X image types
5325 ***********************************************************************/
5327 static void x_clear_image P_ ((struct frame *f, struct image *img));
5328 static unsigned long x_alloc_image_color P_ ((struct frame *f,
5329 struct image *img,
5330 Lisp_Object color_name,
5331 unsigned long dflt));
5333 /* Free X resources of image IMG which is used on frame F. */
5335 static void
5336 x_clear_image (f, img)
5337 struct frame *f;
5338 struct image *img;
5340 if (img->pixmap)
5342 BLOCK_INPUT;
5343 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
5344 img->pixmap = 0;
5345 UNBLOCK_INPUT;
5348 if (img->ncolors)
5350 BLOCK_INPUT;
5351 x_free_colors (f, img->colors, img->ncolors);
5352 UNBLOCK_INPUT;
5354 xfree (img->colors);
5355 img->colors = NULL;
5356 img->ncolors = 0;
5361 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5362 cannot be allocated, use DFLT. Add a newly allocated color to
5363 IMG->colors, so that it can be freed again. Value is the pixel
5364 color. */
5366 static unsigned long
5367 x_alloc_image_color (f, img, color_name, dflt)
5368 struct frame *f;
5369 struct image *img;
5370 Lisp_Object color_name;
5371 unsigned long dflt;
5373 XColor color;
5374 unsigned long result;
5376 xassert (STRINGP (color_name));
5378 if (x_defined_color (f, XSTRING (color_name)->data, &color, 1))
5380 /* This isn't called frequently so we get away with simply
5381 reallocating the color vector to the needed size, here. */
5382 ++img->ncolors;
5383 img->colors =
5384 (unsigned long *) xrealloc (img->colors,
5385 img->ncolors * sizeof *img->colors);
5386 img->colors[img->ncolors - 1] = color.pixel;
5387 result = color.pixel;
5389 else
5390 result = dflt;
5392 return result;
5397 /***********************************************************************
5398 Image Cache
5399 ***********************************************************************/
5401 static void cache_image P_ ((struct frame *f, struct image *img));
5404 /* Return a new, initialized image cache that is allocated from the
5405 heap. Call free_image_cache to free an image cache. */
5407 struct image_cache *
5408 make_image_cache ()
5410 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
5411 int size;
5413 bzero (c, sizeof *c);
5414 c->size = 50;
5415 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
5416 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5417 c->buckets = (struct image **) xmalloc (size);
5418 bzero (c->buckets, size);
5419 return c;
5423 /* Free image cache of frame F. Be aware that X frames share images
5424 caches. */
5426 void
5427 free_image_cache (f)
5428 struct frame *f;
5430 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5431 if (c)
5433 int i;
5435 /* Cache should not be referenced by any frame when freed. */
5436 xassert (c->refcount == 0);
5438 for (i = 0; i < c->used; ++i)
5439 free_image (f, c->images[i]);
5440 xfree (c->images);
5441 xfree (c->buckets);
5442 xfree (c);
5443 FRAME_X_IMAGE_CACHE (f) = NULL;
5448 /* Clear image cache of frame F. FORCE_P non-zero means free all
5449 images. FORCE_P zero means clear only images that haven't been
5450 displayed for some time. Should be called from time to time to
5451 reduce the number of loaded images. If image-eviction-seconds is
5452 non-nil, this frees images in the cache which weren't displayed for
5453 at least that many seconds. */
5455 void
5456 clear_image_cache (f, force_p)
5457 struct frame *f;
5458 int force_p;
5460 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5462 if (c && INTEGERP (Vimage_cache_eviction_delay))
5464 EMACS_TIME t;
5465 unsigned long old;
5466 int i, any_freed_p = 0;
5468 EMACS_GET_TIME (t);
5469 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
5471 for (i = 0; i < c->used; ++i)
5473 struct image *img = c->images[i];
5474 if (img != NULL
5475 && (force_p
5476 || (img->timestamp > old)))
5478 free_image (f, img);
5479 any_freed_p = 1;
5483 /* We may be clearing the image cache because, for example,
5484 Emacs was iconified for a longer period of time. In that
5485 case, current matrices may still contain references to
5486 images freed above. So, clear these matrices. */
5487 if (any_freed_p)
5489 clear_current_matrices (f);
5490 ++windows_or_buffers_changed;
5496 DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
5497 0, 1, 0,
5498 "Clear the image cache of FRAME.\n\
5499 FRAME nil or omitted means use the selected frame.\n\
5500 FRAME t means clear the image caches of all frames.")
5501 (frame)
5502 Lisp_Object frame;
5504 if (EQ (frame, Qt))
5506 Lisp_Object tail;
5508 FOR_EACH_FRAME (tail, frame)
5509 if (FRAME_X_P (XFRAME (frame)))
5510 clear_image_cache (XFRAME (frame), 1);
5512 else
5513 clear_image_cache (check_x_frame (frame), 1);
5515 return Qnil;
5519 /* Return the id of image with Lisp specification SPEC on frame F.
5520 SPEC must be a valid Lisp image specification (see valid_image_p). */
5523 lookup_image (f, spec)
5524 struct frame *f;
5525 Lisp_Object spec;
5527 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5528 struct image *img;
5529 int i;
5530 unsigned hash;
5531 struct gcpro gcpro1;
5532 EMACS_TIME now;
5534 /* F must be a window-system frame, and SPEC must be a valid image
5535 specification. */
5536 xassert (FRAME_WINDOW_P (f));
5537 xassert (valid_image_p (spec));
5539 GCPRO1 (spec);
5541 /* Look up SPEC in the hash table of the image cache. */
5542 hash = sxhash (spec, 0);
5543 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
5545 for (img = c->buckets[i]; img; img = img->next)
5546 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
5547 break;
5549 /* If not found, create a new image and cache it. */
5550 if (img == NULL)
5552 img = make_image (spec, hash);
5553 cache_image (f, img);
5554 img->load_failed_p = img->type->load (f, img) == 0;
5555 xassert (!interrupt_input_blocked);
5557 /* If we can't load the image, and we don't have a width and
5558 height, use some arbitrary width and height so that we can
5559 draw a rectangle for it. */
5560 if (img->load_failed_p)
5562 Lisp_Object value;
5564 value = image_spec_value (spec, QCwidth, NULL);
5565 img->width = (INTEGERP (value)
5566 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
5567 value = image_spec_value (spec, QCheight, NULL);
5568 img->height = (INTEGERP (value)
5569 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
5571 else
5573 /* Handle image type independent image attributes
5574 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5575 Lisp_Object ascent, margin, relief, algorithm, heuristic_mask;
5576 Lisp_Object file;
5578 ascent = image_spec_value (spec, QCascent, NULL);
5579 if (INTEGERP (ascent))
5580 img->ascent = XFASTINT (ascent);
5581 else if (EQ (ascent, Qcenter))
5582 img->ascent = CENTERED_IMAGE_ASCENT;
5584 margin = image_spec_value (spec, QCmargin, NULL);
5585 if (INTEGERP (margin) && XINT (margin) >= 0)
5586 img->margin = XFASTINT (margin);
5588 relief = image_spec_value (spec, QCrelief, NULL);
5589 if (INTEGERP (relief))
5591 img->relief = XINT (relief);
5592 img->margin += abs (img->relief);
5595 /* Should we apply a Laplace edge-detection algorithm? */
5596 algorithm = image_spec_value (spec, QCalgorithm, NULL);
5597 if (img->pixmap && EQ (algorithm, Qlaplace))
5598 x_laplace (f, img);
5600 /* Should we built a mask heuristically? */
5601 heuristic_mask = image_spec_value (spec, QCheuristic_mask, NULL);
5602 if (img->pixmap && !img->mask && !NILP (heuristic_mask))
5603 x_build_heuristic_mask (f, img, heuristic_mask);
5607 /* We're using IMG, so set its timestamp to `now'. */
5608 EMACS_GET_TIME (now);
5609 img->timestamp = EMACS_SECS (now);
5611 UNGCPRO;
5613 /* Value is the image id. */
5614 return img->id;
5618 /* Cache image IMG in the image cache of frame F. */
5620 static void
5621 cache_image (f, img)
5622 struct frame *f;
5623 struct image *img;
5625 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5626 int i;
5628 /* Find a free slot in c->images. */
5629 for (i = 0; i < c->used; ++i)
5630 if (c->images[i] == NULL)
5631 break;
5633 /* If no free slot found, maybe enlarge c->images. */
5634 if (i == c->used && c->used == c->size)
5636 c->size *= 2;
5637 c->images = (struct image **) xrealloc (c->images,
5638 c->size * sizeof *c->images);
5641 /* Add IMG to c->images, and assign IMG an id. */
5642 c->images[i] = img;
5643 img->id = i;
5644 if (i == c->used)
5645 ++c->used;
5647 /* Add IMG to the cache's hash table. */
5648 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
5649 img->next = c->buckets[i];
5650 if (img->next)
5651 img->next->prev = img;
5652 img->prev = NULL;
5653 c->buckets[i] = img;
5657 /* Call FN on every image in the image cache of frame F. Used to mark
5658 Lisp Objects in the image cache. */
5660 void
5661 forall_images_in_image_cache (f, fn)
5662 struct frame *f;
5663 void (*fn) P_ ((struct image *img));
5665 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
5667 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5668 if (c)
5670 int i;
5671 for (i = 0; i < c->used; ++i)
5672 if (c->images[i])
5673 fn (c->images[i]);
5680 /***********************************************************************
5681 X support code
5682 ***********************************************************************/
5684 static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
5685 XImage **, Pixmap *));
5686 static void x_destroy_x_image P_ ((XImage *));
5687 static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
5690 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5691 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5692 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5693 via xmalloc. Print error messages via image_error if an error
5694 occurs. Value is non-zero if successful. */
5696 static int
5697 x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
5698 struct frame *f;
5699 int width, height, depth;
5700 XImage **ximg;
5701 Pixmap *pixmap;
5703 Display *display = FRAME_X_DISPLAY (f);
5704 Screen *screen = FRAME_X_SCREEN (f);
5705 Window window = FRAME_X_WINDOW (f);
5707 xassert (interrupt_input_blocked);
5709 if (depth <= 0)
5710 depth = DefaultDepthOfScreen (screen);
5711 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
5712 depth, ZPixmap, 0, NULL, width, height,
5713 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
5714 if (*ximg == NULL)
5716 image_error ("Unable to allocate X image", Qnil, Qnil);
5717 return 0;
5720 /* Allocate image raster. */
5721 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
5723 /* Allocate a pixmap of the same size. */
5724 *pixmap = XCreatePixmap (display, window, width, height, depth);
5725 if (*pixmap == 0)
5727 x_destroy_x_image (*ximg);
5728 *ximg = NULL;
5729 image_error ("Unable to create X pixmap", Qnil, Qnil);
5730 return 0;
5733 return 1;
5737 /* Destroy XImage XIMG. Free XIMG->data. */
5739 static void
5740 x_destroy_x_image (ximg)
5741 XImage *ximg;
5743 xassert (interrupt_input_blocked);
5744 if (ximg)
5746 xfree (ximg->data);
5747 ximg->data = NULL;
5748 XDestroyImage (ximg);
5753 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5754 are width and height of both the image and pixmap. */
5756 static void
5757 x_put_x_image (f, ximg, pixmap, width, height)
5758 struct frame *f;
5759 XImage *ximg;
5760 Pixmap pixmap;
5762 GC gc;
5764 xassert (interrupt_input_blocked);
5765 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
5766 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
5767 XFreeGC (FRAME_X_DISPLAY (f), gc);
5772 /***********************************************************************
5773 File Handling
5774 ***********************************************************************/
5776 static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5777 static char *slurp_file P_ ((char *, int *));
5780 /* Find image file FILE. Look in data-directory, then
5781 x-bitmap-file-path. Value is the full name of the file found, or
5782 nil if not found. */
5784 static Lisp_Object
5785 x_find_image_file (file)
5786 Lisp_Object file;
5788 Lisp_Object file_found, search_path;
5789 struct gcpro gcpro1, gcpro2;
5790 int fd;
5792 file_found = Qnil;
5793 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
5794 GCPRO2 (file_found, search_path);
5796 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5797 fd = openp (search_path, file, "", &file_found, 0);
5799 if (fd < 0)
5800 file_found = Qnil;
5801 else
5802 close (fd);
5804 UNGCPRO;
5805 return file_found;
5809 /* Read FILE into memory. Value is a pointer to a buffer allocated
5810 with xmalloc holding FILE's contents. Value is null if an error
5811 occured. *SIZE is set to the size of the file. */
5813 static char *
5814 slurp_file (file, size)
5815 char *file;
5816 int *size;
5818 FILE *fp = NULL;
5819 char *buf = NULL;
5820 struct stat st;
5822 if (stat (file, &st) == 0
5823 && (fp = fopen (file, "r")) != NULL
5824 && (buf = (char *) xmalloc (st.st_size),
5825 fread (buf, 1, st.st_size, fp) == st.st_size))
5827 *size = st.st_size;
5828 fclose (fp);
5830 else
5832 if (fp)
5833 fclose (fp);
5834 if (buf)
5836 xfree (buf);
5837 buf = NULL;
5841 return buf;
5846 /***********************************************************************
5847 XBM images
5848 ***********************************************************************/
5850 static int xbm_scan P_ ((char **, char *, char *, int *));
5851 static int xbm_load P_ ((struct frame *f, struct image *img));
5852 static int xbm_load_image P_ ((struct frame *f, struct image *img,
5853 char *, char *));
5854 static int xbm_image_p P_ ((Lisp_Object object));
5855 static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
5856 unsigned char **));
5857 static int xbm_file_p P_ ((Lisp_Object));
5860 /* Indices of image specification fields in xbm_format, below. */
5862 enum xbm_keyword_index
5864 XBM_TYPE,
5865 XBM_FILE,
5866 XBM_WIDTH,
5867 XBM_HEIGHT,
5868 XBM_DATA,
5869 XBM_FOREGROUND,
5870 XBM_BACKGROUND,
5871 XBM_ASCENT,
5872 XBM_MARGIN,
5873 XBM_RELIEF,
5874 XBM_ALGORITHM,
5875 XBM_HEURISTIC_MASK,
5876 XBM_LAST
5879 /* Vector of image_keyword structures describing the format
5880 of valid XBM image specifications. */
5882 static struct image_keyword xbm_format[XBM_LAST] =
5884 {":type", IMAGE_SYMBOL_VALUE, 1},
5885 {":file", IMAGE_STRING_VALUE, 0},
5886 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5887 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5888 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5889 {":foreground", IMAGE_STRING_VALUE, 0},
5890 {":background", IMAGE_STRING_VALUE, 0},
5891 {":ascent", IMAGE_ASCENT_VALUE, 0},
5892 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5893 {":relief", IMAGE_INTEGER_VALUE, 0},
5894 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5895 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
5898 /* Structure describing the image type XBM. */
5900 static struct image_type xbm_type =
5902 &Qxbm,
5903 xbm_image_p,
5904 xbm_load,
5905 x_clear_image,
5906 NULL
5909 /* Tokens returned from xbm_scan. */
5911 enum xbm_token
5913 XBM_TK_IDENT = 256,
5914 XBM_TK_NUMBER
5918 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5919 A valid specification is a list starting with the symbol `image'
5920 The rest of the list is a property list which must contain an
5921 entry `:type xbm..
5923 If the specification specifies a file to load, it must contain
5924 an entry `:file FILENAME' where FILENAME is a string.
5926 If the specification is for a bitmap loaded from memory it must
5927 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5928 WIDTH and HEIGHT are integers > 0. DATA may be:
5930 1. a string large enough to hold the bitmap data, i.e. it must
5931 have a size >= (WIDTH + 7) / 8 * HEIGHT
5933 2. a bool-vector of size >= WIDTH * HEIGHT
5935 3. a vector of strings or bool-vectors, one for each line of the
5936 bitmap.
5938 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
5939 may not be specified in this case because they are defined in the
5940 XBM file.
5942 Both the file and data forms may contain the additional entries
5943 `:background COLOR' and `:foreground COLOR'. If not present,
5944 foreground and background of the frame on which the image is
5945 displayed is used. */
5947 static int
5948 xbm_image_p (object)
5949 Lisp_Object object;
5951 struct image_keyword kw[XBM_LAST];
5953 bcopy (xbm_format, kw, sizeof kw);
5954 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
5955 return 0;
5957 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
5959 if (kw[XBM_FILE].count)
5961 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
5962 return 0;
5964 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
5966 /* In-memory XBM file. */
5967 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
5968 return 0;
5970 else
5972 Lisp_Object data;
5973 int width, height;
5975 /* Entries for `:width', `:height' and `:data' must be present. */
5976 if (!kw[XBM_WIDTH].count
5977 || !kw[XBM_HEIGHT].count
5978 || !kw[XBM_DATA].count)
5979 return 0;
5981 data = kw[XBM_DATA].value;
5982 width = XFASTINT (kw[XBM_WIDTH].value);
5983 height = XFASTINT (kw[XBM_HEIGHT].value);
5985 /* Check type of data, and width and height against contents of
5986 data. */
5987 if (VECTORP (data))
5989 int i;
5991 /* Number of elements of the vector must be >= height. */
5992 if (XVECTOR (data)->size < height)
5993 return 0;
5995 /* Each string or bool-vector in data must be large enough
5996 for one line of the image. */
5997 for (i = 0; i < height; ++i)
5999 Lisp_Object elt = XVECTOR (data)->contents[i];
6001 if (STRINGP (elt))
6003 if (XSTRING (elt)->size
6004 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
6005 return 0;
6007 else if (BOOL_VECTOR_P (elt))
6009 if (XBOOL_VECTOR (elt)->size < width)
6010 return 0;
6012 else
6013 return 0;
6016 else if (STRINGP (data))
6018 if (XSTRING (data)->size
6019 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
6020 return 0;
6022 else if (BOOL_VECTOR_P (data))
6024 if (XBOOL_VECTOR (data)->size < width * height)
6025 return 0;
6027 else
6028 return 0;
6031 return 1;
6035 /* Scan a bitmap file. FP is the stream to read from. Value is
6036 either an enumerator from enum xbm_token, or a character for a
6037 single-character token, or 0 at end of file. If scanning an
6038 identifier, store the lexeme of the identifier in SVAL. If
6039 scanning a number, store its value in *IVAL. */
6041 static int
6042 xbm_scan (s, end, sval, ival)
6043 char **s, *end;
6044 char *sval;
6045 int *ival;
6047 int c;
6049 /* Skip white space. */
6050 while (*s < end && (c = *(*s)++, isspace (c)))
6053 if (*s >= end)
6054 c = 0;
6055 else if (isdigit (c))
6057 int value = 0, digit;
6059 if (c == '0' && *s < end)
6061 c = *(*s)++;
6062 if (c == 'x' || c == 'X')
6064 while (*s < end)
6066 c = *(*s)++;
6067 if (isdigit (c))
6068 digit = c - '0';
6069 else if (c >= 'a' && c <= 'f')
6070 digit = c - 'a' + 10;
6071 else if (c >= 'A' && c <= 'F')
6072 digit = c - 'A' + 10;
6073 else
6074 break;
6075 value = 16 * value + digit;
6078 else if (isdigit (c))
6080 value = c - '0';
6081 while (*s < end
6082 && (c = *(*s)++, isdigit (c)))
6083 value = 8 * value + c - '0';
6086 else
6088 value = c - '0';
6089 while (*s < end
6090 && (c = *(*s)++, isdigit (c)))
6091 value = 10 * value + c - '0';
6094 if (*s < end)
6095 *s = *s - 1;
6096 *ival = value;
6097 c = XBM_TK_NUMBER;
6099 else if (isalpha (c) || c == '_')
6101 *sval++ = c;
6102 while (*s < end
6103 && (c = *(*s)++, (isalnum (c) || c == '_')))
6104 *sval++ = c;
6105 *sval = 0;
6106 if (*s < end)
6107 *s = *s - 1;
6108 c = XBM_TK_IDENT;
6111 return c;
6115 /* Replacement for XReadBitmapFileData which isn't available under old
6116 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6117 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6118 the image. Return in *DATA the bitmap data allocated with xmalloc.
6119 Value is non-zero if successful. DATA null means just test if
6120 CONTENTS looks like an im-memory XBM file. */
6122 static int
6123 xbm_read_bitmap_data (contents, end, width, height, data)
6124 char *contents, *end;
6125 int *width, *height;
6126 unsigned char **data;
6128 char *s = contents;
6129 char buffer[BUFSIZ];
6130 int padding_p = 0;
6131 int v10 = 0;
6132 int bytes_per_line, i, nbytes;
6133 unsigned char *p;
6134 int value;
6135 int LA1;
6137 #define match() \
6138 LA1 = xbm_scan (&s, end, buffer, &value)
6140 #define expect(TOKEN) \
6141 if (LA1 != (TOKEN)) \
6142 goto failure; \
6143 else \
6144 match ()
6146 #define expect_ident(IDENT) \
6147 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6148 match (); \
6149 else \
6150 goto failure
6152 *width = *height = -1;
6153 if (data)
6154 *data = NULL;
6155 LA1 = xbm_scan (&s, end, buffer, &value);
6157 /* Parse defines for width, height and hot-spots. */
6158 while (LA1 == '#')
6160 match ();
6161 expect_ident ("define");
6162 expect (XBM_TK_IDENT);
6164 if (LA1 == XBM_TK_NUMBER);
6166 char *p = strrchr (buffer, '_');
6167 p = p ? p + 1 : buffer;
6168 if (strcmp (p, "width") == 0)
6169 *width = value;
6170 else if (strcmp (p, "height") == 0)
6171 *height = value;
6173 expect (XBM_TK_NUMBER);
6176 if (*width < 0 || *height < 0)
6177 goto failure;
6178 else if (data == NULL)
6179 goto success;
6181 /* Parse bits. Must start with `static'. */
6182 expect_ident ("static");
6183 if (LA1 == XBM_TK_IDENT)
6185 if (strcmp (buffer, "unsigned") == 0)
6187 match ();
6188 expect_ident ("char");
6190 else if (strcmp (buffer, "short") == 0)
6192 match ();
6193 v10 = 1;
6194 if (*width % 16 && *width % 16 < 9)
6195 padding_p = 1;
6197 else if (strcmp (buffer, "char") == 0)
6198 match ();
6199 else
6200 goto failure;
6202 else
6203 goto failure;
6205 expect (XBM_TK_IDENT);
6206 expect ('[');
6207 expect (']');
6208 expect ('=');
6209 expect ('{');
6211 bytes_per_line = (*width + 7) / 8 + padding_p;
6212 nbytes = bytes_per_line * *height;
6213 p = *data = (char *) xmalloc (nbytes);
6215 if (v10)
6217 for (i = 0; i < nbytes; i += 2)
6219 int val = value;
6220 expect (XBM_TK_NUMBER);
6222 *p++ = val;
6223 if (!padding_p || ((i + 2) % bytes_per_line))
6224 *p++ = value >> 8;
6226 if (LA1 == ',' || LA1 == '}')
6227 match ();
6228 else
6229 goto failure;
6232 else
6234 for (i = 0; i < nbytes; ++i)
6236 int val = value;
6237 expect (XBM_TK_NUMBER);
6239 *p++ = val;
6241 if (LA1 == ',' || LA1 == '}')
6242 match ();
6243 else
6244 goto failure;
6248 success:
6249 return 1;
6251 failure:
6253 if (data && *data)
6255 xfree (*data);
6256 *data = NULL;
6258 return 0;
6260 #undef match
6261 #undef expect
6262 #undef expect_ident
6266 /* Load XBM image IMG which will be displayed on frame F from buffer
6267 CONTENTS. END is the end of the buffer. Value is non-zero if
6268 successful. */
6270 static int
6271 xbm_load_image (f, img, contents, end)
6272 struct frame *f;
6273 struct image *img;
6274 char *contents, *end;
6276 int rc;
6277 unsigned char *data;
6278 int success_p = 0;
6280 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6281 if (rc)
6283 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6284 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6285 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6286 Lisp_Object value;
6288 xassert (img->width > 0 && img->height > 0);
6290 /* Get foreground and background colors, maybe allocate colors. */
6291 value = image_spec_value (img->spec, QCforeground, NULL);
6292 if (!NILP (value))
6293 foreground = x_alloc_image_color (f, img, value, foreground);
6295 value = image_spec_value (img->spec, QCbackground, NULL);
6296 if (!NILP (value))
6297 background = x_alloc_image_color (f, img, value, background);
6299 BLOCK_INPUT;
6300 img->pixmap
6301 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6302 FRAME_X_WINDOW (f),
6303 data,
6304 img->width, img->height,
6305 foreground, background,
6306 depth);
6307 xfree (data);
6309 if (img->pixmap == 0)
6311 x_clear_image (f, img);
6312 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6314 else
6315 success_p = 1;
6317 UNBLOCK_INPUT;
6319 else
6320 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6322 return success_p;
6326 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6328 static int
6329 xbm_file_p (data)
6330 Lisp_Object data;
6332 int w, h;
6333 return (STRINGP (data)
6334 && xbm_read_bitmap_data (XSTRING (data)->data,
6335 (XSTRING (data)->data
6336 + STRING_BYTES (XSTRING (data))),
6337 &w, &h, NULL));
6341 /* Fill image IMG which is used on frame F with pixmap data. Value is
6342 non-zero if successful. */
6344 static int
6345 xbm_load (f, img)
6346 struct frame *f;
6347 struct image *img;
6349 int success_p = 0;
6350 Lisp_Object file_name;
6352 xassert (xbm_image_p (img->spec));
6354 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6355 file_name = image_spec_value (img->spec, QCfile, NULL);
6356 if (STRINGP (file_name))
6358 Lisp_Object file;
6359 char *contents;
6360 int size;
6361 struct gcpro gcpro1;
6363 file = x_find_image_file (file_name);
6364 GCPRO1 (file);
6365 if (!STRINGP (file))
6367 image_error ("Cannot find image file `%s'", file_name, Qnil);
6368 UNGCPRO;
6369 return 0;
6372 contents = slurp_file (XSTRING (file)->data, &size);
6373 if (contents == NULL)
6375 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6376 UNGCPRO;
6377 return 0;
6380 success_p = xbm_load_image (f, img, contents, contents + size);
6381 UNGCPRO;
6383 else
6385 struct image_keyword fmt[XBM_LAST];
6386 Lisp_Object data;
6387 unsigned char *bitmap_data;
6388 int depth;
6389 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6390 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6391 char *bits;
6392 int parsed_p, height, width;
6393 int in_memory_file_p = 0;
6395 /* See if data looks like an in-memory XBM file. */
6396 data = image_spec_value (img->spec, QCdata, NULL);
6397 in_memory_file_p = xbm_file_p (data);
6399 /* Parse the image specification. */
6400 bcopy (xbm_format, fmt, sizeof fmt);
6401 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
6402 xassert (parsed_p);
6404 /* Get specified width, and height. */
6405 if (!in_memory_file_p)
6407 img->width = XFASTINT (fmt[XBM_WIDTH].value);
6408 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
6409 xassert (img->width > 0 && img->height > 0);
6412 BLOCK_INPUT;
6414 /* Get foreground and background colors, maybe allocate colors. */
6415 if (fmt[XBM_FOREGROUND].count)
6416 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
6417 foreground);
6418 if (fmt[XBM_BACKGROUND].count)
6419 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
6420 background);
6422 if (in_memory_file_p)
6423 success_p = xbm_load_image (f, img, XSTRING (data)->data,
6424 (XSTRING (data)->data
6425 + STRING_BYTES (XSTRING (data))));
6426 else
6428 if (VECTORP (data))
6430 int i;
6431 char *p;
6432 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6434 p = bits = (char *) alloca (nbytes * img->height);
6435 for (i = 0; i < img->height; ++i, p += nbytes)
6437 Lisp_Object line = XVECTOR (data)->contents[i];
6438 if (STRINGP (line))
6439 bcopy (XSTRING (line)->data, p, nbytes);
6440 else
6441 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
6444 else if (STRINGP (data))
6445 bits = XSTRING (data)->data;
6446 else
6447 bits = XBOOL_VECTOR (data)->data;
6449 /* Create the pixmap. */
6450 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6451 img->pixmap
6452 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6453 FRAME_X_WINDOW (f),
6454 bits,
6455 img->width, img->height,
6456 foreground, background,
6457 depth);
6458 if (img->pixmap)
6459 success_p = 1;
6460 else
6462 image_error ("Unable to create pixmap for XBM image `%s'",
6463 img->spec, Qnil);
6464 x_clear_image (f, img);
6468 UNBLOCK_INPUT;
6471 return success_p;
6476 /***********************************************************************
6477 XPM images
6478 ***********************************************************************/
6480 #if HAVE_XPM
6482 static int xpm_image_p P_ ((Lisp_Object object));
6483 static int xpm_load P_ ((struct frame *f, struct image *img));
6484 static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
6486 #include "X11/xpm.h"
6488 /* The symbol `xpm' identifying XPM-format images. */
6490 Lisp_Object Qxpm;
6492 /* Indices of image specification fields in xpm_format, below. */
6494 enum xpm_keyword_index
6496 XPM_TYPE,
6497 XPM_FILE,
6498 XPM_DATA,
6499 XPM_ASCENT,
6500 XPM_MARGIN,
6501 XPM_RELIEF,
6502 XPM_ALGORITHM,
6503 XPM_HEURISTIC_MASK,
6504 XPM_COLOR_SYMBOLS,
6505 XPM_LAST
6508 /* Vector of image_keyword structures describing the format
6509 of valid XPM image specifications. */
6511 static struct image_keyword xpm_format[XPM_LAST] =
6513 {":type", IMAGE_SYMBOL_VALUE, 1},
6514 {":file", IMAGE_STRING_VALUE, 0},
6515 {":data", IMAGE_STRING_VALUE, 0},
6516 {":ascent", IMAGE_ASCENT_VALUE, 0},
6517 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6518 {":relief", IMAGE_INTEGER_VALUE, 0},
6519 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6520 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6521 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
6524 /* Structure describing the image type XBM. */
6526 static struct image_type xpm_type =
6528 &Qxpm,
6529 xpm_image_p,
6530 xpm_load,
6531 x_clear_image,
6532 NULL
6536 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6537 for XPM images. Such a list must consist of conses whose car and
6538 cdr are strings. */
6540 static int
6541 xpm_valid_color_symbols_p (color_symbols)
6542 Lisp_Object color_symbols;
6544 while (CONSP (color_symbols))
6546 Lisp_Object sym = XCAR (color_symbols);
6547 if (!CONSP (sym)
6548 || !STRINGP (XCAR (sym))
6549 || !STRINGP (XCDR (sym)))
6550 break;
6551 color_symbols = XCDR (color_symbols);
6554 return NILP (color_symbols);
6558 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6560 static int
6561 xpm_image_p (object)
6562 Lisp_Object object;
6564 struct image_keyword fmt[XPM_LAST];
6565 bcopy (xpm_format, fmt, sizeof fmt);
6566 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
6567 /* Either `:file' or `:data' must be present. */
6568 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
6569 /* Either no `:color-symbols' or it's a list of conses
6570 whose car and cdr are strings. */
6571 && (fmt[XPM_COLOR_SYMBOLS].count == 0
6572 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
6576 /* Load image IMG which will be displayed on frame F. Value is
6577 non-zero if successful. */
6579 static int
6580 xpm_load (f, img)
6581 struct frame *f;
6582 struct image *img;
6584 int rc, i;
6585 XpmAttributes attrs;
6586 Lisp_Object specified_file, color_symbols;
6588 /* Configure the XPM lib. Use the visual of frame F. Allocate
6589 close colors. Return colors allocated. */
6590 bzero (&attrs, sizeof attrs);
6591 attrs.visual = FRAME_X_VISUAL (f);
6592 attrs.colormap = FRAME_X_COLORMAP (f);
6593 attrs.valuemask |= XpmVisual;
6594 attrs.valuemask |= XpmColormap;
6595 attrs.valuemask |= XpmReturnAllocPixels;
6596 #ifdef XpmAllocCloseColors
6597 attrs.alloc_close_colors = 1;
6598 attrs.valuemask |= XpmAllocCloseColors;
6599 #else
6600 attrs.closeness = 600;
6601 attrs.valuemask |= XpmCloseness;
6602 #endif
6604 /* If image specification contains symbolic color definitions, add
6605 these to `attrs'. */
6606 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
6607 if (CONSP (color_symbols))
6609 Lisp_Object tail;
6610 XpmColorSymbol *xpm_syms;
6611 int i, size;
6613 attrs.valuemask |= XpmColorSymbols;
6615 /* Count number of symbols. */
6616 attrs.numsymbols = 0;
6617 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
6618 ++attrs.numsymbols;
6620 /* Allocate an XpmColorSymbol array. */
6621 size = attrs.numsymbols * sizeof *xpm_syms;
6622 xpm_syms = (XpmColorSymbol *) alloca (size);
6623 bzero (xpm_syms, size);
6624 attrs.colorsymbols = xpm_syms;
6626 /* Fill the color symbol array. */
6627 for (tail = color_symbols, i = 0;
6628 CONSP (tail);
6629 ++i, tail = XCDR (tail))
6631 Lisp_Object name = XCAR (XCAR (tail));
6632 Lisp_Object color = XCDR (XCAR (tail));
6633 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
6634 strcpy (xpm_syms[i].name, XSTRING (name)->data);
6635 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
6636 strcpy (xpm_syms[i].value, XSTRING (color)->data);
6640 /* Create a pixmap for the image, either from a file, or from a
6641 string buffer containing data in the same format as an XPM file. */
6642 BLOCK_INPUT;
6643 specified_file = image_spec_value (img->spec, QCfile, NULL);
6644 if (STRINGP (specified_file))
6646 Lisp_Object file = x_find_image_file (specified_file);
6647 if (!STRINGP (file))
6649 image_error ("Cannot find image file `%s'", specified_file, Qnil);
6650 UNBLOCK_INPUT;
6651 return 0;
6654 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6655 XSTRING (file)->data, &img->pixmap, &img->mask,
6656 &attrs);
6658 else
6660 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
6661 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6662 XSTRING (buffer)->data,
6663 &img->pixmap, &img->mask,
6664 &attrs);
6666 UNBLOCK_INPUT;
6668 if (rc == XpmSuccess)
6670 /* Remember allocated colors. */
6671 img->ncolors = attrs.nalloc_pixels;
6672 img->colors = (unsigned long *) xmalloc (img->ncolors
6673 * sizeof *img->colors);
6674 for (i = 0; i < attrs.nalloc_pixels; ++i)
6676 img->colors[i] = attrs.alloc_pixels[i];
6677 #ifdef DEBUG_X_COLORS
6678 register_color (img->colors[i]);
6679 #endif
6682 img->width = attrs.width;
6683 img->height = attrs.height;
6684 xassert (img->width > 0 && img->height > 0);
6686 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6687 BLOCK_INPUT;
6688 XpmFreeAttributes (&attrs);
6689 UNBLOCK_INPUT;
6691 else
6693 switch (rc)
6695 case XpmOpenFailed:
6696 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
6697 break;
6699 case XpmFileInvalid:
6700 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
6701 break;
6703 case XpmNoMemory:
6704 image_error ("Out of memory (%s)", img->spec, Qnil);
6705 break;
6707 case XpmColorFailed:
6708 image_error ("Color allocation error (%s)", img->spec, Qnil);
6709 break;
6711 default:
6712 image_error ("Unknown error (%s)", img->spec, Qnil);
6713 break;
6717 return rc == XpmSuccess;
6720 #endif /* HAVE_XPM != 0 */
6723 /***********************************************************************
6724 Color table
6725 ***********************************************************************/
6727 /* An entry in the color table mapping an RGB color to a pixel color. */
6729 struct ct_color
6731 int r, g, b;
6732 unsigned long pixel;
6734 /* Next in color table collision list. */
6735 struct ct_color *next;
6738 /* The bucket vector size to use. Must be prime. */
6740 #define CT_SIZE 101
6742 /* Value is a hash of the RGB color given by R, G, and B. */
6744 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6746 /* The color hash table. */
6748 struct ct_color **ct_table;
6750 /* Number of entries in the color table. */
6752 int ct_colors_allocated;
6754 /* Function prototypes. */
6756 static void init_color_table P_ ((void));
6757 static void free_color_table P_ ((void));
6758 static unsigned long *colors_in_color_table P_ ((int *n));
6759 static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
6760 static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
6763 /* Initialize the color table. */
6765 static void
6766 init_color_table ()
6768 int size = CT_SIZE * sizeof (*ct_table);
6769 ct_table = (struct ct_color **) xmalloc (size);
6770 bzero (ct_table, size);
6771 ct_colors_allocated = 0;
6775 /* Free memory associated with the color table. */
6777 static void
6778 free_color_table ()
6780 int i;
6781 struct ct_color *p, *next;
6783 for (i = 0; i < CT_SIZE; ++i)
6784 for (p = ct_table[i]; p; p = next)
6786 next = p->next;
6787 xfree (p);
6790 xfree (ct_table);
6791 ct_table = NULL;
6795 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6796 entry for that color already is in the color table, return the
6797 pixel color of that entry. Otherwise, allocate a new color for R,
6798 G, B, and make an entry in the color table. */
6800 static unsigned long
6801 lookup_rgb_color (f, r, g, b)
6802 struct frame *f;
6803 int r, g, b;
6805 unsigned hash = CT_HASH_RGB (r, g, b);
6806 int i = hash % CT_SIZE;
6807 struct ct_color *p;
6809 for (p = ct_table[i]; p; p = p->next)
6810 if (p->r == r && p->g == g && p->b == b)
6811 break;
6813 if (p == NULL)
6815 XColor color;
6816 Colormap cmap;
6817 int rc;
6819 color.red = r;
6820 color.green = g;
6821 color.blue = b;
6823 BLOCK_INPUT;
6824 cmap = FRAME_X_COLORMAP (f);
6825 rc = x_alloc_nearest_color (f, cmap, &color);
6826 UNBLOCK_INPUT;
6828 if (rc)
6830 ++ct_colors_allocated;
6832 p = (struct ct_color *) xmalloc (sizeof *p);
6833 p->r = r;
6834 p->g = g;
6835 p->b = b;
6836 p->pixel = color.pixel;
6837 p->next = ct_table[i];
6838 ct_table[i] = p;
6840 else
6841 return FRAME_FOREGROUND_PIXEL (f);
6844 return p->pixel;
6848 /* Look up pixel color PIXEL which is used on frame F in the color
6849 table. If not already present, allocate it. Value is PIXEL. */
6851 static unsigned long
6852 lookup_pixel_color (f, pixel)
6853 struct frame *f;
6854 unsigned long pixel;
6856 int i = pixel % CT_SIZE;
6857 struct ct_color *p;
6859 for (p = ct_table[i]; p; p = p->next)
6860 if (p->pixel == pixel)
6861 break;
6863 if (p == NULL)
6865 XColor color;
6866 Colormap cmap;
6867 int rc;
6869 BLOCK_INPUT;
6871 cmap = FRAME_X_COLORMAP (f);
6872 color.pixel = pixel;
6873 XQueryColor (FRAME_X_DISPLAY (f), cmap, &color);
6874 rc = x_alloc_nearest_color (f, cmap, &color);
6875 UNBLOCK_INPUT;
6877 if (rc)
6879 ++ct_colors_allocated;
6881 p = (struct ct_color *) xmalloc (sizeof *p);
6882 p->r = color.red;
6883 p->g = color.green;
6884 p->b = color.blue;
6885 p->pixel = pixel;
6886 p->next = ct_table[i];
6887 ct_table[i] = p;
6889 else
6890 return FRAME_FOREGROUND_PIXEL (f);
6893 return p->pixel;
6897 /* Value is a vector of all pixel colors contained in the color table,
6898 allocated via xmalloc. Set *N to the number of colors. */
6900 static unsigned long *
6901 colors_in_color_table (n)
6902 int *n;
6904 int i, j;
6905 struct ct_color *p;
6906 unsigned long *colors;
6908 if (ct_colors_allocated == 0)
6910 *n = 0;
6911 colors = NULL;
6913 else
6915 colors = (unsigned long *) xmalloc (ct_colors_allocated
6916 * sizeof *colors);
6917 *n = ct_colors_allocated;
6919 for (i = j = 0; i < CT_SIZE; ++i)
6920 for (p = ct_table[i]; p; p = p->next)
6921 colors[j++] = p->pixel;
6924 return colors;
6929 /***********************************************************************
6930 Algorithms
6931 ***********************************************************************/
6933 static void x_laplace_write_row P_ ((struct frame *, long *,
6934 int, XImage *, int));
6935 static void x_laplace_read_row P_ ((struct frame *, Colormap,
6936 XColor *, int, XImage *, int));
6939 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
6940 frame we operate on, CMAP is the color-map in effect, and WIDTH is
6941 the width of one row in the image. */
6943 static void
6944 x_laplace_read_row (f, cmap, colors, width, ximg, y)
6945 struct frame *f;
6946 Colormap cmap;
6947 XColor *colors;
6948 int width;
6949 XImage *ximg;
6950 int y;
6952 int x;
6954 for (x = 0; x < width; ++x)
6955 colors[x].pixel = XGetPixel (ximg, x, y);
6957 XQueryColors (FRAME_X_DISPLAY (f), cmap, colors, width);
6961 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
6962 containing the pixel colors to write. F is the frame we are
6963 working on. */
6965 static void
6966 x_laplace_write_row (f, pixels, width, ximg, y)
6967 struct frame *f;
6968 long *pixels;
6969 int width;
6970 XImage *ximg;
6971 int y;
6973 int x;
6975 for (x = 0; x < width; ++x)
6976 XPutPixel (ximg, x, y, pixels[x]);
6980 /* Transform image IMG which is used on frame F with a Laplace
6981 edge-detection algorithm. The result is an image that can be used
6982 to draw disabled buttons, for example. */
6984 static void
6985 x_laplace (f, img)
6986 struct frame *f;
6987 struct image *img;
6989 Colormap cmap = FRAME_X_COLORMAP (f);
6990 XImage *ximg, *oimg;
6991 XColor *in[3];
6992 long *out;
6993 Pixmap pixmap;
6994 int x, y, i;
6995 long pixel;
6996 int in_y, out_y, rc;
6997 int mv2 = 45000;
6999 BLOCK_INPUT;
7001 /* Get the X image IMG->pixmap. */
7002 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
7003 0, 0, img->width, img->height, ~0, ZPixmap);
7005 /* Allocate 3 input rows, and one output row of colors. */
7006 for (i = 0; i < 3; ++i)
7007 in[i] = (XColor *) alloca (img->width * sizeof (XColor));
7008 out = (long *) alloca (img->width * sizeof (long));
7010 /* Create an X image for output. */
7011 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 0,
7012 &oimg, &pixmap);
7014 /* Fill first two rows. */
7015 x_laplace_read_row (f, cmap, in[0], img->width, ximg, 0);
7016 x_laplace_read_row (f, cmap, in[1], img->width, ximg, 1);
7017 in_y = 2;
7019 /* Write first row, all zeros. */
7020 init_color_table ();
7021 pixel = lookup_rgb_color (f, 0, 0, 0);
7022 for (x = 0; x < img->width; ++x)
7023 out[x] = pixel;
7024 x_laplace_write_row (f, out, img->width, oimg, 0);
7025 out_y = 1;
7027 for (y = 2; y < img->height; ++y)
7029 int rowa = y % 3;
7030 int rowb = (y + 2) % 3;
7032 x_laplace_read_row (f, cmap, in[rowa], img->width, ximg, in_y++);
7034 for (x = 0; x < img->width - 2; ++x)
7036 int r = in[rowa][x].red + mv2 - in[rowb][x + 2].red;
7037 int g = in[rowa][x].green + mv2 - in[rowb][x + 2].green;
7038 int b = in[rowa][x].blue + mv2 - in[rowb][x + 2].blue;
7040 out[x + 1] = lookup_rgb_color (f, r & 0xffff, g & 0xffff,
7041 b & 0xffff);
7044 x_laplace_write_row (f, out, img->width, oimg, out_y++);
7047 /* Write last line, all zeros. */
7048 for (x = 0; x < img->width; ++x)
7049 out[x] = pixel;
7050 x_laplace_write_row (f, out, img->width, oimg, out_y);
7052 /* Free the input image, and free resources of IMG. */
7053 XDestroyImage (ximg);
7054 x_clear_image (f, img);
7056 /* Put the output image into pixmap, and destroy it. */
7057 x_put_x_image (f, oimg, pixmap, img->width, img->height);
7058 x_destroy_x_image (oimg);
7060 /* Remember new pixmap and colors in IMG. */
7061 img->pixmap = pixmap;
7062 img->colors = colors_in_color_table (&img->ncolors);
7063 free_color_table ();
7065 UNBLOCK_INPUT;
7069 /* Build a mask for image IMG which is used on frame F. FILE is the
7070 name of an image file, for error messages. HOW determines how to
7071 determine the background color of IMG. If it is a list '(R G B)',
7072 with R, G, and B being integers >= 0, take that as the color of the
7073 background. Otherwise, determine the background color of IMG
7074 heuristically. Value is non-zero if successful. */
7076 static int
7077 x_build_heuristic_mask (f, img, how)
7078 struct frame *f;
7079 struct image *img;
7080 Lisp_Object how;
7082 Display *dpy = FRAME_X_DISPLAY (f);
7083 XImage *ximg, *mask_img;
7084 int x, y, rc, look_at_corners_p;
7085 unsigned long bg;
7087 BLOCK_INPUT;
7089 /* Create an image and pixmap serving as mask. */
7090 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
7091 &mask_img, &img->mask);
7092 if (!rc)
7094 UNBLOCK_INPUT;
7095 return 0;
7098 /* Get the X image of IMG->pixmap. */
7099 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
7100 ~0, ZPixmap);
7102 /* Determine the background color of ximg. If HOW is `(R G B)'
7103 take that as color. Otherwise, try to determine the color
7104 heuristically. */
7105 look_at_corners_p = 1;
7107 if (CONSP (how))
7109 int rgb[3], i = 0;
7111 while (i < 3
7112 && CONSP (how)
7113 && NATNUMP (XCAR (how)))
7115 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
7116 how = XCDR (how);
7119 if (i == 3 && NILP (how))
7121 char color_name[30];
7122 XColor exact, color;
7123 Colormap cmap;
7125 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
7127 cmap = FRAME_X_COLORMAP (f);
7128 if (XLookupColor (dpy, cmap, color_name, &exact, &color))
7130 bg = color.pixel;
7131 look_at_corners_p = 0;
7136 if (look_at_corners_p)
7138 unsigned long corners[4];
7139 int i, best_count;
7141 /* Get the colors at the corners of ximg. */
7142 corners[0] = XGetPixel (ximg, 0, 0);
7143 corners[1] = XGetPixel (ximg, img->width - 1, 0);
7144 corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
7145 corners[3] = XGetPixel (ximg, 0, img->height - 1);
7147 /* Choose the most frequently found color as background. */
7148 for (i = best_count = 0; i < 4; ++i)
7150 int j, n;
7152 for (j = n = 0; j < 4; ++j)
7153 if (corners[i] == corners[j])
7154 ++n;
7156 if (n > best_count)
7157 bg = corners[i], best_count = n;
7161 /* Set all bits in mask_img to 1 whose color in ximg is different
7162 from the background color bg. */
7163 for (y = 0; y < img->height; ++y)
7164 for (x = 0; x < img->width; ++x)
7165 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
7167 /* Put mask_img into img->mask. */
7168 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
7169 x_destroy_x_image (mask_img);
7170 XDestroyImage (ximg);
7172 UNBLOCK_INPUT;
7173 return 1;
7178 /***********************************************************************
7179 PBM (mono, gray, color)
7180 ***********************************************************************/
7182 static int pbm_image_p P_ ((Lisp_Object object));
7183 static int pbm_load P_ ((struct frame *f, struct image *img));
7184 static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
7186 /* The symbol `pbm' identifying images of this type. */
7188 Lisp_Object Qpbm;
7190 /* Indices of image specification fields in gs_format, below. */
7192 enum pbm_keyword_index
7194 PBM_TYPE,
7195 PBM_FILE,
7196 PBM_DATA,
7197 PBM_ASCENT,
7198 PBM_MARGIN,
7199 PBM_RELIEF,
7200 PBM_ALGORITHM,
7201 PBM_HEURISTIC_MASK,
7202 PBM_LAST
7205 /* Vector of image_keyword structures describing the format
7206 of valid user-defined image specifications. */
7208 static struct image_keyword pbm_format[PBM_LAST] =
7210 {":type", IMAGE_SYMBOL_VALUE, 1},
7211 {":file", IMAGE_STRING_VALUE, 0},
7212 {":data", IMAGE_STRING_VALUE, 0},
7213 {":ascent", IMAGE_ASCENT_VALUE, 0},
7214 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7215 {":relief", IMAGE_INTEGER_VALUE, 0},
7216 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7217 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7220 /* Structure describing the image type `pbm'. */
7222 static struct image_type pbm_type =
7224 &Qpbm,
7225 pbm_image_p,
7226 pbm_load,
7227 x_clear_image,
7228 NULL
7232 /* Return non-zero if OBJECT is a valid PBM image specification. */
7234 static int
7235 pbm_image_p (object)
7236 Lisp_Object object;
7238 struct image_keyword fmt[PBM_LAST];
7240 bcopy (pbm_format, fmt, sizeof fmt);
7242 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
7243 return 0;
7245 /* Must specify either :data or :file. */
7246 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
7250 /* Scan a decimal number from *S and return it. Advance *S while
7251 reading the number. END is the end of the string. Value is -1 at
7252 end of input. */
7254 static int
7255 pbm_scan_number (s, end)
7256 unsigned char **s, *end;
7258 int c, val = -1;
7260 while (*s < end)
7262 /* Skip white-space. */
7263 while (*s < end && (c = *(*s)++, isspace (c)))
7266 if (c == '#')
7268 /* Skip comment to end of line. */
7269 while (*s < end && (c = *(*s)++, c != '\n'))
7272 else if (isdigit (c))
7274 /* Read decimal number. */
7275 val = c - '0';
7276 while (*s < end && (c = *(*s)++, isdigit (c)))
7277 val = 10 * val + c - '0';
7278 break;
7280 else
7281 break;
7284 return val;
7288 /* Load PBM image IMG for use on frame F. */
7290 static int
7291 pbm_load (f, img)
7292 struct frame *f;
7293 struct image *img;
7295 int raw_p, x, y;
7296 int width, height, max_color_idx = 0;
7297 XImage *ximg;
7298 Lisp_Object file, specified_file;
7299 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
7300 struct gcpro gcpro1;
7301 unsigned char *contents = NULL;
7302 unsigned char *end, *p;
7303 int size;
7305 specified_file = image_spec_value (img->spec, QCfile, NULL);
7306 file = Qnil;
7307 GCPRO1 (file);
7309 if (STRINGP (specified_file))
7311 file = x_find_image_file (specified_file);
7312 if (!STRINGP (file))
7314 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7315 UNGCPRO;
7316 return 0;
7319 contents = slurp_file (XSTRING (file)->data, &size);
7320 if (contents == NULL)
7322 image_error ("Error reading `%s'", file, Qnil);
7323 UNGCPRO;
7324 return 0;
7327 p = contents;
7328 end = contents + size;
7330 else
7332 Lisp_Object data;
7333 data = image_spec_value (img->spec, QCdata, NULL);
7334 p = XSTRING (data)->data;
7335 end = p + STRING_BYTES (XSTRING (data));
7338 /* Check magic number. */
7339 if (end - p < 2 || *p++ != 'P')
7341 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7342 error:
7343 xfree (contents);
7344 UNGCPRO;
7345 return 0;
7348 switch (*p++)
7350 case '1':
7351 raw_p = 0, type = PBM_MONO;
7352 break;
7354 case '2':
7355 raw_p = 0, type = PBM_GRAY;
7356 break;
7358 case '3':
7359 raw_p = 0, type = PBM_COLOR;
7360 break;
7362 case '4':
7363 raw_p = 1, type = PBM_MONO;
7364 break;
7366 case '5':
7367 raw_p = 1, type = PBM_GRAY;
7368 break;
7370 case '6':
7371 raw_p = 1, type = PBM_COLOR;
7372 break;
7374 default:
7375 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7376 goto error;
7379 /* Read width, height, maximum color-component. Characters
7380 starting with `#' up to the end of a line are ignored. */
7381 width = pbm_scan_number (&p, end);
7382 height = pbm_scan_number (&p, end);
7384 if (type != PBM_MONO)
7386 max_color_idx = pbm_scan_number (&p, end);
7387 if (raw_p && max_color_idx > 255)
7388 max_color_idx = 255;
7391 if (width < 0
7392 || height < 0
7393 || (type != PBM_MONO && max_color_idx < 0))
7394 goto error;
7396 BLOCK_INPUT;
7397 if (!x_create_x_image_and_pixmap (f, width, height, 0,
7398 &ximg, &img->pixmap))
7400 UNBLOCK_INPUT;
7401 goto error;
7404 /* Initialize the color hash table. */
7405 init_color_table ();
7407 if (type == PBM_MONO)
7409 int c = 0, g;
7411 for (y = 0; y < height; ++y)
7412 for (x = 0; x < width; ++x)
7414 if (raw_p)
7416 if ((x & 7) == 0)
7417 c = *p++;
7418 g = c & 0x80;
7419 c <<= 1;
7421 else
7422 g = pbm_scan_number (&p, end);
7424 XPutPixel (ximg, x, y, (g
7425 ? FRAME_FOREGROUND_PIXEL (f)
7426 : FRAME_BACKGROUND_PIXEL (f)));
7429 else
7431 for (y = 0; y < height; ++y)
7432 for (x = 0; x < width; ++x)
7434 int r, g, b;
7436 if (type == PBM_GRAY)
7437 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
7438 else if (raw_p)
7440 r = *p++;
7441 g = *p++;
7442 b = *p++;
7444 else
7446 r = pbm_scan_number (&p, end);
7447 g = pbm_scan_number (&p, end);
7448 b = pbm_scan_number (&p, end);
7451 if (r < 0 || g < 0 || b < 0)
7453 xfree (ximg->data);
7454 ximg->data = NULL;
7455 XDestroyImage (ximg);
7456 UNBLOCK_INPUT;
7457 image_error ("Invalid pixel value in image `%s'",
7458 img->spec, Qnil);
7459 goto error;
7462 /* RGB values are now in the range 0..max_color_idx.
7463 Scale this to the range 0..0xffff supported by X. */
7464 r = (double) r * 65535 / max_color_idx;
7465 g = (double) g * 65535 / max_color_idx;
7466 b = (double) b * 65535 / max_color_idx;
7467 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
7471 /* Store in IMG->colors the colors allocated for the image, and
7472 free the color table. */
7473 img->colors = colors_in_color_table (&img->ncolors);
7474 free_color_table ();
7476 /* Put the image into a pixmap. */
7477 x_put_x_image (f, ximg, img->pixmap, width, height);
7478 x_destroy_x_image (ximg);
7479 UNBLOCK_INPUT;
7481 img->width = width;
7482 img->height = height;
7484 UNGCPRO;
7485 xfree (contents);
7486 return 1;
7491 /***********************************************************************
7493 ***********************************************************************/
7495 #if HAVE_PNG
7497 #include <png.h>
7499 /* Function prototypes. */
7501 static int png_image_p P_ ((Lisp_Object object));
7502 static int png_load P_ ((struct frame *f, struct image *img));
7504 /* The symbol `png' identifying images of this type. */
7506 Lisp_Object Qpng;
7508 /* Indices of image specification fields in png_format, below. */
7510 enum png_keyword_index
7512 PNG_TYPE,
7513 PNG_DATA,
7514 PNG_FILE,
7515 PNG_ASCENT,
7516 PNG_MARGIN,
7517 PNG_RELIEF,
7518 PNG_ALGORITHM,
7519 PNG_HEURISTIC_MASK,
7520 PNG_LAST
7523 /* Vector of image_keyword structures describing the format
7524 of valid user-defined image specifications. */
7526 static struct image_keyword png_format[PNG_LAST] =
7528 {":type", IMAGE_SYMBOL_VALUE, 1},
7529 {":data", IMAGE_STRING_VALUE, 0},
7530 {":file", IMAGE_STRING_VALUE, 0},
7531 {":ascent", IMAGE_ASCENT_VALUE, 0},
7532 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7533 {":relief", IMAGE_INTEGER_VALUE, 0},
7534 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7535 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7538 /* Structure describing the image type `png'. */
7540 static struct image_type png_type =
7542 &Qpng,
7543 png_image_p,
7544 png_load,
7545 x_clear_image,
7546 NULL
7550 /* Return non-zero if OBJECT is a valid PNG image specification. */
7552 static int
7553 png_image_p (object)
7554 Lisp_Object object;
7556 struct image_keyword fmt[PNG_LAST];
7557 bcopy (png_format, fmt, sizeof fmt);
7559 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
7560 return 0;
7562 /* Must specify either the :data or :file keyword. */
7563 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
7567 /* Error and warning handlers installed when the PNG library
7568 is initialized. */
7570 static void
7571 my_png_error (png_ptr, msg)
7572 png_struct *png_ptr;
7573 char *msg;
7575 xassert (png_ptr != NULL);
7576 image_error ("PNG error: %s", build_string (msg), Qnil);
7577 longjmp (png_ptr->jmpbuf, 1);
7581 static void
7582 my_png_warning (png_ptr, msg)
7583 png_struct *png_ptr;
7584 char *msg;
7586 xassert (png_ptr != NULL);
7587 image_error ("PNG warning: %s", build_string (msg), Qnil);
7590 /* Memory source for PNG decoding. */
7592 struct png_memory_storage
7594 unsigned char *bytes; /* The data */
7595 size_t len; /* How big is it? */
7596 int index; /* Where are we? */
7600 /* Function set as reader function when reading PNG image from memory.
7601 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7602 bytes from the input to DATA. */
7604 static void
7605 png_read_from_memory (png_ptr, data, length)
7606 png_structp png_ptr;
7607 png_bytep data;
7608 png_size_t length;
7610 struct png_memory_storage *tbr
7611 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
7613 if (length > tbr->len - tbr->index)
7614 png_error (png_ptr, "Read error");
7616 bcopy (tbr->bytes + tbr->index, data, length);
7617 tbr->index = tbr->index + length;
7620 /* Load PNG image IMG for use on frame F. Value is non-zero if
7621 successful. */
7623 static int
7624 png_load (f, img)
7625 struct frame *f;
7626 struct image *img;
7628 Lisp_Object file, specified_file;
7629 Lisp_Object specified_data;
7630 int x, y, i;
7631 XImage *ximg, *mask_img = NULL;
7632 struct gcpro gcpro1;
7633 png_struct *png_ptr = NULL;
7634 png_info *info_ptr = NULL, *end_info = NULL;
7635 FILE *fp = NULL;
7636 png_byte sig[8];
7637 png_byte *pixels = NULL;
7638 png_byte **rows = NULL;
7639 png_uint_32 width, height;
7640 int bit_depth, color_type, interlace_type;
7641 png_byte channels;
7642 png_uint_32 row_bytes;
7643 int transparent_p;
7644 char *gamma_str;
7645 double screen_gamma, image_gamma;
7646 int intent;
7647 struct png_memory_storage tbr; /* Data to be read */
7649 /* Find out what file to load. */
7650 specified_file = image_spec_value (img->spec, QCfile, NULL);
7651 specified_data = image_spec_value (img->spec, QCdata, NULL);
7652 file = Qnil;
7653 GCPRO1 (file);
7655 if (NILP (specified_data))
7657 file = x_find_image_file (specified_file);
7658 if (!STRINGP (file))
7660 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7661 UNGCPRO;
7662 return 0;
7665 /* Open the image file. */
7666 fp = fopen (XSTRING (file)->data, "rb");
7667 if (!fp)
7669 image_error ("Cannot open image file `%s'", file, Qnil);
7670 UNGCPRO;
7671 fclose (fp);
7672 return 0;
7675 /* Check PNG signature. */
7676 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
7677 || !png_check_sig (sig, sizeof sig))
7679 image_error ("Not a PNG file: `%s'", file, Qnil);
7680 UNGCPRO;
7681 fclose (fp);
7682 return 0;
7685 else
7687 /* Read from memory. */
7688 tbr.bytes = XSTRING (specified_data)->data;
7689 tbr.len = STRING_BYTES (XSTRING (specified_data));
7690 tbr.index = 0;
7692 /* Check PNG signature. */
7693 if (tbr.len < sizeof sig
7694 || !png_check_sig (tbr.bytes, sizeof sig))
7696 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
7697 UNGCPRO;
7698 return 0;
7701 /* Need to skip past the signature. */
7702 tbr.bytes += sizeof (sig);
7705 /* Initialize read and info structs for PNG lib. */
7706 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
7707 my_png_error, my_png_warning);
7708 if (!png_ptr)
7710 if (fp) fclose (fp);
7711 UNGCPRO;
7712 return 0;
7715 info_ptr = png_create_info_struct (png_ptr);
7716 if (!info_ptr)
7718 png_destroy_read_struct (&png_ptr, NULL, NULL);
7719 if (fp) fclose (fp);
7720 UNGCPRO;
7721 return 0;
7724 end_info = png_create_info_struct (png_ptr);
7725 if (!end_info)
7727 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
7728 if (fp) fclose (fp);
7729 UNGCPRO;
7730 return 0;
7733 /* Set error jump-back. We come back here when the PNG library
7734 detects an error. */
7735 if (setjmp (png_ptr->jmpbuf))
7737 error:
7738 if (png_ptr)
7739 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
7740 xfree (pixels);
7741 xfree (rows);
7742 if (fp) fclose (fp);
7743 UNGCPRO;
7744 return 0;
7747 /* Read image info. */
7748 if (!NILP (specified_data))
7749 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
7750 else
7751 png_init_io (png_ptr, fp);
7753 png_set_sig_bytes (png_ptr, sizeof sig);
7754 png_read_info (png_ptr, info_ptr);
7755 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
7756 &interlace_type, NULL, NULL);
7758 /* If image contains simply transparency data, we prefer to
7759 construct a clipping mask. */
7760 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
7761 transparent_p = 1;
7762 else
7763 transparent_p = 0;
7765 /* This function is easier to write if we only have to handle
7766 one data format: RGB or RGBA with 8 bits per channel. Let's
7767 transform other formats into that format. */
7769 /* Strip more than 8 bits per channel. */
7770 if (bit_depth == 16)
7771 png_set_strip_16 (png_ptr);
7773 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
7774 if available. */
7775 png_set_expand (png_ptr);
7777 /* Convert grayscale images to RGB. */
7778 if (color_type == PNG_COLOR_TYPE_GRAY
7779 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
7780 png_set_gray_to_rgb (png_ptr);
7782 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
7783 gamma_str = getenv ("SCREEN_GAMMA");
7784 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
7786 /* Tell the PNG lib to handle gamma correction for us. */
7788 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
7789 if (png_get_sRGB (png_ptr, info_ptr, &intent))
7790 /* There is a special chunk in the image specifying the gamma. */
7791 png_set_sRGB (png_ptr, info_ptr, intent);
7792 else
7793 #endif
7794 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
7795 /* Image contains gamma information. */
7796 png_set_gamma (png_ptr, screen_gamma, image_gamma);
7797 else
7798 /* Use a default of 0.5 for the image gamma. */
7799 png_set_gamma (png_ptr, screen_gamma, 0.5);
7801 /* Handle alpha channel by combining the image with a background
7802 color. Do this only if a real alpha channel is supplied. For
7803 simple transparency, we prefer a clipping mask. */
7804 if (!transparent_p)
7806 png_color_16 *image_background;
7808 if (png_get_bKGD (png_ptr, info_ptr, &image_background))
7809 /* Image contains a background color with which to
7810 combine the image. */
7811 png_set_background (png_ptr, image_background,
7812 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
7813 else
7815 /* Image does not contain a background color with which
7816 to combine the image data via an alpha channel. Use
7817 the frame's background instead. */
7818 XColor color;
7819 Colormap cmap;
7820 png_color_16 frame_background;
7822 BLOCK_INPUT;
7823 cmap = FRAME_X_COLORMAP (f);
7824 color.pixel = FRAME_BACKGROUND_PIXEL (f);
7825 XQueryColor (FRAME_X_DISPLAY (f), cmap, &color);
7826 UNBLOCK_INPUT;
7828 bzero (&frame_background, sizeof frame_background);
7829 frame_background.red = color.red;
7830 frame_background.green = color.green;
7831 frame_background.blue = color.blue;
7833 png_set_background (png_ptr, &frame_background,
7834 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
7838 /* Update info structure. */
7839 png_read_update_info (png_ptr, info_ptr);
7841 /* Get number of channels. Valid values are 1 for grayscale images
7842 and images with a palette, 2 for grayscale images with transparency
7843 information (alpha channel), 3 for RGB images, and 4 for RGB
7844 images with alpha channel, i.e. RGBA. If conversions above were
7845 sufficient we should only have 3 or 4 channels here. */
7846 channels = png_get_channels (png_ptr, info_ptr);
7847 xassert (channels == 3 || channels == 4);
7849 /* Number of bytes needed for one row of the image. */
7850 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
7852 /* Allocate memory for the image. */
7853 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
7854 rows = (png_byte **) xmalloc (height * sizeof *rows);
7855 for (i = 0; i < height; ++i)
7856 rows[i] = pixels + i * row_bytes;
7858 /* Read the entire image. */
7859 png_read_image (png_ptr, rows);
7860 png_read_end (png_ptr, info_ptr);
7861 if (fp)
7863 fclose (fp);
7864 fp = NULL;
7867 BLOCK_INPUT;
7869 /* Create the X image and pixmap. */
7870 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
7871 &img->pixmap))
7873 UNBLOCK_INPUT;
7874 goto error;
7877 /* Create an image and pixmap serving as mask if the PNG image
7878 contains an alpha channel. */
7879 if (channels == 4
7880 && !transparent_p
7881 && !x_create_x_image_and_pixmap (f, width, height, 1,
7882 &mask_img, &img->mask))
7884 x_destroy_x_image (ximg);
7885 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
7886 img->pixmap = 0;
7887 UNBLOCK_INPUT;
7888 goto error;
7891 /* Fill the X image and mask from PNG data. */
7892 init_color_table ();
7894 for (y = 0; y < height; ++y)
7896 png_byte *p = rows[y];
7898 for (x = 0; x < width; ++x)
7900 unsigned r, g, b;
7902 r = *p++ << 8;
7903 g = *p++ << 8;
7904 b = *p++ << 8;
7905 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
7907 /* An alpha channel, aka mask channel, associates variable
7908 transparency with an image. Where other image formats
7909 support binary transparency---fully transparent or fully
7910 opaque---PNG allows up to 254 levels of partial transparency.
7911 The PNG library implements partial transparency by combining
7912 the image with a specified background color.
7914 I'm not sure how to handle this here nicely: because the
7915 background on which the image is displayed may change, for
7916 real alpha channel support, it would be necessary to create
7917 a new image for each possible background.
7919 What I'm doing now is that a mask is created if we have
7920 boolean transparency information. Otherwise I'm using
7921 the frame's background color to combine the image with. */
7923 if (channels == 4)
7925 if (mask_img)
7926 XPutPixel (mask_img, x, y, *p > 0);
7927 ++p;
7932 /* Remember colors allocated for this image. */
7933 img->colors = colors_in_color_table (&img->ncolors);
7934 free_color_table ();
7936 /* Clean up. */
7937 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
7938 xfree (rows);
7939 xfree (pixels);
7941 img->width = width;
7942 img->height = height;
7944 /* Put the image into the pixmap, then free the X image and its buffer. */
7945 x_put_x_image (f, ximg, img->pixmap, width, height);
7946 x_destroy_x_image (ximg);
7948 /* Same for the mask. */
7949 if (mask_img)
7951 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
7952 x_destroy_x_image (mask_img);
7955 UNBLOCK_INPUT;
7956 UNGCPRO;
7957 return 1;
7960 #endif /* HAVE_PNG != 0 */
7964 /***********************************************************************
7965 JPEG
7966 ***********************************************************************/
7968 #if HAVE_JPEG
7970 /* Work around a warning about HAVE_STDLIB_H being redefined in
7971 jconfig.h. */
7972 #ifdef HAVE_STDLIB_H
7973 #define HAVE_STDLIB_H_1
7974 #undef HAVE_STDLIB_H
7975 #endif /* HAVE_STLIB_H */
7977 #include <jpeglib.h>
7978 #include <jerror.h>
7979 #include <setjmp.h>
7981 #ifdef HAVE_STLIB_H_1
7982 #define HAVE_STDLIB_H 1
7983 #endif
7985 static int jpeg_image_p P_ ((Lisp_Object object));
7986 static int jpeg_load P_ ((struct frame *f, struct image *img));
7988 /* The symbol `jpeg' identifying images of this type. */
7990 Lisp_Object Qjpeg;
7992 /* Indices of image specification fields in gs_format, below. */
7994 enum jpeg_keyword_index
7996 JPEG_TYPE,
7997 JPEG_DATA,
7998 JPEG_FILE,
7999 JPEG_ASCENT,
8000 JPEG_MARGIN,
8001 JPEG_RELIEF,
8002 JPEG_ALGORITHM,
8003 JPEG_HEURISTIC_MASK,
8004 JPEG_LAST
8007 /* Vector of image_keyword structures describing the format
8008 of valid user-defined image specifications. */
8010 static struct image_keyword jpeg_format[JPEG_LAST] =
8012 {":type", IMAGE_SYMBOL_VALUE, 1},
8013 {":data", IMAGE_STRING_VALUE, 0},
8014 {":file", IMAGE_STRING_VALUE, 0},
8015 {":ascent", IMAGE_ASCENT_VALUE, 0},
8016 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8017 {":relief", IMAGE_INTEGER_VALUE, 0},
8018 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8019 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8022 /* Structure describing the image type `jpeg'. */
8024 static struct image_type jpeg_type =
8026 &Qjpeg,
8027 jpeg_image_p,
8028 jpeg_load,
8029 x_clear_image,
8030 NULL
8034 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8036 static int
8037 jpeg_image_p (object)
8038 Lisp_Object object;
8040 struct image_keyword fmt[JPEG_LAST];
8042 bcopy (jpeg_format, fmt, sizeof fmt);
8044 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
8045 return 0;
8047 /* Must specify either the :data or :file keyword. */
8048 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
8052 struct my_jpeg_error_mgr
8054 struct jpeg_error_mgr pub;
8055 jmp_buf setjmp_buffer;
8059 static void
8060 my_error_exit (cinfo)
8061 j_common_ptr cinfo;
8063 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
8064 longjmp (mgr->setjmp_buffer, 1);
8068 /* Init source method for JPEG data source manager. Called by
8069 jpeg_read_header() before any data is actually read. See
8070 libjpeg.doc from the JPEG lib distribution. */
8072 static void
8073 our_init_source (cinfo)
8074 j_decompress_ptr cinfo;
8079 /* Fill input buffer method for JPEG data source manager. Called
8080 whenever more data is needed. We read the whole image in one step,
8081 so this only adds a fake end of input marker at the end. */
8083 static boolean
8084 our_fill_input_buffer (cinfo)
8085 j_decompress_ptr cinfo;
8087 /* Insert a fake EOI marker. */
8088 struct jpeg_source_mgr *src = cinfo->src;
8089 static JOCTET buffer[2];
8091 buffer[0] = (JOCTET) 0xFF;
8092 buffer[1] = (JOCTET) JPEG_EOI;
8094 src->next_input_byte = buffer;
8095 src->bytes_in_buffer = 2;
8096 return TRUE;
8100 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8101 is the JPEG data source manager. */
8103 static void
8104 our_skip_input_data (cinfo, num_bytes)
8105 j_decompress_ptr cinfo;
8106 long num_bytes;
8108 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
8110 if (src)
8112 if (num_bytes > src->bytes_in_buffer)
8113 ERREXIT (cinfo, JERR_INPUT_EOF);
8115 src->bytes_in_buffer -= num_bytes;
8116 src->next_input_byte += num_bytes;
8121 /* Method to terminate data source. Called by
8122 jpeg_finish_decompress() after all data has been processed. */
8124 static void
8125 our_term_source (cinfo)
8126 j_decompress_ptr cinfo;
8131 /* Set up the JPEG lib for reading an image from DATA which contains
8132 LEN bytes. CINFO is the decompression info structure created for
8133 reading the image. */
8135 static void
8136 jpeg_memory_src (cinfo, data, len)
8137 j_decompress_ptr cinfo;
8138 JOCTET *data;
8139 unsigned int len;
8141 struct jpeg_source_mgr *src;
8143 if (cinfo->src == NULL)
8145 /* First time for this JPEG object? */
8146 cinfo->src = (struct jpeg_source_mgr *)
8147 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
8148 sizeof (struct jpeg_source_mgr));
8149 src = (struct jpeg_source_mgr *) cinfo->src;
8150 src->next_input_byte = data;
8153 src = (struct jpeg_source_mgr *) cinfo->src;
8154 src->init_source = our_init_source;
8155 src->fill_input_buffer = our_fill_input_buffer;
8156 src->skip_input_data = our_skip_input_data;
8157 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
8158 src->term_source = our_term_source;
8159 src->bytes_in_buffer = len;
8160 src->next_input_byte = data;
8164 /* Load image IMG for use on frame F. Patterned after example.c
8165 from the JPEG lib. */
8167 static int
8168 jpeg_load (f, img)
8169 struct frame *f;
8170 struct image *img;
8172 struct jpeg_decompress_struct cinfo;
8173 struct my_jpeg_error_mgr mgr;
8174 Lisp_Object file, specified_file;
8175 Lisp_Object specified_data;
8176 FILE *fp = NULL;
8177 JSAMPARRAY buffer;
8178 int row_stride, x, y;
8179 XImage *ximg = NULL;
8180 int rc;
8181 unsigned long *colors;
8182 int width, height;
8183 struct gcpro gcpro1;
8185 /* Open the JPEG file. */
8186 specified_file = image_spec_value (img->spec, QCfile, NULL);
8187 specified_data = image_spec_value (img->spec, QCdata, NULL);
8188 file = Qnil;
8189 GCPRO1 (file);
8191 if (NILP (specified_data))
8193 file = x_find_image_file (specified_file);
8194 if (!STRINGP (file))
8196 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8197 UNGCPRO;
8198 return 0;
8201 fp = fopen (XSTRING (file)->data, "r");
8202 if (fp == NULL)
8204 image_error ("Cannot open `%s'", file, Qnil);
8205 UNGCPRO;
8206 return 0;
8210 /* Customize libjpeg's error handling to call my_error_exit when an
8211 error is detected. This function will perform a longjmp. */
8212 mgr.pub.error_exit = my_error_exit;
8213 cinfo.err = jpeg_std_error (&mgr.pub);
8215 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
8217 if (rc == 1)
8219 /* Called from my_error_exit. Display a JPEG error. */
8220 char buffer[JMSG_LENGTH_MAX];
8221 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
8222 image_error ("Error reading JPEG image `%s': %s", img->spec,
8223 build_string (buffer));
8226 /* Close the input file and destroy the JPEG object. */
8227 if (fp)
8228 fclose (fp);
8229 jpeg_destroy_decompress (&cinfo);
8231 BLOCK_INPUT;
8233 /* If we already have an XImage, free that. */
8234 x_destroy_x_image (ximg);
8236 /* Free pixmap and colors. */
8237 x_clear_image (f, img);
8239 UNBLOCK_INPUT;
8240 UNGCPRO;
8241 return 0;
8244 /* Create the JPEG decompression object. Let it read from fp.
8245 Read the JPEG image header. */
8246 jpeg_create_decompress (&cinfo);
8248 if (NILP (specified_data))
8249 jpeg_stdio_src (&cinfo, fp);
8250 else
8251 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
8252 STRING_BYTES (XSTRING (specified_data)));
8254 jpeg_read_header (&cinfo, TRUE);
8256 /* Customize decompression so that color quantization will be used.
8257 Start decompression. */
8258 cinfo.quantize_colors = TRUE;
8259 jpeg_start_decompress (&cinfo);
8260 width = img->width = cinfo.output_width;
8261 height = img->height = cinfo.output_height;
8263 BLOCK_INPUT;
8265 /* Create X image and pixmap. */
8266 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8268 UNBLOCK_INPUT;
8269 longjmp (mgr.setjmp_buffer, 2);
8272 /* Allocate colors. When color quantization is used,
8273 cinfo.actual_number_of_colors has been set with the number of
8274 colors generated, and cinfo.colormap is a two-dimensional array
8275 of color indices in the range 0..cinfo.actual_number_of_colors.
8276 No more than 255 colors will be generated. */
8278 int i, ir, ig, ib;
8280 if (cinfo.out_color_components > 2)
8281 ir = 0, ig = 1, ib = 2;
8282 else if (cinfo.out_color_components > 1)
8283 ir = 0, ig = 1, ib = 0;
8284 else
8285 ir = 0, ig = 0, ib = 0;
8287 /* Use the color table mechanism because it handles colors that
8288 cannot be allocated nicely. Such colors will be replaced with
8289 a default color, and we don't have to care about which colors
8290 can be freed safely, and which can't. */
8291 init_color_table ();
8292 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
8293 * sizeof *colors);
8295 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
8297 /* Multiply RGB values with 255 because X expects RGB values
8298 in the range 0..0xffff. */
8299 int r = cinfo.colormap[ir][i] << 8;
8300 int g = cinfo.colormap[ig][i] << 8;
8301 int b = cinfo.colormap[ib][i] << 8;
8302 colors[i] = lookup_rgb_color (f, r, g, b);
8305 /* Remember those colors actually allocated. */
8306 img->colors = colors_in_color_table (&img->ncolors);
8307 free_color_table ();
8310 /* Read pixels. */
8311 row_stride = width * cinfo.output_components;
8312 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
8313 row_stride, 1);
8314 for (y = 0; y < height; ++y)
8316 jpeg_read_scanlines (&cinfo, buffer, 1);
8317 for (x = 0; x < cinfo.output_width; ++x)
8318 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
8321 /* Clean up. */
8322 jpeg_finish_decompress (&cinfo);
8323 jpeg_destroy_decompress (&cinfo);
8324 if (fp)
8325 fclose (fp);
8327 /* Put the image into the pixmap. */
8328 x_put_x_image (f, ximg, img->pixmap, width, height);
8329 x_destroy_x_image (ximg);
8330 UNBLOCK_INPUT;
8331 UNGCPRO;
8332 return 1;
8335 #endif /* HAVE_JPEG */
8339 /***********************************************************************
8340 TIFF
8341 ***********************************************************************/
8343 #if HAVE_TIFF
8345 #include <tiffio.h>
8347 static int tiff_image_p P_ ((Lisp_Object object));
8348 static int tiff_load P_ ((struct frame *f, struct image *img));
8350 /* The symbol `tiff' identifying images of this type. */
8352 Lisp_Object Qtiff;
8354 /* Indices of image specification fields in tiff_format, below. */
8356 enum tiff_keyword_index
8358 TIFF_TYPE,
8359 TIFF_DATA,
8360 TIFF_FILE,
8361 TIFF_ASCENT,
8362 TIFF_MARGIN,
8363 TIFF_RELIEF,
8364 TIFF_ALGORITHM,
8365 TIFF_HEURISTIC_MASK,
8366 TIFF_LAST
8369 /* Vector of image_keyword structures describing the format
8370 of valid user-defined image specifications. */
8372 static struct image_keyword tiff_format[TIFF_LAST] =
8374 {":type", IMAGE_SYMBOL_VALUE, 1},
8375 {":data", IMAGE_STRING_VALUE, 0},
8376 {":file", IMAGE_STRING_VALUE, 0},
8377 {":ascent", IMAGE_ASCENT_VALUE, 0},
8378 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8379 {":relief", IMAGE_INTEGER_VALUE, 0},
8380 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8381 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8384 /* Structure describing the image type `tiff'. */
8386 static struct image_type tiff_type =
8388 &Qtiff,
8389 tiff_image_p,
8390 tiff_load,
8391 x_clear_image,
8392 NULL
8396 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8398 static int
8399 tiff_image_p (object)
8400 Lisp_Object object;
8402 struct image_keyword fmt[TIFF_LAST];
8403 bcopy (tiff_format, fmt, sizeof fmt);
8405 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
8406 return 0;
8408 /* Must specify either the :data or :file keyword. */
8409 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
8413 /* Reading from a memory buffer for TIFF images Based on the PNG
8414 memory source, but we have to provide a lot of extra functions.
8415 Blah.
8417 We really only need to implement read and seek, but I am not
8418 convinced that the TIFF library is smart enough not to destroy
8419 itself if we only hand it the function pointers we need to
8420 override. */
8422 typedef struct
8424 unsigned char *bytes;
8425 size_t len;
8426 int index;
8428 tiff_memory_source;
8431 static size_t
8432 tiff_read_from_memory (data, buf, size)
8433 thandle_t data;
8434 tdata_t buf;
8435 tsize_t size;
8437 tiff_memory_source *src = (tiff_memory_source *) data;
8439 if (size > src->len - src->index)
8440 return (size_t) -1;
8441 bcopy (src->bytes + src->index, buf, size);
8442 src->index += size;
8443 return size;
8447 static size_t
8448 tiff_write_from_memory (data, buf, size)
8449 thandle_t data;
8450 tdata_t buf;
8451 tsize_t size;
8453 return (size_t) -1;
8457 static toff_t
8458 tiff_seek_in_memory (data, off, whence)
8459 thandle_t data;
8460 toff_t off;
8461 int whence;
8463 tiff_memory_source *src = (tiff_memory_source *) data;
8464 int idx;
8466 switch (whence)
8468 case SEEK_SET: /* Go from beginning of source. */
8469 idx = off;
8470 break;
8472 case SEEK_END: /* Go from end of source. */
8473 idx = src->len + off;
8474 break;
8476 case SEEK_CUR: /* Go from current position. */
8477 idx = src->index + off;
8478 break;
8480 default: /* Invalid `whence'. */
8481 return -1;
8484 if (idx > src->len || idx < 0)
8485 return -1;
8487 src->index = idx;
8488 return src->index;
8492 static int
8493 tiff_close_memory (data)
8494 thandle_t data;
8496 /* NOOP */
8497 return 0;
8501 static int
8502 tiff_mmap_memory (data, pbase, psize)
8503 thandle_t data;
8504 tdata_t *pbase;
8505 toff_t *psize;
8507 /* It is already _IN_ memory. */
8508 return 0;
8512 static void
8513 tiff_unmap_memory (data, base, size)
8514 thandle_t data;
8515 tdata_t base;
8516 toff_t size;
8518 /* We don't need to do this. */
8522 static toff_t
8523 tiff_size_of_memory (data)
8524 thandle_t data;
8526 return ((tiff_memory_source *) data)->len;
8530 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8531 successful. */
8533 static int
8534 tiff_load (f, img)
8535 struct frame *f;
8536 struct image *img;
8538 Lisp_Object file, specified_file;
8539 Lisp_Object specified_data;
8540 TIFF *tiff;
8541 int width, height, x, y;
8542 uint32 *buf;
8543 int rc;
8544 XImage *ximg;
8545 struct gcpro gcpro1;
8546 tiff_memory_source memsrc;
8548 specified_file = image_spec_value (img->spec, QCfile, NULL);
8549 specified_data = image_spec_value (img->spec, QCdata, NULL);
8550 file = Qnil;
8551 GCPRO1 (file);
8553 if (NILP (specified_data))
8555 /* Read from a file */
8556 file = x_find_image_file (specified_file);
8557 if (!STRINGP (file))
8559 image_error ("Cannot find image file `%s'", file, Qnil);
8560 UNGCPRO;
8561 return 0;
8564 /* Try to open the image file. */
8565 tiff = TIFFOpen (XSTRING (file)->data, "r");
8566 if (tiff == NULL)
8568 image_error ("Cannot open `%s'", file, Qnil);
8569 UNGCPRO;
8570 return 0;
8573 else
8575 /* Memory source! */
8576 memsrc.bytes = XSTRING (specified_data)->data;
8577 memsrc.len = STRING_BYTES (XSTRING (specified_data));
8578 memsrc.index = 0;
8580 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
8581 (TIFFReadWriteProc) tiff_read_from_memory,
8582 (TIFFReadWriteProc) tiff_write_from_memory,
8583 tiff_seek_in_memory,
8584 tiff_close_memory,
8585 tiff_size_of_memory,
8586 tiff_mmap_memory,
8587 tiff_unmap_memory);
8589 if (!tiff)
8591 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
8592 UNGCPRO;
8593 return 0;
8597 /* Get width and height of the image, and allocate a raster buffer
8598 of width x height 32-bit values. */
8599 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
8600 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
8601 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
8603 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
8604 TIFFClose (tiff);
8605 if (!rc)
8607 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
8608 xfree (buf);
8609 UNGCPRO;
8610 return 0;
8613 BLOCK_INPUT;
8615 /* Create the X image and pixmap. */
8616 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8618 UNBLOCK_INPUT;
8619 xfree (buf);
8620 UNGCPRO;
8621 return 0;
8624 /* Initialize the color table. */
8625 init_color_table ();
8627 /* Process the pixel raster. Origin is in the lower-left corner. */
8628 for (y = 0; y < height; ++y)
8630 uint32 *row = buf + y * width;
8632 for (x = 0; x < width; ++x)
8634 uint32 abgr = row[x];
8635 int r = TIFFGetR (abgr) << 8;
8636 int g = TIFFGetG (abgr) << 8;
8637 int b = TIFFGetB (abgr) << 8;
8638 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
8642 /* Remember the colors allocated for the image. Free the color table. */
8643 img->colors = colors_in_color_table (&img->ncolors);
8644 free_color_table ();
8646 /* Put the image into the pixmap, then free the X image and its buffer. */
8647 x_put_x_image (f, ximg, img->pixmap, width, height);
8648 x_destroy_x_image (ximg);
8649 xfree (buf);
8650 UNBLOCK_INPUT;
8652 img->width = width;
8653 img->height = height;
8655 UNGCPRO;
8656 return 1;
8659 #endif /* HAVE_TIFF != 0 */
8663 /***********************************************************************
8665 ***********************************************************************/
8667 #if HAVE_GIF
8669 #include <gif_lib.h>
8671 static int gif_image_p P_ ((Lisp_Object object));
8672 static int gif_load P_ ((struct frame *f, struct image *img));
8674 /* The symbol `gif' identifying images of this type. */
8676 Lisp_Object Qgif;
8678 /* Indices of image specification fields in gif_format, below. */
8680 enum gif_keyword_index
8682 GIF_TYPE,
8683 GIF_DATA,
8684 GIF_FILE,
8685 GIF_ASCENT,
8686 GIF_MARGIN,
8687 GIF_RELIEF,
8688 GIF_ALGORITHM,
8689 GIF_HEURISTIC_MASK,
8690 GIF_IMAGE,
8691 GIF_LAST
8694 /* Vector of image_keyword structures describing the format
8695 of valid user-defined image specifications. */
8697 static struct image_keyword gif_format[GIF_LAST] =
8699 {":type", IMAGE_SYMBOL_VALUE, 1},
8700 {":data", IMAGE_STRING_VALUE, 0},
8701 {":file", IMAGE_STRING_VALUE, 0},
8702 {":ascent", IMAGE_ASCENT_VALUE, 0},
8703 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8704 {":relief", IMAGE_INTEGER_VALUE, 0},
8705 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8706 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8707 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
8710 /* Structure describing the image type `gif'. */
8712 static struct image_type gif_type =
8714 &Qgif,
8715 gif_image_p,
8716 gif_load,
8717 x_clear_image,
8718 NULL
8722 /* Return non-zero if OBJECT is a valid GIF image specification. */
8724 static int
8725 gif_image_p (object)
8726 Lisp_Object object;
8728 struct image_keyword fmt[GIF_LAST];
8729 bcopy (gif_format, fmt, sizeof fmt);
8731 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
8732 return 0;
8734 /* Must specify either the :data or :file keyword. */
8735 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
8739 /* Reading a GIF image from memory
8740 Based on the PNG memory stuff to a certain extent. */
8742 typedef struct
8744 unsigned char *bytes;
8745 size_t len;
8746 int index;
8748 gif_memory_source;
8751 /* Make the current memory source available to gif_read_from_memory.
8752 It's done this way because not all versions of libungif support
8753 a UserData field in the GifFileType structure. */
8754 static gif_memory_source *current_gif_memory_src;
8756 static int
8757 gif_read_from_memory (file, buf, len)
8758 GifFileType *file;
8759 GifByteType *buf;
8760 int len;
8762 gif_memory_source *src = current_gif_memory_src;
8764 if (len > src->len - src->index)
8765 return -1;
8767 bcopy (src->bytes + src->index, buf, len);
8768 src->index += len;
8769 return len;
8773 /* Load GIF image IMG for use on frame F. Value is non-zero if
8774 successful. */
8776 static int
8777 gif_load (f, img)
8778 struct frame *f;
8779 struct image *img;
8781 Lisp_Object file, specified_file;
8782 Lisp_Object specified_data;
8783 int rc, width, height, x, y, i;
8784 XImage *ximg;
8785 ColorMapObject *gif_color_map;
8786 unsigned long pixel_colors[256];
8787 GifFileType *gif;
8788 struct gcpro gcpro1;
8789 Lisp_Object image;
8790 int ino, image_left, image_top, image_width, image_height;
8791 gif_memory_source memsrc;
8792 unsigned char *raster;
8794 specified_file = image_spec_value (img->spec, QCfile, NULL);
8795 specified_data = image_spec_value (img->spec, QCdata, NULL);
8796 file = Qnil;
8797 GCPRO1 (file);
8799 if (NILP (specified_data))
8801 file = x_find_image_file (specified_file);
8802 if (!STRINGP (file))
8804 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8805 UNGCPRO;
8806 return 0;
8809 /* Open the GIF file. */
8810 gif = DGifOpenFileName (XSTRING (file)->data);
8811 if (gif == NULL)
8813 image_error ("Cannot open `%s'", file, Qnil);
8814 UNGCPRO;
8815 return 0;
8818 else
8820 /* Read from memory! */
8821 current_gif_memory_src = &memsrc;
8822 memsrc.bytes = XSTRING (specified_data)->data;
8823 memsrc.len = STRING_BYTES (XSTRING (specified_data));
8824 memsrc.index = 0;
8826 gif = DGifOpen(&memsrc, gif_read_from_memory);
8827 if (!gif)
8829 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
8830 UNGCPRO;
8831 return 0;
8835 /* Read entire contents. */
8836 rc = DGifSlurp (gif);
8837 if (rc == GIF_ERROR)
8839 image_error ("Error reading `%s'", img->spec, Qnil);
8840 DGifCloseFile (gif);
8841 UNGCPRO;
8842 return 0;
8845 image = image_spec_value (img->spec, QCindex, NULL);
8846 ino = INTEGERP (image) ? XFASTINT (image) : 0;
8847 if (ino >= gif->ImageCount)
8849 image_error ("Invalid image number `%s' in image `%s'",
8850 image, img->spec);
8851 DGifCloseFile (gif);
8852 UNGCPRO;
8853 return 0;
8856 width = img->width = gif->SWidth;
8857 height = img->height = gif->SHeight;
8859 BLOCK_INPUT;
8861 /* Create the X image and pixmap. */
8862 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8864 UNBLOCK_INPUT;
8865 DGifCloseFile (gif);
8866 UNGCPRO;
8867 return 0;
8870 /* Allocate colors. */
8871 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
8872 if (!gif_color_map)
8873 gif_color_map = gif->SColorMap;
8874 init_color_table ();
8875 bzero (pixel_colors, sizeof pixel_colors);
8877 for (i = 0; i < gif_color_map->ColorCount; ++i)
8879 int r = gif_color_map->Colors[i].Red << 8;
8880 int g = gif_color_map->Colors[i].Green << 8;
8881 int b = gif_color_map->Colors[i].Blue << 8;
8882 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
8885 img->colors = colors_in_color_table (&img->ncolors);
8886 free_color_table ();
8888 /* Clear the part of the screen image that are not covered by
8889 the image from the GIF file. Full animated GIF support
8890 requires more than can be done here (see the gif89 spec,
8891 disposal methods). Let's simply assume that the part
8892 not covered by a sub-image is in the frame's background color. */
8893 image_top = gif->SavedImages[ino].ImageDesc.Top;
8894 image_left = gif->SavedImages[ino].ImageDesc.Left;
8895 image_width = gif->SavedImages[ino].ImageDesc.Width;
8896 image_height = gif->SavedImages[ino].ImageDesc.Height;
8898 for (y = 0; y < image_top; ++y)
8899 for (x = 0; x < width; ++x)
8900 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8902 for (y = image_top + image_height; y < height; ++y)
8903 for (x = 0; x < width; ++x)
8904 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8906 for (y = image_top; y < image_top + image_height; ++y)
8908 for (x = 0; x < image_left; ++x)
8909 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8910 for (x = image_left + image_width; x < width; ++x)
8911 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8914 /* Read the GIF image into the X image. We use a local variable
8915 `raster' here because RasterBits below is a char *, and invites
8916 problems with bytes >= 0x80. */
8917 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
8919 if (gif->SavedImages[ino].ImageDesc.Interlace)
8921 static int interlace_start[] = {0, 4, 2, 1};
8922 static int interlace_increment[] = {8, 8, 4, 2};
8923 int pass, inc;
8924 int row = interlace_start[0];
8926 pass = 0;
8928 for (y = 0; y < image_height; y++)
8930 if (row >= image_height)
8932 row = interlace_start[++pass];
8933 while (row >= image_height)
8934 row = interlace_start[++pass];
8937 for (x = 0; x < image_width; x++)
8939 int i = raster[(y * image_width) + x];
8940 XPutPixel (ximg, x + image_left, row + image_top,
8941 pixel_colors[i]);
8944 row += interlace_increment[pass];
8947 else
8949 for (y = 0; y < image_height; ++y)
8950 for (x = 0; x < image_width; ++x)
8952 int i = raster[y * image_width + x];
8953 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
8957 DGifCloseFile (gif);
8959 /* Put the image into the pixmap, then free the X image and its buffer. */
8960 x_put_x_image (f, ximg, img->pixmap, width, height);
8961 x_destroy_x_image (ximg);
8962 UNBLOCK_INPUT;
8964 UNGCPRO;
8965 return 1;
8968 #endif /* HAVE_GIF != 0 */
8972 /***********************************************************************
8973 Ghostscript
8974 ***********************************************************************/
8976 static int gs_image_p P_ ((Lisp_Object object));
8977 static int gs_load P_ ((struct frame *f, struct image *img));
8978 static void gs_clear_image P_ ((struct frame *f, struct image *img));
8980 /* The symbol `postscript' identifying images of this type. */
8982 Lisp_Object Qpostscript;
8984 /* Keyword symbols. */
8986 Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
8988 /* Indices of image specification fields in gs_format, below. */
8990 enum gs_keyword_index
8992 GS_TYPE,
8993 GS_PT_WIDTH,
8994 GS_PT_HEIGHT,
8995 GS_FILE,
8996 GS_LOADER,
8997 GS_BOUNDING_BOX,
8998 GS_ASCENT,
8999 GS_MARGIN,
9000 GS_RELIEF,
9001 GS_ALGORITHM,
9002 GS_HEURISTIC_MASK,
9003 GS_LAST
9006 /* Vector of image_keyword structures describing the format
9007 of valid user-defined image specifications. */
9009 static struct image_keyword gs_format[GS_LAST] =
9011 {":type", IMAGE_SYMBOL_VALUE, 1},
9012 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9013 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9014 {":file", IMAGE_STRING_VALUE, 1},
9015 {":loader", IMAGE_FUNCTION_VALUE, 0},
9016 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
9017 {":ascent", IMAGE_ASCENT_VALUE, 0},
9018 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9019 {":relief", IMAGE_INTEGER_VALUE, 0},
9020 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9021 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
9024 /* Structure describing the image type `ghostscript'. */
9026 static struct image_type gs_type =
9028 &Qpostscript,
9029 gs_image_p,
9030 gs_load,
9031 gs_clear_image,
9032 NULL
9036 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9038 static void
9039 gs_clear_image (f, img)
9040 struct frame *f;
9041 struct image *img;
9043 /* IMG->data.ptr_val may contain a recorded colormap. */
9044 xfree (img->data.ptr_val);
9045 x_clear_image (f, img);
9049 /* Return non-zero if OBJECT is a valid Ghostscript image
9050 specification. */
9052 static int
9053 gs_image_p (object)
9054 Lisp_Object object;
9056 struct image_keyword fmt[GS_LAST];
9057 Lisp_Object tem;
9058 int i;
9060 bcopy (gs_format, fmt, sizeof fmt);
9062 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
9063 return 0;
9065 /* Bounding box must be a list or vector containing 4 integers. */
9066 tem = fmt[GS_BOUNDING_BOX].value;
9067 if (CONSP (tem))
9069 for (i = 0; i < 4; ++i, tem = XCDR (tem))
9070 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
9071 return 0;
9072 if (!NILP (tem))
9073 return 0;
9075 else if (VECTORP (tem))
9077 if (XVECTOR (tem)->size != 4)
9078 return 0;
9079 for (i = 0; i < 4; ++i)
9080 if (!INTEGERP (XVECTOR (tem)->contents[i]))
9081 return 0;
9083 else
9084 return 0;
9086 return 1;
9090 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9091 if successful. */
9093 static int
9094 gs_load (f, img)
9095 struct frame *f;
9096 struct image *img;
9098 char buffer[100];
9099 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
9100 struct gcpro gcpro1, gcpro2;
9101 Lisp_Object frame;
9102 double in_width, in_height;
9103 Lisp_Object pixel_colors = Qnil;
9105 /* Compute pixel size of pixmap needed from the given size in the
9106 image specification. Sizes in the specification are in pt. 1 pt
9107 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9108 info. */
9109 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
9110 in_width = XFASTINT (pt_width) / 72.0;
9111 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
9112 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
9113 in_height = XFASTINT (pt_height) / 72.0;
9114 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
9116 /* Create the pixmap. */
9117 BLOCK_INPUT;
9118 xassert (img->pixmap == 0);
9119 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9120 img->width, img->height,
9121 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
9122 UNBLOCK_INPUT;
9124 if (!img->pixmap)
9126 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
9127 return 0;
9130 /* Call the loader to fill the pixmap. It returns a process object
9131 if successful. We do not record_unwind_protect here because
9132 other places in redisplay like calling window scroll functions
9133 don't either. Let the Lisp loader use `unwind-protect' instead. */
9134 GCPRO2 (window_and_pixmap_id, pixel_colors);
9136 sprintf (buffer, "%lu %lu",
9137 (unsigned long) FRAME_X_WINDOW (f),
9138 (unsigned long) img->pixmap);
9139 window_and_pixmap_id = build_string (buffer);
9141 sprintf (buffer, "%lu %lu",
9142 FRAME_FOREGROUND_PIXEL (f),
9143 FRAME_BACKGROUND_PIXEL (f));
9144 pixel_colors = build_string (buffer);
9146 XSETFRAME (frame, f);
9147 loader = image_spec_value (img->spec, QCloader, NULL);
9148 if (NILP (loader))
9149 loader = intern ("gs-load-image");
9151 img->data.lisp_val = call6 (loader, frame, img->spec,
9152 make_number (img->width),
9153 make_number (img->height),
9154 window_and_pixmap_id,
9155 pixel_colors);
9156 UNGCPRO;
9157 return PROCESSP (img->data.lisp_val);
9161 /* Kill the Ghostscript process that was started to fill PIXMAP on
9162 frame F. Called from XTread_socket when receiving an event
9163 telling Emacs that Ghostscript has finished drawing. */
9165 void
9166 x_kill_gs_process (pixmap, f)
9167 Pixmap pixmap;
9168 struct frame *f;
9170 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9171 int class, i;
9172 struct image *img;
9174 /* Find the image containing PIXMAP. */
9175 for (i = 0; i < c->used; ++i)
9176 if (c->images[i]->pixmap == pixmap)
9177 break;
9179 /* Kill the GS process. We should have found PIXMAP in the image
9180 cache and its image should contain a process object. */
9181 xassert (i < c->used);
9182 img = c->images[i];
9183 xassert (PROCESSP (img->data.lisp_val));
9184 Fkill_process (img->data.lisp_val, Qnil);
9185 img->data.lisp_val = Qnil;
9187 /* On displays with a mutable colormap, figure out the colors
9188 allocated for the image by looking at the pixels of an XImage for
9189 img->pixmap. */
9190 class = FRAME_X_VISUAL (f)->class;
9191 if (class != StaticColor && class != StaticGray && class != TrueColor)
9193 XImage *ximg;
9195 BLOCK_INPUT;
9197 /* Try to get an XImage for img->pixmep. */
9198 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9199 0, 0, img->width, img->height, ~0, ZPixmap);
9200 if (ximg)
9202 int x, y;
9204 /* Initialize the color table. */
9205 init_color_table ();
9207 /* For each pixel of the image, look its color up in the
9208 color table. After having done so, the color table will
9209 contain an entry for each color used by the image. */
9210 for (y = 0; y < img->height; ++y)
9211 for (x = 0; x < img->width; ++x)
9213 unsigned long pixel = XGetPixel (ximg, x, y);
9214 lookup_pixel_color (f, pixel);
9217 /* Record colors in the image. Free color table and XImage. */
9218 img->colors = colors_in_color_table (&img->ncolors);
9219 free_color_table ();
9220 XDestroyImage (ximg);
9222 #if 0 /* This doesn't seem to be the case. If we free the colors
9223 here, we get a BadAccess later in x_clear_image when
9224 freeing the colors. */
9225 /* We have allocated colors once, but Ghostscript has also
9226 allocated colors on behalf of us. So, to get the
9227 reference counts right, free them once. */
9228 if (img->ncolors)
9229 x_free_colors (f, img->colors, img->ncolors);
9230 #endif
9232 else
9233 image_error ("Cannot get X image of `%s'; colors will not be freed",
9234 img->spec, Qnil);
9236 UNBLOCK_INPUT;
9242 /***********************************************************************
9243 Window properties
9244 ***********************************************************************/
9246 DEFUN ("x-change-window-property", Fx_change_window_property,
9247 Sx_change_window_property, 2, 3, 0,
9248 "Change window property PROP to VALUE on the X window of FRAME.\n\
9249 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9250 selected frame. Value is VALUE.")
9251 (prop, value, frame)
9252 Lisp_Object frame, prop, value;
9254 struct frame *f = check_x_frame (frame);
9255 Atom prop_atom;
9257 CHECK_STRING (prop, 1);
9258 CHECK_STRING (value, 2);
9260 BLOCK_INPUT;
9261 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
9262 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9263 prop_atom, XA_STRING, 8, PropModeReplace,
9264 XSTRING (value)->data, XSTRING (value)->size);
9266 /* Make sure the property is set when we return. */
9267 XFlush (FRAME_X_DISPLAY (f));
9268 UNBLOCK_INPUT;
9270 return value;
9274 DEFUN ("x-delete-window-property", Fx_delete_window_property,
9275 Sx_delete_window_property, 1, 2, 0,
9276 "Remove window property PROP from X window of FRAME.\n\
9277 FRAME nil or omitted means use the selected frame. Value is PROP.")
9278 (prop, frame)
9279 Lisp_Object prop, frame;
9281 struct frame *f = check_x_frame (frame);
9282 Atom prop_atom;
9284 CHECK_STRING (prop, 1);
9285 BLOCK_INPUT;
9286 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
9287 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
9289 /* Make sure the property is removed when we return. */
9290 XFlush (FRAME_X_DISPLAY (f));
9291 UNBLOCK_INPUT;
9293 return prop;
9297 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
9298 1, 2, 0,
9299 "Value is the value of window property PROP on FRAME.\n\
9300 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9301 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9302 value.")
9303 (prop, frame)
9304 Lisp_Object prop, frame;
9306 struct frame *f = check_x_frame (frame);
9307 Atom prop_atom;
9308 int rc;
9309 Lisp_Object prop_value = Qnil;
9310 char *tmp_data = NULL;
9311 Atom actual_type;
9312 int actual_format;
9313 unsigned long actual_size, bytes_remaining;
9315 CHECK_STRING (prop, 1);
9316 BLOCK_INPUT;
9317 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
9318 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9319 prop_atom, 0, 0, False, XA_STRING,
9320 &actual_type, &actual_format, &actual_size,
9321 &bytes_remaining, (unsigned char **) &tmp_data);
9322 if (rc == Success)
9324 int size = bytes_remaining;
9326 XFree (tmp_data);
9327 tmp_data = NULL;
9329 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9330 prop_atom, 0, bytes_remaining,
9331 False, XA_STRING,
9332 &actual_type, &actual_format,
9333 &actual_size, &bytes_remaining,
9334 (unsigned char **) &tmp_data);
9335 if (rc == Success)
9336 prop_value = make_string (tmp_data, size);
9338 XFree (tmp_data);
9341 UNBLOCK_INPUT;
9342 return prop_value;
9347 /***********************************************************************
9348 Busy cursor
9349 ***********************************************************************/
9351 /* If non-null, an asynchronous timer that, when it expires, displays
9352 a busy cursor on all frames. */
9354 static struct atimer *busy_cursor_atimer;
9356 /* Non-zero means a busy cursor is currently shown. */
9358 static int busy_cursor_shown_p;
9360 /* Number of seconds to wait before displaying a busy cursor. */
9362 static Lisp_Object Vbusy_cursor_delay;
9364 /* Default number of seconds to wait before displaying a busy
9365 cursor. */
9367 #define DEFAULT_BUSY_CURSOR_DELAY 1
9369 /* Function prototypes. */
9371 static void show_busy_cursor P_ ((struct atimer *));
9372 static void hide_busy_cursor P_ ((void));
9375 /* Cancel a currently active busy-cursor timer, and start a new one. */
9377 void
9378 start_busy_cursor ()
9380 EMACS_TIME delay;
9381 int secs, usecs = 0;
9383 cancel_busy_cursor ();
9385 if (INTEGERP (Vbusy_cursor_delay)
9386 && XINT (Vbusy_cursor_delay) > 0)
9387 secs = XFASTINT (Vbusy_cursor_delay);
9388 else if (FLOATP (Vbusy_cursor_delay)
9389 && XFLOAT_DATA (Vbusy_cursor_delay) > 0)
9391 Lisp_Object tem;
9392 tem = Ftruncate (Vbusy_cursor_delay, Qnil);
9393 secs = XFASTINT (tem);
9394 usecs = (XFLOAT_DATA (Vbusy_cursor_delay) - secs) * 1000000;
9396 else
9397 secs = DEFAULT_BUSY_CURSOR_DELAY;
9399 EMACS_SET_SECS_USECS (delay, secs, usecs);
9400 busy_cursor_atimer = start_atimer (ATIMER_RELATIVE, delay,
9401 show_busy_cursor, NULL);
9405 /* Cancel the busy cursor timer if active, hide a busy cursor if
9406 shown. */
9408 void
9409 cancel_busy_cursor ()
9411 if (busy_cursor_atimer)
9413 cancel_atimer (busy_cursor_atimer);
9414 busy_cursor_atimer = NULL;
9417 if (busy_cursor_shown_p)
9418 hide_busy_cursor ();
9422 /* Timer function of busy_cursor_atimer. TIMER is equal to
9423 busy_cursor_atimer.
9425 Display a busy cursor on all frames by mapping the frames'
9426 busy_window. Set the busy_p flag in the frames' output_data.x
9427 structure to indicate that a busy cursor is shown on the
9428 frames. */
9430 static void
9431 show_busy_cursor (timer)
9432 struct atimer *timer;
9434 /* The timer implementation will cancel this timer automatically
9435 after this function has run. Set busy_cursor_atimer to null
9436 so that we know the timer doesn't have to be canceled. */
9437 busy_cursor_atimer = NULL;
9439 if (!busy_cursor_shown_p)
9441 Lisp_Object rest, frame;
9443 BLOCK_INPUT;
9445 FOR_EACH_FRAME (rest, frame)
9446 if (FRAME_X_P (XFRAME (frame)))
9448 struct frame *f = XFRAME (frame);
9450 f->output_data.x->busy_p = 1;
9452 if (!f->output_data.x->busy_window)
9454 unsigned long mask = CWCursor;
9455 XSetWindowAttributes attrs;
9457 attrs.cursor = f->output_data.x->busy_cursor;
9459 f->output_data.x->busy_window
9460 = XCreateWindow (FRAME_X_DISPLAY (f),
9461 FRAME_OUTER_WINDOW (f),
9462 0, 0, 32000, 32000, 0, 0,
9463 InputOnly,
9464 CopyFromParent,
9465 mask, &attrs);
9468 XMapRaised (FRAME_X_DISPLAY (f), f->output_data.x->busy_window);
9469 XFlush (FRAME_X_DISPLAY (f));
9472 busy_cursor_shown_p = 1;
9473 UNBLOCK_INPUT;
9478 /* Hide the busy cursor on all frames, if it is currently shown. */
9480 static void
9481 hide_busy_cursor ()
9483 if (busy_cursor_shown_p)
9485 Lisp_Object rest, frame;
9487 BLOCK_INPUT;
9488 FOR_EACH_FRAME (rest, frame)
9490 struct frame *f = XFRAME (frame);
9492 if (FRAME_X_P (f)
9493 /* Watch out for newly created frames. */
9494 && f->output_data.x->busy_window)
9496 XUnmapWindow (FRAME_X_DISPLAY (f), f->output_data.x->busy_window);
9497 /* Sync here because XTread_socket looks at the busy_p flag
9498 that is reset to zero below. */
9499 XSync (FRAME_X_DISPLAY (f), False);
9500 f->output_data.x->busy_p = 0;
9504 busy_cursor_shown_p = 0;
9505 UNBLOCK_INPUT;
9511 /***********************************************************************
9512 Tool tips
9513 ***********************************************************************/
9515 static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
9516 Lisp_Object));
9518 /* The frame of a currently visible tooltip, or null. */
9520 struct frame *tip_frame;
9522 /* If non-nil, a timer started that hides the last tooltip when it
9523 fires. */
9525 Lisp_Object tip_timer;
9526 Window tip_window;
9528 /* Create a frame for a tooltip on the display described by DPYINFO.
9529 PARMS is a list of frame parameters. Value is the frame. */
9531 static Lisp_Object
9532 x_create_tip_frame (dpyinfo, parms)
9533 struct x_display_info *dpyinfo;
9534 Lisp_Object parms;
9536 struct frame *f;
9537 Lisp_Object frame, tem;
9538 Lisp_Object name;
9539 long window_prompting = 0;
9540 int width, height;
9541 int count = specpdl_ptr - specpdl;
9542 struct gcpro gcpro1, gcpro2, gcpro3;
9543 struct kboard *kb;
9545 check_x ();
9547 /* Use this general default value to start with until we know if
9548 this frame has a specified name. */
9549 Vx_resource_name = Vinvocation_name;
9551 #ifdef MULTI_KBOARD
9552 kb = dpyinfo->kboard;
9553 #else
9554 kb = &the_only_kboard;
9555 #endif
9557 /* Get the name of the frame to use for resource lookup. */
9558 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
9559 if (!STRINGP (name)
9560 && !EQ (name, Qunbound)
9561 && !NILP (name))
9562 error ("Invalid frame name--not a string or nil");
9563 Vx_resource_name = name;
9565 frame = Qnil;
9566 GCPRO3 (parms, name, frame);
9567 tip_frame = f = make_frame (1);
9568 XSETFRAME (frame, f);
9569 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
9571 f->output_method = output_x_window;
9572 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
9573 bzero (f->output_data.x, sizeof (struct x_output));
9574 f->output_data.x->icon_bitmap = -1;
9575 f->output_data.x->fontset = -1;
9576 f->icon_name = Qnil;
9577 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
9578 #ifdef MULTI_KBOARD
9579 FRAME_KBOARD (f) = kb;
9580 #endif
9581 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
9582 f->output_data.x->explicit_parent = 0;
9584 /* Set the name; the functions to which we pass f expect the name to
9585 be set. */
9586 if (EQ (name, Qunbound) || NILP (name))
9588 f->name = build_string (dpyinfo->x_id_name);
9589 f->explicit_name = 0;
9591 else
9593 f->name = name;
9594 f->explicit_name = 1;
9595 /* use the frame's title when getting resources for this frame. */
9596 specbind (Qx_resource_name, name);
9599 /* Extract the window parameters from the supplied values
9600 that are needed to determine window geometry. */
9602 Lisp_Object font;
9604 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
9606 BLOCK_INPUT;
9607 /* First, try whatever font the caller has specified. */
9608 if (STRINGP (font))
9610 tem = Fquery_fontset (font, Qnil);
9611 if (STRINGP (tem))
9612 font = x_new_fontset (f, XSTRING (tem)->data);
9613 else
9614 font = x_new_font (f, XSTRING (font)->data);
9617 /* Try out a font which we hope has bold and italic variations. */
9618 if (!STRINGP (font))
9619 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9620 if (!STRINGP (font))
9621 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9622 if (! STRINGP (font))
9623 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9624 if (! STRINGP (font))
9625 /* This was formerly the first thing tried, but it finds too many fonts
9626 and takes too long. */
9627 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9628 /* If those didn't work, look for something which will at least work. */
9629 if (! STRINGP (font))
9630 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9631 UNBLOCK_INPUT;
9632 if (! STRINGP (font))
9633 font = build_string ("fixed");
9635 x_default_parameter (f, parms, Qfont, font,
9636 "font", "Font", RES_TYPE_STRING);
9639 x_default_parameter (f, parms, Qborder_width, make_number (2),
9640 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
9642 /* This defaults to 2 in order to match xterm. We recognize either
9643 internalBorderWidth or internalBorder (which is what xterm calls
9644 it). */
9645 if (NILP (Fassq (Qinternal_border_width, parms)))
9647 Lisp_Object value;
9649 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
9650 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
9651 if (! EQ (value, Qunbound))
9652 parms = Fcons (Fcons (Qinternal_border_width, value),
9653 parms);
9656 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
9657 "internalBorderWidth", "internalBorderWidth",
9658 RES_TYPE_NUMBER);
9660 /* Also do the stuff which must be set before the window exists. */
9661 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
9662 "foreground", "Foreground", RES_TYPE_STRING);
9663 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
9664 "background", "Background", RES_TYPE_STRING);
9665 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
9666 "pointerColor", "Foreground", RES_TYPE_STRING);
9667 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
9668 "cursorColor", "Foreground", RES_TYPE_STRING);
9669 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
9670 "borderColor", "BorderColor", RES_TYPE_STRING);
9672 /* Init faces before x_default_parameter is called for scroll-bar
9673 parameters because that function calls x_set_scroll_bar_width,
9674 which calls change_frame_size, which calls Fset_window_buffer,
9675 which runs hooks, which call Fvertical_motion. At the end, we
9676 end up in init_iterator with a null face cache, which should not
9677 happen. */
9678 init_frame_faces (f);
9680 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
9681 window_prompting = x_figure_window_size (f, parms);
9683 if (window_prompting & XNegative)
9685 if (window_prompting & YNegative)
9686 f->output_data.x->win_gravity = SouthEastGravity;
9687 else
9688 f->output_data.x->win_gravity = NorthEastGravity;
9690 else
9692 if (window_prompting & YNegative)
9693 f->output_data.x->win_gravity = SouthWestGravity;
9694 else
9695 f->output_data.x->win_gravity = NorthWestGravity;
9698 f->output_data.x->size_hint_flags = window_prompting;
9700 XSetWindowAttributes attrs;
9701 unsigned long mask;
9703 BLOCK_INPUT;
9704 mask = CWBackPixel | CWOverrideRedirect | CWSaveUnder | CWEventMask;
9705 /* Window managers look at the override-redirect flag to determine
9706 whether or net to give windows a decoration (Xlib spec, chapter
9707 3.2.8). */
9708 attrs.override_redirect = True;
9709 attrs.save_under = True;
9710 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
9711 /* Arrange for getting MapNotify and UnmapNotify events. */
9712 attrs.event_mask = StructureNotifyMask;
9713 tip_window
9714 = FRAME_X_WINDOW (f)
9715 = XCreateWindow (FRAME_X_DISPLAY (f),
9716 FRAME_X_DISPLAY_INFO (f)->root_window,
9717 /* x, y, width, height */
9718 0, 0, 1, 1,
9719 /* Border. */
9721 CopyFromParent, InputOutput, CopyFromParent,
9722 mask, &attrs);
9723 UNBLOCK_INPUT;
9726 x_make_gc (f);
9728 x_default_parameter (f, parms, Qauto_raise, Qnil,
9729 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
9730 x_default_parameter (f, parms, Qauto_lower, Qnil,
9731 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
9732 x_default_parameter (f, parms, Qcursor_type, Qbox,
9733 "cursorType", "CursorType", RES_TYPE_SYMBOL);
9735 /* Dimensions, especially f->height, must be done via change_frame_size.
9736 Change will not be effected unless different from the current
9737 f->height. */
9738 width = f->width;
9739 height = f->height;
9740 f->height = 0;
9741 SET_FRAME_WIDTH (f, 0);
9742 change_frame_size (f, height, width, 1, 0, 0);
9744 f->no_split = 1;
9746 UNGCPRO;
9748 /* It is now ok to make the frame official even if we get an error
9749 below. And the frame needs to be on Vframe_list or making it
9750 visible won't work. */
9751 Vframe_list = Fcons (frame, Vframe_list);
9753 /* Now that the frame is official, it counts as a reference to
9754 its display. */
9755 FRAME_X_DISPLAY_INFO (f)->reference_count++;
9757 return unbind_to (count, frame);
9761 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 4, 0,
9762 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9763 A tooltip window is a small X window displaying STRING at\n\
9764 the current mouse position.\n\
9765 FRAME nil or omitted means use the selected frame.\n\
9766 PARMS is an optional list of frame parameters which can be\n\
9767 used to change the tooltip's appearance.\n\
9768 Automatically hide the tooltip after TIMEOUT seconds.\n\
9769 TIMEOUT nil means use the default timeout of 5 seconds.")
9770 (string, frame, parms, timeout)
9771 Lisp_Object string, frame, parms, timeout;
9773 struct frame *f;
9774 struct window *w;
9775 Window root, child;
9776 Lisp_Object buffer;
9777 struct buffer *old_buffer;
9778 struct text_pos pos;
9779 int i, width, height;
9780 int root_x, root_y, win_x, win_y;
9781 unsigned pmask;
9782 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9783 int old_windows_or_buffers_changed = windows_or_buffers_changed;
9784 int count = specpdl_ptr - specpdl;
9786 specbind (Qinhibit_redisplay, Qt);
9788 GCPRO4 (string, parms, frame, timeout);
9790 CHECK_STRING (string, 0);
9791 f = check_x_frame (frame);
9792 if (NILP (timeout))
9793 timeout = make_number (5);
9794 else
9795 CHECK_NATNUM (timeout, 2);
9797 /* Hide a previous tip, if any. */
9798 Fx_hide_tip ();
9800 /* Add default values to frame parameters. */
9801 if (NILP (Fassq (Qname, parms)))
9802 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
9803 if (NILP (Fassq (Qinternal_border_width, parms)))
9804 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
9805 if (NILP (Fassq (Qborder_width, parms)))
9806 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
9807 if (NILP (Fassq (Qborder_color, parms)))
9808 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
9809 if (NILP (Fassq (Qbackground_color, parms)))
9810 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
9811 parms);
9813 /* Create a frame for the tooltip, and record it in the global
9814 variable tip_frame. */
9815 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms);
9816 tip_frame = f = XFRAME (frame);
9818 /* Set up the frame's root window. Currently we use a size of 80
9819 columns x 40 lines. If someone wants to show a larger tip, he
9820 will loose. I don't think this is a realistic case. */
9821 w = XWINDOW (FRAME_ROOT_WINDOW (f));
9822 w->left = w->top = make_number (0);
9823 w->width = make_number (80);
9824 w->height = make_number (40);
9825 adjust_glyphs (f);
9826 w->pseudo_window_p = 1;
9828 /* Display the tooltip text in a temporary buffer. */
9829 buffer = Fget_buffer_create (build_string (" *tip*"));
9830 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
9831 old_buffer = current_buffer;
9832 set_buffer_internal_1 (XBUFFER (buffer));
9833 Ferase_buffer ();
9834 Finsert (1, &string);
9835 clear_glyph_matrix (w->desired_matrix);
9836 clear_glyph_matrix (w->current_matrix);
9837 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
9838 try_window (FRAME_ROOT_WINDOW (f), pos);
9840 /* Compute width and height of the tooltip. */
9841 width = height = 0;
9842 for (i = 0; i < w->desired_matrix->nrows; ++i)
9844 struct glyph_row *row = &w->desired_matrix->rows[i];
9845 struct glyph *last;
9846 int row_width;
9848 /* Stop at the first empty row at the end. */
9849 if (!row->enabled_p || !row->displays_text_p)
9850 break;
9852 /* Let the row go over the full width of the frame. */
9853 row->full_width_p = 1;
9855 /* There's a glyph at the end of rows that is used to place
9856 the cursor there. Don't include the width of this glyph. */
9857 if (row->used[TEXT_AREA])
9859 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
9860 row_width = row->pixel_width - last->pixel_width;
9862 else
9863 row_width = row->pixel_width;
9865 height += row->height;
9866 width = max (width, row_width);
9869 /* Add the frame's internal border to the width and height the X
9870 window should have. */
9871 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
9872 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
9874 /* Move the tooltip window where the mouse pointer is. Resize and
9875 show it. */
9876 BLOCK_INPUT;
9877 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
9878 &root, &child, &root_x, &root_y, &win_x, &win_y, &pmask);
9879 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9880 root_x + 5, root_y - height - 5, width, height);
9881 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
9882 UNBLOCK_INPUT;
9884 /* Draw into the window. */
9885 w->must_be_updated_p = 1;
9886 update_single_window (w, 1);
9888 /* Restore original current buffer. */
9889 set_buffer_internal_1 (old_buffer);
9890 windows_or_buffers_changed = old_windows_or_buffers_changed;
9892 /* Let the tip disappear after timeout seconds. */
9893 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
9894 intern ("x-hide-tip"));
9896 UNGCPRO;
9897 return unbind_to (count, Qnil);
9901 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
9902 "Hide the current tooltip window, if there is any.\n\
9903 Value is t is tooltip was open, nil otherwise.")
9906 int count = specpdl_ptr - specpdl;
9907 int deleted_p = 0;
9909 specbind (Qinhibit_redisplay, Qt);
9911 if (!NILP (tip_timer))
9913 call1 (intern ("cancel-timer"), tip_timer);
9914 tip_timer = Qnil;
9917 if (tip_frame)
9919 Lisp_Object frame;
9921 XSETFRAME (frame, tip_frame);
9922 Fdelete_frame (frame, Qt);
9923 tip_frame = NULL;
9924 deleted_p = 1;
9927 return unbind_to (count, deleted_p ? Qt : Qnil);
9932 /***********************************************************************
9933 File selection dialog
9934 ***********************************************************************/
9936 #ifdef USE_MOTIF
9938 /* Callback for "OK" and "Cancel" on file selection dialog. */
9940 static void
9941 file_dialog_cb (widget, client_data, call_data)
9942 Widget widget;
9943 XtPointer call_data, client_data;
9945 int *result = (int *) client_data;
9946 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
9947 *result = cb->reason;
9951 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
9952 "Read file name, prompting with PROMPT in directory DIR.\n\
9953 Use a file selection dialog.\n\
9954 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9955 specified. Don't let the user enter a file name in the file\n\
9956 selection dialog's entry field, if MUSTMATCH is non-nil.")
9957 (prompt, dir, default_filename, mustmatch)
9958 Lisp_Object prompt, dir, default_filename, mustmatch;
9960 int result;
9961 struct frame *f = SELECTED_FRAME ();
9962 Lisp_Object file = Qnil;
9963 Widget dialog, text, list, help;
9964 Arg al[10];
9965 int ac = 0;
9966 extern XtAppContext Xt_app_con;
9967 char *title;
9968 XmString dir_xmstring, pattern_xmstring;
9969 int popup_activated_flag;
9970 int count = specpdl_ptr - specpdl;
9971 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
9973 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
9974 CHECK_STRING (prompt, 0);
9975 CHECK_STRING (dir, 1);
9977 /* Prevent redisplay. */
9978 specbind (Qinhibit_redisplay, Qt);
9980 BLOCK_INPUT;
9982 /* Create the dialog with PROMPT as title, using DIR as initial
9983 directory and using "*" as pattern. */
9984 dir = Fexpand_file_name (dir, Qnil);
9985 dir_xmstring = XmStringCreateLocalized (XSTRING (dir)->data);
9986 pattern_xmstring = XmStringCreateLocalized ("*");
9988 XtSetArg (al[ac], XmNtitle, XSTRING (prompt)->data); ++ac;
9989 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
9990 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
9991 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
9992 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
9993 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
9994 "fsb", al, ac);
9995 XmStringFree (dir_xmstring);
9996 XmStringFree (pattern_xmstring);
9998 /* Add callbacks for OK and Cancel. */
9999 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
10000 (XtPointer) &result);
10001 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
10002 (XtPointer) &result);
10004 /* Disable the help button since we can't display help. */
10005 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
10006 XtSetSensitive (help, False);
10008 /* Mark OK button as default. */
10009 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
10010 XmNshowAsDefault, True, NULL);
10012 /* If MUSTMATCH is non-nil, disable the file entry field of the
10013 dialog, so that the user must select a file from the files list
10014 box. We can't remove it because we wouldn't have a way to get at
10015 the result file name, then. */
10016 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
10017 if (!NILP (mustmatch))
10019 Widget label;
10020 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
10021 XtSetSensitive (text, False);
10022 XtSetSensitive (label, False);
10025 /* Manage the dialog, so that list boxes get filled. */
10026 XtManageChild (dialog);
10028 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10029 must include the path for this to work. */
10030 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
10031 if (STRINGP (default_filename))
10033 XmString default_xmstring;
10034 int item_pos;
10036 default_xmstring
10037 = XmStringCreateLocalized (XSTRING (default_filename)->data);
10039 if (!XmListItemExists (list, default_xmstring))
10041 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10042 XmListAddItem (list, default_xmstring, 0);
10043 item_pos = 0;
10045 else
10046 item_pos = XmListItemPos (list, default_xmstring);
10047 XmStringFree (default_xmstring);
10049 /* Select the item and scroll it into view. */
10050 XmListSelectPos (list, item_pos, True);
10051 XmListSetPos (list, item_pos);
10054 /* Process all events until the user presses Cancel or OK. */
10055 for (result = 0; result == 0;)
10057 XEvent event;
10058 Widget widget, parent;
10060 XtAppNextEvent (Xt_app_con, &event);
10062 /* See if the receiver of the event is one of the widgets of
10063 the file selection dialog. If so, dispatch it. If not,
10064 discard it. */
10065 widget = XtWindowToWidget (event.xany.display, event.xany.window);
10066 parent = widget;
10067 while (parent && parent != dialog)
10068 parent = XtParent (parent);
10070 if (parent == dialog
10071 || (event.type == Expose
10072 && !process_expose_from_menu (event)))
10073 XtDispatchEvent (&event);
10076 /* Get the result. */
10077 if (result == XmCR_OK)
10079 XmString text;
10080 String data;
10082 XtVaGetValues (dialog, XmNtextString, &text, 0);
10083 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
10084 XmStringFree (text);
10085 file = build_string (data);
10086 XtFree (data);
10088 else
10089 file = Qnil;
10091 /* Clean up. */
10092 XtUnmanageChild (dialog);
10093 XtDestroyWidget (dialog);
10094 UNBLOCK_INPUT;
10095 UNGCPRO;
10097 /* Make "Cancel" equivalent to C-g. */
10098 if (NILP (file))
10099 Fsignal (Qquit, Qnil);
10101 return unbind_to (count, file);
10104 #endif /* USE_MOTIF */
10108 /***********************************************************************
10109 Initialization
10110 ***********************************************************************/
10112 void
10113 syms_of_xfns ()
10115 /* This is zero if not using X windows. */
10116 x_in_use = 0;
10118 /* The section below is built by the lisp expression at the top of the file,
10119 just above where these variables are declared. */
10120 /*&&& init symbols here &&&*/
10121 Qauto_raise = intern ("auto-raise");
10122 staticpro (&Qauto_raise);
10123 Qauto_lower = intern ("auto-lower");
10124 staticpro (&Qauto_lower);
10125 Qbar = intern ("bar");
10126 staticpro (&Qbar);
10127 Qborder_color = intern ("border-color");
10128 staticpro (&Qborder_color);
10129 Qborder_width = intern ("border-width");
10130 staticpro (&Qborder_width);
10131 Qbox = intern ("box");
10132 staticpro (&Qbox);
10133 Qcursor_color = intern ("cursor-color");
10134 staticpro (&Qcursor_color);
10135 Qcursor_type = intern ("cursor-type");
10136 staticpro (&Qcursor_type);
10137 Qgeometry = intern ("geometry");
10138 staticpro (&Qgeometry);
10139 Qicon_left = intern ("icon-left");
10140 staticpro (&Qicon_left);
10141 Qicon_top = intern ("icon-top");
10142 staticpro (&Qicon_top);
10143 Qicon_type = intern ("icon-type");
10144 staticpro (&Qicon_type);
10145 Qicon_name = intern ("icon-name");
10146 staticpro (&Qicon_name);
10147 Qinternal_border_width = intern ("internal-border-width");
10148 staticpro (&Qinternal_border_width);
10149 Qleft = intern ("left");
10150 staticpro (&Qleft);
10151 Qright = intern ("right");
10152 staticpro (&Qright);
10153 Qmouse_color = intern ("mouse-color");
10154 staticpro (&Qmouse_color);
10155 Qnone = intern ("none");
10156 staticpro (&Qnone);
10157 Qparent_id = intern ("parent-id");
10158 staticpro (&Qparent_id);
10159 Qscroll_bar_width = intern ("scroll-bar-width");
10160 staticpro (&Qscroll_bar_width);
10161 Qsuppress_icon = intern ("suppress-icon");
10162 staticpro (&Qsuppress_icon);
10163 Qundefined_color = intern ("undefined-color");
10164 staticpro (&Qundefined_color);
10165 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
10166 staticpro (&Qvertical_scroll_bars);
10167 Qvisibility = intern ("visibility");
10168 staticpro (&Qvisibility);
10169 Qwindow_id = intern ("window-id");
10170 staticpro (&Qwindow_id);
10171 Qouter_window_id = intern ("outer-window-id");
10172 staticpro (&Qouter_window_id);
10173 Qx_frame_parameter = intern ("x-frame-parameter");
10174 staticpro (&Qx_frame_parameter);
10175 Qx_resource_name = intern ("x-resource-name");
10176 staticpro (&Qx_resource_name);
10177 Quser_position = intern ("user-position");
10178 staticpro (&Quser_position);
10179 Quser_size = intern ("user-size");
10180 staticpro (&Quser_size);
10181 Qscroll_bar_foreground = intern ("scroll-bar-foreground");
10182 staticpro (&Qscroll_bar_foreground);
10183 Qscroll_bar_background = intern ("scroll-bar-background");
10184 staticpro (&Qscroll_bar_background);
10185 Qscreen_gamma = intern ("screen-gamma");
10186 staticpro (&Qscreen_gamma);
10187 Qline_spacing = intern ("line-spacing");
10188 staticpro (&Qline_spacing);
10189 Qcenter = intern ("center");
10190 staticpro (&Qcenter);
10191 /* This is the end of symbol initialization. */
10193 /* Text property `display' should be nonsticky by default. */
10194 Vtext_property_default_nonsticky
10195 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
10198 Qlaplace = intern ("laplace");
10199 staticpro (&Qlaplace);
10201 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
10202 staticpro (&Qface_set_after_frame_default);
10204 Fput (Qundefined_color, Qerror_conditions,
10205 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
10206 Fput (Qundefined_color, Qerror_message,
10207 build_string ("Undefined color"));
10209 init_x_parm_symbols ();
10211 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
10212 "List of directories to search for bitmap files for X.");
10213 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
10215 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
10216 "The shape of the pointer when over text.\n\
10217 Changing the value does not affect existing frames\n\
10218 unless you set the mouse color.");
10219 Vx_pointer_shape = Qnil;
10221 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
10222 "The name Emacs uses to look up X resources.\n\
10223 `x-get-resource' uses this as the first component of the instance name\n\
10224 when requesting resource values.\n\
10225 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10226 was invoked, or to the value specified with the `-name' or `-rn'\n\
10227 switches, if present.\n\
10229 It may be useful to bind this variable locally around a call\n\
10230 to `x-get-resource'. See also the variable `x-resource-class'.");
10231 Vx_resource_name = Qnil;
10233 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
10234 "The class Emacs uses to look up X resources.\n\
10235 `x-get-resource' uses this as the first component of the instance class\n\
10236 when requesting resource values.\n\
10237 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10239 Setting this variable permanently is not a reasonable thing to do,\n\
10240 but binding this variable locally around a call to `x-get-resource'\n\
10241 is a reasonable practice. See also the variable `x-resource-name'.");
10242 Vx_resource_class = build_string (EMACS_CLASS);
10244 #if 0 /* This doesn't really do anything. */
10245 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
10246 "The shape of the pointer when not over text.\n\
10247 This variable takes effect when you create a new frame\n\
10248 or when you set the mouse color.");
10249 #endif
10250 Vx_nontext_pointer_shape = Qnil;
10252 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape,
10253 "The shape of the pointer when Emacs is busy.\n\
10254 This variable takes effect when you create a new frame\n\
10255 or when you set the mouse color.");
10256 Vx_busy_pointer_shape = Qnil;
10258 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p,
10259 "Non-zero means Emacs displays a busy cursor on window systems.");
10260 display_busy_cursor_p = 1;
10262 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay,
10263 "*Seconds to wait before displaying a busy-cursor.\n\
10264 Value must be an integer or float.");
10265 Vbusy_cursor_delay = make_number (DEFAULT_BUSY_CURSOR_DELAY);
10267 #if 0 /* This doesn't really do anything. */
10268 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
10269 "The shape of the pointer when over the mode line.\n\
10270 This variable takes effect when you create a new frame\n\
10271 or when you set the mouse color.");
10272 #endif
10273 Vx_mode_pointer_shape = Qnil;
10275 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10276 &Vx_sensitive_text_pointer_shape,
10277 "The shape of the pointer when over mouse-sensitive text.\n\
10278 This variable takes effect when you create a new frame\n\
10279 or when you set the mouse color.");
10280 Vx_sensitive_text_pointer_shape = Qnil;
10282 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
10283 "A string indicating the foreground color of the cursor box.");
10284 Vx_cursor_fore_pixel = Qnil;
10286 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
10287 "Non-nil if no X window manager is in use.\n\
10288 Emacs doesn't try to figure this out; this is always nil\n\
10289 unless you set it to something else.");
10290 /* We don't have any way to find this out, so set it to nil
10291 and maybe the user would like to set it to t. */
10292 Vx_no_window_manager = Qnil;
10294 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10295 &Vx_pixel_size_width_font_regexp,
10296 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10298 Since Emacs gets width of a font matching with this regexp from\n\
10299 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10300 such a font. This is especially effective for such large fonts as\n\
10301 Chinese, Japanese, and Korean.");
10302 Vx_pixel_size_width_font_regexp = Qnil;
10304 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
10305 "Time after which cached images are removed from the cache.\n\
10306 When an image has not been displayed this many seconds, remove it\n\
10307 from the image cache. Value must be an integer or nil with nil\n\
10308 meaning don't clear the cache.");
10309 Vimage_cache_eviction_delay = make_number (30 * 60);
10311 #ifdef USE_X_TOOLKIT
10312 Fprovide (intern ("x-toolkit"));
10313 #endif
10314 #ifdef USE_MOTIF
10315 Fprovide (intern ("motif"));
10316 #endif
10318 defsubr (&Sx_get_resource);
10320 /* X window properties. */
10321 defsubr (&Sx_change_window_property);
10322 defsubr (&Sx_delete_window_property);
10323 defsubr (&Sx_window_property);
10325 defsubr (&Sxw_display_color_p);
10326 defsubr (&Sx_display_grayscale_p);
10327 defsubr (&Sxw_color_defined_p);
10328 defsubr (&Sxw_color_values);
10329 defsubr (&Sx_server_max_request_size);
10330 defsubr (&Sx_server_vendor);
10331 defsubr (&Sx_server_version);
10332 defsubr (&Sx_display_pixel_width);
10333 defsubr (&Sx_display_pixel_height);
10334 defsubr (&Sx_display_mm_width);
10335 defsubr (&Sx_display_mm_height);
10336 defsubr (&Sx_display_screens);
10337 defsubr (&Sx_display_planes);
10338 defsubr (&Sx_display_color_cells);
10339 defsubr (&Sx_display_visual_class);
10340 defsubr (&Sx_display_backing_store);
10341 defsubr (&Sx_display_save_under);
10342 defsubr (&Sx_parse_geometry);
10343 defsubr (&Sx_create_frame);
10344 defsubr (&Sx_open_connection);
10345 defsubr (&Sx_close_connection);
10346 defsubr (&Sx_display_list);
10347 defsubr (&Sx_synchronize);
10348 defsubr (&Sx_focus_frame);
10350 /* Setting callback functions for fontset handler. */
10351 get_font_info_func = x_get_font_info;
10353 #if 0 /* This function pointer doesn't seem to be used anywhere.
10354 And the pointer assigned has the wrong type, anyway. */
10355 list_fonts_func = x_list_fonts;
10356 #endif
10358 load_font_func = x_load_font;
10359 find_ccl_program_func = x_find_ccl_program;
10360 query_font_func = x_query_font;
10361 set_frame_fontset_func = x_set_font;
10362 check_window_system_func = check_x;
10364 /* Images. */
10365 Qxbm = intern ("xbm");
10366 staticpro (&Qxbm);
10367 QCtype = intern (":type");
10368 staticpro (&QCtype);
10369 QCalgorithm = intern (":algorithm");
10370 staticpro (&QCalgorithm);
10371 QCheuristic_mask = intern (":heuristic-mask");
10372 staticpro (&QCheuristic_mask);
10373 QCcolor_symbols = intern (":color-symbols");
10374 staticpro (&QCcolor_symbols);
10375 QCascent = intern (":ascent");
10376 staticpro (&QCascent);
10377 QCmargin = intern (":margin");
10378 staticpro (&QCmargin);
10379 QCrelief = intern (":relief");
10380 staticpro (&QCrelief);
10381 Qpostscript = intern ("postscript");
10382 staticpro (&Qpostscript);
10383 QCloader = intern (":loader");
10384 staticpro (&QCloader);
10385 QCbounding_box = intern (":bounding-box");
10386 staticpro (&QCbounding_box);
10387 QCpt_width = intern (":pt-width");
10388 staticpro (&QCpt_width);
10389 QCpt_height = intern (":pt-height");
10390 staticpro (&QCpt_height);
10391 QCindex = intern (":index");
10392 staticpro (&QCindex);
10393 Qpbm = intern ("pbm");
10394 staticpro (&Qpbm);
10396 #if HAVE_XPM
10397 Qxpm = intern ("xpm");
10398 staticpro (&Qxpm);
10399 #endif
10401 #if HAVE_JPEG
10402 Qjpeg = intern ("jpeg");
10403 staticpro (&Qjpeg);
10404 #endif
10406 #if HAVE_TIFF
10407 Qtiff = intern ("tiff");
10408 staticpro (&Qtiff);
10409 #endif
10411 #if HAVE_GIF
10412 Qgif = intern ("gif");
10413 staticpro (&Qgif);
10414 #endif
10416 #if HAVE_PNG
10417 Qpng = intern ("png");
10418 staticpro (&Qpng);
10419 #endif
10421 defsubr (&Sclear_image_cache);
10423 busy_cursor_atimer = NULL;
10424 busy_cursor_shown_p = 0;
10426 defsubr (&Sx_show_tip);
10427 defsubr (&Sx_hide_tip);
10428 staticpro (&tip_timer);
10429 tip_timer = Qnil;
10431 #ifdef USE_MOTIF
10432 defsubr (&Sx_file_dialog);
10433 #endif
10437 void
10438 init_xfns ()
10440 image_types = NULL;
10441 Vimage_types = Qnil;
10443 define_image_type (&xbm_type);
10444 define_image_type (&gs_type);
10445 define_image_type (&pbm_type);
10447 #if HAVE_XPM
10448 define_image_type (&xpm_type);
10449 #endif
10451 #if HAVE_JPEG
10452 define_image_type (&jpeg_type);
10453 #endif
10455 #if HAVE_TIFF
10456 define_image_type (&tiff_type);
10457 #endif
10459 #if HAVE_GIF
10460 define_image_type (&gif_type);
10461 #endif
10463 #if HAVE_PNG
10464 define_image_type (&png_type);
10465 #endif
10468 #endif /* HAVE_X_WINDOWS */